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