(Regexp Replace): Further update text for new replacement operators.
[bpt/emacs.git] / lisp / frame.el
CommitLineData
55535639 1;;; frame.el --- multi-frame management independent of window systems
c88ab9ce 2
bb2c34b1 3;; Copyright (C) 1993, 1994, 1996, 1997, 2000, 2001, 2003, 2004
a6c411ff 4;; Free Software Foundation, Inc.
3a801d0c 5
fc68affa 6;; Maintainer: FSF
fd7fa35a 7;; Keywords: internal
fc68affa 8
b578f267
EN
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs 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.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
64c669bc 25
55535639
PJ
26;;; Commentary:
27
fc68affa
ER
28;;; Code:
29
dc6d9681
JB
30(defvar frame-creation-function nil
31 "Window-system dependent function to call to create a new frame.
32The window system startup file should set this to its frame creation
64c669bc
JB
33function, which should take an alist of parameters as its argument.")
34
7e573c4a
SM
35;; The initial value given here used to ask for a minibuffer.
36;; But that's not necessary, because the default is to have one.
37;; By not specifying it here, we let an X resource specify it.
0c966f88 38(defcustom initial-frame-alist nil
0b9d32af 39 "*Alist of frame parameters for creating the initial X window frame.
eaa974e1 40You can set this in your `.emacs' file; for example,
dc6d9681 41 (setq initial-frame-alist '((top . 1) (left . 1) (width . 80) (height . 55)))
de17da15
RS
42Parameters specified here supersede the values given in `default-frame-alist'.
43
44If the value calls for a frame without a minibuffer, and you have not created
45a minibuffer frame on your own, one is created according to
7eadab74 46`minibuffer-frame-alist'.
de17da15
RS
47
48You can specify geometry-related options for just the initial frame
49by setting this variable in your `.emacs' file; however, they won't
85557d7e 50take effect until Emacs reads `.emacs', which happens after first creating
de17da15
RS
51the frame. If you want the frame to have the proper geometry as soon
52as it appears, you need to use this three-step process:
53* Specify X resources to give the geometry you want.
54* Set `default-frame-alist' to override these options so that they
55 don't affect subsequent frames.
56* Set `initial-frame-alist' in a way that matches the X resources,
0c966f88
RS
57 to override what you put in `default-frame-alist'."
58 :type '(repeat (cons :format "%v"
59 (symbol :tag "Parameter")
60 (sexp :tag "Value")))
61 :group 'frames)
64c669bc 62
0b9d32af
RS
63(defcustom minibuffer-frame-alist '((width . 80) (height . 2))
64 "*Alist of frame parameters for initially creating a minibuffer frame.
eaa974e1 65You can set this in your `.emacs' file; for example,
dc6d9681 66 (setq minibuffer-frame-alist
7eadab74 67 '((top . 1) (left . 1) (width . 80) (height . 2)))
eaa974e1 68Parameters specified here supersede the values given in
0b9d32af
RS
69`default-frame-alist', for a minibuffer frame."
70 :type '(repeat (cons :format "%v"
71 (symbol :tag "Parameter")
72 (sexp :tag "Value")))
73 :group 'frames)
64c669bc 74
0b9d32af
RS
75(defcustom pop-up-frame-alist nil
76 "*Alist of frame parameters used when creating pop-up frames.
dc6d9681 77Pop-up frames are used for completions, help, and the like.
64c669bc 78This variable can be set in your init file, like this:
dc6d9681 79 (setq pop-up-frame-alist '((width . 80) (height . 20)))
0b9d32af
RS
80These supersede the values given in `default-frame-alist',
81for pop-up frames."
82 :type '(repeat (cons :format "%v"
83 (symbol :tag "Parameter")
84 (sexp :tag "Value")))
85 :group 'frames)
64c669bc 86
dc6d9681 87(setq pop-up-frame-function
7f18ce22
RS
88 ;; Using `function' here caused some sort of problem.
89 '(lambda ()
90 (make-frame pop-up-frame-alist)))
64c669bc 91
30e19aee 92(defcustom special-display-frame-alist
8a9e86e6
RS
93 '((height . 14) (width . 80) (unsplittable . t))
94 "*Alist of frame parameters used when creating special frames.
95Special frames are used for buffers whose names are in
96`special-display-buffer-names' and for buffers whose names match
97one of the regular expressions in `special-display-regexps'.
98This variable can be set in your init file, like this:
99 (setq special-display-frame-alist '((width . 80) (height . 20)))
30e19aee
RS
100These supersede the values given in `default-frame-alist'."
101 :type '(repeat (cons :format "%v"
102 (symbol :tag "Parameter")
103 (sexp :tag "Value")))
104 :group 'frames)
8a9e86e6 105
95e6cf39 106(defun special-display-popup-frame (buffer &optional args)
40d34803
DL
107 "Display BUFFER in its own frame, reusing an existing window if any.
108Return the window chosen.
109Currently we do not insist on selecting the window within its frame.
110If ARGS is an alist, use it as a list of frame parameter specs.
111If ARGS is a list whose car is a symbol,
112use (car ARGS) as a function to do the work.
113Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
95e6cf39
RS
114 (if (and args (symbolp (car args)))
115 (apply (car args) buffer (cdr args))
bb2c34b1 116 (let ((window (get-buffer-window buffer 0)))
7e573c4a
SM
117 (or
118 ;; If we have a window already, make it visible.
119 (when window
120 (let ((frame (window-frame window)))
121 (make-frame-visible frame)
122 (raise-frame frame)
123 window))
124 ;; Reuse the current window if the user requested it.
125 (when (cdr (assq 'same-window args))
126 (condition-case nil
127 (progn (switch-to-buffer buffer) (selected-window))
128 (error nil)))
129 ;; Stay on the same frame if requested.
130 (when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args)))
131 (let* ((pop-up-frames nil) (pop-up-windows t)
132 special-display-regexps special-display-buffer-names
133 (window (display-buffer buffer)))
bb2c34b1 134 ;; Only do it if this is a new window:
7e573c4a
SM
135 ;; (set-window-dedicated-p window t)
136 window))
137 ;; If no window yet, make one in a new frame.
138 (let ((frame (make-frame (append args special-display-frame-alist))))
139 (set-window-buffer (frame-selected-window frame) buffer)
140 (set-window-dedicated-p (frame-selected-window frame) t)
141 (frame-selected-window frame))))))
8a9e86e6 142
924be53a 143(defun handle-delete-frame (event)
40d34803 144 "Handle delete-frame events from the X server."
924be53a
RS
145 (interactive "e")
146 (let ((frame (posn-window (event-start event)))
147 (i 0)
148 (tail (frame-list)))
149 (while tail
150 (and (frame-visible-p (car tail))
151 (not (eq (car tail) frame))
152 (setq i (1+ i)))
153 (setq tail (cdr tail)))
154 (if (> i 0)
155 (delete-frame frame t)
a9562d19
RS
156 ;; Gildea@x.org says it is ok to ask questions before terminating.
157 (save-buffers-kill-emacs))))
64c669bc 158\f
dc6d9681 159;;;; Arrangement of frames at startup
64c669bc 160
7e573c4a
SM
161;; 1) Load the window system startup file from the lisp library and read the
162;; high-priority arguments (-q and the like). The window system startup
163;; file should create any frames specified in the window system defaults.
164;;
165;; 2) If no frames have been opened, we open an initial text frame.
166;;
167;; 3) Once the init file is done, we apply any newly set parameters
168;; in initial-frame-alist to the frame.
64c669bc 169
85557d7e 170;; These are now called explicitly at the proper times,
fc4d4afb
RS
171;; since that is easier to understand.
172;; Actually using hooks within Emacs is bad for future maintenance. --rms.
173;; (add-hook 'before-init-hook 'frame-initialize)
174;; (add-hook 'window-setup-hook 'frame-notice-user-settings)
64c669bc 175
7e573c4a 176;; If we create the initial frame, this is it.
dc6d9681 177(defvar frame-initial-frame nil)
64c669bc 178
3f2f8c83
RS
179;; Record the parameters used in frame-initialize to make the initial frame.
180(defvar frame-initial-frame-alist)
181
791e09d8
RS
182(defvar frame-initial-geometry-arguments nil)
183
7e573c4a
SM
184;; startup.el calls this function before loading the user's init
185;; file - if there is no frame with a minibuffer open now, create
186;; one to display messages while loading the init file.
dc6d9681 187(defun frame-initialize ()
ff2a1c79 188 "Create an initial frame if necessary."
64c669bc 189 ;; Are we actually running under a window system at all?
004f057a 190 (if (and window-system (not noninteractive) (not (eq window-system 'pc)))
7eadab74 191 (progn
62642af9
RS
192 ;; Turn on special-display processing only if there's a window system.
193 (setq special-display-function 'special-display-popup-frame)
194
7eadab74
JB
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-alist omit the
198 ;; minibuffer spec.
199 (or (delq terminal-frame (minibuffer-frame-list))
36fc9c9f 200 (progn
3f2f8c83 201 (setq frame-initial-frame-alist
9688894d 202 (append initial-frame-alist default-frame-alist nil))
a8bb5882
RS
203 (or (assq 'horizontal-scroll-bars frame-initial-frame-alist)
204 (setq frame-initial-frame-alist
205 (cons '(horizontal-scroll-bars . t)
206 frame-initial-frame-alist)))
36fc9c9f
RS
207 (setq default-minibuffer-frame
208 (setq frame-initial-frame
96a84970 209 (make-frame frame-initial-frame-alist)))
11281034
RS
210 ;; Delete any specifications for window geometry parameters
211 ;; so that we won't reapply them in frame-notice-user-settings.
212 ;; It would be wrong to reapply them then,
213 ;; because that would override explicit user resizing.
58bf6042 214 (setq initial-frame-alist
c2079f0a 215 (frame-remove-geometry-params initial-frame-alist))))
85557d7e 216 ;; At this point, we know that we have a frame open, so we
dc6d9681
JB
217 ;; can delete the terminal frame.
218 (delete-frame terminal-frame)
219 (setq terminal-frame nil))
85557d7e 220
0759c4d0
KH
221 ;; No, we're not running a window system. Use make-terminal-frame if
222 ;; we support that feature, otherwise arrange to cause errors.
004f057a
RS
223 (or (eq window-system 'pc)
224 (setq frame-creation-function
81b99826
GM
225 (if (fboundp 'tty-create-frame-with-faces)
226 'tty-create-frame-with-faces
004f057a
RS
227 (function
228 (lambda (parameters)
229 (error
230 "Can't create multiple frames without a window system"))))))))
85557d7e 231
8f2a992b
GM
232(defvar frame-notice-user-settings t
233 "Non-nil means function `frame-notice-user-settings' wasn't run yet.")
234
7e573c4a
SM
235;; startup.el calls this function after loading the user's init
236;; file. Now default-frame-alist and initial-frame-alist contain
237;; information to which we must react; do what needs to be done.
dc6d9681 238(defun frame-notice-user-settings ()
40d34803
DL
239 "Act on user's init file settings of frame parameters.
240React to settings of `default-frame-alist', `initial-frame-alist' there."
2ffa6186 241 ;; Make menu-bar-mode and default-frame-alist consistent.
61f2bcd7
GM
242 (when (boundp 'menu-bar-mode)
243 (let ((default (assq 'menu-bar-lines default-frame-alist)))
244 (if default
245 (setq menu-bar-mode (not (eq (cdr default) 0)))
246 (setq default-frame-alist
247 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
248 default-frame-alist)))))
f39784dd 249
33a33c06
GM
250 ;; Make tool-bar-mode and default-frame-alist consistent. Don't do
251 ;; it in batch mode since that would leave a tool-bar-lines
252 ;; parameter in default-frame-alist in a dumped Emacs, which is not
9688894d 253 ;; what we want.
33a33c06
GM
254 (when (and (boundp 'tool-bar-mode)
255 (not noninteractive))
61f2bcd7
GM
256 (let ((default (assq 'tool-bar-lines default-frame-alist)))
257 (if default
258 (setq tool-bar-mode (not (eq (cdr default) 0)))
259 (setq default-frame-alist
260 (cons (cons 'tool-bar-lines (if tool-bar-mode 1 0))
261 default-frame-alist)))))
2ffa6186 262
7eadab74
JB
263 ;; Creating and deleting frames may shift the selected frame around,
264 ;; and thus the current buffer. Protect against that. We don't
265 ;; want to use save-excursion here, because that may also try to set
266 ;; the buffer of the selected window, which fails when the selected
267 ;; window is the minibuffer.
268 (let ((old-buffer (current-buffer)))
269
8f2a992b
GM
270 (when (and frame-notice-user-settings
271 (null frame-initial-frame))
42002db5
EZ
272 ;; This case happens when we don't have a window system, and
273 ;; also for MS-DOS frames.
8f2a992b
GM
274 (let ((parms (frame-parameters frame-initial-frame)))
275 ;; Don't change the frame names.
276 (setq parms (delq (assq 'name parms) parms))
277 ;; Can't modify the minibuffer parameter, so don't try.
278 (setq parms (delq (assq 'minibuffer parms) parms))
279 (modify-frame-parameters nil
42002db5
EZ
280 (if (null window-system)
281 (append initial-frame-alist
282 default-frame-alist
283 parms
284 nil)
285 ;; initial-frame-alist and
286 ;; default-frame-alist were already
287 ;; applied in pc-win.el.
288 parms))
289 (if (null window-system) ;; MS-DOS does this differently in pc-win.el
290 (let ((newparms (frame-parameters))
291 (frame (selected-frame)))
292 (tty-handle-reverse-video frame newparms)
293 ;; If we changed the background color, we need to update
294 ;; the background-mode parameter, and maybe some faces,
295 ;; too.
296 (when (assq 'background-color newparms)
297 (unless (or (assq 'background-mode initial-frame-alist)
298 (assq 'background-mode default-frame-alist))
299 (frame-set-background-mode frame))
300 (face-set-after-frame-default frame))))))
8f2a992b 301
7eadab74
JB
302 ;; If the initial frame is still around, apply initial-frame-alist
303 ;; and default-frame-alist to it.
9688894d
GM
304 (when (frame-live-p frame-initial-frame)
305
306 ;; When tool-bar has been switched off, correct the frame size
307 ;; by the lines added in x-create-frame for the tool-bar and
308 ;; switch `tool-bar-mode' off.
085ef9b3
GM
309 (when (display-graphic-p)
310 (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
311 (assq 'tool-bar-lines default-frame-alist))))
5c39a60f
JR
312 (when (and tool-bar-originally-present
313 (or (null tool-bar-lines)
314 (null (cdr tool-bar-lines))
315 (eq 0 (cdr tool-bar-lines))))
085ef9b3 316 (let* ((char-height (frame-char-height frame-initial-frame))
5c39a60f 317 (image-height tool-bar-images-pixel-height)
085ef9b3
GM
318 (margin (cond ((and (consp tool-bar-button-margin)
319 (integerp (cdr tool-bar-button-margin))
320 (> tool-bar-button-margin 0))
321 (cdr tool-bar-button-margin))
322 ((and (integerp tool-bar-button-margin)
323 (> tool-bar-button-margin 0))
324 tool-bar-button-margin)
325 (t 0)))
326 (relief (if (and (integerp tool-bar-button-relief)
327 (> tool-bar-button-relief 0))
328 tool-bar-button-relief 3))
f39784dd 329 (lines (/ (+ image-height
085ef9b3
GM
330 (* 2 margin)
331 (* 2 relief)
332 (1- char-height))
333 char-height))
334 (height (frame-parameter frame-initial-frame 'height))
335 (newparms (list (cons 'height (- height lines))))
f39784dd 336 (initial-top (cdr (assq 'top
085ef9b3
GM
337 frame-initial-geometry-arguments)))
338 (top (frame-parameter frame-initial-frame 'top)))
339 (when (and (consp initial-top) (eq '- (car initial-top)))
7f18ce22
RS
340 (let ((adjusted-top
341 (cond ((and (consp top)
342 (eq '+ (car top)))
343 (list '+
344 (+ (cadr top)
345 (* lines char-height))))
346 ((and (consp top)
347 (eq '- (car top)))
348 (list '-
349 (- (cadr top)
350 (* lines char-height))))
351 (t (+ top (* lines char-height))))))
352 (setq newparms
353 (append newparms
354 `((top . ,adjusted-top))
355 nil))))
085ef9b3
GM
356 (modify-frame-parameters frame-initial-frame newparms)
357 (tool-bar-mode -1)))))
9688894d
GM
358
359 ;; The initial frame we create above always has a minibuffer.
360 ;; If the user wants to remove it, or make it a minibuffer-only
361 ;; frame, then we'll have to delete the current frame and make a
362 ;; new one; you can't remove or add a root window to/from an
363 ;; existing frame.
364 ;;
365 ;; NOTE: default-frame-alist was nil when we created the
366 ;; existing frame. We need to explicitly include
367 ;; default-frame-alist in the parameters of the screen we
368 ;; create here, so that its new value, gleaned from the user's
369 ;; .emacs file, will be applied to the existing screen.
de2f5dbe
GM
370 (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
371 (assq 'minibuffer default-frame-alist)
372 '(minibuffer . t)))
373 t))
374 ;; Create the new frame.
375 (let (parms new)
376 ;; If the frame isn't visible yet, wait till it is.
377 ;; If the user has to position the window,
378 ;; Emacs doesn't know its real position until
379 ;; the frame is seen to be visible.
380 (while (not (cdr (assq 'visibility
381 (frame-parameters frame-initial-frame))))
382 (sleep-for 1))
383 (setq parms (frame-parameters frame-initial-frame))
9688894d 384
f39784dd 385 ;; Get rid of `name' unless it was specified explicitly before.
de2f5dbe
GM
386 (or (assq 'name frame-initial-frame-alist)
387 (setq parms (delq (assq 'name parms) parms)))
388
389 (setq parms (append initial-frame-alist
390 default-frame-alist
391 parms
392 nil))
393
394 ;; Get rid of `reverse', because that was handled
395 ;; when we first made the frame.
396 (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms)))
397
398 (if (assq 'height frame-initial-geometry-arguments)
399 (setq parms (assq-delete-all 'height parms)))
400 (if (assq 'width frame-initial-geometry-arguments)
401 (setq parms (assq-delete-all 'width parms)))
402 (if (assq 'left frame-initial-geometry-arguments)
403 (setq parms (assq-delete-all 'left parms)))
404 (if (assq 'top frame-initial-geometry-arguments)
405 (setq parms (assq-delete-all 'top parms)))
406 (setq new
407 (make-frame
408 ;; Use the geometry args that created the existing
409 ;; frame, rather than the parms we get for it.
410 (append frame-initial-geometry-arguments
411 '((user-size . t) (user-position . t))
412 parms)))
413 ;; The initial frame, which we are about to delete, may be
414 ;; the only frame with a minibuffer. If it is, create a
415 ;; new one.
416 (or (delq frame-initial-frame (minibuffer-frame-list))
417 (make-initial-minibuffer-frame nil))
418
419 ;; If the initial frame is serving as a surrogate
420 ;; minibuffer frame for any frames, we need to wean them
421 ;; onto a new frame. The default-minibuffer-frame
422 ;; variable must be handled similarly.
423 (let ((users-of-initial
424 (filtered-frame-list
425 (function (lambda (frame)
426 (and (not (eq frame frame-initial-frame))
427 (eq (window-frame
428 (minibuffer-window frame))
429 frame-initial-frame)))))))
430 (if (or users-of-initial
431 (eq default-minibuffer-frame frame-initial-frame))
432
433 ;; Choose an appropriate frame. Prefer frames which
434 ;; are only minibuffers.
435 (let* ((new-surrogate
436 (car
437 (or (filtered-frame-list
438 (function
439 (lambda (frame)
440 (eq (cdr (assq 'minibuffer
441 (frame-parameters frame)))
442 'only))))
443 (minibuffer-frame-list))))
444 (new-minibuffer (minibuffer-window new-surrogate)))
445
446 (if (eq default-minibuffer-frame frame-initial-frame)
447 (setq default-minibuffer-frame new-surrogate))
448
449 ;; Wean the frames using frame-initial-frame as
450 ;; their minibuffer frame.
451 (mapcar
452 (function
453 (lambda (frame)
454 (modify-frame-parameters
455 frame (list (cons 'minibuffer new-minibuffer)))))
456 users-of-initial))))
457
458 ;; Redirect events enqueued at this frame to the new frame.
459 ;; Is this a good idea?
460 (redirect-frame-focus frame-initial-frame new)
461
462 ;; Finally, get rid of the old frame.
463 (delete-frame frame-initial-frame t))
9688894d
GM
464
465 ;; Otherwise, we don't need all that rigamarole; just apply
466 ;; the new parameters.
467 (let (newparms allparms tail)
468 (setq allparms (append initial-frame-alist
469 default-frame-alist nil))
470 (if (assq 'height frame-initial-geometry-arguments)
471 (setq allparms (assq-delete-all 'height allparms)))
472 (if (assq 'width frame-initial-geometry-arguments)
473 (setq allparms (assq-delete-all 'width allparms)))
474 (if (assq 'left frame-initial-geometry-arguments)
475 (setq allparms (assq-delete-all 'left allparms)))
476 (if (assq 'top frame-initial-geometry-arguments)
477 (setq allparms (assq-delete-all 'top allparms)))
478 (setq tail allparms)
479 ;; Find just the parms that have changed since we first
480 ;; made this frame. Those are the ones actually set by
f39784dd 481 ;; the init file. For those parms whose values we already knew
9688894d
GM
482 ;; (such as those spec'd by command line options)
483 ;; it is undesirable to specify the parm again
f39784dd 484 ;; once the user has seen the frame and been able to alter it
9688894d
GM
485 ;; manually.
486 (while tail
487 (let (newval oldval)
488 (setq oldval (assq (car (car tail))
489 frame-initial-frame-alist))
490 (setq newval (cdr (assq (car (car tail)) allparms)))
491 (or (and oldval (eq (cdr oldval) newval))
492 (setq newparms
493 (cons (cons (car (car tail)) newval) newparms))))
494 (setq tail (cdr tail)))
495 (setq newparms (nreverse newparms))
496 (modify-frame-parameters frame-initial-frame
497 newparms)
498 ;; If we changed the background color,
499 ;; we need to update the background-mode parameter
500 ;; and maybe some faces too.
501 (when (assq 'background-color newparms)
502 (unless (assq 'background-mode newparms)
503 (frame-set-background-mode frame-initial-frame))
504 (face-set-after-frame-default frame-initial-frame)))))
64c669bc 505
7eadab74
JB
506 ;; Restore the original buffer.
507 (set-buffer old-buffer)
508
509 ;; Make sure the initial frame can be GC'd if it is ever deleted.
d202f1f2 510 ;; Make sure frame-notice-user-settings does nothing if called twice.
8f2a992b 511 (setq frame-notice-user-settings nil)
d202f1f2 512 (setq frame-initial-frame nil)))
64c669bc 513
746bd265
KH
514(defun make-initial-minibuffer-frame (display)
515 (let ((parms (append minibuffer-frame-alist '((minibuffer . only)))))
516 (if display
517 (make-frame-on-display display parms)
518 (make-frame parms))))
519
7eadab74 520;;;; Creation of additional frames, and other frame miscellanea
dc6d9681 521
63019bad 522(defun modify-all-frames-parameters (alist)
d398de43 523 "Modify all current and future frames' parameters according to ALIST.
63019bad
JB
524This changes `default-frame-alist' and possibly `initial-frame-alist'.
525See help of `modify-frame-parameters' for more information."
526 (let (element) ;; temp
527 (dolist (frame (frame-list))
528 (modify-frame-parameters frame alist))
529
530 (dolist (pair alist) ;; conses to add/replace
531 ;; initial-frame-alist needs setting only when
532 ;; frame-notice-user-settings is true
533 (and frame-notice-user-settings
534 (setq element (assoc (car pair) initial-frame-alist))
535 (setq initial-frame-alist (delq element initial-frame-alist)))
536 (and (setq element (assoc (car pair) default-frame-alist))
537 (setq default-frame-alist (delq element default-frame-alist)))))
538 (and frame-notice-user-settings
539 (setq initial-frame-alist (append initial-frame-alist alist)))
540 (setq default-frame-alist (append default-frame-alist alist)))
541
7253d8e0 542(defun get-other-frame ()
40d34803
DL
543 "Return some frame other than the current frame.
544Create one if necessary. Note that the minibuffer frame, if separate,
545is not considered (see `next-frame')."
dc6d9681 546 (let ((s (if (equal (next-frame (selected-frame)) (selected-frame))
6eb018ba 547 (make-frame)
dc6d9681 548 (next-frame (selected-frame)))))
64c669bc
JB
549 s))
550
dc6d9681
JB
551(defun next-multiframe-window ()
552 "Select the next window, regardless of which frame it is on."
64c669bc
JB
553 (interactive)
554 (select-window (next-window (selected-window)
555 (> (minibuffer-depth) 0)
bb2c34b1 556 0))
030f4537 557 (select-frame-set-input-focus (selected-frame)))
64c669bc 558
dc6d9681
JB
559(defun previous-multiframe-window ()
560 "Select the previous window, regardless of which frame it is on."
64c669bc
JB
561 (interactive)
562 (select-window (previous-window (selected-window)
563 (> (minibuffer-depth) 0)
bb2c34b1 564 0))
030f4537 565 (select-frame-set-input-focus (selected-frame)))
64c669bc 566
6d73e337
RS
567(defun make-frame-on-display (display &optional parameters)
568 "Make a frame on display DISPLAY.
569The optional second argument PARAMETERS specifies additional frame parameters."
570 (interactive "sMake frame on display: ")
a9ca74cd
RS
571 (or (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" display)
572 (error "Invalid display, not HOST:SERVER or HOST:SERVER.SCREEN"))
6d73e337
RS
573 (make-frame (cons (cons 'display display) parameters)))
574
6238bfaf
RS
575(defun make-frame-command ()
576 "Make a new frame, and select it if the terminal displays only one frame."
577 (interactive)
c1b1350b 578 (if (and window-system (not (eq window-system 'pc)))
6238bfaf
RS
579 (make-frame)
580 (select-frame (make-frame))))
581
45c4fdeb
SM
582(defvar before-make-frame-hook nil
583 "Functions to run before a frame is created.")
584
585(defvar after-make-frame-functions nil
586 "Functions to run after a frame is created.
587The functions are run with one arg, the newly created frame.")
588
72bf1a8b 589(defvar after-setting-font-hook nil
81b99826
GM
590 "Functions to run after a frame's font has been changed.")
591
92e443b1 592;; Alias, kept temporarily.
31e1d920 593(defalias 'new-frame 'make-frame)
f7df88f4 594(make-obsolete 'new-frame 'make-frame "21.4")
bc93c097 595
45c4fdeb
SM
596(defun make-frame (&optional parameters)
597 "Return a newly created frame displaying the current buffer.
598Optional argument PARAMETERS is an alist of parameters for the new frame.
599Each element of PARAMETERS should have the form (NAME . VALUE), for example:
a105105a 600
45c4fdeb 601 (name . STRING) The frame should be named STRING.
43a2e52c 602
45c4fdeb
SM
603 (width . NUMBER) The frame should be NUMBER characters in width.
604 (height . NUMBER) The frame should be NUMBER text lines high.
43a2e52c 605
45c4fdeb 606You cannot specify either `width' or `height', you must use neither or both.
43a2e52c 607
45c4fdeb
SM
608 (minibuffer . t) The frame should have a minibuffer.
609 (minibuffer . nil) The frame should have no minibuffer.
610 (minibuffer . only) The frame should contain only a minibuffer.
611 (minibuffer . WINDOW) The frame should use WINDOW as its minibuffer window.
43a2e52c 612
45c4fdeb
SM
613Before the frame is created (via `frame-creation-function'), functions on the
614hook `before-make-frame-hook' are run. After the frame is created, functions
615on `after-make-frame-functions' are run with one arg, the newly created frame."
64c669bc 616 (interactive)
45c4fdeb
SM
617 (run-hooks 'before-make-frame-hook)
618 (let ((frame (funcall frame-creation-function parameters)))
619 (run-hook-with-args 'after-make-frame-functions frame)
620 frame))
64c669bc 621
7eadab74
JB
622(defun filtered-frame-list (predicate)
623 "Return a list of all live frames which satisfy PREDICATE."
047bc928
GM
624 (let* ((frames (frame-list))
625 (list frames))
7eadab74 626 (while (consp frames)
047bc928
GM
627 (unless (funcall predicate (car frames))
628 (setcar frames nil))
7eadab74 629 (setq frames (cdr frames)))
047bc928 630 (delq nil list)))
7eadab74
JB
631
632(defun minibuffer-frame-list ()
633 "Return a list of all frames with their own minibuffers."
634 (filtered-frame-list
635 (function (lambda (frame)
636 (eq frame (window-frame (minibuffer-window frame)))))))
637
9911648b
EZ
638(defun frames-on-display-list (&optional display)
639 "Return a list of all frames on DISPLAY.
640DISPLAY is a name of a display, a string of the form HOST:SERVER.SCREEN.
641If DISPLAY is omitted or nil, it defaults to the selected frame's display."
047bc928
GM
642 (let* ((display (or display (frame-parameter nil 'display)))
643 (func #'(lambda (frame)
f29173c9 644 (equal (frame-parameter frame 'display) display))))
9911648b
EZ
645 (filtered-frame-list func)))
646
647(defun framep-on-display (&optional display)
648 "Return the type of frames on DISPLAY.
649DISPLAY may be a display name or a frame. If it is a frame, its type is
650returned.
651If DISPLAY is omitted or nil, it defaults to the selected frame's display.
652All frames on a given display are of the same type."
653 (or (framep display)
654 (framep (car (frames-on-display-list display)))))
655
58bf6042
JB
656(defun frame-remove-geometry-params (param-list)
657 "Return the parameter list PARAM-LIST, but with geometry specs removed.
658This deletes all bindings in PARAM-LIST for `top', `left', `width',
791e09d8 659`height', `user-size' and `user-position' parameters.
58bf6042
JB
660Emacs uses this to avoid overriding explicit moves and resizings from
661the user during startup."
662 (setq param-list (cons nil param-list))
663 (let ((tail param-list))
664 (while (consp (cdr tail))
665 (if (and (consp (car (cdr tail)))
791e09d8
RS
666 (memq (car (car (cdr tail)))
667 '(height width top left user-position user-size)))
668 (progn
669 (setq frame-initial-geometry-arguments
670 (cons (car (cdr tail)) frame-initial-geometry-arguments))
671 (setcdr tail (cdr (cdr tail))))
58bf6042 672 (setq tail (cdr tail)))))
e11c3dc2
KH
673 (setq frame-initial-geometry-arguments
674 (nreverse frame-initial-geometry-arguments))
58bf6042
JB
675 (cdr param-list))
676
0ac18fb0 677(defcustom focus-follows-mouse t
6527c9b7
RS
678 "*Non-nil if window system changes focus when you move the mouse.
679You should set this variable to tell Emacs how your window manager
680handles focus, since there is no way in general for Emacs to find out
681automatically."
0ac18fb0 682 :type 'boolean
cd32a7ba
DN
683 :group 'frames
684 :version "20.3")
26ef026d 685
030f4537
GM
686(defun select-frame-set-input-focus (frame)
687 "Select FRAME, raise it, and set input focus, if possible."
688 (select-frame frame)
689 (raise-frame frame)
690 ;; Ensure, if possible, that frame gets input focus.
80c39c38
RS
691 (cond ((eq window-system 'x)
692 (x-focus-frame frame))
693 ((eq window-system 'w32)
694 (w32-focus-frame frame)))
030f4537 695 (cond (focus-follows-mouse
80c39c38 696 (set-mouse-position (selected-frame) (1- (frame-width)) 0))))
030f4537 697
ceab6935 698(defun other-frame (arg)
563283b1 699 "Select the ARG'th different visible frame on current display, and raise it.
ceab6935
RM
700All frames are arranged in a cyclic order.
701This command selects the frame ARG steps away in that order.
bb578a72
RS
702A negative ARG moves in the opposite order.
703
704To make this command work properly, you must tell Emacs
705how the system (or the window manager) generally handles
706focus-switching between windows. If moving the mouse onto a window
707selects it (gives it focus), set `focus-follows-mouse' to t.
708Otherwise, that variable should be nil."
ceab6935
RM
709 (interactive "p")
710 (let ((frame (selected-frame)))
711 (while (> arg 0)
a569dbc3
RM
712 (setq frame (next-frame frame))
713 (while (not (eq (frame-visible-p frame) t))
714 (setq frame (next-frame frame)))
715 (setq arg (1- arg)))
ceab6935 716 (while (< arg 0)
a569dbc3
RM
717 (setq frame (previous-frame frame))
718 (while (not (eq (frame-visible-p frame) t))
719 (setq frame (previous-frame frame)))
915cfd1f 720 (setq arg (1+ arg)))
030f4537 721 (select-frame-set-input-focus frame)))
845cde06 722
3db7df06
SM
723(defun iconify-or-deiconify-frame ()
724 "Iconify the selected frame, or deiconify if it's currently an icon."
725 (interactive)
726 (if (eq (cdr (assq 'visibility (frame-parameters))) t)
727 (iconify-frame)
728 (make-frame-visible)))
729
845cde06
EZ
730(defun make-frame-names-alist ()
731 (let* ((current-frame (selected-frame))
732 (falist
733 (cons
734 (cons (frame-parameter current-frame 'name) current-frame) nil))
735 (frame (next-frame nil t)))
736 (while (not (eq frame current-frame))
737 (progn
738 (setq falist (cons (cons (frame-parameter frame 'name) frame) falist))
739 (setq frame (next-frame frame t))))
740 falist))
741
742(defvar frame-name-history nil)
845cde06 743(defun select-frame-by-name (name)
563283b1 744 "Select the frame on the current terminal whose name is NAME and raise it.
845cde06
EZ
745If there is no frame by that name, signal an error."
746 (interactive
716ff1c9
RS
747 (let* ((frame-names-alist (make-frame-names-alist))
748 (default (car (car frame-names-alist)))
749 (input (completing-read
750 (format "Select Frame (default %s): " default)
751 frame-names-alist nil t nil 'frame-name-history)))
845cde06
EZ
752 (if (= (length input) 0)
753 (list default)
754 (list input))))
716ff1c9
RS
755 (let* ((frame-names-alist (make-frame-names-alist))
756 (frame (cdr (assoc name frame-names-alist))))
845cde06
EZ
757 (or frame
758 (error "There is no frame named `%s'" name))
759 (make-frame-visible frame)
760 (raise-frame frame)
880a9ae1
AI
761 (select-frame frame)
762 ;; Ensure, if possible, that frame gets input focus.
80c39c38
RS
763 (cond ((eq window-system 'x)
764 (x-focus-frame frame))
765 ((eq window-system 'w32)
766 (w32-focus-frame frame)))
767 (when focus-follows-mouse
768 (set-mouse-position frame (1- (frame-width frame)) 0))))
64c669bc 769\f
dc6d9681
JB
770;;;; Frame configurations
771
772(defun current-frame-configuration ()
773 "Return a list describing the positions and states of all frames.
376a7584
JB
774Its car is `frame-configuration'.
775Each element of the cdr is a list of the form (FRAME ALIST WINDOW-CONFIG),
776where
777 FRAME is a frame object,
778 ALIST is an association list specifying some of FRAME's parameters, and
779 WINDOW-CONFIG is a window configuration object for FRAME."
780 (cons 'frame-configuration
781 (mapcar (function
782 (lambda (frame)
783 (list frame
784 (frame-parameters frame)
785 (current-window-configuration frame))))
786 (frame-list))))
dc6d9681 787
68cd265f 788(defun set-frame-configuration (configuration &optional nodelete)
dc6d9681
JB
789 "Restore the frames to the state described by CONFIGURATION.
790Each frame listed in CONFIGURATION has its position, size, window
68cd265f 791configuration, and other parameters set as specified in CONFIGURATION.
d398de43
LT
792However, this function does not restore deleted frames.
793
a78db71c
RS
794Ordinarily, this function deletes all existing frames not
795listed in CONFIGURATION. But if optional second argument NODELETE
5da841d2 796is given and non-nil, the unwanted frames are iconified instead."
376a7584
JB
797 (or (frame-configuration-p configuration)
798 (signal 'wrong-type-argument
799 (list 'frame-configuration-p configuration)))
800 (let ((config-alist (cdr configuration))
801 frames-to-delete)
06b1a5ef 802 (mapcar (function
dc6d9681 803 (lambda (frame)
376a7584 804 (let ((parameters (assq frame config-alist)))
06b1a5ef
JB
805 (if parameters
806 (progn
98e9d14b
JB
807 (modify-frame-parameters
808 frame
85557d7e 809 ;; Since we can't set a frame's minibuffer status,
98e9d14b
JB
810 ;; we might as well omit the parameter altogether.
811 (let* ((parms (nth 1 parameters))
812 (mini (assq 'minibuffer parms)))
813 (if mini (setq parms (delq mini parms)))
814 parms))
06b1a5ef 815 (set-window-configuration (nth 2 parameters)))
dc6d9681
JB
816 (setq frames-to-delete (cons frame frames-to-delete))))))
817 (frame-list))
a78db71c 818 (if nodelete
5da841d2
RS
819 ;; Note: making frames invisible here was tried
820 ;; but led to some strange behavior--each time the frame
821 ;; was made visible again, the window manager asked afresh
822 ;; for where to put it.
823 (mapcar 'iconify-frame frames-to-delete)
a78db71c 824 (mapcar 'delete-frame frames-to-delete))))
64c669bc 825\f
dc6d9681
JB
826;;;; Convenience functions for accessing and interactively changing
827;;;; frame parameters.
64c669bc 828
151bdc83 829(defun frame-height (&optional frame)
dc6d9681
JB
830 "Return number of lines available for display on FRAME.
831If FRAME is omitted, describe the currently selected frame."
151bdc83 832 (cdr (assq 'height (frame-parameters frame))))
dc6d9681
JB
833
834(defun frame-width (&optional frame)
835 "Return number of columns available for display on FRAME.
836If FRAME is omitted, describe the currently selected frame."
151bdc83 837 (cdr (assq 'width (frame-parameters frame))))
dc6d9681 838
889611f0 839(defalias 'set-default-font 'set-frame-font)
1cef6541 840(defun set-frame-font (font-name &optional keep-size)
40d34803 841 "Set the font of the selected frame to FONT-NAME.
61298010 842When called interactively, prompt for the name of the font to use.
1cef6541
JB
843To get the frame's current default font, use `frame-parameters'.
844
845The default behavior is to keep the numbers of lines and columns in
846the frame, thus may change its pixel size. If optional KEEP-SIZE is
847non-nil (interactively, prefix argument) the current frame size (in
848pixels) is kept by adjusting the numbers of the lines and columns."
f39784dd 849 (interactive
1cef6541
JB
850 (let* ((completion-ignore-case t)
851 (font (completing-read "Font name: "
852 (mapcar #'list
853 ;; x-list-fonts will fail with an error
854 ;; if this frame doesn't support fonts.
93289292
MB
855 (x-list-fonts "*" nil (selected-frame)))
856 nil nil nil nil
857 (frame-parameter nil 'font))))
1cef6541
JB
858 (list font current-prefix-arg)))
859 (let (fht fwd)
860 (if keep-size
861 (setq fht (* (frame-parameter nil 'height) (frame-char-height))
862 fwd (* (frame-parameter nil 'width) (frame-char-width))))
863 (modify-frame-parameters (selected-frame)
864 (list (cons 'font font-name)))
865 (if keep-size
866 (modify-frame-parameters
867 (selected-frame)
868 (list (cons 'height (round fht (frame-char-height)))
869 (cons 'width (round fwd (frame-char-width)))))))
72bf1a8b 870 (run-hooks 'after-setting-font-hook 'after-setting-font-hooks))
64c669bc 871
7e573c4a
SM
872(defun set-frame-parameter (frame parameter value)
873 (modify-frame-parameters frame (list (cons parameter value))))
874
8290babd 875(defun set-background-color (color-name)
40d34803 876 "Set the background color of the selected frame to COLOR-NAME.
61298010
RS
877When called interactively, prompt for the name of the color to use.
878To get the frame's current background color, use `frame-parameters'."
40d34803 879 (interactive (list (facemenu-read-color)))
dc6d9681 880 (modify-frame-parameters (selected-frame)
528e1416
EZ
881 (list (cons 'background-color color-name)))
882 (or window-system
883 (face-set-after-frame-default (selected-frame))))
64c669bc 884
8290babd 885(defun set-foreground-color (color-name)
40d34803 886 "Set the foreground color of the selected frame to COLOR-NAME.
61298010
RS
887When called interactively, prompt for the name of the color to use.
888To get the frame's current foreground color, use `frame-parameters'."
40d34803 889 (interactive (list (facemenu-read-color)))
dc6d9681 890 (modify-frame-parameters (selected-frame)
528e1416
EZ
891 (list (cons 'foreground-color color-name)))
892 (or window-system
893 (face-set-after-frame-default (selected-frame))))
64c669bc
JB
894
895(defun set-cursor-color (color-name)
40d34803 896 "Set the text cursor color of the selected frame to COLOR-NAME.
61298010
RS
897When called interactively, prompt for the name of the color to use.
898To get the frame's current cursor color, use `frame-parameters'."
40d34803 899 (interactive (list (facemenu-read-color)))
dc6d9681 900 (modify-frame-parameters (selected-frame)
7eadab74 901 (list (cons 'cursor-color color-name))))
64c669bc 902
eaa974e1 903(defun set-mouse-color (color-name)
40d34803 904 "Set the color of the mouse pointer of the selected frame to COLOR-NAME.
61298010
RS
905When called interactively, prompt for the name of the color to use.
906To get the frame's current mouse color, use `frame-parameters'."
40d34803 907 (interactive (list (facemenu-read-color)))
dc6d9681 908 (modify-frame-parameters (selected-frame)
ec6d4463
KH
909 (list (cons 'mouse-color
910 (or color-name
911 (cdr (assq 'mouse-color
912 (frame-parameters))))))))
7eadab74 913
eaa974e1 914(defun set-border-color (color-name)
40d34803 915 "Set the color of the border of the selected frame to COLOR-NAME.
61298010
RS
916When called interactively, prompt for the name of the color to use.
917To get the frame's current border color, use `frame-parameters'."
40d34803 918 (interactive (list (facemenu-read-color)))
eaa974e1
JB
919 (modify-frame-parameters (selected-frame)
920 (list (cons 'border-color color-name))))
921
922(defun auto-raise-mode (arg)
7eadab74 923 "Toggle whether or not the selected frame should auto-raise.
79e6ae33
RS
924With arg, turn auto-raise mode on if and only if arg is positive.
925Note that this controls Emacs's own auto-raise feature.
926Some window managers allow you to enable auto-raise for certain windows.
927You can use that for Emacs windows if you wish, but if you do,
928that is beyond the control of Emacs and this command has no effect on it."
7eadab74
JB
929 (interactive "P")
930 (if (null arg)
931 (setq arg
932 (if (cdr (assq 'auto-raise (frame-parameters (selected-frame))))
933 -1 1)))
9626b928
GM
934 (if (> arg 0)
935 (raise-frame (selected-frame)))
dc6d9681 936 (modify-frame-parameters (selected-frame)
7eadab74
JB
937 (list (cons 'auto-raise (> arg 0)))))
938
eaa974e1 939(defun auto-lower-mode (arg)
7eadab74 940 "Toggle whether or not the selected frame should auto-lower.
79e6ae33
RS
941With arg, turn auto-lower mode on if and only if arg is positive.
942Note that this controls Emacs's own auto-lower feature.
943Some window managers allow you to enable auto-lower for certain windows.
944You can use that for Emacs windows if you wish, but if you do,
945that is beyond the control of Emacs and this command has no effect on it."
7eadab74
JB
946 (interactive "P")
947 (if (null arg)
948 (setq arg
949 (if (cdr (assq 'auto-lower (frame-parameters (selected-frame))))
950 -1 1)))
dc6d9681 951 (modify-frame-parameters (selected-frame)
7eadab74 952 (list (cons 'auto-lower (> arg 0)))))
7777d03b
EZ
953(defun set-frame-name (name)
954 "Set the name of the selected frame to NAME.
955When called interactively, prompt for the name of the frame.
956The frame name is displayed on the modeline if the terminal displays only
957one frame, otherwise the name is displayed on the frame's caption bar."
958 (interactive "sFrame name: ")
959 (modify-frame-parameters (selected-frame)
960 (list (cons 'name name))))
56cfea72
KS
961
962(defun frame-current-scroll-bars (&optional frame)
963 "Return the current scroll-bar settings in frame FRAME.
964Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the
965current location of the vertical scroll-bars (left, right, or nil),
966and HORISONTAL specifies the current location of the horisontal scroll
967bars (top, bottom, or nil)."
968 (let ((vert (frame-parameter frame 'vertical-scroll-bars))
969 (hor nil))
970 (unless (memq vert '(left right nil))
971 (setq vert default-frame-scroll-bars))
972 (cons vert hor)))
64c669bc 973\f
9911648b
EZ
974;;;; Frame/display capabilities.
975(defun display-mouse-p (&optional display)
976 "Return non-nil if DISPLAY has a mouse available.
977DISPLAY can be a display name, a frame, or nil (meaning the selected
978frame's display)."
979 (let ((frame-type (framep-on-display display)))
980 (cond
981 ((eq frame-type 'pc)
982 (msdos-mouse-p))
983 ((eq system-type 'windows-nt)
984 (> w32-num-mouse-buttons 0))
985 ((memq frame-type '(x mac))
986 t) ;; We assume X and Mac *always* have a pointing device
987 (t
7565ee93
DL
988 (or (and (featurep 'xt-mouse)
989 xterm-mouse-mode)
990 ;; t-mouse is distributed with the GPM package. It doesn't have
991 ;; a toggle.
992 (featurep 't-mouse))))))
9911648b
EZ
993
994(defun display-popup-menus-p (&optional display)
995 "Return non-nil if popup menus are supported on DISPLAY.
996DISPLAY can be a display name, a frame, or nil (meaning the selected
997frame's display).
998Support for popup menus requires that the mouse be available."
999 (and
1000 (let ((frame-type (framep-on-display display)))
1001 (memq frame-type '(x w32 pc mac)))
1002 (display-mouse-p display)))
1003
1004(defun display-graphic-p (&optional display)
1005 "Return non-nil if DISPLAY is a graphic display.
1006Graphical displays are those which are capable of displaying several
1007frames and several different fonts at once. This is true for displays
1008that use a window system such as X, and false for text-only terminals.
1009DISPLAY can be a display name, a frame, or nil (meaning the selected
1010frame's display)."
1011 (not (null (memq (framep-on-display display) '(x w32 mac)))))
1012
ddc456e4
EZ
1013(defun display-images-p (&optional display)
1014 "Return non-nil if DISPLAY can display images.
1015
1016DISPLAY can be a display name, a frame, or nil (meaning the selected
1017frame's display)."
1018 (and (display-graphic-p display)
1019 (fboundp 'image-mask-p)
fcc6f5cc 1020 (fboundp 'image-size)))
ddc456e4 1021
6693b279
EZ
1022(defalias 'display-multi-frame-p 'display-graphic-p)
1023(defalias 'display-multi-font-p 'display-graphic-p)
1024
9911648b
EZ
1025(defun display-selections-p (&optional display)
1026 "Return non-nil if DISPLAY supports selections.
1027A selection is a way to transfer text or other data between programs
1028via special system buffers called `selection' or `cut buffer' or
1029`clipboard'.
1030DISPLAY can be a display name, a frame, or nil (meaning the selected
1031frame's display)."
1032 (let ((frame-type (framep-on-display display)))
1033 (cond
1034 ((eq frame-type 'pc)
1035 ;; MS-DOG frames support selections when Emacs runs inside
1036 ;; the Windows' DOS Box.
1037 (not (null dos-windows-version)))
1038 ((memq frame-type '(x w32 mac))
1039 t) ;; FIXME?
1040 (t
1041 nil))))
1042
1043(defun display-screens (&optional display)
1044 "Return the number of screens associated with DISPLAY."
1045 (let ((frame-type (framep-on-display display)))
1046 (cond
1047 ((memq frame-type '(x w32))
1048 (x-display-screens display))
1049 (t ;; FIXME: is this correct for the Mac?
1050 1))))
1051
1052(defun display-pixel-height (&optional display)
1053 "Return the height of DISPLAY's screen in pixels.
1054For character terminals, each character counts as a single pixel."
1055 (let ((frame-type (framep-on-display display)))
1056 (cond
1057 ((memq frame-type '(x w32 mac))
1058 (x-display-pixel-height display))
1059 (t
1060 (frame-height (if (framep display) display (selected-frame)))))))
1061
1062(defun display-pixel-width (&optional display)
1063 "Return the width of DISPLAY's screen in pixels.
1064For character terminals, each character counts as a single pixel."
1065 (let ((frame-type (framep-on-display display)))
1066 (cond
1067 ((memq frame-type '(x w32 mac))
1068 (x-display-pixel-width display))
1069 (t
1070 (frame-width (if (framep display) display (selected-frame)))))))
1071
1072(defun display-mm-height (&optional display)
1073 "Return the height of DISPLAY's screen in millimeters.
1074If the information is unavailable, value is nil."
1075 (and (memq (framep-on-display display) '(x w32 mac))
1076 (x-display-mm-height display)))
1077
1078(defun display-mm-width (&optional display)
1079 "Return the width of DISPLAY's screen in millimeters.
1080If the information is unavailable, value is nil."
1081 (and (memq (framep-on-display display) '(x w32 mac))
1082 (x-display-mm-width display)))
1083
1084(defun display-backing-store (&optional display)
1085 "Return the backing store capability of DISPLAY's screen.
1086The value may be `always', `when-mapped', `not-useful', or nil if
1087the question is inapplicable to a certain kind of display."
1088 (let ((frame-type (framep-on-display display)))
1089 (cond
1090 ((memq frame-type '(x w32 mac))
1091 (x-display-backing-store display))
1092 (t
1093 'not-useful))))
1094
1095(defun display-save-under (&optional display)
1096 "Return non-nil if DISPLAY's screen supports the SaveUnder feature."
1097 (let ((frame-type (framep-on-display display)))
1098 (cond
1099 ((memq frame-type '(x w32 mac))
1100 (x-display-save-under display))
1101 (t
1102 'not-useful))))
1103
1104(defun display-planes (&optional display)
1105 "Return the number of planes supported by DISPLAY."
1106 (let ((frame-type (framep-on-display display)))
1107 (cond
1108 ((memq frame-type '(x w32 mac))
1109 (x-display-planes display))
1110 ((eq frame-type 'pc)
1111 4)
1112 (t
1113 (truncate (log (length (tty-color-alist)) 2))))))
1114
1115(defun display-color-cells (&optional display)
1116 "Return the number of color cells supported by DISPLAY."
1117 (let ((frame-type (framep-on-display display)))
1118 (cond
1119 ((memq frame-type '(x w32 mac))
1120 (x-display-color-cells display))
1121 ((eq frame-type 'pc)
1122 16)
1123 (t
a6ab2fcf 1124 (tty-display-color-cells)))))
9911648b
EZ
1125
1126(defun display-visual-class (&optional display)
1127 "Returns the visual class of DISPLAY.
1128The value is one of the symbols `static-gray', `gray-scale',
1129`static-color', `pseudo-color', `true-color', or `direct-color'."
1130 (let ((frame-type (framep-on-display display)))
1131 (cond
1132 ((memq frame-type '(x w32 mac))
1133 (x-display-visual-class display))
1134 ((and (memq frame-type '(pc t))
1135 (tty-display-color-p display))
1136 'static-color)
1137 (t
1138 'static-gray))))
1139
1140\f
dc6d9681 1141;;;; Aliases for backward compatibility with Emacs 18.
31e1d920
ER
1142(defalias 'screen-height 'frame-height)
1143(defalias 'screen-width 'frame-width)
9e2b097b
JB
1144
1145(defun set-screen-width (cols &optional pretend)
40d34803
DL
1146 "Obsolete function to change the size of the screen to COLS columns.
1147Optional second arg non-nil means that redisplay should use COLS columns
1148but that the idea of the actual width of the frame should not be changed.
1149This function is provided only for compatibility with Emacs 18; new code
fe668515 1150should use `set-frame-width instead'."
9e2b097b
JB
1151 (set-frame-width (selected-frame) cols pretend))
1152
1153(defun set-screen-height (lines &optional pretend)
40d34803
DL
1154 "Obsolete function to change the height of the screen to LINES lines.
1155Optional second arg non-nil means that redisplay should use LINES lines
1156but that the idea of the actual height of the screen should not be changed.
1157This function is provided only for compatibility with Emacs 18; new code
ef5a6345 1158should use `set-frame-height' instead."
9e2b097b
JB
1159 (set-frame-height (selected-frame) lines pretend))
1160
154a757e
GM
1161(defun delete-other-frames (&optional frame)
1162 "Delete all frames except FRAME.
a2125918
GM
1163If FRAME uses another frame's minibuffer, the minibuffer frame is
1164left untouched. FRAME nil or omitted means use the selected frame."
154a757e
GM
1165 (interactive)
1166 (unless frame
1167 (setq frame (selected-frame)))
a2125918
GM
1168 (let* ((mini-frame (window-frame (minibuffer-window frame)))
1169 (frames (delq mini-frame (delq frame (frame-list)))))
1170 ;; Delete mon-minibuffer-only frames first, because `delete-frame'
1171 ;; signals an error when trying to delete a mini-frame that's
1172 ;; still in use by another frame.
1173 (dolist (frame frames)
1174 (unless (eq (frame-parameter frame 'minibuffer) 'only)
1175 (delete-frame frame)))
1176 ;; Delete minibuffer-only frames.
1177 (dolist (frame frames)
1178 (when (eq (frame-parameter frame 'minibuffer) 'only)
1179 (delete-frame frame)))))
154a757e 1180
2598a293
SM
1181(make-obsolete 'screen-height 'frame-height) ;before 19.15
1182(make-obsolete 'screen-width 'frame-width) ;before 19.15
1183(make-obsolete 'set-screen-width 'set-frame-width) ;before 19.15
1184(make-obsolete 'set-screen-height 'set-frame-height) ;before 19.15
dc6d9681 1185
da7829a3
JPW
1186;; miscellaneous obsolescence declarations
1187(defvaralias 'delete-frame-hook 'delete-frame-functions)
1188(make-obsolete-variable 'delete-frame-hook 'delete-frame-functions "21.4")
1189
dc6d9681 1190\f
7e573c4a 1191;; Highlighting trailing whitespace.
81b99826
GM
1192
1193(make-variable-buffer-local 'show-trailing-whitespace)
1194
1195(defcustom show-trailing-whitespace nil
e6c45c29
LT
1196 "*Non-nil means highlight trailing whitespace.
1197This is done in the face `trailing-whitespace'."
81b99826 1198 :tag "Highlight trailing whitespace."
81b99826
GM
1199 :type 'boolean
1200 :group 'font-lock)
1201
1202
1203\f
7e573c4a 1204;; Scrolling
79b14b94
GM
1205
1206(defgroup scrolling nil
1207 "Scrolling windows."
1208 :version "21.1"
1209 :group 'frames)
1210
968ecc28 1211(defcustom auto-hscroll-mode t
310e9a21 1212 "*Allow or disallow automatic scrolling windows horizontally.
9ea60c46 1213If non-nil, windows are automatically scrolled horizontally to make
79b14b94
GM
1214point visible."
1215 :version "21.1"
1216 :type 'boolean
1217 :group 'scrolling)
968ecc28 1218(defvaralias 'automatic-hscrolling 'auto-hscroll-mode)
79b14b94
GM
1219
1220\f
7e573c4a 1221;; Blinking cursor
81b99826
GM
1222
1223(defgroup cursor nil
ca693be8 1224 "Displaying text cursors."
40d34803 1225 :version "21.1"
81b99826
GM
1226 :group 'frames)
1227
1228(defcustom blink-cursor-delay 0.5
ca693be8 1229 "*Seconds of idle time after which cursor starts to blink."
81b99826
GM
1230 :tag "Delay in seconds."
1231 :type 'number
1232 :group 'cursor)
1233
1234(defcustom blink-cursor-interval 0.5
1235 "*Length of cursor blink interval in seconds."
1236 :tag "Blink interval in seconds."
1237 :type 'number
1238 :group 'cursor)
1239
1240(defvar blink-cursor-idle-timer nil
ca693be8
GM
1241 "Timer started after `blink-cursor-delay' seconds of Emacs idle time.
1242The function `blink-cursor-start' is called when the timer fires.")
81b99826
GM
1243
1244(defvar blink-cursor-timer nil
ca693be8
GM
1245 "Timer started from `blink-cursor-start'.
1246This timer calls `blink-cursor' every `blink-cursor-interval' seconds.")
81b99826
GM
1247
1248(defvar blink-cursor-mode nil
1249 "Non-nil means blinking cursor is active.")
1250
1251(defun blink-cursor-mode (arg)
1252 "Toggle blinking cursor mode.
be6bbb55 1253With a numeric argument, turn blinking cursor mode on iff ARG is positive.
81b99826 1254When blinking cursor mode is enabled, the cursor of the selected
cacf2193
RS
1255window blinks.
1256
1257Note that this command is effective only when Emacs
1258displays through a window system, because then Emacs does its own
1259cursor display. On a text-only terminal, this is not implemented."
81b99826
GM
1260 (interactive "P")
1261 (let ((on-p (if (null arg)
1262 (not blink-cursor-mode)
1263 (> (prefix-numeric-value arg) 0))))
1264 (if blink-cursor-idle-timer
1265 (cancel-timer blink-cursor-idle-timer))
1266 (if blink-cursor-timer
1267 (cancel-timer blink-cursor-timer))
1268 (setq blink-cursor-idle-timer nil
1269 blink-cursor-timer nil
1270 blink-cursor-mode nil)
1271 (if on-p
1272 (progn
1273 ;; Hide the cursor.
cae2c28e 1274 ;(internal-show-cursor nil nil)
81b99826
GM
1275 (setq blink-cursor-idle-timer
1276 (run-with-idle-timer blink-cursor-delay
1277 blink-cursor-delay
1278 'blink-cursor-start))
d4ed0cba
GM
1279 (setq blink-cursor-mode t))
1280 (internal-show-cursor nil t))))
81b99826 1281
cae2c28e
GM
1282;; Note that this is really initialized from startup.el before
1283;; the init-file is read.
1284
1285(defcustom blink-cursor nil
ca693be8 1286 "*Non-nil means blinking cursor mode is active."
cae2c28e 1287 :group 'cursor
81b99826
GM
1288 :tag "Blinking cursor"
1289 :type 'boolean
81b99826
GM
1290 :set #'(lambda (symbol value)
1291 (set-default symbol value)
1292 (blink-cursor-mode (or value 0))))
1293
1294(defun blink-cursor-start ()
ca693be8
GM
1295 "Timer function called from the timer `blink-cursor-idle-timer'.
1296This starts the timer `blink-cursor-timer', which makes the cursor blink
1297if appropriate. It also arranges to cancel that timer when the next
1298command starts, by installing a pre-command hook."
81b99826
GM
1299 (when (null blink-cursor-timer)
1300 (add-hook 'pre-command-hook 'blink-cursor-end)
9dbf2cd6 1301 (internal-show-cursor nil nil)
81b99826
GM
1302 (setq blink-cursor-timer
1303 (run-with-timer blink-cursor-interval blink-cursor-interval
0a5ebe4b
GM
1304 'blink-cursor-timer-function))))
1305
1306(defun blink-cursor-timer-function ()
1307 "Timer function of timer `blink-cursor-timer'."
1308 (internal-show-cursor nil (not (internal-show-cursor-p))))
81b99826
GM
1309
1310(defun blink-cursor-end ()
1311 "Stop cursor blinking.
ca693be8 1312This is installed as a pre-command hook by `blink-cursor-start'.
f39784dd 1313When run, it cancels the timer `blink-cursor-timer' and removes
ca693be8 1314itself as a pre-command hook."
81b99826 1315 (remove-hook 'pre-command-hook 'blink-cursor-end)
0a5ebe4b 1316 (internal-show-cursor nil t)
81b99826
GM
1317 (cancel-timer blink-cursor-timer)
1318 (setq blink-cursor-timer nil))
1319
1320
1321\f
7e573c4a 1322;; Hourglass pointer
81b99826 1323
a6c411ff
GM
1324(defcustom display-hourglass t
1325 "*Non-nil means show an hourglass pointer when running under a window system."
1326 :tag "Hourglass pointer"
81b99826 1327 :type 'boolean
a6c411ff 1328 :group 'cursor)
81b99826 1329
a6c411ff
GM
1330(defcustom hourglass-delay 1
1331 "*Seconds to wait before displaying an hourglass pointer."
1332 :tag "Hourglass delay"
0a86e779 1333 :type 'number
a6c411ff 1334 :group 'cursor)
1d0a3ef4 1335
5b2c5477 1336\f
c0eb3c10 1337(defcustom cursor-in-non-selected-windows t
5b2c5477 1338 "*Non-nil means show a hollow box cursor in non-selected-windows.
e053c60f 1339If nil, don't show a cursor except in the selected window.
f39784dd 1340Use Custom to set this variable to get the display updated."
5b2c5477
GM
1341 :tag "Cursor in non-selected windows"
1342 :type 'boolean
1343 :group 'cursor
5b2c5477
GM
1344 :set #'(lambda (symbol value)
1345 (set-default symbol value)
5b2c5477 1346 (force-mode-line-update t)))
f39784dd 1347
81b99826 1348\f
64c669bc 1349;;;; Key bindings
64c669bc 1350
6238bfaf 1351(define-key ctl-x-5-map "2" 'make-frame-command)
154a757e 1352(define-key ctl-x-5-map "1" 'delete-other-frames)
dc6d9681 1353(define-key ctl-x-5-map "0" 'delete-frame)
ceab6935 1354(define-key ctl-x-5-map "o" 'other-frame)
49116ac0 1355
dc6d9681 1356(provide 'frame)
c88ab9ce 1357
ab5796a9 1358;;; arch-tag: 82979c70-b8f2-4306-b2ad-ddbd6b328b56
dc6d9681 1359;;; frame.el ends here