diff options
| author | Stefan Monnier | 2007-07-25 19:37:21 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2007-07-25 19:37:21 +0000 |
| commit | b7de6024f602f75a8c49ae36645845de07d00672 (patch) | |
| tree | 1b991452a68401f24d1ec364d71d35edc49fec0c | |
| parent | 40ed3f4f565af3b4aa375dc3a654fe7506690d40 (diff) | |
| download | emacs-b7de6024f602f75a8c49ae36645845de07d00672.tar.gz emacs-b7de6024f602f75a8c49ae36645845de07d00672.zip | |
Use mapc and dolist instead of mapcar where possible.
(close-display-connection): New command.
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/frame.el | 136 |
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 @@ | |||
| 1 | 2007-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 | |||
| 1 | 2007-07-25 Alexandre Julliard <julliard@winehq.org> | 6 | 2007-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. | ||
| 574 | For DISPLAY, specify either a frame or a display name (a string). | ||
| 575 | If 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 |