1 ;;; frame.el --- multi-frame management independent of window systems.
3 ;; Copyright (C) 1993-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996 Ben Wing.
6 ;; Maintainer: SXEmacs Development Team
7 ;; Keywords: internal, dumped
9 ;; This file is part of SXEmacs.
11 ;; SXEmacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; SXEmacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Synched up with: FSF 19.30.
28 ;; This file is dumped with SXEmacs.
33 "Support for Emacs frames and window systems."
36 ; No need for `frame-creation-function'.
38 ;;; The initial value given here for this must ask for a minibuffer.
39 ;;; There must always exist a frame with a minibuffer, and after we
40 ;;; delete the terminal frame, this will be the only frame.
41 (defcustom initial-frame-plist '(minibuffer t)
42 "Plist of frame properties for creating the initial X window frame.
43 You can set this in your `.emacs' file; for example,
44 (setq initial-frame-plist '(top 1 left 1 width 80 height 55))
45 Properties specified here supersede the values given in `default-frame-plist'.
46 The format of this can also be an alist for backward compatibility.
48 If the value calls for a frame without a minibuffer, and you have not created
49 a minibuffer frame on your own, one is created according to
50 `minibuffer-frame-plist'.
52 You can specify geometry-related options for just the initial frame
53 by setting this variable in your `.emacs' file; however, they won't
54 take effect until Emacs reads `.emacs', which happens after first creating
55 the frame. If you want the frame to have the proper geometry as soon
56 as it appears, you need to use this three-step process:
57 * Specify X resources to give the geometry you want.
58 * Set `default-frame-plist' to override these options so that they
59 don't affect subsequent frames.
60 * Set `initial-frame-plist' in a way that matches the X resources,
61 to override what you put in `default-frame-plist'."
65 (defcustom minibuffer-frame-plist '(width 80 height 2 menubar-visible-p nil
66 default-toolbar-visible-p nil)
67 "Plist of frame properties for initially creating a minibuffer frame.
68 You can set this in your `.emacs' file; for example,
69 (setq minibuffer-frame-plist '(top 1 left 1 width 80 height 2))
70 Properties specified here supersede the values given in
71 `default-frame-plist'.
72 The format of this can also be an alist for backward compatibility."
76 (defcustom pop-up-frame-plist nil
77 "Plist of frame properties used when creating pop-up frames.
78 Pop-up frames are used for completions, help, and the like.
79 This variable can be set in your init file, like this:
80 (setq pop-up-frame-plist '(width 80 height 20))
81 These supersede the values given in `default-frame-plist'.
82 The format of this can also be an alist for backward compatibility."
86 (setq pop-up-frame-function
88 (make-frame pop-up-frame-plist))))
90 (defcustom special-display-frame-plist '(height 14 width 80 unsplittable t)
91 "*Plist of frame properties used when creating special frames.
92 Special frames are used for buffers whose names are in
93 `special-display-buffer-names' and for buffers whose names match
94 one of the regular expressions in `special-display-regexps'.
95 This variable can be set in your init file, like this:
96 (setq special-display-frame-plist '(width 80 height 20))
97 These supersede the values given in `default-frame-plist'.
98 The format of this can also be an alist for backward compatibility."
102 (defun safe-alist-to-plist (cruftiness)
103 (if (consp (car cruftiness))
104 (alist-to-plist cruftiness)
107 ;; Display BUFFER in its own frame, reusing an existing window if any.
108 ;; Return the window chosen.
109 ;; Currently we do not insist on selecting the window within its frame.
110 ;; If ARGS is a plist, use it as a list of frame property specs.
111 ;; #### Change, not compatible with FSF: This stuff is all so incredibly
112 ;; junky anyway that I doubt it makes any difference.
113 ;; If ARGS is a list whose car is t,
114 ;; use (cadr ARGS) as a function to do the work.
115 ;; Pass it BUFFER as first arg, and (cddr ARGS) gives the rest of the args.
116 (defun special-display-popup-frame (buffer &optional args)
117 ;; if we can't display simultaneous multiple frames, just return
118 ;; nil and let the normal behavior take over.
119 (and (device-on-window-system-p)
120 (if (and args (eq t (car args)))
121 (apply (cadr args) buffer (cddr args))
122 (let ((window (get-buffer-window buffer t)))
124 ;; If we have a window already, make it visible.
125 (let ((frame (window-frame window)))
126 (make-frame-visible frame)
129 ;; If no window yet, make one in a new frame.
131 (make-frame (append (safe-alist-to-plist args)
133 special-display-frame-plist)))))
134 (set-window-buffer (frame-selected-window frame) buffer)
135 (set-window-dedicated-p (frame-selected-window frame) t)
136 (frame-selected-window frame)))))))
138 (setq special-display-function 'special-display-popup-frame)
140 ;;; Handle delete-frame events from the X server.
141 ;(defun handle-delete-frame (event)
143 ; (let ((frame (posn-window (event-start event)))
145 ; (tail (frame-list)))
147 ; (and (frame-visible-p (car tail))
148 ; (not (eq (car tail) frame))
150 ; (setq tail (cdr tail)))
152 ; (delete-frame frame t)
156 ;;;; Arrangement of frames at startup
158 ;;; 1) Load the window system startup file from the lisp library and read the
159 ;;; high-priority arguments (-q and the like). The window system startup
160 ;;; file should create any frames specified in the window system defaults.
162 ;;; 2) If no frames have been opened, we open an initial text frame.
164 ;;; 3) Once the init file is done, we apply any newly set properties
165 ;;; in initial-frame-plist to the frame.
167 ;; These are now called explicitly at the proper times,
168 ;; since that is easier to understand.
169 ;; Actually using hooks within Emacs is bad for future maintenance. --rms.
170 ;; (add-hook 'before-init-hook 'frame-initialize)
171 ;; (add-hook 'window-setup-hook 'frame-notice-user-settings)
173 ;;; If we create the initial frame, this is it.
174 (defvar frame-initial-frame nil)
176 ;; Record the properties used in frame-initialize to make the initial frame.
177 (defvar frame-initial-frame-plist)
179 (defvar frame-initial-geometry-arguments nil)
181 (defun canonicalize-frame-plists ()
182 (setq initial-frame-plist (safe-alist-to-plist initial-frame-plist))
183 (setq default-frame-plist (safe-alist-to-plist default-frame-plist)))
185 ;;; startup.el calls this function before loading the user's init
186 ;;; file - if there is no frame with a minibuffer open now, create
187 ;;; one to display messages while loading the init file.
188 (defun frame-initialize ()
189 ;; In batch mode, we actually use the initial terminal device for output.
190 (canonicalize-frame-plists)
191 (if (not (noninteractive))
193 ;; Don't call select-frame here - focus is a matter of WM policy.
195 ;; If there is no frame with a minibuffer besides the terminal
196 ;; frame, then we need to create the opening frame. Make sure
197 ;; it has a minibuffer, but let initial-frame-plist omit the
199 (or (delq terminal-frame (minibuffer-frame-list))
201 (setq frame-initial-frame-plist
202 (append initial-frame-plist default-frame-plist))
203 ;; FSFmacs has scroll-bar junk here that we don't need.
204 (setq default-minibuffer-frame
205 (setq frame-initial-frame
206 (make-frame initial-frame-plist
207 (car (delq terminal-device
209 ;; Delete any specifications for window geometry properties
210 ;; so that we won't reapply them in frame-notice-user-settings.
211 ;; It would be wrong to reapply them then,
212 ;; because that would override explicit user resizing.
213 (setq initial-frame-plist
214 (frame-remove-geometry-props initial-frame-plist))))
215 ;; At this point, we know that we have a frame open, so we
216 ;; can delete the terminal device.
217 ;; (delete-device terminal-device)
218 ;; Do it the same way Fkill_emacs does it. -slb
219 (delete-console terminal-console)
220 (setq terminal-frame nil)
222 ;; FSFmacs sets frame-creation-function here, but no need.
225 ;;; startup.el calls this function after loading the user's init
226 ;;; file. Now default-frame-plist and initial-frame-plist contain
227 ;;; information to which we must react; do what needs to be done.
228 (defun frame-notice-user-settings ()
230 ;; FSFmacs has menu-bar junk here that we don't need.
232 (canonicalize-frame-plists)
234 ;; Creating and deleting frames may shift the selected frame around,
235 ;; and thus the current buffer. Protect against that. We don't
236 ;; want to use save-excursion here, because that may also try to set
237 ;; the buffer of the selected window, which fails when the selected
238 ;; window is the minibuffer.
239 (let ((old-buffer (current-buffer)))
241 ;; If the initial frame is still around, apply initial-frame-plist
242 ;; and default-frame-plist to it.
243 (if (frame-live-p frame-initial-frame)
245 ;; The initial frame we create above always has a minibuffer.
246 ;; If the user wants to remove it, or make it a minibuffer-only
247 ;; frame, then we'll have to delete the selected frame and make a
248 ;; new one; you can't remove or add a root window to/from an
251 ;; NOTE: default-frame-plist was nil when we created the
252 ;; existing frame. We need to explicitly include
253 ;; default-frame-plist in the properties of the screen we
254 ;; create here, so that its new value, gleaned from the user's
255 ;; .emacs file, will be applied to the existing screen.
257 (or (and (lax-plist-member
258 initial-frame-plist 'minibuffer)
259 (list (lax-plist-get initial-frame-plist
261 (and (lax-plist-member default-frame-plist
263 (list (lax-plist-get default-frame-plist
267 ;; Create the new frame.
270 ;; If the frame isn't visible yet, wait till it is.
271 ;; If the user has to position the window,
272 ;; Emacs doesn't know its real position until
273 ;; the frame is seen to be visible.
275 (if (frame-property frame-initial-frame 'initially-unmapped)
277 (while (not (frame-visible-p frame-initial-frame))
279 (setq props (frame-properties frame-initial-frame))
280 ;; Get rid of `name' unless it was specified explicitly before.
281 (or (lax-plist-member frame-initial-frame-plist 'name)
282 (setq props (lax-plist-remprop props 'name)))
283 (setq props (append initial-frame-plist default-frame-plist
286 ;; Get rid of `reverse', because that was handled
287 ;; when we first made the frame.
288 (laxputf props 'reverse nil)
289 ;; Get rid of `window-id', otherwise make-frame will
290 ;; think we're trying to setup an external widget.
291 (laxremf props 'window-id)
292 (if (lax-plist-member frame-initial-geometry-arguments 'height)
293 (laxremf props 'height))
294 (if (lax-plist-member frame-initial-geometry-arguments 'width)
295 (laxremf props 'width))
296 (if (lax-plist-member frame-initial-geometry-arguments 'left)
297 (laxremf props 'left))
298 (if (lax-plist-member frame-initial-geometry-arguments 'top)
299 (laxremf props 'top))
301 ;; Now create the replacement initial frame.
303 ;; Use the geometry args that created the existing
304 ;; frame, rather than the props we get for it.
305 (append '(user-size t user-position t)
306 frame-initial-geometry-arguments
308 ;; The initial frame, which we are about to delete, may be
309 ;; the only frame with a minibuffer. If it is, create a
311 (or (delq frame-initial-frame (minibuffer-frame-list))
312 (make-initial-minibuffer-frame nil))
314 ;; If the initial frame is serving as a surrogate
315 ;; minibuffer frame for any frames, we need to wean them
316 ;; onto a new frame. The default-minibuffer-frame
317 ;; variable must be handled similarly.
318 (let ((users-of-initial
321 (and (not (eq frame frame-initial-frame))
323 (minibuffer-window frame))
324 frame-initial-frame))))))
325 (if (or users-of-initial
326 (eq default-minibuffer-frame frame-initial-frame))
328 ;; Choose an appropriate frame. Prefer frames which
329 ;; are only minibuffers.
330 (let* ((new-surrogate
332 (or (filtered-frame-list
335 (frame-property frame 'minibuffer))))
336 (minibuffer-frame-list))))
337 (new-minibuffer (minibuffer-window new-surrogate)))
339 (if (eq default-minibuffer-frame frame-initial-frame)
340 (setq default-minibuffer-frame new-surrogate))
342 ;; Wean the frames using frame-initial-frame as
343 ;; their minibuffer frame.
347 (set-frame-property frame 'minibuffer
351 ;; Redirect events enqueued at this frame to the new frame.
352 ;; Is this a good idea?
353 ;; Probably not, since this whole redirect-frame-focus
354 ;; stuff is a load of trash, and so is this function we're in.
356 ;(redirect-frame-focus frame-initial-frame new)
358 ;; Finally, get rid of the old frame.
359 (delete-frame frame-initial-frame t))
361 ;; Otherwise, we don't need all that rigamarole; just apply
362 ;; the new properties.
363 (let (newprops allprops tail)
364 (setq allprops (append initial-frame-plist
365 default-frame-plist))
366 (if (lax-plist-member frame-initial-geometry-arguments 'height)
367 (laxremf allprops 'height))
368 (if (lax-plist-member frame-initial-geometry-arguments 'width)
369 (remf allprops 'width))
370 (if (lax-plist-member frame-initial-geometry-arguments 'left)
371 (laxremf allprops 'left))
372 (if (lax-plist-member frame-initial-geometry-arguments 'top)
373 (laxremf allprops 'top))
375 ;; Find just the props that have changed since we first
376 ;; made this frame. Those are the ones actually set by
377 ;; the init file. For those props whose values we already knew
378 ;; (such as those spec'd by command line options)
379 ;; it is undesirable to specify the parm again
380 ;; once the user has seen the frame and been able to alter it
384 (setq oldval (lax-plist-get frame-initial-frame-plist
386 (setq newval (lax-plist-get allprops (car tail)))
387 (or (eq oldval newval)
388 (laxputf newprops (car tail) newval)))
389 (setq tail (cddr tail)))
390 (set-frame-properties frame-initial-frame newprops)
392 ;if (lax-plist-member newprops 'font)
393 ; (frame-update-faces frame-initial-frame))
397 ;; Restore the original buffer.
398 (set-buffer old-buffer)
400 ;; Make sure the initial frame can be GC'd if it is ever deleted.
401 ;; Make sure frame-notice-user-settings does nothing if called twice.
402 (setq frame-initial-frame nil)))
404 (defun make-initial-minibuffer-frame (device)
405 (let ((props (append '(minibuffer only)
406 (safe-alist-to-plist minibuffer-frame-plist))))
407 (make-frame props device)))
410 ;;;; Creation of additional frames, and other frame miscellanea
412 (defun get-other-frame ()
413 "Return some frame other than the selected frame, creating one if necessary."
414 (let* ((this (selected-frame))
415 ;; search visible frames first
416 (next (next-frame this 'visible-nomini)))
417 ;; then search iconified frames
419 (setq next (next-frame 'visible-iconic-nomini)))
421 ;; otherwise, make a new frame
425 (defun next-multiframe-window ()
426 "Select the next window, regardless of which frame it is on."
428 (select-window (next-window (selected-window)
429 (> (minibuffer-depth) 0)
432 (defun previous-multiframe-window ()
433 "Select the previous window, regardless of which frame it is on."
435 (select-window (previous-window (selected-window)
436 (> (minibuffer-depth) 0)
439 (defun make-frame-on-device (type connection &optional props)
440 "Create a frame of type TYPE on CONNECTION.
441 TYPE should be a symbol naming the device type, i.e. one of
443 x An X display. CONNECTION should be a standard display string
444 such as \"unix:0\", or nil for the display specified on the
445 command line or in the DISPLAY environment variable. Only if
446 support for X was compiled into XEmacs.
447 tty A standard TTY connection or terminal. CONNECTION should be
448 a TTY device name such as \"/dev/ttyp2\" (as determined by
449 the Unix command `tty') or nil for XEmacs' standard input
450 and output (usually the TTY in which XEmacs started). Only
451 if support for TTY's was compiled into XEmacs.
453 ns A connection to a machine running the NeXTstep windowing
454 system. Not currently implemented.
455 pc A direct-write MS-DOS frame. Not currently implemented.
457 PROPS should be a plist of properties, as in the call to `make-frame'.
459 If a connection to CONNECTION already exists, it is reused; otherwise,
460 a new connection is opened."
461 (make-frame props (make-device type connection props)))
463 ;; Alias, kept temporarily.
464 (defalias 'new-frame 'make-frame)
466 ; FSFmacs has make-frame here. We have it in C, so no need for
467 ; frame-creation-function.
469 (defun filtered-frame-list (predicate &optional device)
470 "Return a list of all live frames which satisfy PREDICATE.
471 If optional second arg DEVICE is non-nil, restrict the frames
472 returned to that device."
473 (let ((frames (if device (device-frame-list device)
476 (while (consp frames)
477 (if (funcall predicate (car frames))
478 (setq good-frames (cons (car frames) good-frames)))
479 (setq frames (cdr frames)))
482 (defun minibuffer-frame-list (&optional device)
483 "Return a list of all frames with their own minibuffers.
484 If optional second arg DEVICE is non-nil, restrict the frames
485 returned to that device."
488 (eq frame (window-frame (minibuffer-window frame))))
491 (defun frame-minibuffer-only-p (frame)
492 "Return non-nil if FRAME is a minibuffer-only frame."
493 (eq (frame-root-window frame) (minibuffer-window frame)))
495 (defun frame-remove-geometry-props (plist)
496 "Return the property list PLIST, but with geometry specs removed.
497 This deletes all bindings in PLIST for `top', `left', `width',
498 `height', `user-size' and `user-position' properties.
499 Emacs uses this to avoid overriding explicit moves and resizings from
500 the user during startup."
501 (setq plist (canonicalize-lax-plist (copy-sequence plist)))
502 (mapcar #'(lambda (property)
503 (if (lax-plist-member plist property)
505 (setq frame-initial-geometry-arguments
507 (cons (lax-plist-get plist property)
508 frame-initial-geometry-arguments)))
509 (setq plist (lax-plist-remprop plist property)))))
510 '(height width top left user-size user-position))
513 (defun other-frame (arg)
514 "Select the ARG'th different visible frame, and raise it.
515 All frames are arranged in a cyclic order.
516 This command selects the frame ARG steps away in that order.
517 A negative ARG moves in the opposite order.
519 This sets the window system focus, regardless of the value
520 of `focus-follows-mouse'."
522 (let ((frame (selected-frame)))
524 (setq frame (next-frame frame 'visible-nomini))
527 (setq frame (previous-frame frame 'visible-nomini))
531 ;this is a bad idea; you should in general never warp the
532 ;pointer unless the user asks for this. Furthermore,
533 ;our version of `set-mouse-position' takes a window,
535 ;(set-mouse-position (selected-frame) (1- (frame-width)) 0)
536 ;some weird FSFmacs randomness
537 ;(if (fboundp 'unfocus-frame)
541 ;; XEmacs-added utility functions
543 (defmacro save-selected-frame (&rest body)
544 "Execute forms in BODY, then restore the selected frame.
545 The value returned is the value of the last form in BODY."
546 (let ((old-frame (gensym "ssf")))
547 `(let ((,old-frame (selected-frame)))
550 (select-frame ,old-frame)))))
552 (defmacro with-selected-frame (frame &rest body)
553 "Execute forms in BODY with FRAME as the selected frame.
554 The value returned is the value of the last form in BODY."
555 `(save-selected-frame
556 (select-frame ,frame)
559 ; this is in C in FSFmacs
561 "Return a list of all frames on all devices/consoles."
562 ;; Lists are copies, so nconc is safe here.
563 (apply 'nconc (mapcar 'device-frame-list (device-list))))
565 (defun frame-type (&optional frame)
566 "Return the type of the specified frame (e.g. `x' or `tty').
567 This is equivalent to the type of the frame's device.
568 Value is `tty' for a tty frame (a character-only terminal),
569 `x' for a frame that is an X window,
570 `ns' for a frame that is a NeXTstep window (not yet implemented),
571 `stream' for a stream frame (which acts like a stdio stream), and
572 `dead' for a deleted frame."
573 (or frame (setq frame (selected-frame)))
574 (if (not (frame-live-p frame)) 'dead
575 (device-type (frame-device frame))))
577 (defun device-or-frame-p (object)
578 "Return non-nil if OBJECT is a device or frame."
582 (defun device-or-frame-type (device-or-frame)
583 "Return the type (e.g. `x' or `tty') of DEVICE-OR-FRAME.
584 DEVICE-OR-FRAME should be a device or a frame object. See `device-type'
585 for a description of the possible types."
586 (if (devicep device-or-frame)
587 (device-type device-or-frame)
588 (frame-type device-or-frame)))
590 (defun fw-frame (obj)
591 "Given a frame or window, return the associated frame.
592 Return nil otherwise."
593 (cond ((windowp obj) (window-frame obj))
598 ;;;; Frame configurations
600 (defun current-frame-configuration ()
601 "Return a list describing the positions and states of all frames.
602 Its car is `frame-configuration'.
603 Each element of the cdr is a list of the form (FRAME PLIST WINDOW-CONFIG),
605 FRAME is a frame object,
606 PLIST is a property list specifying some of FRAME's properties, and
607 WINDOW-CONFIG is a window configuration object for FRAME."
608 (cons 'frame-configuration
612 (frame-properties frame)
613 (current-window-configuration frame))))
616 (defun set-frame-configuration (configuration &optional nodelete)
617 "Restore the frames to the state described by CONFIGURATION.
618 Each frame listed in CONFIGURATION has its position, size, window
619 configuration, and other properties set as specified in CONFIGURATION.
620 Ordinarily, this function deletes all existing frames not
621 listed in CONFIGURATION. But if optional second argument NODELETE
622 is given and non-nil, the unwanted frames are iconified instead."
623 (or (frame-configuration-p configuration)
624 (signal 'wrong-type-argument
625 (list 'frame-configuration-p configuration)))
626 (let ((config-plist (cdr configuration))
628 (mapc (lambda (frame)
629 (let ((properties (assq frame config-plist)))
632 (set-frame-properties
634 ;; Since we can't set a frame's minibuffer status,
635 ;; we might as well omit the parameter altogether.
636 (lax-plist-remprop (nth 1 properties) 'minibuffer))
637 (set-window-configuration (nth 2 properties)))
638 (setq frames-to-delete (cons frame frames-to-delete)))))
641 ;; Note: making frames invisible here was tried
642 ;; but led to some strange behavior--each time the frame
643 ;; was made visible again, the window manager asked afresh
644 ;; for where to put it.
645 (mapc 'iconify-frame frames-to-delete)
646 (mapc 'delete-frame frames-to-delete))))
648 ; this function is in subr.el in FSFmacs.
649 ; that's because they don't always include frame.el, while we do.
651 (defun frame-configuration-p (object)
652 "Return non-nil if OBJECT seems to be a frame configuration.
653 Any list whose car is `frame-configuration' is assumed to be a frame
656 (eq (car object) 'frame-configuration)))
659 ;; FSFmacs has functions `frame-width', `frame-height' here.
660 ;; We have them in C.
662 ;; FSFmacs has weird functions `set-default-font', `set-background-color',
663 ;; `set-foreground-color' here. They don't do sensible things like
664 ;; set faces; instead they set frame properties (??!!) and call
665 ;; useless functions such as `frame-update-faces' and
666 ;; `frame-update-face-colors'.
668 ;; FSFmacs has functions `set-cursor-color', `set-mouse-color', and
669 ;; `set-border-color', which refer to frame properties.
670 ;; #### We need to use specifiers here.
672 ;(defun auto-raise-mode (arg)
673 ; "Toggle whether or not the selected frame should auto-raise.
674 ;With arg, turn auto-raise mode on if and only if arg is positive.
675 ;Note that this controls Emacs's own auto-raise feature.
676 ;Some window managers allow you to enable auto-raise for certain windows.
677 ;You can use that for Emacs windows if you wish, but if you do,
678 ;that is beyond the control of Emacs and this command has no effect on it."
682 ; (if (frame-property (selected-frame) 'auto-raise)
684 ; (set-frame-property (selected-frame) 'auto-raise (> arg 0)))
686 ;(defun auto-lower-mode (arg)
687 ; "Toggle whether or not the selected frame should auto-lower.
688 ;With arg, turn auto-lower mode on if and only if arg is positive.
689 ;Note that this controls Emacs's own auto-lower feature.
690 ;Some window managers allow you to enable auto-lower for certain windows.
691 ;You can use that for Emacs windows if you wish, but if you do,
692 ;that is beyond the control of Emacs and this command has no effect on it."
696 ; (if (frame-property (selected-frame) 'auto-lower)
698 ; (set-frame-property (selected-frame) 'auto-lower (> arg 0)))
700 ;; FSFmacs has silly functions `toggle-scroll-bar',
701 ;; `toggle-horizontal-scrollbar'
703 ;;; Iconifying emacs.
705 ;;; The function iconify-emacs replaces every non-iconified emacs window
706 ;;; with a *single* icon. Iconified emacs windows are left alone. When
707 ;;; emacs is in this globally-iconified state, de-iconifying any emacs icon
708 ;;; will uniconify all frames that were visible, and iconify all frames
709 ;;; that were not. This is done by temporarily changing the value of
710 ;;; `map-frame-hook' to `deiconify-emacs' (which should never be called
711 ;;; except from the map-frame-hook while emacs is iconified).
713 ;;; The title of the icon representing all emacs frames is controlled by
714 ;;; the variable `icon-name'. This is done by temporarily changing the
715 ;;; value of `frame-icon-title-format'. Unfortunately, this changes the
716 ;;; titles of all emacs icons, not just the "big" icon.
718 ;;; It would be nice if existing icons were removed and restored by
719 ;;; iconifying the emacs process, but I couldn't make that work yet.
721 (defvar icon-name nil) ; set this at run time, not load time.
723 (defvar iconification-data nil)
725 (defun iconify-emacs ()
726 "Replace every non-iconified FRAME with a *single* icon.
727 Iconified frames are left alone. When XEmacs is in this
728 globally-iconified state, de-iconifying any emacs icon will uniconify
729 all frames that were visible, and iconify all frames that were not."
731 (if iconification-data (error "already iconified?"))
732 (let* ((frames (frame-list))
734 (me (selected-frame))
737 (setq frame (car rest))
738 (setcar rest (cons frame (frame-visible-p frame)))
739 ; (if (memq (cdr (car rest)) '(icon nil))
741 ; (make-frame-visible frame) ; deiconify, and process the X event
742 ; (sleep-for 500 t) ; process X events; I really want to XSync() here
744 (or (eq frame me) (make-frame-invisible frame))
745 (setq rest (cdr rest)))
746 (or (boundp 'map-frame-hook) (setq map-frame-hook nil))
748 (setq icon-name (concat invocation-name " @ " (system-name))))
749 (setq iconification-data
750 (list frame-icon-title-format map-frame-hook frames)
751 frame-icon-title-format icon-name
752 map-frame-hook 'deiconify-emacs)
756 (defun deiconify-emacs (&optional ignore)
757 (or iconification-data (error "not iconified?"))
758 (setq frame-icon-title-format (car iconification-data)
759 map-frame-hook (car (cdr iconification-data))
760 iconification-data (car (cdr (cdr iconification-data))))
761 (while iconification-data
762 (let ((visibility (cdr (car iconification-data))))
763 (cond (visibility ;; JV (Note non-nil means visible in XEmacs)
764 (make-frame-visible (car (car iconification-data))))
765 ; (t ;; (eq visibility 'icon) ;; JV Not in XEmacs!!!
766 ; (make-frame-visible (car (car iconification-data)))
767 ; (sleep-for 500 t) ; process X events; I really want to XSync() here
768 ; (iconify-frame (car (car iconification-data))))
771 (setq iconification-data (cdr iconification-data))))
773 (defun suspend-or-iconify-emacs ()
774 "Call iconify-emacs if using a window system, otherwise suspend Emacs."
776 (cond ((device-on-window-system-p)
778 ((and (eq (device-type) 'tty)
779 (console-tty-controlling-process (selected-console)))
780 (suspend-console (selected-console)))
784 ;; This is quite a mouthful, but it should be descriptive, as it's
785 ;; bound to C-z. FSF takes the easy way out by binding C-z to
786 ;; different things depending on window-system. We can't do the same,
787 ;; because we allow simultaneous X and TTY consoles.
788 (defun suspend-emacs-or-iconify-frame ()
789 "Iconify the selected frame if using a window system, otherwise suspend Emacs."
791 (cond ((device-on-window-system-p)
793 ((and (eq (frame-type) 'tty)
794 (console-tty-controlling-process (selected-console)))
795 (suspend-console (selected-console)))
800 ;;; auto-raise and auto-lower
802 (defcustom auto-raise-frame nil
803 "*If true, frames will be raised to the top when selected.
804 Under X, most ICCCM-compliant window managers will have an option to do this
805 for you, but this variable is provided in case you're using a broken WM."
809 (defcustom auto-lower-frame nil
810 "*If true, frames will be lowered to the bottom when no longer selected.
811 Under X, most ICCCM-compliant window managers will have an option to do this
812 for you, but this variable is provided in case you're using a broken WM."
816 (defun default-select-frame-hook ()
817 "Implement the `auto-raise-frame' variable.
818 For use as the value of `select-frame-hook'."
819 (if auto-raise-frame (raise-frame (selected-frame))))
821 (defun default-deselect-frame-hook ()
822 "Implement the `auto-lower-frame' variable.
823 For use as the value of `deselect-frame-hook'."
824 (if auto-lower-frame (lower-frame (selected-frame)))
825 (highlight-extent nil nil))
827 (or select-frame-hook
828 (add-hook 'select-frame-hook 'default-select-frame-hook))
830 (or deselect-frame-hook
831 (add-hook 'deselect-frame-hook 'default-deselect-frame-hook))
834 ;;; Application-specific frame-management
836 (defcustom get-frame-for-buffer-default-frame-name nil
837 "*The default frame to select; see doc of `get-frame-for-buffer'."
841 (defcustom get-frame-for-buffer-default-instance-limit nil
842 "*The default instance limit for creating new frames;
843 see doc of `get-frame-for-buffer'."
847 (defun get-frame-name-for-buffer (buffer)
848 (let ((mode (and (get-buffer buffer)
849 (save-excursion (set-buffer buffer)
851 (or (get mode 'frame-name)
852 get-frame-for-buffer-default-frame-name)))
854 (defun get-frame-for-buffer-make-new-frame (buffer &optional frame-name plist)
855 (let* ((fr (make-frame plist))
856 (w (frame-root-window fr)))
858 ;; Make the one buffer being displayed in this newly created
859 ;; frame be the buffer of interest, instead of something
860 ;; random, so that it won't be shown in two-window mode.
861 ;; Avoid calling switch-to-buffer here, since that's something
862 ;; people might want to call this routine from.
864 ;; (If the root window doesn't have a buffer, then that means
865 ;; there is more than one window on the frame, which can only
866 ;; happen if the user has done something funny on the frame-
867 ;; creation-hook. If that's the case, leave it alone.)
869 (if (window-buffer w)
870 (set-window-buffer w buffer))
873 (defcustom get-frame-for-buffer-default-to-current nil
874 "*When non-nil, `get-frame-for-buffer' will default to the selected frame."
878 (defun get-frame-for-buffer-noselect (buffer
879 &optional not-this-window-p on-frame)
880 "Return a frame in which to display BUFFER.
881 This is a subroutine of `get-frame-for-buffer' (which see)."
884 ((or on-frame (eq (selected-window) (minibuffer-window)))
885 ;; don't switch frames if a frame was specified, or to list
886 ;; completions from the minibuffer, etc.
889 ((setq name (get-frame-name-for-buffer buffer))
891 ;; This buffer's mode expressed a preference for a frame of a particular
892 ;; name. That always takes priority.
894 (let ((limit (get name 'instance-limit))
895 (defaults (get name 'frame-defaults))
896 (matching-frames '())
897 frames frame already-visible)
898 ;; Sort the list so that iconic frames will be found last. They
899 ;; will be used too, but mapped frames take precedence. And
900 ;; fully visible frames come before occluded frames.
901 ;; Hidden frames come after really visible ones
905 (cond ((frame-totally-visible-p s2)
907 ((not (frame-visible-p s2))
908 (frame-visible-p s1))
909 ((eq (frame-visible-p s2) 'hidden)
910 (eq (frame-visible-p s1) t ))
911 ((not (frame-totally-visible-p s2))
912 (and (frame-visible-p s1)
913 (frame-totally-visible-p s1)))))))
914 ;; but the selected frame should come first, even if it's occluded,
915 ;; to minimize thrashing.
916 (setq frames (cons (selected-frame)
917 (delq (selected-frame) frames)))
919 (setq name (symbol-name name))
921 (setq frame (car frames))
922 (if (equal name (frame-name frame))
923 (if (get-buffer-window buffer frame)
924 (setq already-visible frame
926 (setq matching-frames (cons frame matching-frames))))
927 (setq frames (cdr frames)))
928 (cond (already-visible
930 ((or (null matching-frames)
931 (eq limit 0) ; means create with reckless abandon
932 (and limit (< (length matching-frames) limit)))
933 (get-frame-for-buffer-make-new-frame
936 (alist-to-plist (acons 'name name
937 (plist-to-alist defaults)))))
939 ;; do not switch any of the window/buffer associations in an
940 ;; existing frame; this function only picks a frame; the
941 ;; determination of which windows on it get reused is up to
942 ;; display-buffer itself.
943 ;; (or (window-dedicated-p (selected-window))
944 ;; (switch-to-buffer buffer))
945 (car matching-frames)))))
947 ((setq limit get-frame-for-buffer-default-instance-limit)
949 ;; This buffer's mode did not express a preference for a frame of a
950 ;; particular name, but the user wants a new frame rather than
951 ;; reusing the existing one.
953 (or (plist-get default-frame-plist 'name)
956 (sort (filtered-frame-list #'(lambda (x)
957 (or (frame-visible-p x)
958 (frame-iconified-p x))))
960 (cond ((and (frame-visible-p s1)
961 (not (frame-visible-p s2))))
962 ((and (eq (frame-visible-p s1) t)
963 (eq (frame-visible-p s2) 'hidden)))
964 ((and (frame-visible-p s2)
965 (not (frame-visible-p s1)))
967 ((and (equal (frame-name s1) defname)
968 (not (equal (frame-name s2) defname))))
969 ((and (equal (frame-name s2) defname)
970 (not (equal (frame-name s1) defname)))
972 ((frame-totally-visible-p s2)
975 ;; put the selected frame last. The user wants a new frame,
976 ;; so don't reuse the existing one unless forced to.
977 (setq frames (append (delq (selected-frame) frames) (list frames)))
978 (if (or (eq limit 0) ; means create with reckless abandon
979 (< (length frames) limit))
980 (get-frame-for-buffer-make-new-frame buffer)
984 (let ((w-list (windows-of-buffer buffer))
987 (second-choice (if get-frame-for-buffer-default-to-current
991 (while (and w-list (null first-choice))
994 (cond ((eq w (selected-window)) nil)
995 ((not (frame-visible-p f))
996 (if (null last-resort)
997 (setq last-resort f)))
998 ((eq f (selected-frame))
999 (setq first-choice f))
1000 ((null second-choice)
1001 (setq second-choice f)))
1002 (setq w-list (cdr w-list)))
1003 (or first-choice second-choice last-resort)))
1005 (get-frame-for-buffer-default-to-current (selected-frame))
1009 ;; This buffer's mode did not express a preference for a frame of a
1010 ;; particular name. So try to find a frame already displaying this
1013 (let ((w (or (get-buffer-window buffer nil) ; check current first
1014 (get-buffer-window buffer 'visible) ; then visible
1015 (get-buffer-window buffer 0)))) ; then iconic
1017 ;; It's not in any window - return nil, meaning no frame has
1021 ;; Otherwise, return the frame of the buffer's window.
1022 (window-frame w))))))))
1025 ;; The pre-display-buffer-function is called for effect, so this needs to
1026 ;; actually select the frame it wants. Fdisplay_buffer() takes notice of
1027 ;; changes to the selected frame.
1028 (defun get-frame-for-buffer (buffer &optional not-this-window-p on-frame
1030 "Select and return a frame in which to display BUFFER.
1031 Normally, the buffer will simply be displayed in the selected frame.
1032 But if the symbol naming the major-mode of the buffer has a 'frame-name
1033 property (which should be a symbol), then the buffer will be displayed in
1034 a frame of that name. If there is no frame of that name, then one is
1037 If the major-mode doesn't have a 'frame-name property, then the frame
1038 named by `get-frame-for-buffer-default-frame-name' will be used. If
1039 that is nil (the default) then the currently selected frame will used.
1041 If the frame-name symbol has an 'instance-limit property (an integer)
1042 then each time a buffer of the mode in question is displayed, a new frame
1043 with that name will be created, until there are `instance-limit' of them.
1044 If instance-limit is 0, then a new frame will be created each time.
1046 If a buffer is already displayed in a frame, then `instance-limit' is
1047 ignored, and that frame is used.
1049 If the frame-name symbol has a 'frame-defaults property, then that is
1050 prepended to the `default-frame-plist' when creating a frame for the
1053 This function may be used as the value of `pre-display-buffer-function',
1054 to cause the `display-buffer' function and its callers to exhibit the
1056 (let ((frame (get-frame-for-buffer-noselect
1057 buffer not-this-window-p on-frame)))
1058 (if (not (eq frame (selected-frame)))
1060 (select-frame frame)
1061 (or (frame-visible-p frame)
1062 ;; If the frame was already visible, just focus on it.
1063 ;; If it wasn't visible (it was just created, or it used
1064 ;; to be iconified) then uniconify, raise, etc.
1065 (make-frame-visible frame))
1068 (defun frames-of-buffer (&optional buffer visible-only)
1069 "Return list of frames that BUFFER is currently being displayed on.
1070 If the buffer is being displayed on the currently selected frame, that frame
1071 is first in the list. VISIBLE-ONLY will only list non-iconified frames."
1072 (let ((list (windows-of-buffer buffer))
1073 (cur-frame (selected-frame))
1074 next-frame frames save-frame)
1077 (if (memq (setq next-frame (window-frame (car list)))
1080 (if (eq cur-frame next-frame)
1081 (setq save-frame next-frame)
1083 (or (not visible-only)
1084 (frame-visible-p next-frame))
1085 (setq frames (append frames (list next-frame))))))
1086 (setq list (cdr list)))
1089 (append (list save-frame) frames)
1092 (defcustom temp-buffer-shrink-to-fit nil
1093 "*When non-nil resize temporary output buffers to minimize blank lines."
1097 (defcustom temp-buffer-max-height .5
1098 "*Proportion of frame to use for temp windows."
1102 (defun show-temp-buffer-in-current-frame (buffer)
1103 "For use as the value of `temp-buffer-show-function':
1104 always displays the buffer in the selected frame, regardless of the behavior
1105 that would otherwise be introduced by the `pre-display-buffer-function', which
1106 is normally set to `get-frame-for-buffer' (which see)."
1107 (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is
1108 (let ((window (display-buffer buffer nil nil temp-buffer-shrink-to-fit)))
1109 (if (not (eq (last-nonminibuf-frame) (window-frame window)))
1110 ;; only the pre-display-buffer-function should ever do this.
1111 (error "display-buffer switched frames on its own!!"))
1112 (setq minibuffer-scroll-window window)
1113 (set-window-start window 1) ; obeys narrowing
1114 (set-window-point window 1)
1117 (setq pre-display-buffer-function 'get-frame-for-buffer)
1118 (setq temp-buffer-show-function 'show-temp-buffer-in-current-frame)
1121 ;; from Bob Weiner <bweiner@pts.mot.com>, modified by Ben Wing
1122 (defun delete-other-frames (&optional frame)
1123 "Delete all but FRAME (or the selected frame)."
1125 (mapc 'delete-frame (delq (or frame (selected-frame)) (frame-list))))
1127 ;; By adding primitives to directly access the window hierarchy,
1128 ;; we can move many functions into Lisp. We do it this way
1129 ;; because the implementations are simpler in Lisp, and because
1130 ;; new functions like this can be added without requiring C
1133 (defun frame-utmost-window-2 (window position left-right-p major-end-p
1135 ;; LEFT-RIGHT-P means we're looking for the leftmost or rightmost
1136 ;; window, instead of the highest or lowest. In this case, we
1137 ;; say that the "major axis" goes left-to-right instead of top-to-
1138 ;; bottom. The "minor axis" always goes perpendicularly.
1140 ;; If MAJOR-END-P is t, we're looking for a windows that abut the
1141 ;; end (i.e. right or bottom) of the major axis, instead of the
1144 ;; If MINOR-END-P is t, then we want to start counting from the
1145 ;; end of the minor axis instead of the beginning.
1147 ;; Here's the general idea: Imagine we're trying to count the number
1148 ;; of windows that abut the top; call this function foo(). So, we
1149 ;; start with the root window. If this is a vertical combination
1150 ;; window, then foo() applied to the root window is the same as
1151 ;; foo() applied to the first child. If the root is a horizontal
1152 ;; combination window, then foo() applied to the root is the
1153 ;; same as the sum of foo() applied to each of the children.
1154 ;; Otherwise, the root window is a leaf window, and foo() is 1.
1155 ;; Now it's clear that, each time foo() encounters a leaf window,
1156 ;; it's encountering a different window that abuts the top.
1157 ;; With a little examining, you can see that foo encounters the
1158 ;; top-abutting windows in order from left to right. We can
1159 ;; modify foo() to return the nth top-abutting window by simply
1160 ;; keeping a global variable that is decremented each time
1161 ;; foo() encounters a leaf window and would return 1. If the
1162 ;; global counter gets to zero, we've encountered the window
1163 ;; we were looking for, so we exit right away using a `throw'.
1164 ;; Otherwise, we make sure that all normal paths return nil.
1167 (cond ((setq child (if left-right-p
1168 (window-first-hchild window)
1169 (window-first-vchild window)))
1171 (while (window-next-child child)
1172 (setq child (window-next-child child))))
1173 (frame-utmost-window-2 child position left-right-p major-end-p
1175 ((setq child (if left-right-p
1176 (window-first-vchild window)
1177 (window-first-hchild window)))
1179 (while (window-next-child child)
1180 (setq child (window-next-child child))))
1182 (frame-utmost-window-2 child position left-right-p major-end-p
1184 (setq child (if minor-end-p
1185 (window-previous-child child)
1186 (window-next-child child))))
1189 (setcar position (1- (car position)))
1190 (if (= (car position) 0)
1191 (throw 'fhw-exit window)
1194 (defun frame-utmost-window-1 (frame position left-right-p major-end-p)
1196 (or frame (setq frame (selected-frame)))
1197 (or position (setq position 0))
1199 (setq position (1+ position))
1200 (setq minor-end-p t)
1201 (setq position (- position)))
1203 ;; we use a cons here as a simple form of call-by-reference.
1204 ;; scheme has "boxes" for the same purpose.
1205 (frame-utmost-window-2 (frame-root-window frame) (list position)
1206 left-right-p major-end-p minor-end-p))))
1209 (defun frame-highest-window (&optional frame position)
1210 "Return the highest window on FRAME which is at POSITION.
1211 If omitted, FRAME defaults to the currently selected frame.
1212 POSITION is used to distinguish between multiple windows that abut
1213 the top of the frame: 0 means the leftmost window abutting the
1214 top of the frame, 1 the next-leftmost, etc. POSITION can also
1215 be less than zero: -1 means the rightmost window abutting the
1216 top of the frame, -2 the next-rightmost, etc.
1217 If omitted, POSITION defaults to 0, i.e. the leftmost highest window.
1218 If there is no window at the given POSITION, return nil."
1219 (frame-utmost-window-1 frame position nil nil))
1221 (defun frame-lowest-window (&optional frame position)
1222 "Return the lowest window on FRAME which is at POSITION.
1223 If omitted, FRAME defaults to the currently selected frame.
1224 POSITION is used to distinguish between multiple windows that abut
1225 the bottom of the frame: 0 means the leftmost window abutting the
1226 bottom of the frame, 1 the next-leftmost, etc. POSITION can also
1227 be less than zero: -1 means the rightmost window abutting the
1228 bottom of the frame, -2 the next-rightmost, etc.
1229 If omitted, POSITION defaults to 0, i.e. the leftmost lowest window.
1230 If there is no window at the given POSITION, return nil."
1231 (frame-utmost-window-1 frame position nil t))
1233 (defun frame-leftmost-window (&optional frame position)
1234 "Return the leftmost window on FRAME which is at POSITION.
1235 If omitted, FRAME defaults to the currently selected frame.
1236 POSITION is used to distinguish between multiple windows that abut
1237 the left edge of the frame: 0 means the highest window abutting the
1238 left edge of the frame, 1 the next-highest, etc. POSITION can also
1239 be less than zero: -1 means the lowest window abutting the
1240 left edge of the frame, -2 the next-lowest, etc.
1241 If omitted, POSITION defaults to 0, i.e. the highest leftmost window.
1242 If there is no window at the given POSITION, return nil."
1243 (frame-utmost-window-1 frame position t nil))
1245 (defun frame-rightmost-window (&optional frame position)
1246 "Return the rightmost window on FRAME which is at POSITION.
1247 If omitted, FRAME defaults to the currently selected frame.
1248 POSITION is used to distinguish between multiple windows that abut
1249 the right edge of the frame: 0 means the highest window abutting the
1250 right edge of the frame, 1 the next-highest, etc. POSITION can also
1251 be less than zero: -1 means the lowest window abutting the
1252 right edge of the frame, -2 the next-lowest, etc.
1253 If omitted, POSITION defaults to 0, i.e. the highest rightmost window.
1254 If there is no window at the given POSITION, return nil."
1255 (frame-utmost-window-1 frame position t t))
1259 ;; frame properties.
1261 (defun set-frame-property (frame prop val)
1262 "Set property PROP of FRAME to VAL. See `set-frame-properties'."
1263 (set-frame-properties frame (list prop val)))
1265 (defun frame-height (&optional frame)
1266 "Return number of lines available for display on FRAME."
1267 (frame-property frame 'height))
1269 (defun frame-width (&optional frame)
1270 "Return number of columns available for display on FRAME."
1271 (frame-property frame 'width))
1273 (put 'cursor-color 'frame-property-alias [text-cursor background])
1274 (put 'modeline 'frame-property-alias 'has-modeline-p)
1279 ;;; frame.el ends here