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