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