comparison lisp/frame.el @ 209:41ff10fd062f r20-4b3

Import from CVS: tag r20-4b3
author cvs
date Mon, 13 Aug 2007 10:04:58 +0200
parents
children 78478c60bfcd
comparison
equal deleted inserted replaced
208:f427b8ec4379 209:41ff10fd062f
1 ;;; frame.el --- multi-frame management independent of window systems.
2
3 ;; Copyright (C) 1993-4, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995, 1996 Ben Wing.
5
6 ;; Maintainer: XEmacs Development Team
7 ;; Keywords: internal, dumped
8
9 ;; This file is part of XEmacs.
10
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
20
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
23 ;; Free Software Foundation, 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Synched up with: FSF 19.30.
27
28 ;;; Commentary:
29
30 ;; This file is dumped with XEmacs.
31
32 ;;; Code:
33
34 (defgroup frames nil
35 "Support for Emacs frames and window systems."
36 :group 'environment)
37
38 ; No need for `frame-creation-function'.
39
40 ;;; The initial value given here for this must ask for a minibuffer.
41 ;;; There must always exist a frame with a minibuffer, and after we
42 ;;; delete the terminal frame, this will be the only frame.
43 (defcustom initial-frame-plist '(minibuffer t)
44 "Plist of frame properties for creating the initial X window frame.
45 You can set this in your `.emacs' file; for example,
46 (setq initial-frame-plist '(top 1 left 1 width 80 height 55))
47 Properties specified here supersede the values given in `default-frame-plist'.
48 The format of this can also be an alist for backward compatibility.
49
50 If the value calls for a frame without a minibuffer, and you have not created
51 a minibuffer frame on your own, one is created according to
52 `minibuffer-frame-plist'.
53
54 You can specify geometry-related options for just the initial frame
55 by setting this variable in your `.emacs' file; however, they won't
56 take effect until Emacs reads `.emacs', which happens after first creating
57 the frame. If you want the frame to have the proper geometry as soon
58 as it appears, you need to use this three-step process:
59 * Specify X resources to give the geometry you want.
60 * Set `default-frame-plist' to override these options so that they
61 don't affect subsequent frames.
62 * Set `initial-frame-plist' in a way that matches the X resources,
63 to override what you put in `default-frame-plist'."
64 :type '(repeat (group :inline t
65 (symbol :tag "Property")
66 (sexp :tag "Value")))
67 :group 'frames)
68
69 (defcustom minibuffer-frame-plist '(width 80 height 2 menubar-visible-p nil
70 default-toolbar-visible-p nil)
71 "Plist of frame properties for initially creating a minibuffer frame.
72 You can set this in your `.emacs' file; for example,
73 (setq minibuffer-frame-plist '(top 1 left 1 width 80 height 2))
74 Properties specified here supersede the values given in
75 `default-frame-plist'.
76 The format of this can also be an alist for backward compatibility."
77 :type '(repeat (group :inline t
78 (symbol :tag "Property")
79 (sexp :tag "Value")))
80 :group 'frames)
81
82 (defcustom pop-up-frame-plist nil
83 "Plist of frame properties used when creating pop-up frames.
84 Pop-up frames are used for completions, help, and the like.
85 This variable can be set in your init file, like this:
86 (setq pop-up-frame-plist '(width 80 height 20))
87 These supersede the values given in `default-frame-plist'.
88 The format of this can also be an alist for backward compatibility."
89 :type '(repeat (group :inline t
90 (symbol :tag "Property")
91 (sexp :tag "Value")))
92 :group 'frames)
93
94 (setq pop-up-frame-function
95 (function (lambda ()
96 (make-frame pop-up-frame-plist))))
97
98 (defcustom special-display-frame-plist '(height 14 width 80 unsplittable t)
99 "*Plist of frame properties used when creating special frames.
100 Special frames are used for buffers whose names are in
101 `special-display-buffer-names' and for buffers whose names match
102 one of the regular expressions in `special-display-regexps'.
103 This variable can be set in your init file, like this:
104 (setq special-display-frame-plist '(width 80 height 20))
105 These supersede the values given in `default-frame-plist'.
106 The format of this can also be an alist for backward compatibility."
107 :type '(repeat (group :inline t
108 (symbol :tag "Property")
109 (sexp :tag "Value")))
110 :group 'frames)
111
112 (defun safe-alist-to-plist (cruftiness)
113 (if (consp (car cruftiness))
114 (alist-to-plist cruftiness)
115 cruftiness))
116
117 ;; Display BUFFER in its own frame, reusing an existing window if any.
118 ;; Return the window chosen.
119 ;; Currently we do not insist on selecting the window within its frame.
120 ;; If ARGS is a plist, use it as a list of frame property specs.
121 ;; #### Change, not compatible with FSF: This stuff is all so incredibly
122 ;; junky anyway that I doubt it makes any difference.
123 ;; If ARGS is a list whose car is t,
124 ;; use (cadr ARGS) as a function to do the work.
125 ;; Pass it BUFFER as first arg, and (cddr ARGS) gives the rest of the args.
126 (defun special-display-popup-frame (buffer &optional args)
127 ;; if we can't display simultaneous multiple frames, just return
128 ;; nil and let the normal behavior take over.
129 (and (device-on-window-system-p)
130 (if (and args (eq t (car args)))
131 (apply (cadr args) buffer (cddr args))
132 (let ((window (get-buffer-window buffer t)))
133 (if window
134 ;; If we have a window already, make it visible.
135 (let ((frame (window-frame window)))
136 (make-frame-visible frame)
137 (raise-frame frame)
138 window)
139 ;; If no window yet, make one in a new frame.
140 (let ((frame
141 (make-frame (append (safe-alist-to-plist args)
142 (safe-alist-to-plist
143 special-display-frame-plist)))))
144 (set-window-buffer (frame-selected-window frame) buffer)
145 (set-window-dedicated-p (frame-selected-window frame) t)
146 (frame-selected-window frame)))))))
147
148 (setq special-display-function 'special-display-popup-frame)
149
150 ;;; Handle delete-frame events from the X server.
151 ;(defun handle-delete-frame (event)
152 ; (interactive "e")
153 ; (let ((frame (posn-window (event-start event)))
154 ; (i 0)
155 ; (tail (frame-list)))
156 ; (while tail
157 ; (and (frame-visible-p (car tail))
158 ; (not (eq (car tail) frame))
159 ; (setq i (1+ i)))
160 ; (setq tail (cdr tail)))
161 ; (if (> i 0)
162 ; (delete-frame frame t)
163 ; (kill-emacs))))
164
165
166 ;;;; Arrangement of frames at startup
167
168 ;;; 1) Load the window system startup file from the lisp library and read the
169 ;;; high-priority arguments (-q and the like). The window system startup
170 ;;; file should create any frames specified in the window system defaults.
171 ;;;
172 ;;; 2) If no frames have been opened, we open an initial text frame.
173 ;;;
174 ;;; 3) Once the init file is done, we apply any newly set properties
175 ;;; in initial-frame-plist to the frame.
176
177 ;; These are now called explicitly at the proper times,
178 ;; since that is easier to understand.
179 ;; Actually using hooks within Emacs is bad for future maintenance. --rms.
180 ;; (add-hook 'before-init-hook 'frame-initialize)
181 ;; (add-hook 'window-setup-hook 'frame-notice-user-settings)
182
183 ;;; If we create the initial frame, this is it.
184 (defvar frame-initial-frame nil)
185
186 ;; Record the properties used in frame-initialize to make the initial frame.
187 (defvar frame-initial-frame-plist)
188
189 (defvar frame-initial-geometry-arguments nil)
190
191 (defun canonicalize-frame-plists ()
192 (setq initial-frame-plist (safe-alist-to-plist initial-frame-plist))
193 (setq default-frame-plist (safe-alist-to-plist default-frame-plist)))
194
195 ;;; startup.el calls this function before loading the user's init
196 ;;; file - if there is no frame with a minibuffer open now, create
197 ;;; one to display messages while loading the init file.
198 (defun frame-initialize ()
199 ;; In batch mode, we actually use the initial terminal device for output.
200 (canonicalize-frame-plists)
201 (if (not (noninteractive))
202 (progn
203 ;; Don't call select-frame here - focus is a matter of WM policy.
204
205 ;; If there is no frame with a minibuffer besides the terminal
206 ;; frame, then we need to create the opening frame. Make sure
207 ;; it has a minibuffer, but let initial-frame-plist omit the
208 ;; minibuffer spec.
209 (or (delq terminal-frame (minibuffer-frame-list))
210 (progn
211 (setq frame-initial-frame-plist
212 (append initial-frame-plist default-frame-plist))
213 ;; FSFmacs has scroll-bar junk here that we don't need.
214 (setq default-minibuffer-frame
215 (setq frame-initial-frame
216 (make-frame initial-frame-plist
217 (car (delq terminal-device
218 (device-list))))))
219 ;; Delete any specifications for window geometry properties
220 ;; so that we won't reapply them in frame-notice-user-settings.
221 ;; It would be wrong to reapply them then,
222 ;; because that would override explicit user resizing.
223 (setq initial-frame-plist
224 (frame-remove-geometry-props initial-frame-plist))))
225 ;; At this point, we know that we have a frame open, so we
226 ;; can delete the terminal device.
227 (delete-device terminal-device)
228 (setq terminal-frame nil)
229
230 ;; FSFmacs sets frame-creation-function here, but no need.
231 )))
232
233 ;;; startup.el calls this function after loading the user's init
234 ;;; file. Now default-frame-plist and initial-frame-plist contain
235 ;;; information to which we must react; do what needs to be done.
236 (defun frame-notice-user-settings ()
237
238 ;; FSFmacs has menu-bar junk here that we don't need.
239
240 (canonicalize-frame-plists)
241
242 ;; Creating and deleting frames may shift the selected frame around,
243 ;; and thus the current buffer. Protect against that. We don't
244 ;; want to use save-excursion here, because that may also try to set
245 ;; the buffer of the selected window, which fails when the selected
246 ;; window is the minibuffer.
247 (let ((old-buffer (current-buffer)))
248
249 ;; If the initial frame is still around, apply initial-frame-plist
250 ;; and default-frame-plist to it.
251 (if (frame-live-p frame-initial-frame)
252
253 ;; The initial frame we create above always has a minibuffer.
254 ;; If the user wants to remove it, or make it a minibuffer-only
255 ;; frame, then we'll have to delete the current frame and make a
256 ;; new one; you can't remove or add a root window to/from an
257 ;; existing frame.
258 ;;
259 ;; NOTE: default-frame-plist was nil when we created the
260 ;; existing frame. We need to explicitly include
261 ;; default-frame-plist in the properties of the screen we
262 ;; create here, so that its new value, gleaned from the user's
263 ;; .emacs file, will be applied to the existing screen.
264 (if (not (eq (car
265 (or (and (lax-plist-member
266 initial-frame-plist 'minibuffer)
267 (list (lax-plist-get initial-frame-plist
268 'minibuffer)))
269 (and (lax-plist-member default-frame-plist
270 'minibuffer)
271 (list (lax-plist-get default-frame-plist
272 'minibuffer)))
273 '(t)))
274 t))
275 ;; Create the new frame.
276 (let (props
277 )
278 ;; If the frame isn't visible yet, wait till it is.
279 ;; If the user has to position the window,
280 ;; Emacs doesn't know its real position until
281 ;; the frame is seen to be visible.
282
283 (if (frame-property frame-initial-frame 'initially-unmapped)
284 nil
285 (while (not (frame-visible-p frame-initial-frame))
286 (sleep-for 1)))
287 (setq props (frame-properties frame-initial-frame))
288 ;; Get rid of `name' unless it was specified explicitly before.
289 (or (lax-plist-member frame-initial-frame-plist 'name)
290 (setq props (lax-plist-remprop props 'name)))
291 (setq props (append initial-frame-plist default-frame-plist
292 props
293 nil))
294 ;; Get rid of `reverse', because that was handled
295 ;; when we first made the frame.
296 (laxputf props 'reverse nil)
297 ;; Get rid of `window-id', otherwise make-frame will
298 ;; think we're trying to setup an external widget.
299 (laxremf props 'window-id)
300 (if (lax-plist-member frame-initial-geometry-arguments 'height)
301 (laxremf props 'height))
302 (if (lax-plist-member frame-initial-geometry-arguments 'width)
303 (laxremf props 'width))
304 (if (lax-plist-member frame-initial-geometry-arguments 'left)
305 (laxremf props 'left))
306 (if (lax-plist-member frame-initial-geometry-arguments 'top)
307 (laxremf props 'top))
308
309 ;; Now create the replacement initial frame.
310 (make-frame
311 ;; Use the geometry args that created the existing
312 ;; frame, rather than the props we get for it.
313 (append '(user-size t user-position t)
314 frame-initial-geometry-arguments
315 props))
316 ;; The initial frame, which we are about to delete, may be
317 ;; the only frame with a minibuffer. If it is, create a
318 ;; new one.
319 (or (delq frame-initial-frame (minibuffer-frame-list))
320 (make-initial-minibuffer-frame nil))
321
322 ;; If the initial frame is serving as a surrogate
323 ;; minibuffer frame for any frames, we need to wean them
324 ;; onto a new frame. The default-minibuffer-frame
325 ;; variable must be handled similarly.
326 (let ((users-of-initial
327 (filtered-frame-list
328 #'(lambda (frame)
329 (and (not (eq frame frame-initial-frame))
330 (eq (window-frame
331 (minibuffer-window frame))
332 frame-initial-frame))))))
333 (if (or users-of-initial
334 (eq default-minibuffer-frame frame-initial-frame))
335
336 ;; Choose an appropriate frame. Prefer frames which
337 ;; are only minibuffers.
338 (let* ((new-surrogate
339 (car
340 (or (filtered-frame-list
341 #'(lambda (frame)
342 (eq 'only
343 (frame-property frame 'minibuffer))))
344 (minibuffer-frame-list))))
345 (new-minibuffer (minibuffer-window new-surrogate)))
346
347 (if (eq default-minibuffer-frame frame-initial-frame)
348 (setq default-minibuffer-frame new-surrogate))
349
350 ;; Wean the frames using frame-initial-frame as
351 ;; their minibuffer frame.
352 (mapcar
353 #'
354 (lambda (frame)
355 (set-frame-property frame 'minibuffer
356 new-minibuffer))
357 users-of-initial))))
358
359 ;; Redirect events enqueued at this frame to the new frame.
360 ;; Is this a good idea?
361 ;; Probably not, since this whole redirect-frame-focus
362 ;; stuff is a load of trash, and so is this function we're in.
363 ;; --ben
364 ;(redirect-frame-focus frame-initial-frame new)
365
366 ;; Finally, get rid of the old frame.
367 (delete-frame frame-initial-frame t))
368
369 ;; Otherwise, we don't need all that rigamarole; just apply
370 ;; the new properties.
371 (let (newprops allprops tail)
372 (setq allprops (append initial-frame-plist
373 default-frame-plist))
374 (if (lax-plist-member frame-initial-geometry-arguments 'height)
375 (laxremf allprops 'height))
376 (if (lax-plist-member frame-initial-geometry-arguments 'width)
377 (remf allprops 'width))
378 (if (lax-plist-member frame-initial-geometry-arguments 'left)
379 (laxremf allprops 'left))
380 (if (lax-plist-member frame-initial-geometry-arguments 'top)
381 (laxremf allprops 'top))
382 (setq tail allprops)
383 ;; Find just the props that have changed since we first
384 ;; made this frame. Those are the ones actually set by
385 ;; the init file. For those props whose values we already knew
386 ;; (such as those spec'd by command line options)
387 ;; it is undesirable to specify the parm again
388 ;; once the user has seen the frame and been able to alter it
389 ;; manually.
390 (while tail
391 (let (newval oldval)
392 (setq oldval (lax-plist-get frame-initial-frame-plist
393 (car tail)))
394 (setq newval (lax-plist-get allprops (car tail)))
395 (or (eq oldval newval)
396 (laxputf newprops (car tail) newval)))
397 (setq tail (cddr tail)))
398 (set-frame-properties frame-initial-frame newprops)
399 ;silly FSFmacs junk
400 ;if (lax-plist-member newprops 'font)
401 ; (frame-update-faces frame-initial-frame))
402
403 )))
404
405 ;; Restore the original buffer.
406 (set-buffer old-buffer)
407
408 ;; Make sure the initial frame can be GC'd if it is ever deleted.
409 ;; Make sure frame-notice-user-settings does nothing if called twice.
410 (setq frame-initial-frame nil)))
411
412 (defun make-initial-minibuffer-frame (device)
413 (let ((props (append '(minibuffer only)
414 (safe-alist-to-plist minibuffer-frame-plist))))
415 (make-frame props device)))
416
417
418 ;;;; Creation of additional frames, and other frame miscellanea
419
420 (defun get-other-frame ()
421 "Return some frame other than the current frame, creating one if necessary."
422 (let* ((this (selected-frame))
423 ;; search visible frames first
424 (next (next-frame this 'visible-nomini)))
425 ;; then search iconified frames
426 (if (eq this next)
427 (setq next (next-frame 'visible-iconic-nomini)))
428 (if (eq this next)
429 ;; otherwise, make a new frame
430 (make-frame)
431 next)))
432
433 (defun next-multiframe-window ()
434 "Select the next window, regardless of which frame it is on."
435 (interactive)
436 (select-window (next-window (selected-window)
437 (> (minibuffer-depth) 0)
438 t)))
439
440 (defun previous-multiframe-window ()
441 "Select the previous window, regardless of which frame it is on."
442 (interactive)
443 (select-window (previous-window (selected-window)
444 (> (minibuffer-depth) 0)
445 t)))
446
447 (defun make-frame-on-device (type connection &optional props)
448 "Create a frame of type TYPE on CONNECTION.
449 TYPE should be a symbol naming the device type, i.e. one of
450
451 x An X display. CONNECTION should be a standard display string
452 such as \"unix:0\", or nil for the display specified on the
453 command line or in the DISPLAY environment variable. Only if
454 support for X was compiled into XEmacs.
455 tty A standard TTY connection or terminal. CONNECTION should be
456 a TTY device name such as \"/dev/ttyp2\" (as determined by
457 the Unix command `tty') or nil for XEmacs' standard input
458 and output (usually the TTY in which XEmacs started). Only
459 if support for TTY's was compiled into XEmacs.
460 ns A connection to a machine running the NeXTstep windowing
461 system. Not currently implemented.
462 w32 A connection to a machine running Microsoft Windows NT or
463 Windows 95.
464 pc A direct-write MS-DOS frame. Not currently implemented.
465
466 PROPS should be a plist of properties, as in the call to `make-frame'.
467
468 If a connection to CONNECTION already exists, it is reused; otherwise,
469 a new connection is opened."
470 (make-frame props (make-device type connection props)))
471
472 ;; Alias, kept temporarily.
473 (defalias 'new-frame 'make-frame)
474
475 ; FSFmacs has make-frame here. We have it in C, so no need for
476 ; frame-creation-function.
477
478 (defun filtered-frame-list (predicate &optional device)
479 "Return a list of all live frames which satisfy PREDICATE.
480 If optional second arg DEVICE is non-nil, restrict the frames
481 returned to that device."
482 (let ((frames (if device (device-frame-list device)
483 (frame-list)))
484 good-frames)
485 (while (consp frames)
486 (if (funcall predicate (car frames))
487 (setq good-frames (cons (car frames) good-frames)))
488 (setq frames (cdr frames)))
489 good-frames))
490
491 (defun minibuffer-frame-list (&optional device)
492 "Return a list of all frames with their own minibuffers.
493 If optional second arg DEVICE is non-nil, restrict the frames
494 returned to that device."
495 (filtered-frame-list
496 #'(lambda (frame)
497 (eq frame (window-frame (minibuffer-window frame))))
498 device))
499
500 (defun frame-minibuffer-only-p (frame)
501 "Return non-nil if FRAME is a minibuffer-only frame."
502 (eq (frame-root-window frame) (minibuffer-window frame)))
503
504 (defun frame-remove-geometry-props (plist)
505 "Return the property list PLIST, but with geometry specs removed.
506 This deletes all bindings in PLIST for `top', `left', `width',
507 `height', `user-size' and `user-position' properties.
508 Emacs uses this to avoid overriding explicit moves and resizings from
509 the user during startup."
510 (setq plist (canonicalize-lax-plist (copy-sequence plist)))
511 (mapcar #'(lambda (propname)
512 (if (lax-plist-member plist propname)
513 (progn
514 (setq frame-initial-geometry-arguments
515 (cons propname
516 (cons (lax-plist-get plist propname)
517 frame-initial-geometry-arguments)))
518 (setq plist (lax-plist-remprop plist propname)))))
519 '(height width top left user-size user-position))
520 plist)
521
522 (defun other-frame (arg)
523 "Select the ARG'th different visible frame, and raise it.
524 All frames are arranged in a cyclic order.
525 This command selects the frame ARG steps away in that order.
526 A negative ARG moves in the opposite order."
527 (interactive "p")
528 (let ((frame (selected-frame)))
529 (while (> arg 0)
530 (setq frame (next-frame frame 'visible-nomini))
531 (setq arg (1- arg)))
532 (while (< arg 0)
533 (setq frame (previous-frame frame 'visible-nomini))
534 (setq arg (1+ arg)))
535 (raise-frame frame)
536 (select-frame frame)
537 ;this is a bad idea; you should in general never warp the
538 ;pointer unless the user asks for this. Furthermore,
539 ;our version of `set-mouse-position' takes a window,
540 ;not a frame.
541 ;(set-mouse-position (selected-frame) (1- (frame-width)) 0)
542 ;some weird FSFmacs randomness
543 ;(if (fboundp 'unfocus-frame)
544 ; (unfocus-frame))))
545 ))
546
547 ;; XEmacs-added utility functions
548
549 ; this is in C in FSFmacs
550 (defun frame-list ()
551 "Return a list of all frames on all devices/consoles."
552 ;; Lists are copies, so nconc is safe here.
553 (apply 'nconc (mapcar 'device-frame-list (device-list))))
554
555 (defun frame-type (&optional frame)
556 "Return the type of the specified frame (e.g. `x' or `tty').
557 This is equivalent to the type of the frame's device.
558 Value is `tty' for a tty frame (a character-only terminal),
559 `x' for a frame that is an X window,
560 `ns' for a frame that is a NeXTstep window (not yet implemented),
561 `win32' for a frame that is a Windows or Windows NT window (not yet
562 implemented),
563 `pc' for a frame that is a direct-write MS-DOS frame (not yet implemented),
564 `stream' for a stream frame (which acts like a stdio stream), and
565 `dead' for a deleted frame."
566 (or frame (setq frame (selected-frame)))
567 (if (not (frame-live-p frame)) 'dead
568 (device-type (frame-device frame))))
569
570 (defun device-or-frame-p (object)
571 "Return non-nil if OBJECT is a device or frame."
572 (or (devicep object)
573 (framep object)))
574
575 (defun device-or-frame-type (device-or-frame)
576 "Return the type (e.g. `x' or `tty') of DEVICE-OR-FRAME.
577 DEVICE-OR-FRAME should be a device or a frame object. See `device-type'
578 for a description of the possible types."
579 (if (devicep device-or-frame)
580 (device-type device-or-frame)
581 (frame-type device-or-frame)))
582
583 (defun fw-frame (obj)
584 "Given a frame or window, return the associated frame.
585 Return nil otherwise."
586 (cond ((windowp obj) (window-frame obj))
587 ((framep obj) obj)
588 (t nil)))
589
590
591 ;;;; Frame configurations
592
593 (defun current-frame-configuration ()
594 "Return a list describing the positions and states of all frames.
595 Its car is `frame-configuration'.
596 Each element of the cdr is a list of the form (FRAME PLIST WINDOW-CONFIG),
597 where
598 FRAME is a frame object,
599 PLIST is a property list specifying some of FRAME's properties, and
600 WINDOW-CONFIG is a window configuration object for FRAME."
601 (cons 'frame-configuration
602 (mapcar (function
603 (lambda (frame)
604 (list frame
605 (frame-properties frame)
606 (current-window-configuration frame))))
607 (frame-list))))
608
609 (defun set-frame-configuration (configuration &optional nodelete)
610 "Restore the frames to the state described by CONFIGURATION.
611 Each frame listed in CONFIGURATION has its position, size, window
612 configuration, and other properties set as specified in CONFIGURATION.
613 Ordinarily, this function deletes all existing frames not
614 listed in CONFIGURATION. But if optional second argument NODELETE
615 is given and non-nil, the unwanted frames are iconified instead."
616 (or (frame-configuration-p configuration)
617 (signal 'wrong-type-argument
618 (list 'frame-configuration-p configuration)))
619 (let ((config-plist (cdr configuration))
620 frames-to-delete)
621 (mapc (lambda (frame)
622 (let ((properties (assq frame config-plist)))
623 (if properties
624 (progn
625 (set-frame-properties
626 frame
627 ;; Since we can't set a frame's minibuffer status,
628 ;; we might as well omit the parameter altogether.
629 (lax-plist-remprop (nth 1 properties) 'minibuffer))
630 (set-window-configuration (nth 2 properties)))
631 (setq frames-to-delete (cons frame frames-to-delete)))))
632 (frame-list))
633 (if nodelete
634 ;; Note: making frames invisible here was tried
635 ;; but led to some strange behavior--each time the frame
636 ;; was made visible again, the window manager asked afresh
637 ;; for where to put it.
638 (mapc 'iconify-frame frames-to-delete)
639 (mapc 'delete-frame frames-to-delete))))
640
641 ; this function is in subr.el in FSFmacs.
642 ; that's because they don't always include frame.el, while we do.
643
644 (defun frame-configuration-p (object)
645 "Return non-nil if OBJECT seems to be a frame configuration.
646 Any list whose car is `frame-configuration' is assumed to be a frame
647 configuration."
648 (and (consp object)
649 (eq (car object) 'frame-configuration)))
650
651
652 ;; FSFmacs has functions `frame-width', `frame-height' here.
653 ;; We have them in C.
654
655 ;; FSFmacs has weird functions `set-default-font', `set-background-color',
656 ;; `set-foreground-color' here. They don't do sensible things like
657 ;; set faces; instead they set frame properties (??!!) and call
658 ;; useless functions such as `frame-update-faces' and
659 ;; `frame-update-face-colors'.
660
661 ;; FSFmacs has functions `set-cursor-color', `set-mouse-color', and
662 ;; `set-border-color', which refer to frame properties.
663 ;; #### We need to use specifiers here.
664
665 ;(defun auto-raise-mode (arg)
666 ; "Toggle whether or not the selected frame should auto-raise.
667 ;With arg, turn auto-raise mode on if and only if arg is positive.
668 ;Note that this controls Emacs's own auto-raise feature.
669 ;Some window managers allow you to enable auto-raise for certain windows.
670 ;You can use that for Emacs windows if you wish, but if you do,
671 ;that is beyond the control of Emacs and this command has no effect on it."
672 ; (interactive "P")
673 ; (if (null arg)
674 ; (setq arg
675 ; (if (frame-property (selected-frame) 'auto-raise)
676 ; -1 1)))
677 ; (set-frame-property (selected-frame) 'auto-raise (> arg 0)))
678
679 ;(defun auto-lower-mode (arg)
680 ; "Toggle whether or not the selected frame should auto-lower.
681 ;With arg, turn auto-lower mode on if and only if arg is positive.
682 ;Note that this controls Emacs's own auto-lower feature.
683 ;Some window managers allow you to enable auto-lower for certain windows.
684 ;You can use that for Emacs windows if you wish, but if you do,
685 ;that is beyond the control of Emacs and this command has no effect on it."
686 ; (interactive "P")
687 ; (if (null arg)
688 ; (setq arg
689 ; (if (frame-property (selected-frame) 'auto-lower)
690 ; -1 1)))
691 ; (set-frame-property (selected-frame) 'auto-lower (> arg 0)))
692
693 ;; FSFmacs has silly functions `toggle-scroll-bar',
694 ;; `toggle-horizontal-scrollbar'
695
696 ;;; Iconifying emacs.
697 ;;;
698 ;;; The function iconify-emacs replaces every non-iconified emacs window
699 ;;; with a *single* icon. Iconified emacs windows are left alone. When
700 ;;; emacs is in this globally-iconified state, de-iconifying any emacs icon
701 ;;; will uniconify all frames that were visible, and iconify all frames
702 ;;; that were not. This is done by temporarily changing the value of
703 ;;; `map-frame-hook' to `deiconify-emacs' (which should never be called
704 ;;; except from the map-frame-hook while emacs is iconified).
705 ;;;
706 ;;; The title of the icon representing all emacs frames is controlled by
707 ;;; the variable `icon-name'. This is done by temporarily changing the
708 ;;; value of `frame-icon-title-format'. Unfortunately, this changes the
709 ;;; titles of all emacs icons, not just the "big" icon.
710 ;;;
711 ;;; It would be nice if existing icons were removed and restored by
712 ;;; iconifying the emacs process, but I couldn't make that work yet.
713
714 (defvar icon-name nil) ; set this at run time, not load time.
715
716 (defvar iconification-data nil)
717
718 (defun iconify-emacs ()
719 "Replace every non-iconified FRAME with a *single* icon.
720 Iconified frames are left alone. When XEmacs is in this
721 globally-iconified state, de-iconifying any emacs icon will uniconify
722 all frames that were visible, and iconify all frames that were not."
723 (interactive)
724 (if iconification-data (error "already iconified?"))
725 (let* ((frames (frame-list))
726 (rest frames)
727 (me (selected-frame))
728 frame)
729 (while rest
730 (setq frame (car rest))
731 (setcar rest (cons frame (frame-visible-p frame)))
732 ; (if (memq (cdr (car rest)) '(icon nil))
733 ; (progn
734 ; (make-frame-visible frame) ; deiconify, and process the X event
735 ; (sleep-for 500 t) ; process X events; I really want to XSync() here
736 ; ))
737 (or (eq frame me) (make-frame-invisible frame))
738 (setq rest (cdr rest)))
739 (or (boundp 'map-frame-hook) (setq map-frame-hook nil))
740 (or icon-name
741 (setq icon-name (concat invocation-name " @ " (system-name))))
742 (setq iconification-data
743 (list frame-icon-title-format map-frame-hook frames)
744 frame-icon-title-format icon-name
745 map-frame-hook 'deiconify-emacs)
746 (iconify-frame me)))
747
748
749 (defun deiconify-emacs (&optional ignore)
750 (or iconification-data (error "not iconified?"))
751 (setq frame-icon-title-format (car iconification-data)
752 map-frame-hook (car (cdr iconification-data))
753 iconification-data (car (cdr (cdr iconification-data))))
754 (while iconification-data
755 (let ((visibility (cdr (car iconification-data))))
756 (cond (visibility ;; JV (Note non-nil means visible in XEmacs)
757 (make-frame-visible (car (car iconification-data))))
758 ; (t ;; (eq visibility 'icon) ;; JV Not in XEmacs!!!
759 ; (make-frame-visible (car (car iconification-data)))
760 ; (sleep-for 500 t) ; process X events; I really want to XSync() here
761 ; (iconify-frame (car (car iconification-data))))
762 ;; (t nil)
763 ))
764 (setq iconification-data (cdr iconification-data))))
765
766 (defun suspend-or-iconify-emacs ()
767 "Calls iconify-emacs if frame is an X frame, otherwise calls suspend-emacs"
768 (interactive)
769 (cond
770 ((eq (frame-type) 'x)
771 (iconify-emacs))
772 ((and (eq (frame-type) 'tty)
773 (console-tty-controlling-process (selected-console)))
774 (suspend-console (selected-console)))
775 (t
776 (suspend-emacs))))
777
778 ;; This is quite a mouthful, but it should be descriptive, as it's
779 ;; bound to C-z
780 (defun suspend-emacs-or-iconify-frame ()
781 "Iconify current frame if it is an X frame, otherwise suspend Emacs."
782 (interactive)
783 (cond ((eq (frame-type) 'x)
784 (iconify-frame))
785 ((and (eq (frame-type) 'tty)
786 (console-tty-controlling-process (selected-console)))
787 (suspend-console (selected-console)))
788 (t
789 (suspend-emacs))))
790
791
792 ;;; auto-raise and auto-lower
793
794 (defcustom auto-raise-frame nil
795 "*If true, frames will be raised to the top when selected.
796 Under X, most ICCCM-compliant window managers will have an option to do this
797 for you, but this variable is provided in case you're using a broken WM."
798 :type 'boolean
799 :group 'frames)
800
801 (defcustom auto-lower-frame nil
802 "*If true, frames will be lowered to the bottom when no longer selected.
803 Under X, most ICCCM-compliant window managers will have an option to do this
804 for you, but this variable is provided in case you're using a broken WM."
805 :type 'boolean
806 :group 'frames)
807
808 (defun default-select-frame-hook ()
809 "Implements the `auto-raise-frame' variable.
810 For use as the value of `select-frame-hook'."
811 (if auto-raise-frame (raise-frame (selected-frame))))
812
813 (defun default-deselect-frame-hook ()
814 "Implements the `auto-lower-frame' variable.
815 For use as the value of `deselect-frame-hook'."
816 (if auto-lower-frame (lower-frame (selected-frame))))
817
818 (or select-frame-hook
819 (add-hook 'select-frame-hook 'default-select-frame-hook))
820
821 (or deselect-frame-hook
822 (add-hook 'deselect-frame-hook 'default-deselect-frame-hook))
823
824 (defun default-drag-and-drop-functions (frame filepath &optional data)
825 "Implements the `drag-and-drop-functions' variable.
826 For use as the value of `drag-and-drop-functions'.
827 A file is popped up in a new buffer, some data without
828 is inserted at point."
829 ;; changed this back -- hope it works for CDE ;-) Oliver Graf <ograf@fga.de>
830 ;; the OffiX drop stuff has moved to mouse.el (mouse-offix-drop)
831 (if data
832 (insert data)
833 (let ((x pop-up-windows))
834 (setq pop-up-windows nil)
835 (pop-to-buffer (find-file-noselect filepath) nil frame)
836 (make-frame-visible frame)
837 (setq pop-up-windows x))))
838
839 (and (boundp 'drag-and-drop-functions)
840 (or drag-and-drop-functions
841 (add-hook 'drag-and-drop-functions 'default-drag-and-drop-functions)))
842
843 (defun cde-start-drag (begin end)
844 "Implements the CDE drag operation.
845 Calls the internal function cde-start-drag-internal to do the actual work."
846 (interactive "_r")
847 (if (featurep 'cde)
848 ;; Avoid build-time doc string warning by calling the function
849 ;; in the following roundabout way:
850 (funcall (intern "cde-start-drag-internal")
851 (buffer-substring-no-properties begin end))
852 (error "CDE functionality not compiled in.")))
853
854 ;; the OffiX drag stuff will soon move also (perhaps mouse.el)
855 ;; if the drag event is done
856 (defun offix-start-drag (event data &optional type)
857 "Implements the OffiX drag operation.
858 Calls the internal function offix-start-drag-internal to do the actual work.
859 If type is not given, DndText is assumed."
860 ;; Oliver Graf <ograf@fga.de>
861 (interactive "esi")
862 (if (featurep 'offix)
863 (funcall (intern "offix-start-drag-internal") event data type)
864 (error "OffiX functionality not compiled in.")))
865
866 (defun offix-start-drag-region (event begin end)
867 "Implements the OffiX drag operation for a region.
868 Calls the internal function offix-start-drag-internal to do the actual work.
869 This always assumes DndText as type."
870 ;; Oliver Graf <ograf@fga.de>
871 (interactive "_er")
872 (if (featurep 'offix)
873 (funcall (intern "offix-start-drag-internal")
874 event (buffer-substring-no-properties begin end))
875 (error "OffiX functionality not compiled in.")))
876
877
878
879 ;;; Application-specific frame-management
880
881 (defvar get-frame-for-buffer-default-frame-name nil
882 "The default frame to select; see doc of `get-frame-for-buffer'.")
883
884 (defvar get-frame-for-buffer-default-instance-limit nil)
885
886 (defun get-frame-name-for-buffer (buffer)
887 (let ((mode (and (get-buffer buffer)
888 (save-excursion (set-buffer buffer)
889 major-mode))))
890 (or (get mode 'frame-name)
891 get-frame-for-buffer-default-frame-name)))
892
893 (defun get-frame-for-buffer-make-new-frame (buffer &optional frame-name plist)
894 (let* ((fr (make-frame plist))
895 (w (frame-root-window fr)))
896 ;;
897 ;; Make the one buffer being displayed in this newly created
898 ;; frame be the buffer of interest, instead of something
899 ;; random, so that it won't be shown in two-window mode.
900 ;; Avoid calling switch-to-buffer here, since that's something
901 ;; people might want to call this routine from.
902 ;;
903 ;; (If the root window doesn't have a buffer, then that means
904 ;; there is more than one window on the frame, which can only
905 ;; happen if the user has done something funny on the frame-
906 ;; creation-hook. If that's the case, leave it alone.)
907 ;;
908 (if (window-buffer w)
909 (set-window-buffer w buffer))
910 fr))
911
912 (defun get-frame-for-buffer-noselect (buffer
913 &optional not-this-window-p on-frame)
914 "Return a frame in which to display BUFFER.
915 This is a subroutine of `get-frame-for-buffer' (which see)."
916 (let (name limit)
917 (cond
918 ((or on-frame (eq (selected-window) (minibuffer-window)))
919 ;; don't switch frames if a frame was specified, or to list
920 ;; completions from the minibuffer, etc.
921 nil)
922
923 ((setq name (get-frame-name-for-buffer buffer))
924 ;;
925 ;; This buffer's mode expressed a preference for a frame of a particular
926 ;; name. That always takes priority.
927 ;;
928 (let ((limit (get name 'instance-limit))
929 (defaults (get name 'frame-defaults))
930 (matching-frames '())
931 frames frame already-visible)
932 ;; Sort the list so that iconic frames will be found last. They
933 ;; will be used too, but mapped frames take precedence. And
934 ;; fully visible frames come before occluded frames.
935 ;; Hidden frames come after really visible ones
936 (setq frames
937 (sort (frame-list)
938 #'(lambda (s1 s2)
939 (cond ((frame-totally-visible-p s2)
940 nil)
941 ((not (frame-visible-p s2))
942 (frame-visible-p s1))
943 ((eq (frame-visible-p s2) 'hidden)
944 (eq (frame-visible-p s1) t ))
945 ((not (frame-totally-visible-p s2))
946 (and (frame-visible-p s1)
947 (frame-totally-visible-p s1)))))))
948 ;; but the selected frame should come first, even if it's occluded,
949 ;; to minimize thrashing.
950 (setq frames (cons (selected-frame)
951 (delq (selected-frame) frames)))
952
953 (setq name (symbol-name name))
954 (while frames
955 (setq frame (car frames))
956 (if (equal name (frame-name frame))
957 (if (get-buffer-window buffer frame)
958 (setq already-visible frame
959 frames nil)
960 (setq matching-frames (cons frame matching-frames))))
961 (setq frames (cdr frames)))
962 (cond (already-visible
963 already-visible)
964 ((or (null matching-frames)
965 (eq limit 0) ; means create with reckless abandon
966 (and limit (< (length matching-frames) limit)))
967 (get-frame-for-buffer-make-new-frame
968 buffer
969 name
970 (alist-to-plist (acons 'name name
971 (plist-to-alist defaults)))))
972 (t
973 ;; do not switch any of the window/buffer associations in an
974 ;; existing frame; this function only picks a frame; the
975 ;; determination of which windows on it get reused is up to
976 ;; display-buffer itself.
977 ;; (or (window-dedicated-p (selected-window))
978 ;; (switch-to-buffer buffer))
979 (car matching-frames)))))
980
981 ((setq limit get-frame-for-buffer-default-instance-limit)
982 ;;
983 ;; This buffer's mode did not express a preference for a frame of a
984 ;; particular name, but the user wants a new frame rather than
985 ;; reusing the existing one.
986 (let* ((defname
987 (or (plist-get default-frame-plist 'name)
988 default-frame-name))
989 (frames
990 (sort (filtered-frame-list #'(lambda (x)
991 (or (frame-visible-p x)
992 (frame-iconified-p x))))
993 #'(lambda (s1 s2)
994 (cond ((and (frame-visible-p s1)
995 (not (frame-visible-p s2))))
996 ((and (eq (frame-visible-p s1) t)
997 (eq (frame-visible-p s2) 'hidden)))
998 ((and (frame-visible-p s2)
999 (not (frame-visible-p s1)))
1000 nil)
1001 ((and (equal (frame-name s1) defname)
1002 (not (equal (frame-name s2) defname))))
1003 ((and (equal (frame-name s2) defname)
1004 (not (equal (frame-name s1) defname)))
1005 nil)
1006 ((frame-totally-visible-p s2)
1007 nil)
1008 (t))))))
1009 ;; put the selected frame last. The user wants a new frame,
1010 ;; so don't reuse the existing one unless forced to.
1011 (setq frames (append (delq (selected-frame) frames) (list frames)))
1012 (if (or (eq limit 0) ; means create with reckless abandon
1013 (< (length frames) limit))
1014 (get-frame-for-buffer-make-new-frame buffer)
1015 (car frames))))
1016
1017 (t
1018 ;;
1019 ;; This buffer's mode did not express a preference for a frame of a
1020 ;; particular name. So try to find a frame already displaying this
1021 ;; buffer.
1022 ;;
1023 (let ((w (or (get-buffer-window buffer 'visible) ; check visible first
1024 (get-buffer-window buffer 0)))) ; then iconic
1025 (cond ((null w)
1026 ;; It's not in any window - return nil, meaning no frame has
1027 ;; preference.
1028 nil)
1029 ((and not-this-window-p
1030 (eq (selected-frame) (window-frame w)))
1031 ;; It's in a window, but on this frame, and we have been
1032 ;; asked to pick another window. Return nil, meaning no
1033 ;; frame has preference.
1034 nil)
1035 (t
1036 ;; Otherwise, return the frame of the buffer's window.
1037 (window-frame w))))))))
1038
1039
1040 ;; The pre-display-buffer-function is called for effect, so this needs to
1041 ;; actually select the frame it wants. Fdisplay_buffer() takes notice of
1042 ;; changes to the selected frame.
1043 (defun get-frame-for-buffer (buffer &optional not-this-window-p on-frame)
1044 "Select and return a frame in which to display BUFFER.
1045 Normally, the buffer will simply be displayed in the current frame.
1046 But if the symbol naming the major-mode of the buffer has a 'frame-name
1047 property (which should be a symbol), then the buffer will be displayed in
1048 a frame of that name. If there is no frame of that name, then one is
1049 created.
1050
1051 If the major-mode doesn't have a 'frame-name property, then the frame
1052 named by `get-frame-for-buffer-default-frame-name' will be used. If
1053 that is nil (the default) then the currently selected frame will used.
1054
1055 If the frame-name symbol has an 'instance-limit property (an integer)
1056 then each time a buffer of the mode in question is displayed, a new frame
1057 with that name will be created, until there are `instance-limit' of them.
1058 If instance-limit is 0, then a new frame will be created each time.
1059
1060 If a buffer is already displayed in a frame, then `instance-limit' is
1061 ignored, and that frame is used.
1062
1063 If the frame-name symbol has a 'frame-defaults property, then that is
1064 prepended to the `default-frame-plist' when creating a frame for the
1065 first time.
1066
1067 This function may be used as the value of `pre-display-buffer-function',
1068 to cause the display-buffer function and its callers to exhibit the above
1069 behavior."
1070 (let ((frame (get-frame-for-buffer-noselect
1071 buffer not-this-window-p on-frame)))
1072 (if (not (eq frame (selected-frame)))
1073 frame
1074 (select-frame frame)
1075 (or (frame-visible-p frame)
1076 ;; If the frame was already visible, just focus on it.
1077 ;; If it wasn't visible (it was just created, or it used
1078 ;; to be iconified) then uniconify, raise, etc.
1079 (make-frame-visible frame))
1080 frame)))
1081
1082 (defun frames-of-buffer (&optional buffer visible-only)
1083 "Return list of frames that BUFFER is currently being displayed on.
1084 If the buffer is being displayed on the currently selected frame, that frame
1085 is first in the list. VISIBLE-ONLY will only list non-iconified frames."
1086 (let ((list (windows-of-buffer buffer))
1087 (cur-frame (selected-frame))
1088 next-frame frames save-frame)
1089
1090 (while list
1091 (if (memq (setq next-frame (window-frame (car list)))
1092 frames)
1093 nil
1094 (if (eq cur-frame next-frame)
1095 (setq save-frame next-frame)
1096 (and
1097 (or (not visible-only)
1098 (frame-visible-p next-frame))
1099 (setq frames (append frames (list next-frame))))))
1100 (setq list (cdr list)))
1101
1102 (if save-frame
1103 (append (list save-frame) frames)
1104 frames)))
1105
1106 (defcustom temp-buffer-shrink-to-fit nil
1107 "*When non-nil resize temporary output buffers to minimize blank lines."
1108 :type 'boolean
1109 :group 'frames)
1110
1111 (defcustom temp-buffer-max-height .5
1112 "*Proportion of frame to use for temp windows."
1113 :type 'number
1114 :group 'frames)
1115
1116 (defun show-temp-buffer-in-current-frame (buffer)
1117 "For use as the value of temp-buffer-show-function:
1118 always displays the buffer in the current frame, regardless of the behavior
1119 that would otherwise be introduced by the `pre-display-buffer-function', which
1120 is normally set to `get-frame-for-buffer' (which see)."
1121 (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is
1122 (let ((window (display-buffer buffer)))
1123 (if (not (eq (last-nonminibuf-frame) (window-frame window)))
1124 ;; only the pre-display-buffer-function should ever do this.
1125 (error "display-buffer switched frames on its own!!"))
1126 (setq minibuffer-scroll-window window)
1127 (set-window-start window 1) ; obeys narrowing
1128 (set-window-point window 1)
1129 (when temp-buffer-shrink-to-fit
1130 (let* ((temp-window-size (round (* temp-buffer-max-height
1131 (frame-height (window-frame window)))))
1132 (size (window-displayed-height window)))
1133 (when (< size temp-window-size)
1134 (enlarge-window (- temp-window-size size) nil window)))
1135 (shrink-window-if-larger-than-buffer window))
1136 nil)))
1137
1138 (setq pre-display-buffer-function 'get-frame-for-buffer)
1139 (setq temp-buffer-show-function 'show-temp-buffer-in-current-frame)
1140
1141
1142 ;; from Bob Weiner <bweiner@pts.mot.com>, modified by Ben Wing
1143 (defun delete-other-frames (&optional frame)
1144 "Delete all but FRAME (or the selected frame)."
1145 (interactive)
1146 (mapc 'delete-frame (delq (or frame (selected-frame)) (frame-list))))
1147
1148 ;; By adding primitives to directly access the window hierarchy,
1149 ;; we can move many functions into Lisp. We do it this way
1150 ;; because the implementations are simpler in Lisp, and because
1151 ;; new functions like this can be added without requiring C
1152 ;; additions.
1153
1154 (defun frame-utmost-window-2 (window position left-right-p major-end-p
1155 minor-end-p)
1156 ;; LEFT-RIGHT-P means we're looking for the leftmost or rightmost
1157 ;; window, instead of the highest or lowest. In this case, we
1158 ;; say that the "major axis" goes left-to-right instead of top-to-
1159 ;; bottom. The "minor axis" always goes perpendicularly.
1160 ;;
1161 ;; If MAJOR-END-P is t, we're looking for a windows that abut the
1162 ;; end (i.e. right or bottom) of the major axis, instead of the
1163 ;; start.
1164 ;;
1165 ;; If MINOR-END-P is t, then we want to start counting from the
1166 ;; end of the minor axis instead of the beginning.
1167 ;;
1168 ;; Here's the general idea: Imagine we're trying to count the number
1169 ;; of windows that abut the top; call this function foo(). So, we
1170 ;; start with the root window. If this is a vertical combination
1171 ;; window, then foo() applied to the root window is the same as
1172 ;; foo() applied to the first child. If the root is a horizontal
1173 ;; combination window, then foo() applied to the root is the
1174 ;; same as the sum of foo() applied to each of the children.
1175 ;; Otherwise, the root window is a leaf window, and foo() is 1.
1176 ;; Now it's clear that, each time foo() encounters a leaf window,
1177 ;; it's encountering a different window that abuts the top.
1178 ;; With a little examining, you can see that foo encounters the
1179 ;; top-abutting windows in order from left to right. We can
1180 ;; modify foo() to return the nth top-abutting window by simply
1181 ;; keeping a global variable that is decremented each time
1182 ;; foo() encounters a leaf window and would return 1. If the
1183 ;; global counter gets to zero, we've encountered the window
1184 ;; we were looking for, so we exit right away using a `throw'.
1185 ;; Otherwise, we make sure that all normal paths return nil.
1186
1187 (let (child)
1188 (cond ((setq child (if left-right-p
1189 (window-first-hchild window)
1190 (window-first-vchild window)))
1191 (if major-end-p
1192 (while (window-next-child child)
1193 (setq child (window-next-child child))))
1194 (frame-utmost-window-2 child position left-right-p major-end-p
1195 minor-end-p))
1196 ((setq child (if left-right-p
1197 (window-first-vchild window)
1198 (window-first-hchild window)))
1199 (if minor-end-p
1200 (while (window-next-child child)
1201 (setq child (window-next-child child))))
1202 (while child
1203 (frame-utmost-window-2 child position left-right-p major-end-p
1204 minor-end-p)
1205 (setq child (if minor-end-p
1206 (window-previous-child child)
1207 (window-next-child child))))
1208 nil)
1209 (t
1210 (setcar position (1- (car position)))
1211 (if (= (car position) 0)
1212 (throw 'fhw-exit window)
1213 nil)))))
1214
1215 (defun frame-utmost-window-1 (frame position left-right-p major-end-p)
1216 (let (minor-end-p)
1217 (or frame (setq frame (selected-frame)))
1218 (or position (setq position 0))
1219 (if (>= position 0)
1220 (setq position (1+ position))
1221 (setq minor-end-p t)
1222 (setq position (- position)))
1223 (catch 'fhw-exit
1224 ;; we use a cons here as a simple form of call-by-reference.
1225 ;; scheme has "boxes" for the same purpose.
1226 (frame-utmost-window-2 (frame-root-window frame) (list position)
1227 left-right-p major-end-p minor-end-p))))
1228
1229
1230 (defun frame-highest-window (&optional frame position)
1231 "Return the highest window on FRAME which is at POSITION.
1232 If omitted, FRAME defaults to the currently selected frame.
1233 POSITION is used to distinguish between multiple windows that abut
1234 the top of the frame: 0 means the leftmost window abutting the
1235 top of the frame, 1 the next-leftmost, etc. POSITION can also
1236 be less than zero: -1 means the rightmost window abutting the
1237 top of the frame, -2 the next-rightmost, etc.
1238 If omitted, POSITION defaults to 0, i.e. the leftmost highest window.
1239 If there is no window at the given POSITION, return nil."
1240 (frame-utmost-window-1 frame position nil nil))
1241
1242 (defun frame-lowest-window (&optional frame position)
1243 "Return the lowest window on FRAME which is at POSITION.
1244 If omitted, FRAME defaults to the currently selected frame.
1245 POSITION is used to distinguish between multiple windows that abut
1246 the bottom of the frame: 0 means the leftmost window abutting the
1247 bottom of the frame, 1 the next-leftmost, etc. POSITION can also
1248 be less than zero: -1 means the rightmost window abutting the
1249 bottom of the frame, -2 the next-rightmost, etc.
1250 If omitted, POSITION defaults to 0, i.e. the leftmost lowest window.
1251 If there is no window at the given POSITION, return nil."
1252 (frame-utmost-window-1 frame position nil t))
1253
1254 (defun frame-leftmost-window (&optional frame position)
1255 "Return the leftmost window on FRAME which is at POSITION.
1256 If omitted, FRAME defaults to the currently selected frame.
1257 POSITION is used to distinguish between multiple windows that abut
1258 the left edge of the frame: 0 means the highest window abutting the
1259 left edge of the frame, 1 the next-highest, etc. POSITION can also
1260 be less than zero: -1 means the lowest window abutting the
1261 left edge of the frame, -2 the next-lowest, etc.
1262 If omitted, POSITION defaults to 0, i.e. the highest leftmost window.
1263 If there is no window at the given POSITION, return nil."
1264 (frame-utmost-window-1 frame position t nil))
1265
1266 (defun frame-rightmost-window (&optional frame position)
1267 "Return the rightmost window on FRAME which is at POSITION.
1268 If omitted, FRAME defaults to the currently selected frame.
1269 POSITION is used to distinguish between multiple windows that abut
1270 the right edge of the frame: 0 means the highest window abutting the
1271 right edge of the frame, 1 the next-highest, etc. POSITION can also
1272 be less than zero: -1 means the lowest window abutting the
1273 right edge of the frame, -2 the next-lowest, etc.
1274 If omitted, POSITION defaults to 0, i.e. the highest rightmost window.
1275 If there is no window at the given POSITION, return nil."
1276 (frame-utmost-window-1 frame position t t))
1277
1278
1279
1280 ;; frame properties.
1281
1282 (defun set-frame-property (frame prop val)
1283 "Set property PROP of FRAME to VAL. See `set-frame-properties'."
1284 (set-frame-properties frame (list prop val)))
1285
1286 (defun frame-height (&optional frame)
1287 "Return number of lines available for display on FRAME."
1288 (frame-property frame 'height))
1289
1290 (defun frame-width (&optional frame)
1291 "Return number of columns available for display on FRAME."
1292 (frame-property frame 'width))
1293
1294 (put 'cursor-color 'frame-property-alias [text-cursor background])
1295 (put 'modeline 'frame-property-alias 'has-modeline-p)
1296
1297
1298 (provide 'frame)
1299
1300 ;;; frame.el ends here