aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2007-07-25 19:37:21 +0000
committerStefan Monnier2007-07-25 19:37:21 +0000
commitb7de6024f602f75a8c49ae36645845de07d00672 (patch)
tree1b991452a68401f24d1ec364d71d35edc49fec0c
parent40ed3f4f565af3b4aa375dc3a654fe7506690d40 (diff)
downloademacs-b7de6024f602f75a8c49ae36645845de07d00672.tar.gz
emacs-b7de6024f602f75a8c49ae36645845de07d00672.zip
Use mapc and dolist instead of mapcar where possible.
(close-display-connection): New command.
-rw-r--r--lisp/ChangeLog5
-rw-r--r--lisp/frame.el136
2 files changed, 84 insertions, 57 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index eaabf87af3e..20996aa2244 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
12007-07-25 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * frame.el: Use mapc and dolist instead of mapcar where possible.
4 (close-display-connection): New command.
5
12007-07-25 Alexandre Julliard <julliard@winehq.org> 62007-07-25 Alexandre Julliard <julliard@winehq.org>
2 7
3 * vc-git.el (vc-git-log-view-mode): Port to the multi-file vc interface. 8 * vc-git.el (vc-git-log-view-mode): Port to the multi-file vc interface.
diff --git a/lisp/frame.el b/lisp/frame.el
index 4ff87efc4e1..5026aa446a2 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -226,10 +226,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
226 (setq frame-creation-function 226 (setq frame-creation-function
227 (if (fboundp 'tty-create-frame-with-faces) 227 (if (fboundp 'tty-create-frame-with-faces)
228 'tty-create-frame-with-faces 228 'tty-create-frame-with-faces
229 (function 229 (lambda (parameters)
230 (lambda (parameters) 230 (error
231 (error 231 "Can't create multiple frames without a window system")))))))
232 "Can't create multiple frames without a window system"))))))))
233 232
234(defvar frame-notice-user-settings t 233(defvar frame-notice-user-settings t
235 "Non-nil means function `frame-notice-user-settings' wasn't run yet.") 234 "Non-nil means function `frame-notice-user-settings' wasn't run yet.")
@@ -424,12 +423,12 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
424 ;; variable must be handled similarly. 423 ;; variable must be handled similarly.
425 (let ((users-of-initial 424 (let ((users-of-initial
426 (filtered-frame-list 425 (filtered-frame-list
427 (function (lambda (frame) 426 (lambda (frame)
428 (and (not (eq frame frame-initial-frame)) 427 (and (not (eq frame frame-initial-frame))
429 (eq (window-frame 428 (eq (window-frame
430 (minibuffer-window frame)) 429 (minibuffer-window frame))
431 frame-initial-frame))))))) 430 frame-initial-frame))))))
432 (if (or users-of-initial 431 (if (or users-of-initial
433 (eq default-minibuffer-frame frame-initial-frame)) 432 (eq default-minibuffer-frame frame-initial-frame))
434 433
435 ;; Choose an appropriate frame. Prefer frames which 434 ;; Choose an appropriate frame. Prefer frames which
@@ -437,11 +436,10 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
437 (let* ((new-surrogate 436 (let* ((new-surrogate
438 (car 437 (car
439 (or (filtered-frame-list 438 (or (filtered-frame-list
440 (function 439 (lambda (frame)
441 (lambda (frame) 440 (eq (cdr (assq 'minibuffer
442 (eq (cdr (assq 'minibuffer 441 (frame-parameters frame)))
443 (frame-parameters frame))) 442 'only)))
444 'only))))
445 (minibuffer-frame-list)))) 443 (minibuffer-frame-list))))
446 (new-minibuffer (minibuffer-window new-surrogate))) 444 (new-minibuffer (minibuffer-window new-surrogate)))
447 445
@@ -450,14 +448,11 @@ React to settings of `default-frame-alist', `initial-frame-alist' there."
450 448
451 ;; Wean the frames using frame-initial-frame as 449 ;; Wean the frames using frame-initial-frame as
452 ;; their minibuffer frame. 450 ;; their minibuffer frame.
453 (mapcar 451 (dolist (frame users-of-initial)
454 (function 452 (modify-frame-parameters
455 (lambda (frame) 453 frame (list (cons 'minibuffer new-minibuffer)))))))
456 (modify-frame-parameters 454
457 frame (list (cons 'minibuffer new-minibuffer))))) 455 ;; Redirect events enqueued at this frame to the new frame.
458 users-of-initial))))
459
460 ;; Redirect events enqueued at this frame to the new frame.
461 ;; Is this a good idea? 456 ;; Is this a good idea?
462 (redirect-frame-focus frame-initial-frame new) 457 (redirect-frame-focus frame-initial-frame new)
463 458
@@ -574,6 +569,36 @@ The optional second argument PARAMETERS specifies additional frame parameters."
574 (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN")) 569 (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
575 (make-frame (cons (cons 'display display) parameters))) 570 (make-frame (cons (cons 'display display) parameters)))
576 571
572(defun close-display-connection (display)
573 "Close the connection to a display, deleting all its associated frames.
574For DISPLAY, specify either a frame or a display name (a string).
575If DISPLAY is nil, that stands for the selected frame's display."
576 (interactive
577 (list
578 (let* ((default (frame-parameter nil 'display))
579 (display (completing-read
580 (format "Close display (default %s): " default)
581 (delete-dups
582 (mapcar (lambda (frame)
583 (frame-parameter frame 'display))
584 (frame-list)))
585 nil t nil nil
586 default)))
587 (if (zerop (length display)) default display))))
588 (let ((frames (delq nil
589 (mapcar (lambda (frame)
590 (if (equal display
591 (frame-parameter frame 'display))
592 frame))
593 (frame-list)))))
594 (if (and (consp frames)
595 (not (y-or-n-p (if (cdr frames)
596 (format "Delete %s frames? " (length frames))
597 (format "Delete %s ? " (car frames))))))
598 (error "Abort!")
599 (mapc 'delete-frame frames)
600 (x-close-connection display))))
601
577(defun make-frame-command () 602(defun make-frame-command ()
578 "Make a new frame, and select it if the terminal displays only one frame." 603 "Make a new frame, and select it if the terminal displays only one frame."
579 (interactive) 604 (interactive)
@@ -639,8 +664,8 @@ setup is for focus to follow the pointer."
639(defun minibuffer-frame-list () 664(defun minibuffer-frame-list ()
640 "Return a list of all frames with their own minibuffers." 665 "Return a list of all frames with their own minibuffers."
641 (filtered-frame-list 666 (filtered-frame-list
642 (function (lambda (frame) 667 (lambda (frame)
643 (eq frame (window-frame (minibuffer-window frame))))))) 668 (eq frame (window-frame (minibuffer-window frame))))))
644 669
645(defun frames-on-display-list (&optional display) 670(defun frames-on-display-list (&optional display)
646 "Return a list of all frames on DISPLAY. 671 "Return a list of all frames on DISPLAY.
@@ -787,11 +812,10 @@ where
787 ALIST is an association list specifying some of FRAME's parameters, and 812 ALIST is an association list specifying some of FRAME's parameters, and
788 WINDOW-CONFIG is a window configuration object for FRAME." 813 WINDOW-CONFIG is a window configuration object for FRAME."
789 (cons 'frame-configuration 814 (cons 'frame-configuration
790 (mapcar (function 815 (mapcar (lambda (frame)
791 (lambda (frame) 816 (list frame
792 (list frame 817 (frame-parameters frame)
793 (frame-parameters frame) 818 (current-window-configuration frame)))
794 (current-window-configuration frame))))
795 (frame-list)))) 819 (frame-list))))
796 820
797(defun set-frame-configuration (configuration &optional nodelete) 821(defun set-frame-configuration (configuration &optional nodelete)
@@ -808,29 +832,28 @@ is given and non-nil, the unwanted frames are iconified instead."
808 (list 'frame-configuration-p configuration))) 832 (list 'frame-configuration-p configuration)))
809 (let ((config-alist (cdr configuration)) 833 (let ((config-alist (cdr configuration))
810 frames-to-delete) 834 frames-to-delete)
811 (mapcar (function 835 (dolist (frame (frame-list))
812 (lambda (frame) 836 (let ((parameters (assq frame config-alist)))
813 (let ((parameters (assq frame config-alist))) 837 (if parameters
814 (if parameters 838 (progn
815 (progn 839 (modify-frame-parameters
816 (modify-frame-parameters 840 frame
817 frame 841 ;; Since we can't set a frame's minibuffer status,
818 ;; Since we can't set a frame's minibuffer status, 842 ;; we might as well omit the parameter altogether.
819 ;; we might as well omit the parameter altogether. 843 (let* ((parms (nth 1 parameters))
820 (let* ((parms (nth 1 parameters)) 844 (mini (assq 'minibuffer parms)))
821 (mini (assq 'minibuffer parms))) 845 (if mini (setq parms (delq mini parms)))
822 (if mini (setq parms (delq mini parms))) 846 parms))
823 parms)) 847 (set-window-configuration (nth 2 parameters)))
824 (set-window-configuration (nth 2 parameters))) 848 (setq frames-to-delete (cons frame frames-to-delete)))))
825 (setq frames-to-delete (cons frame frames-to-delete)))))) 849 (mapc (if nodelete
826 (frame-list)) 850 ;; Note: making frames invisible here was tried
827 (if nodelete 851 ;; but led to some strange behavior--each time the frame
828 ;; Note: making frames invisible here was tried 852 ;; was made visible again, the window manager asked afresh
829 ;; but led to some strange behavior--each time the frame 853 ;; for where to put it.
830 ;; was made visible again, the window manager asked afresh 854 'iconify-frame
831 ;; for where to put it. 855 'delete-frame)
832 (mapcar 'iconify-frame frames-to-delete) 856 frames-to-delete)))
833 (mapcar 'delete-frame frames-to-delete))))
834 857
835;;;; Convenience functions for accessing and interactively changing 858;;;; Convenience functions for accessing and interactively changing
836;;;; frame parameters. 859;;;; frame parameters.
@@ -858,12 +881,11 @@ pixels) is kept by adjusting the numbers of the lines and columns."
858 (interactive 881 (interactive
859 (let* ((completion-ignore-case t) 882 (let* ((completion-ignore-case t)
860 (font (completing-read "Font name: " 883 (font (completing-read "Font name: "
861 (mapcar #'list
862 ;; x-list-fonts will fail with an error 884 ;; x-list-fonts will fail with an error
863 ;; if this frame doesn't support fonts. 885 ;; if this frame doesn't support fonts.
864 (x-list-fonts "*" nil (selected-frame))) 886 (x-list-fonts "*" nil (selected-frame))
865 nil nil nil nil 887 nil nil nil nil
866 (frame-parameter nil 'font)))) 888 (frame-parameter nil 'font))))
867 (list font current-prefix-arg))) 889 (list font current-prefix-arg)))
868 (let (fht fwd) 890 (let (fht fwd)
869 (if keep-size 891 (if keep-size