Mercurial > emacs
comparison lisp/frame.el @ 83648:65663fcd2caa
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 824-838)
- Update from CVS
- Merge from emacs--rel--22
- Remove lisp/erc/erc-nicklist.el
- Update some .arch-inventory files
- Fix void function definition error in cus-edit.el
- Restore lisp/emacs-lisp/cl-loaddefs.el
* emacs--rel--22 (patch 70-83)
- Update from CVS
- Remove lisp/erc/erc-nicklist.el
- Update some .arch-inventory files
- Indicate that emacs--devo--0--patch-834 does not need to be applied
- Merge from gnus--rel--5.10
- Restore lisp/emacs-lisp/cl-loaddefs.el
* gnus--rel--5.10 (patch 239-241)
- Merge from emacs--devo--0
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-28
author | Miles Bader <miles@gnu.org> |
---|---|
date | Tue, 31 Jul 2007 05:50:45 +0000 |
parents | 2aee92eacdab b98604865ea0 |
children | 5b644ae74c91 |
comparison
equal
deleted
inserted
replaced
83647:3468e549a55b | 83648:65663fcd2caa |
---|---|
8 | 8 |
9 ;; This file is part of GNU Emacs. | 9 ;; This file is part of GNU Emacs. |
10 | 10 |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | 11 ;; GNU Emacs is free software; you can redistribute it and/or modify |
12 ;; it under the terms of the GNU General Public License as published by | 12 ;; it under the terms of the GNU General Public License as published by |
13 ;; the Free Software Foundation; either version 2, or (at your option) | 13 ;; the Free Software Foundation; either version 3, or (at your option) |
14 ;; any later version. | 14 ;; any later version. |
15 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | 16 ;; GNU Emacs is distributed in the hope that it will be useful, |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
457 ;; minibuffer frame for any frames, we need to wean them | 457 ;; minibuffer frame for any frames, we need to wean them |
458 ;; onto a new frame. The default-minibuffer-frame | 458 ;; onto a new frame. The default-minibuffer-frame |
459 ;; variable must be handled similarly. | 459 ;; variable must be handled similarly. |
460 (let ((users-of-initial | 460 (let ((users-of-initial |
461 (filtered-frame-list | 461 (filtered-frame-list |
462 (function (lambda (frame) | 462 (lambda (frame) |
463 (and (not (eq frame frame-initial-frame)) | 463 (and (not (eq frame frame-initial-frame)) |
464 (eq (window-frame | 464 (eq (window-frame |
465 (minibuffer-window frame)) | 465 (minibuffer-window frame)) |
466 frame-initial-frame))))))) | 466 frame-initial-frame)))))) |
467 (if (or users-of-initial | 467 (if (or users-of-initial |
468 (eq default-minibuffer-frame frame-initial-frame)) | 468 (eq default-minibuffer-frame frame-initial-frame)) |
469 | 469 |
470 ;; Choose an appropriate frame. Prefer frames which | 470 ;; Choose an appropriate frame. Prefer frames which |
471 ;; are only minibuffers. | 471 ;; are only minibuffers. |
472 (let* ((new-surrogate | 472 (let* ((new-surrogate |
473 (car | 473 (car |
474 (or (filtered-frame-list | 474 (or (filtered-frame-list |
475 (function | 475 (lambda (frame) |
476 (lambda (frame) | 476 (eq (cdr (assq 'minibuffer |
477 (eq (cdr (assq 'minibuffer | 477 (frame-parameters frame))) |
478 (frame-parameters frame))) | 478 'only))) |
479 'only)))) | |
480 (minibuffer-frame-list)))) | 479 (minibuffer-frame-list)))) |
481 (new-minibuffer (minibuffer-window new-surrogate))) | 480 (new-minibuffer (minibuffer-window new-surrogate))) |
482 | 481 |
483 (if (eq default-minibuffer-frame frame-initial-frame) | 482 (if (eq default-minibuffer-frame frame-initial-frame) |
484 (setq default-minibuffer-frame new-surrogate)) | 483 (setq default-minibuffer-frame new-surrogate)) |
485 | 484 |
486 ;; Wean the frames using frame-initial-frame as | 485 ;; Wean the frames using frame-initial-frame as |
487 ;; their minibuffer frame. | 486 ;; their minibuffer frame. |
488 (mapcar | 487 (dolist (frame users-of-initial) |
489 (function | 488 (modify-frame-parameters |
490 (lambda (frame) | 489 frame (list (cons 'minibuffer new-minibuffer))))))) |
491 (modify-frame-parameters | 490 |
492 frame (list (cons 'minibuffer new-minibuffer))))) | 491 ;; Redirect events enqueued at this frame to the new frame. |
493 users-of-initial)))) | |
494 | |
495 ;; Redirect events enqueued at this frame to the new frame. | |
496 ;; Is this a good idea? | 492 ;; Is this a good idea? |
497 (redirect-frame-focus frame-initial-frame new) | 493 (redirect-frame-focus frame-initial-frame new) |
498 | 494 |
499 ;; Finally, get rid of the old frame. | 495 ;; Finally, get rid of the old frame. |
500 (delete-frame frame-initial-frame t)) | 496 (delete-frame frame-initial-frame t)) |
630 (error "Invalid terminal device")) | 626 (error "Invalid terminal device")) |
631 (unless type | 627 (unless type |
632 (error "Invalid terminal type")) | 628 (error "Invalid terminal type")) |
633 (make-frame `((window-system . nil) (tty . ,tty) (tty-type . ,type) . ,parameters))) | 629 (make-frame `((window-system . nil) (tty . ,tty) (tty-type . ,type) . ,parameters))) |
634 | 630 |
631 (defun close-display-connection (display) | |
632 "Close the connection to a display, deleting all its associated frames. | |
633 For DISPLAY, specify either a frame or a display name (a string). | |
634 If DISPLAY is nil, that stands for the selected frame's display." | |
635 (interactive | |
636 (list | |
637 (let* ((default (frame-parameter nil 'display)) | |
638 (display (completing-read | |
639 (format "Close display (default %s): " default) | |
640 (delete-dups | |
641 (mapcar (lambda (frame) | |
642 (frame-parameter frame 'display)) | |
643 (frame-list))) | |
644 nil t nil nil | |
645 default))) | |
646 (if (zerop (length display)) default display)))) | |
647 (let ((frames (delq nil | |
648 (mapcar (lambda (frame) | |
649 (if (equal display | |
650 (frame-parameter frame 'display)) | |
651 frame)) | |
652 (frame-list))))) | |
653 (if (and (consp frames) | |
654 (not (y-or-n-p (if (cdr frames) | |
655 (format "Delete %s frames? " (length frames)) | |
656 (format "Delete %s ? " (car frames)))))) | |
657 (error "Abort!") | |
658 (mapc 'delete-frame frames) | |
659 (x-close-connection display)))) | |
660 | |
635 (defun make-frame-command () | 661 (defun make-frame-command () |
636 "Make a new frame, and select it if the terminal displays only one frame." | 662 "Make a new frame, and select it if the terminal displays only one frame." |
637 (interactive) | 663 (interactive) |
638 (if (and window-system (not (eq window-system 'pc))) | 664 (if (and window-system (not (eq window-system 'pc))) |
639 (make-frame) | 665 (make-frame) |
731 (delq nil list))) | 757 (delq nil list))) |
732 | 758 |
733 (defun minibuffer-frame-list () | 759 (defun minibuffer-frame-list () |
734 "Return a list of all frames with their own minibuffers." | 760 "Return a list of all frames with their own minibuffers." |
735 (filtered-frame-list | 761 (filtered-frame-list |
736 (function (lambda (frame) | 762 (lambda (frame) |
737 (eq frame (window-frame (minibuffer-window frame))))))) | 763 (eq frame (window-frame (minibuffer-window frame)))))) |
738 | 764 |
739 (defun frames-on-display-list (&optional terminal) | 765 (defun frames-on-display-list (&optional terminal) |
740 "Return a list of all frames on TERMINAL. | 766 "Return a list of all frames on TERMINAL. |
741 | 767 |
742 TERMINAL should be a terminal identifier (an integer), a frame, | 768 TERMINAL should be a terminal identifier (an integer), a frame, |
900 where | 926 where |
901 FRAME is a frame object, | 927 FRAME is a frame object, |
902 ALIST is an association list specifying some of FRAME's parameters, and | 928 ALIST is an association list specifying some of FRAME's parameters, and |
903 WINDOW-CONFIG is a window configuration object for FRAME." | 929 WINDOW-CONFIG is a window configuration object for FRAME." |
904 (cons 'frame-configuration | 930 (cons 'frame-configuration |
905 (mapcar (function | 931 (mapcar (lambda (frame) |
906 (lambda (frame) | 932 (list frame |
907 (list frame | 933 (frame-parameters frame) |
908 (frame-parameters frame) | 934 (current-window-configuration frame))) |
909 (current-window-configuration frame)))) | |
910 (frame-list)))) | 935 (frame-list)))) |
911 | 936 |
912 (defun set-frame-configuration (configuration &optional nodelete) | 937 (defun set-frame-configuration (configuration &optional nodelete) |
913 "Restore the frames to the state described by CONFIGURATION. | 938 "Restore the frames to the state described by CONFIGURATION. |
914 Each frame listed in CONFIGURATION has its position, size, window | 939 Each frame listed in CONFIGURATION has its position, size, window |
921 (or (frame-configuration-p configuration) | 946 (or (frame-configuration-p configuration) |
922 (signal 'wrong-type-argument | 947 (signal 'wrong-type-argument |
923 (list 'frame-configuration-p configuration))) | 948 (list 'frame-configuration-p configuration))) |
924 (let ((config-alist (cdr configuration)) | 949 (let ((config-alist (cdr configuration)) |
925 frames-to-delete) | 950 frames-to-delete) |
926 (mapcar (function | 951 (dolist (frame (frame-list)) |
927 (lambda (frame) | 952 (let ((parameters (assq frame config-alist))) |
928 (let ((parameters (assq frame config-alist))) | 953 (if parameters |
929 (if parameters | 954 (progn |
930 (progn | 955 (modify-frame-parameters |
931 (modify-frame-parameters | 956 frame |
932 frame | 957 ;; Since we can't set a frame's minibuffer status, |
933 ;; Since we can't set a frame's minibuffer status, | 958 ;; we might as well omit the parameter altogether. |
934 ;; we might as well omit the parameter altogether. | 959 (let* ((parms (nth 1 parameters)) |
935 (let* ((parms (nth 1 parameters)) | 960 (mini (assq 'minibuffer parms))) |
936 (mini (assq 'minibuffer parms))) | 961 (if mini (setq parms (delq mini parms))) |
937 (if mini (setq parms (delq mini parms))) | 962 parms)) |
938 parms)) | 963 (set-window-configuration (nth 2 parameters))) |
939 (set-window-configuration (nth 2 parameters))) | 964 (setq frames-to-delete (cons frame frames-to-delete))))) |
940 (setq frames-to-delete (cons frame frames-to-delete)))))) | 965 (mapc (if nodelete |
941 (frame-list)) | 966 ;; Note: making frames invisible here was tried |
942 (if nodelete | 967 ;; but led to some strange behavior--each time the frame |
943 ;; Note: making frames invisible here was tried | 968 ;; was made visible again, the window manager asked afresh |
944 ;; but led to some strange behavior--each time the frame | 969 ;; for where to put it. |
945 ;; was made visible again, the window manager asked afresh | 970 'iconify-frame |
946 ;; for where to put it. | 971 'delete-frame) |
947 (mapcar 'iconify-frame frames-to-delete) | 972 frames-to-delete))) |
948 (mapcar 'delete-frame frames-to-delete)))) | |
949 | 973 |
950 ;;;; Convenience functions for accessing and interactively changing | 974 ;;;; Convenience functions for accessing and interactively changing |
951 ;;;; frame parameters. | 975 ;;;; frame parameters. |
952 | 976 |
953 (defun frame-height (&optional frame) | 977 (defun frame-height (&optional frame) |
971 non-nil (interactively, prefix argument) the current frame size (in | 995 non-nil (interactively, prefix argument) the current frame size (in |
972 pixels) is kept by adjusting the numbers of the lines and columns." | 996 pixels) is kept by adjusting the numbers of the lines and columns." |
973 (interactive | 997 (interactive |
974 (let* ((completion-ignore-case t) | 998 (let* ((completion-ignore-case t) |
975 (font (completing-read "Font name: " | 999 (font (completing-read "Font name: " |
976 (mapcar #'list | |
977 ;; x-list-fonts will fail with an error | 1000 ;; x-list-fonts will fail with an error |
978 ;; if this frame doesn't support fonts. | 1001 ;; if this frame doesn't support fonts. |
979 (x-list-fonts "*" nil (selected-frame))) | 1002 (x-list-fonts "*" nil (selected-frame)) |
980 nil nil nil nil | 1003 nil nil nil nil |
981 (frame-parameter nil 'font)))) | 1004 (frame-parameter nil 'font)))) |
982 (list font current-prefix-arg))) | 1005 (list font current-prefix-arg))) |
983 (let (fht fwd) | 1006 (let (fht fwd) |
984 (if keep-size | 1007 (if keep-size |
985 (setq fht (* (frame-parameter nil 'height) (frame-char-height)) | 1008 (setq fht (* (frame-parameter nil 'height) (frame-char-height)) |
986 fwd (* (frame-parameter nil 'width) (frame-char-width)))) | 1009 fwd (* (frame-parameter nil 'width) (frame-char-width)))) |