# HG changeset patch # User Stefan Monnier # Date 1185392241 0 # Node ID 63aefab8fbc3c8b90fc5be69420cc3486a44a5bd # Parent b9d2156e3f5d7fa766d08fafeb841af00abf831f Use mapc and dolist instead of mapcar where possible. (close-display-connection): New command. diff -r b9d2156e3f5d -r 63aefab8fbc3 lisp/ChangeLog --- a/lisp/ChangeLog Wed Jul 25 15:08:09 2007 +0000 +++ b/lisp/ChangeLog Wed Jul 25 19:37:21 2007 +0000 @@ -1,3 +1,8 @@ +2007-07-25 Stefan Monnier + + * frame.el: Use mapc and dolist instead of mapcar where possible. + (close-display-connection): New command. + 2007-07-25 Alexandre Julliard * vc-git.el (vc-git-log-view-mode): Port to the multi-file vc interface. diff -r b9d2156e3f5d -r 63aefab8fbc3 lisp/frame.el --- a/lisp/frame.el Wed Jul 25 15:08:09 2007 +0000 +++ b/lisp/frame.el Wed Jul 25 19:37:21 2007 +0000 @@ -226,10 +226,9 @@ (setq frame-creation-function (if (fboundp 'tty-create-frame-with-faces) 'tty-create-frame-with-faces - (function - (lambda (parameters) - (error - "Can't create multiple frames without a window system")))))))) + (lambda (parameters) + (error + "Can't create multiple frames without a window system"))))))) (defvar frame-notice-user-settings t "Non-nil means function `frame-notice-user-settings' wasn't run yet.") @@ -424,12 +423,12 @@ ;; variable must be handled similarly. (let ((users-of-initial (filtered-frame-list - (function (lambda (frame) - (and (not (eq frame frame-initial-frame)) - (eq (window-frame - (minibuffer-window frame)) - frame-initial-frame))))))) - (if (or users-of-initial + (lambda (frame) + (and (not (eq frame frame-initial-frame)) + (eq (window-frame + (minibuffer-window frame)) + frame-initial-frame)))))) + (if (or users-of-initial (eq default-minibuffer-frame frame-initial-frame)) ;; Choose an appropriate frame. Prefer frames which @@ -437,11 +436,10 @@ (let* ((new-surrogate (car (or (filtered-frame-list - (function - (lambda (frame) - (eq (cdr (assq 'minibuffer - (frame-parameters frame))) - 'only)))) + (lambda (frame) + (eq (cdr (assq 'minibuffer + (frame-parameters frame))) + 'only))) (minibuffer-frame-list)))) (new-minibuffer (minibuffer-window new-surrogate))) @@ -450,14 +448,11 @@ ;; Wean the frames using frame-initial-frame as ;; their minibuffer frame. - (mapcar - (function - (lambda (frame) - (modify-frame-parameters - frame (list (cons 'minibuffer new-minibuffer))))) - users-of-initial)))) + (dolist (frame users-of-initial) + (modify-frame-parameters + frame (list (cons 'minibuffer new-minibuffer))))))) - ;; Redirect events enqueued at this frame to the new frame. + ;; Redirect events enqueued at this frame to the new frame. ;; Is this a good idea? (redirect-frame-focus frame-initial-frame new) @@ -574,6 +569,36 @@ (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN")) (make-frame (cons (cons 'display display) parameters))) +(defun close-display-connection (display) + "Close the connection to a display, deleting all its associated frames. +For DISPLAY, specify either a frame or a display name (a string). +If DISPLAY is nil, that stands for the selected frame's display." + (interactive + (list + (let* ((default (frame-parameter nil 'display)) + (display (completing-read + (format "Close display (default %s): " default) + (delete-dups + (mapcar (lambda (frame) + (frame-parameter frame 'display)) + (frame-list))) + nil t nil nil + default))) + (if (zerop (length display)) default display)))) + (let ((frames (delq nil + (mapcar (lambda (frame) + (if (equal display + (frame-parameter frame 'display)) + frame)) + (frame-list))))) + (if (and (consp frames) + (not (y-or-n-p (if (cdr frames) + (format "Delete %s frames? " (length frames)) + (format "Delete %s ? " (car frames)))))) + (error "Abort!") + (mapc 'delete-frame frames) + (x-close-connection display)))) + (defun make-frame-command () "Make a new frame, and select it if the terminal displays only one frame." (interactive) @@ -639,8 +664,8 @@ (defun minibuffer-frame-list () "Return a list of all frames with their own minibuffers." (filtered-frame-list - (function (lambda (frame) - (eq frame (window-frame (minibuffer-window frame))))))) + (lambda (frame) + (eq frame (window-frame (minibuffer-window frame)))))) (defun frames-on-display-list (&optional display) "Return a list of all frames on DISPLAY. @@ -787,11 +812,10 @@ ALIST is an association list specifying some of FRAME's parameters, and WINDOW-CONFIG is a window configuration object for FRAME." (cons 'frame-configuration - (mapcar (function - (lambda (frame) - (list frame - (frame-parameters frame) - (current-window-configuration frame)))) + (mapcar (lambda (frame) + (list frame + (frame-parameters frame) + (current-window-configuration frame))) (frame-list)))) (defun set-frame-configuration (configuration &optional nodelete) @@ -808,29 +832,28 @@ (list 'frame-configuration-p configuration))) (let ((config-alist (cdr configuration)) frames-to-delete) - (mapcar (function - (lambda (frame) - (let ((parameters (assq frame config-alist))) - (if parameters - (progn - (modify-frame-parameters - frame - ;; Since we can't set a frame's minibuffer status, - ;; we might as well omit the parameter altogether. - (let* ((parms (nth 1 parameters)) - (mini (assq 'minibuffer parms))) - (if mini (setq parms (delq mini parms))) - parms)) - (set-window-configuration (nth 2 parameters))) - (setq frames-to-delete (cons frame frames-to-delete)))))) - (frame-list)) - (if nodelete - ;; Note: making frames invisible here was tried - ;; but led to some strange behavior--each time the frame - ;; was made visible again, the window manager asked afresh - ;; for where to put it. - (mapcar 'iconify-frame frames-to-delete) - (mapcar 'delete-frame frames-to-delete)))) + (dolist (frame (frame-list)) + (let ((parameters (assq frame config-alist))) + (if parameters + (progn + (modify-frame-parameters + frame + ;; Since we can't set a frame's minibuffer status, + ;; we might as well omit the parameter altogether. + (let* ((parms (nth 1 parameters)) + (mini (assq 'minibuffer parms))) + (if mini (setq parms (delq mini parms))) + parms)) + (set-window-configuration (nth 2 parameters))) + (setq frames-to-delete (cons frame frames-to-delete))))) + (mapc (if nodelete + ;; Note: making frames invisible here was tried + ;; but led to some strange behavior--each time the frame + ;; was made visible again, the window manager asked afresh + ;; for where to put it. + 'iconify-frame + 'delete-frame) + frames-to-delete))) ;;;; Convenience functions for accessing and interactively changing ;;;; frame parameters. @@ -858,12 +881,11 @@ (interactive (let* ((completion-ignore-case t) (font (completing-read "Font name: " - (mapcar #'list ;; x-list-fonts will fail with an error ;; if this frame doesn't support fonts. - (x-list-fonts "*" nil (selected-frame))) - nil nil nil nil - (frame-parameter nil 'font)))) + (x-list-fonts "*" nil (selected-frame)) + nil nil nil nil + (frame-parameter nil 'font)))) (list font current-prefix-arg))) (let (fht fwd) (if keep-size