Mercurial > hg > xemacs-beta
comparison lisp/frame.el @ 272:c5d627a313b1 r21-0b34
Import from CVS: tag r21-0b34
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:28:48 +0200 |
parents | 966663fcf606 |
children | 90d73dddcdc4 |
comparison
equal
deleted
inserted
replaced
271:c7b7086b0a39 | 272:c5d627a313b1 |
---|---|
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 ;; General Public License for more details. | 19 ;; General Public License for more details. |
20 | 20 |
21 ;; You should have received a copy of the GNU General Public License | 21 ;; You should have received a copy of the GNU General Public License |
22 ;; along with XEmacs; see the file COPYING. If not, write to the | 22 ;; along with XEmacs; see the file COPYING. If not, write to the |
23 ;; Free Software Foundation, 59 Temple Place - Suite 330, | 23 ;; Free Software Foundation, 59 Temple Place - Suite 330, |
24 ;; Boston, MA 02111-1307, USA. | 24 ;; Boston, MA 02111-1307, USA. |
25 | 25 |
26 ;;; Synched up with: FSF 19.30. | 26 ;;; Synched up with: FSF 19.30. |
27 | 27 |
244 ;; and default-frame-plist to it. | 244 ;; and default-frame-plist to it. |
245 (if (frame-live-p frame-initial-frame) | 245 (if (frame-live-p frame-initial-frame) |
246 | 246 |
247 ;; The initial frame we create above always has a minibuffer. | 247 ;; The initial frame we create above always has a minibuffer. |
248 ;; If the user wants to remove it, or make it a minibuffer-only | 248 ;; If the user wants to remove it, or make it a minibuffer-only |
249 ;; frame, then we'll have to delete the current frame and make a | 249 ;; frame, then we'll have to delete the selected frame and make a |
250 ;; new one; you can't remove or add a root window to/from an | 250 ;; new one; you can't remove or add a root window to/from an |
251 ;; existing frame. | 251 ;; existing frame. |
252 ;; | 252 ;; |
253 ;; NOTE: default-frame-plist was nil when we created the | 253 ;; NOTE: default-frame-plist was nil when we created the |
254 ;; existing frame. We need to explicitly include | 254 ;; existing frame. We need to explicitly include |
410 | 410 |
411 | 411 |
412 ;;;; Creation of additional frames, and other frame miscellanea | 412 ;;;; Creation of additional frames, and other frame miscellanea |
413 | 413 |
414 (defun get-other-frame () | 414 (defun get-other-frame () |
415 "Return some frame other than the current frame, creating one if necessary." | 415 "Return some frame other than the selected frame, creating one if necessary." |
416 (let* ((this (selected-frame)) | 416 (let* ((this (selected-frame)) |
417 ;; search visible frames first | 417 ;; search visible frames first |
418 (next (next-frame this 'visible-nomini))) | 418 (next (next-frame this 'visible-nomini))) |
419 ;; then search iconified frames | 419 ;; then search iconified frames |
420 (if (eq this next) | 420 (if (eq this next) |
691 ;;; The function iconify-emacs replaces every non-iconified emacs window | 691 ;;; The function iconify-emacs replaces every non-iconified emacs window |
692 ;;; with a *single* icon. Iconified emacs windows are left alone. When | 692 ;;; with a *single* icon. Iconified emacs windows are left alone. When |
693 ;;; emacs is in this globally-iconified state, de-iconifying any emacs icon | 693 ;;; emacs is in this globally-iconified state, de-iconifying any emacs icon |
694 ;;; will uniconify all frames that were visible, and iconify all frames | 694 ;;; will uniconify all frames that were visible, and iconify all frames |
695 ;;; that were not. This is done by temporarily changing the value of | 695 ;;; that were not. This is done by temporarily changing the value of |
696 ;;; `map-frame-hook' to `deiconify-emacs' (which should never be called | 696 ;;; `map-frame-hook' to `deiconify-emacs' (which should never be called |
697 ;;; except from the map-frame-hook while emacs is iconified). | 697 ;;; except from the map-frame-hook while emacs is iconified). |
698 ;;; | 698 ;;; |
699 ;;; The title of the icon representing all emacs frames is controlled by | 699 ;;; The title of the icon representing all emacs frames is controlled by |
700 ;;; the variable `icon-name'. This is done by temporarily changing the | 700 ;;; the variable `icon-name'. This is done by temporarily changing the |
701 ;;; value of `frame-icon-title-format'. Unfortunately, this changes the | 701 ;;; value of `frame-icon-title-format'. Unfortunately, this changes the |
755 ;; (t nil) | 755 ;; (t nil) |
756 )) | 756 )) |
757 (setq iconification-data (cdr iconification-data)))) | 757 (setq iconification-data (cdr iconification-data)))) |
758 | 758 |
759 (defun suspend-or-iconify-emacs () | 759 (defun suspend-or-iconify-emacs () |
760 "Calls iconify-emacs if frame is an X frame, otherwise calls suspend-emacs" | 760 "Call iconify-emacs if using a window system, otherwise call suspend-emacs." |
761 (interactive) | 761 (interactive) |
762 (cond ((device-on-window-system-p) | 762 (cond ((device-on-window-system-p) |
763 (iconify-emacs)) | 763 (iconify-emacs)) |
764 ((and (eq (frame-type) 'tty) | 764 ((and (eq (device-type) 'tty) |
765 (console-tty-controlling-process (selected-console))) | 765 (console-tty-controlling-process (selected-console))) |
766 (suspend-console (selected-console))) | 766 (suspend-console (selected-console))) |
767 (t | 767 (t |
768 (suspend-emacs)))) | 768 (suspend-emacs)))) |
769 | 769 |
770 ;; This is quite a mouthful, but it should be descriptive, as it's | 770 ;; This is quite a mouthful, but it should be descriptive, as it's |
771 ;; bound to C-z. FSF takes the easy way out by binding C-z to | 771 ;; bound to C-z. FSF takes the easy way out by binding C-z to |
772 ;; different things depending on window-system. We can't do the same, | 772 ;; different things depending on window-system. We can't do the same, |
773 ;; because we allow simultaneous X and TTY consoles. | 773 ;; because we allow simultaneous X and TTY consoles. |
774 (defun suspend-emacs-or-iconify-frame () | 774 (defun suspend-emacs-or-iconify-frame () |
775 "Iconify current frame if it is an X frame, otherwise suspend Emacs." | 775 "Iconify the selected frame if using a window system, otherwise suspend Emacs." |
776 (interactive) | 776 (interactive) |
777 (cond ((device-on-window-system-p) | 777 (cond ((device-on-window-system-p) |
778 (iconify-frame)) | 778 (iconify-frame)) |
779 ((and (eq (frame-type) 'tty) | 779 ((and (eq (frame-type) 'tty) |
780 (console-tty-controlling-process (selected-console))) | 780 (console-tty-controlling-process (selected-console))) |
798 for you, but this variable is provided in case you're using a broken WM." | 798 for you, but this variable is provided in case you're using a broken WM." |
799 :type 'boolean | 799 :type 'boolean |
800 :group 'frames) | 800 :group 'frames) |
801 | 801 |
802 (defun default-select-frame-hook () | 802 (defun default-select-frame-hook () |
803 "Implements the `auto-raise-frame' variable. | 803 "Implement the `auto-raise-frame' variable. |
804 For use as the value of `select-frame-hook'." | 804 For use as the value of `select-frame-hook'." |
805 (if auto-raise-frame (raise-frame (selected-frame)))) | 805 (if auto-raise-frame (raise-frame (selected-frame)))) |
806 | 806 |
807 (defun default-deselect-frame-hook () | 807 (defun default-deselect-frame-hook () |
808 "Implements the `auto-lower-frame' variable. | 808 "Implement the `auto-lower-frame' variable. |
809 For use as the value of `deselect-frame-hook'." | 809 For use as the value of `deselect-frame-hook'." |
810 (if auto-lower-frame (lower-frame (selected-frame))) | 810 (if auto-lower-frame (lower-frame (selected-frame))) |
811 (highlight-extent nil nil)) | 811 (highlight-extent nil nil)) |
812 | 812 |
813 (or select-frame-hook | 813 (or select-frame-hook |
815 | 815 |
816 (or deselect-frame-hook | 816 (or deselect-frame-hook |
817 (add-hook 'deselect-frame-hook 'default-deselect-frame-hook)) | 817 (add-hook 'deselect-frame-hook 'default-deselect-frame-hook)) |
818 | 818 |
819 (defun default-drag-and-drop-functions (frame filepath &optional data) | 819 (defun default-drag-and-drop-functions (frame filepath &optional data) |
820 "Implements the `drag-and-drop-functions' variable. | 820 "Implement the `drag-and-drop-functions' variable. |
821 For use as the value of `drag-and-drop-functions'. | 821 For use as the value of `drag-and-drop-functions'. |
822 A file is popped up in a new buffer, some data without | 822 A file is popped up in a new buffer, some data without |
823 is inserted at point." | 823 is inserted at point." |
824 ;; changed this back -- hope it works for CDE ;-) Oliver Graf <ograf@fga.de> | 824 ;; changed this back -- hope it works for CDE ;-) Oliver Graf <ograf@fga.de> |
825 ;; the OffiX drop stuff has moved to mouse.el (mouse-offix-drop) | 825 ;; the OffiX drop stuff has moved to mouse.el (mouse-offix-drop) |
834 (and (boundp 'drag-and-drop-functions) | 834 (and (boundp 'drag-and-drop-functions) |
835 (or drag-and-drop-functions | 835 (or drag-and-drop-functions |
836 (add-hook 'drag-and-drop-functions 'default-drag-and-drop-functions))) | 836 (add-hook 'drag-and-drop-functions 'default-drag-and-drop-functions))) |
837 | 837 |
838 (defun cde-start-drag (begin end) | 838 (defun cde-start-drag (begin end) |
839 "Implements the CDE drag operation. | 839 "Implement the CDE drag operation. |
840 Calls the internal function cde-start-drag-internal to do the actual work." | 840 Calls the internal function cde-start-drag-internal to do the actual work." |
841 (interactive "_r") | 841 (interactive "_r") |
842 (if (featurep 'cde) | 842 (if (featurep 'cde) |
843 ;; Avoid build-time doc string warning by calling the function | 843 ;; Avoid build-time doc string warning by calling the function |
844 ;; in the following roundabout way: | 844 ;; in the following roundabout way: |
847 (error "CDE functionality not compiled in."))) | 847 (error "CDE functionality not compiled in."))) |
848 | 848 |
849 ;; the OffiX drag stuff will soon move also (perhaps mouse.el) | 849 ;; the OffiX drag stuff will soon move also (perhaps mouse.el) |
850 ;; if the drag event is done | 850 ;; if the drag event is done |
851 (defun offix-start-drag (event data &optional type) | 851 (defun offix-start-drag (event data &optional type) |
852 "Implements the OffiX drag operation. | 852 "Implement the OffiX drag operation. |
853 Calls the internal function offix-start-drag-internal to do the actual work. | 853 Calls the internal function offix-start-drag-internal to do the actual work. |
854 If type is not given, DndText is assumed." | 854 If type is not given, DndText is assumed." |
855 ;; Oliver Graf <ograf@fga.de> | 855 ;; Oliver Graf <ograf@fga.de> |
856 (interactive "esi") | 856 (interactive "esi") |
857 (if (featurep 'offix) | 857 (if (featurep 'offix) |
858 (funcall (intern "offix-start-drag-internal") event data type) | 858 (funcall (intern "offix-start-drag-internal") event data type) |
859 (error "OffiX functionality not compiled in."))) | 859 (error "OffiX functionality not compiled in."))) |
860 | 860 |
861 (defun offix-start-drag-region (event begin end) | 861 (defun offix-start-drag-region (event begin end) |
862 "Implements the OffiX drag operation for a region. | 862 "Implement the OffiX drag operation for a region. |
863 Calls the internal function offix-start-drag-internal to do the actual work. | 863 Calls the internal function offix-start-drag-internal to do the actual work. |
864 This always assumes DndText as type." | 864 This always assumes DndText as type." |
865 ;; Oliver Graf <ograf@fga.de> | 865 ;; Oliver Graf <ograf@fga.de> |
866 (interactive "_er") | 866 (interactive "_er") |
867 (if (featurep 'offix) | 867 (if (featurep 'offix) |
903 (if (window-buffer w) | 903 (if (window-buffer w) |
904 (set-window-buffer w buffer)) | 904 (set-window-buffer w buffer)) |
905 fr)) | 905 fr)) |
906 | 906 |
907 (defcustom get-frame-for-buffer-default-to-current nil | 907 (defcustom get-frame-for-buffer-default-to-current nil |
908 "*When non-nil, `get-frame-for-buffer' will default to the current frame." | 908 "*When non-nil, `get-frame-for-buffer' will default to the selected frame." |
909 :type 'boolean | 909 :type 'boolean |
910 :group 'frames) | 910 :group 'frames) |
911 | 911 |
912 (defun get-frame-for-buffer-noselect (buffer | 912 (defun get-frame-for-buffer-noselect (buffer |
913 &optional not-this-window-p on-frame) | 913 &optional not-this-window-p on-frame) |
947 (frame-totally-visible-p s1))))))) | 947 (frame-totally-visible-p s1))))))) |
948 ;; but the selected frame should come first, even if it's occluded, | 948 ;; but the selected frame should come first, even if it's occluded, |
949 ;; to minimize thrashing. | 949 ;; to minimize thrashing. |
950 (setq frames (cons (selected-frame) | 950 (setq frames (cons (selected-frame) |
951 (delq (selected-frame) frames))) | 951 (delq (selected-frame) frames))) |
952 | 952 |
953 (setq name (symbol-name name)) | 953 (setq name (symbol-name name)) |
954 (while frames | 954 (while frames |
955 (setq frame (car frames)) | 955 (setq frame (car frames)) |
956 (if (equal name (frame-name frame)) | 956 (if (equal name (frame-name frame)) |
957 (if (get-buffer-window buffer frame) | 957 (if (get-buffer-window buffer frame) |
1040 | 1040 |
1041 (t | 1041 (t |
1042 ;; | 1042 ;; |
1043 ;; This buffer's mode did not express a preference for a frame of a | 1043 ;; This buffer's mode did not express a preference for a frame of a |
1044 ;; particular name. So try to find a frame already displaying this | 1044 ;; particular name. So try to find a frame already displaying this |
1045 ;; buffer. | 1045 ;; buffer. |
1046 ;; | 1046 ;; |
1047 (let ((w (or (get-buffer-window buffer nil) ; check current first | 1047 (let ((w (or (get-buffer-window buffer nil) ; check current first |
1048 (get-buffer-window buffer 'visible) ; then visible | 1048 (get-buffer-window buffer 'visible) ; then visible |
1049 (get-buffer-window buffer 0)))) ; then iconic | 1049 (get-buffer-window buffer 0)))) ; then iconic |
1050 (cond ((null w) | 1050 (cond ((null w) |
1059 ;; The pre-display-buffer-function is called for effect, so this needs to | 1059 ;; The pre-display-buffer-function is called for effect, so this needs to |
1060 ;; actually select the frame it wants. Fdisplay_buffer() takes notice of | 1060 ;; actually select the frame it wants. Fdisplay_buffer() takes notice of |
1061 ;; changes to the selected frame. | 1061 ;; changes to the selected frame. |
1062 (defun get-frame-for-buffer (buffer &optional not-this-window-p on-frame) | 1062 (defun get-frame-for-buffer (buffer &optional not-this-window-p on-frame) |
1063 "Select and return a frame in which to display BUFFER. | 1063 "Select and return a frame in which to display BUFFER. |
1064 Normally, the buffer will simply be displayed in the current frame. | 1064 Normally, the buffer will simply be displayed in the selected frame. |
1065 But if the symbol naming the major-mode of the buffer has a 'frame-name | 1065 But if the symbol naming the major-mode of the buffer has a 'frame-name |
1066 property (which should be a symbol), then the buffer will be displayed in | 1066 property (which should be a symbol), then the buffer will be displayed in |
1067 a frame of that name. If there is no frame of that name, then one is | 1067 a frame of that name. If there is no frame of that name, then one is |
1068 created. | 1068 created. |
1069 | 1069 |
1070 If the major-mode doesn't have a 'frame-name property, then the frame | 1070 If the major-mode doesn't have a 'frame-name property, then the frame |
1071 named by `get-frame-for-buffer-default-frame-name' will be used. If | 1071 named by `get-frame-for-buffer-default-frame-name' will be used. If |
1072 that is nil (the default) then the currently selected frame will used. | 1072 that is nil (the default) then the currently selected frame will used. |
1073 | 1073 |
1074 If the frame-name symbol has an 'instance-limit property (an integer) | 1074 If the frame-name symbol has an 'instance-limit property (an integer) |
1075 then each time a buffer of the mode in question is displayed, a new frame | 1075 then each time a buffer of the mode in question is displayed, a new frame |
1076 with that name will be created, until there are `instance-limit' of them. | 1076 with that name will be created, until there are `instance-limit' of them. |
1077 If instance-limit is 0, then a new frame will be created each time. | 1077 If instance-limit is 0, then a new frame will be created each time. |
1078 | 1078 |
1079 If a buffer is already displayed in a frame, then `instance-limit' is | 1079 If a buffer is already displayed in a frame, then `instance-limit' is |
1080 ignored, and that frame is used. | 1080 ignored, and that frame is used. |
1081 | 1081 |
1082 If the frame-name symbol has a 'frame-defaults property, then that is | 1082 If the frame-name symbol has a 'frame-defaults property, then that is |
1083 prepended to the `default-frame-plist' when creating a frame for the | 1083 prepended to the `default-frame-plist' when creating a frame for the |
1084 first time. | 1084 first time. |
1085 | 1085 |
1086 This function may be used as the value of `pre-display-buffer-function', | 1086 This function may be used as the value of `pre-display-buffer-function', |
1087 to cause the display-buffer function and its callers to exhibit the above | 1087 to cause the display-buffer function and its callers to exhibit the above |
1088 behavior." | 1088 behavior." |
1089 (let ((frame (get-frame-for-buffer-noselect | 1089 (let ((frame (get-frame-for-buffer-noselect |
1090 buffer not-this-window-p on-frame))) | 1090 buffer not-this-window-p on-frame))) |
1091 (if (not (eq frame (selected-frame))) | 1091 (if (not (eq frame (selected-frame))) |
1110 (if (memq (setq next-frame (window-frame (car list))) | 1110 (if (memq (setq next-frame (window-frame (car list))) |
1111 frames) | 1111 frames) |
1112 nil | 1112 nil |
1113 (if (eq cur-frame next-frame) | 1113 (if (eq cur-frame next-frame) |
1114 (setq save-frame next-frame) | 1114 (setq save-frame next-frame) |
1115 (and | 1115 (and |
1116 (or (not visible-only) | 1116 (or (not visible-only) |
1117 (frame-visible-p next-frame)) | 1117 (frame-visible-p next-frame)) |
1118 (setq frames (append frames (list next-frame)))))) | 1118 (setq frames (append frames (list next-frame)))))) |
1119 (setq list (cdr list))) | 1119 (setq list (cdr list))) |
1120 | 1120 |
1132 :type 'number | 1132 :type 'number |
1133 :group 'frames) | 1133 :group 'frames) |
1134 | 1134 |
1135 (defun show-temp-buffer-in-current-frame (buffer) | 1135 (defun show-temp-buffer-in-current-frame (buffer) |
1136 "For use as the value of temp-buffer-show-function: | 1136 "For use as the value of temp-buffer-show-function: |
1137 always displays the buffer in the current frame, regardless of the behavior | 1137 always displays the buffer in the selected frame, regardless of the behavior |
1138 that would otherwise be introduced by the `pre-display-buffer-function', which | 1138 that would otherwise be introduced by the `pre-display-buffer-function', which |
1139 is normally set to `get-frame-for-buffer' (which see)." | 1139 is normally set to `get-frame-for-buffer' (which see)." |
1140 (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is | 1140 (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is |
1141 (let ((window (display-buffer buffer))) | 1141 (let ((window (display-buffer buffer))) |
1142 (if (not (eq (last-nonminibuf-frame) (window-frame window))) | 1142 (if (not (eq (last-nonminibuf-frame) (window-frame window))) |