1 ;;; frame.el --- multi-frame management independent of window systems
3 ;; Copyright (C) 1993-1994, 1996-1997, 2000-2014 Free Software Foundation, Inc.
5 ;; Maintainer: emacs-devel@gnu.org
9 ;; This file is part of GNU Emacs.
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 3 of the License, or
14 ;; (at your option) any later version.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 (eval-when-compile (require 'cl-lib
))
29 (defvar frame-creation-function-alist
31 (if (fboundp 'tty-create-frame-with-faces
)
32 'tty-create-frame-with-faces
34 (error "Can't create multiple frames without a window system")))))
35 "Alist of window-system dependent functions to call to create a new frame.
36 The window system startup file should add its frame creation
37 function to this list, which should take an alist of parameters
40 (defvar window-system-default-frame-alist nil
41 "Window-system dependent default frame parameters.
42 The value should be an alist of elements (WINDOW-SYSTEM . ALIST),
43 where WINDOW-SYSTEM is a window system symbol (see `window-system')
44 and ALIST is a frame parameter alist like `default-frame-alist'.
45 Then, for frames on WINDOW-SYSTEM, any parameters specified in
46 ALIST supersede the corresponding parameters specified in
47 `default-frame-alist'.")
49 (defvar display-format-alist nil
50 "Alist of patterns to decode display names.
51 The car of each entry is a regular expression matching a display
52 name string. The cdr is a symbol giving the window-system that
53 handles the corresponding kind of display.")
55 ;; The initial value given here used to ask for a minibuffer.
56 ;; But that's not necessary, because the default is to have one.
57 ;; By not specifying it here, we let an X resource specify it.
58 (defcustom initial-frame-alist nil
59 "Alist of parameters for the initial X window frame.
60 You can set this in your init file; for example,
62 (setq initial-frame-alist
63 '((top . 1) (left . 1) (width . 80) (height . 55)))
65 Parameters specified here supersede the values given in
66 `default-frame-alist'.
68 If the value calls for a frame without a minibuffer, and you have
69 not created a minibuffer frame on your own, a minibuffer frame is
70 created according to `minibuffer-frame-alist'.
72 You can specify geometry-related options for just the initial
73 frame by setting this variable in your init file; however, they
74 won't take effect until Emacs reads your init file, which happens
75 after creating the initial frame. If you want the initial frame
76 to have the proper geometry as soon as it appears, you need to
77 use this three-step process:
78 * Specify X resources to give the geometry you want.
79 * Set `default-frame-alist' to override these options so that they
80 don't affect subsequent frames.
81 * Set `initial-frame-alist' in a way that matches the X resources,
82 to override what you put in `default-frame-alist'."
83 :type
'(repeat (cons :format
"%v"
84 (symbol :tag
"Parameter")
88 (defcustom minibuffer-frame-alist
'((width .
80) (height .
2))
89 "Alist of parameters for the initial minibuffer frame.
90 This is the minibuffer frame created if `initial-frame-alist'
91 calls for a frame without a minibuffer. The parameters specified
92 here supersede those given in `default-frame-alist', for the
93 initial minibuffer frame.
95 You can set this in your init file; for example,
97 (setq minibuffer-frame-alist
98 '((top . 1) (left . 1) (width . 80) (height . 2)))
100 It is not necessary to include (minibuffer . only); that is
101 appended when the minibuffer frame is created."
102 :type
'(repeat (cons :format
"%v"
103 (symbol :tag
"Parameter")
104 (sexp :tag
"Value")))
107 (defun handle-delete-frame (event)
108 "Handle delete-frame events from the X server."
110 (let ((frame (posn-window (event-start event
)))
114 (and (frame-visible-p (car tail
))
115 (not (eq (car tail
) frame
))
117 (setq tail
(cdr tail
)))
119 (delete-frame frame t
)
120 ;; Gildea@x.org says it is ok to ask questions before terminating.
121 (save-buffers-kill-emacs))))
123 (defun handle-focus-in (_event)
124 "Handle a focus-in event.
125 Focus-in events are usually bound to this function.
126 Focus-in events occur when a frame has focus, but a switch-frame event
128 This function runs the hook `focus-in-hook'."
130 (run-hooks 'focus-in-hook
))
132 (defun handle-focus-out (_event)
133 "Handle a focus-out event.
134 Focus-out events are usually bound to this function.
135 Focus-out events occur when no frame has focus.
136 This function runs the hook `focus-out-hook'."
138 (run-hooks 'focus-out-hook
))
140 ;;;; Arrangement of frames at startup
142 ;; 1) Load the window system startup file from the lisp library and read the
143 ;; high-priority arguments (-q and the like). The window system startup
144 ;; file should create any frames specified in the window system defaults.
146 ;; 2) If no frames have been opened, we open an initial text frame.
148 ;; 3) Once the init file is done, we apply any newly set parameters
149 ;; in initial-frame-alist to the frame.
151 ;; If we create the initial frame, this is it.
152 (defvar frame-initial-frame nil
)
154 ;; Record the parameters used in frame-initialize to make the initial frame.
155 (defvar frame-initial-frame-alist
)
157 (defvar frame-initial-geometry-arguments nil
)
159 ;; startup.el calls this function before loading the user's init
160 ;; file - if there is no frame with a minibuffer open now, create
161 ;; one to display messages while loading the init file.
162 (defun frame-initialize ()
163 "Create an initial frame if necessary."
164 ;; Are we actually running under a window system at all?
165 (if (and initial-window-system
167 (not (eq initial-window-system
'pc
)))
169 ;; If there is no frame with a minibuffer besides the terminal
170 ;; frame, then we need to create the opening frame. Make sure
171 ;; it has a minibuffer, but let initial-frame-alist omit the
173 (or (delq terminal-frame
(minibuffer-frame-list))
175 (setq frame-initial-frame-alist
176 (append initial-frame-alist default-frame-alist nil
))
177 (setq frame-initial-frame-alist
178 (cons (cons 'window-system initial-window-system
)
179 frame-initial-frame-alist
))
180 (setq default-minibuffer-frame
181 (setq frame-initial-frame
182 (make-frame frame-initial-frame-alist
)))
183 ;; Delete any specifications for window geometry parameters
184 ;; so that we won't reapply them in frame-notice-user-settings.
185 ;; It would be wrong to reapply them then,
186 ;; because that would override explicit user resizing.
187 (setq initial-frame-alist
188 (frame-remove-geometry-params initial-frame-alist
))))
189 ;; Copy the environment of the Emacs process into the new frame.
190 (set-frame-parameter frame-initial-frame
'environment
191 (frame-parameter terminal-frame
'environment
))
192 ;; At this point, we know that we have a frame open, so we
193 ;; can delete the terminal frame.
194 (delete-frame terminal-frame
)
195 (setq terminal-frame nil
))))
197 (defvar frame-notice-user-settings t
198 "Non-nil means function `frame-notice-user-settings' wasn't run yet.")
200 (declare-function tool-bar-mode
"tool-bar" (&optional arg
))
202 (defalias 'tool-bar-lines-needed
'tool-bar-height
)
204 ;; startup.el calls this function after loading the user's init
205 ;; file. Now default-frame-alist and initial-frame-alist contain
206 ;; information to which we must react; do what needs to be done.
207 (defun frame-notice-user-settings ()
208 "Act on user's init file settings of frame parameters.
209 React to settings of `initial-frame-alist',
210 `window-system-default-frame-alist' and `default-frame-alist'
211 there (in decreasing order of priority)."
212 ;; Creating and deleting frames may shift the selected frame around,
213 ;; and thus the current buffer. Protect against that. We don't
214 ;; want to use save-excursion here, because that may also try to set
215 ;; the buffer of the selected window, which fails when the selected
216 ;; window is the minibuffer.
217 (let ((old-buffer (current-buffer))
218 (window-system-frame-alist
219 (cdr (assq initial-window-system
220 window-system-default-frame-alist
))))
222 (when (and frame-notice-user-settings
223 (null frame-initial-frame
))
224 ;; This case happens when we don't have a window system, and
225 ;; also for MS-DOS frames.
226 (let ((parms (frame-parameters)))
227 ;; Don't change the frame names.
228 (setq parms
(delq (assq 'name parms
) parms
))
229 ;; Can't modify the minibuffer parameter, so don't try.
230 (setq parms
(delq (assq 'minibuffer parms
) parms
))
231 (modify-frame-parameters
233 (if initial-window-system
235 ;; initial-frame-alist and default-frame-alist were already
236 ;; applied in pc-win.el.
237 (append initial-frame-alist window-system-frame-alist
238 default-frame-alist parms nil
)))
239 (if (null initial-window-system
) ;; MS-DOS does this differently in pc-win.el
240 (let ((newparms (frame-parameters))
241 (frame (selected-frame)))
242 (tty-handle-reverse-video frame newparms
)
243 ;; If we changed the background color, we need to update
244 ;; the background-mode parameter, and maybe some faces,
246 (when (assq 'background-color newparms
)
247 (unless (or (assq 'background-mode initial-frame-alist
)
248 (assq 'background-mode default-frame-alist
))
249 (frame-set-background-mode frame
))
250 (face-set-after-frame-default frame
))))))
252 ;; If the initial frame is still around, apply initial-frame-alist
253 ;; and default-frame-alist to it.
254 (when (frame-live-p frame-initial-frame
)
255 ;; When tool-bar has been switched off, correct the frame size
256 ;; by the lines added in x-create-frame for the tool-bar and
257 ;; switch `tool-bar-mode' off.
258 (when (display-graphic-p)
259 (let ((tool-bar-lines
260 (or (assq 'tool-bar-lines initial-frame-alist
)
261 (assq 'tool-bar-lines window-system-frame-alist
)
262 (assq 'tool-bar-lines default-frame-alist
))))
263 ;; Shrink frame by its initial tool bar height iff either zero
264 ;; tool bar lines have been requested in one of the frame's
265 ;; alists or tool bar mode has been turned off explicitly in
266 ;; the user's init file.
267 (when (and tool-bar-lines
268 (> frame-initial-frame-tool-bar-height
0)
269 (or (not tool-bar-mode
)
270 (null (cdr tool-bar-lines
))
271 (eq 0 (cdr tool-bar-lines
))))
273 frame-initial-frame
(- (frame-text-height frame-initial-frame
)
274 frame-initial-frame-tool-bar-height
)
277 (cdr (assq 'top frame-initial-geometry-arguments
)))
278 (top (frame-parameter frame-initial-frame
'top
)))
279 (when (and (consp initial-top
) (eq '-
(car initial-top
)))
282 ((and (consp top
) (eq '+ (car top
)))
283 (list '+ (+ (cadr top
)
284 frame-initial-frame-tool-bar-height
)))
285 ((and (consp top
) (eq '-
(car top
)))
286 (list '-
(- (cadr top
)
287 frame-initial-frame-tool-bar-height
)))
288 (t (+ top frame-initial-frame-tool-bar-height
)))))
289 (modify-frame-parameters
290 frame-initial-frame
'((top . adjusted-top
))))))
291 (tool-bar-mode -
1))))
293 ;; The initial frame we create above always has a minibuffer.
294 ;; If the user wants to remove it, or make it a minibuffer-only
295 ;; frame, then we'll have to delete the current frame and make a
296 ;; new one; you can't remove or add a root window to/from an
299 ;; NOTE: default-frame-alist was nil when we created the
300 ;; existing frame. We need to explicitly include
301 ;; default-frame-alist in the parameters of the screen we
302 ;; create here, so that its new value, gleaned from the user's
303 ;; init file, will be applied to the existing screen.
304 (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist
)
305 (assq 'minibuffer window-system-frame-alist
)
306 (assq 'minibuffer default-frame-alist
)
309 ;; Create the new frame.
311 ;; MS-Windows needs this to avoid inflooping below.
312 (if (eq system-type
'windows-nt
)
314 ;; If the frame isn't visible yet, wait till it is.
315 ;; If the user has to position the window,
316 ;; Emacs doesn't know its real position until
317 ;; the frame is seen to be visible.
318 (while (not (cdr (assq 'visibility
319 (frame-parameters frame-initial-frame
))))
321 (setq parms
(frame-parameters frame-initial-frame
))
323 ;; Get rid of `name' unless it was specified explicitly before.
324 (or (assq 'name frame-initial-frame-alist
)
325 (setq parms
(delq (assq 'name parms
) parms
)))
326 ;; An explicit parent-id is a request to XEmbed the frame.
327 (or (assq 'parent-id frame-initial-frame-alist
)
328 (setq parms
(delq (assq 'parent-id parms
) parms
)))
330 (setq parms
(append initial-frame-alist
331 window-system-frame-alist
336 ;; Get rid of `reverse', because that was handled
337 ;; when we first made the frame.
338 (setq parms
(cons '(reverse) (delq (assq 'reverse parms
) parms
)))
340 (if (assq 'height frame-initial-geometry-arguments
)
341 (setq parms
(assq-delete-all 'height parms
)))
342 (if (assq 'width frame-initial-geometry-arguments
)
343 (setq parms
(assq-delete-all 'width parms
)))
344 (if (assq 'left frame-initial-geometry-arguments
)
345 (setq parms
(assq-delete-all 'left parms
)))
346 (if (assq 'top frame-initial-geometry-arguments
)
347 (setq parms
(assq-delete-all 'top parms
)))
350 ;; Use the geometry args that created the existing
351 ;; frame, rather than the parms we get for it.
352 (append frame-initial-geometry-arguments
353 '((user-size . t
) (user-position . t
))
355 ;; The initial frame, which we are about to delete, may be
356 ;; the only frame with a minibuffer. If it is, create a
358 (or (delq frame-initial-frame
(minibuffer-frame-list))
359 (make-initial-minibuffer-frame nil
))
361 ;; If the initial frame is serving as a surrogate
362 ;; minibuffer frame for any frames, we need to wean them
363 ;; onto a new frame. The default-minibuffer-frame
364 ;; variable must be handled similarly.
365 (let ((users-of-initial
368 (and (not (eq frame frame-initial-frame
))
370 (minibuffer-window frame
))
371 frame-initial-frame
))))))
372 (if (or users-of-initial
373 (eq default-minibuffer-frame frame-initial-frame
))
375 ;; Choose an appropriate frame. Prefer frames which
376 ;; are only minibuffers.
377 (let* ((new-surrogate
379 (or (filtered-frame-list
381 (eq (cdr (assq 'minibuffer
382 (frame-parameters frame
)))
384 (minibuffer-frame-list))))
385 (new-minibuffer (minibuffer-window new-surrogate
)))
387 (if (eq default-minibuffer-frame frame-initial-frame
)
388 (setq default-minibuffer-frame new-surrogate
))
390 ;; Wean the frames using frame-initial-frame as
391 ;; their minibuffer frame.
392 (dolist (frame users-of-initial
)
393 (modify-frame-parameters
394 frame
(list (cons 'minibuffer new-minibuffer
)))))))
396 ;; Redirect events enqueued at this frame to the new frame.
397 ;; Is this a good idea?
398 (redirect-frame-focus frame-initial-frame new
)
400 ;; Finally, get rid of the old frame.
401 (delete-frame frame-initial-frame t
))
403 ;; Otherwise, we don't need all that rigmarole; just apply
404 ;; the new parameters.
405 (let (newparms allparms tail
)
406 (setq allparms
(append initial-frame-alist
407 window-system-frame-alist
408 default-frame-alist nil
))
409 (if (assq 'height frame-initial-geometry-arguments
)
410 (setq allparms
(assq-delete-all 'height allparms
)))
411 (if (assq 'width frame-initial-geometry-arguments
)
412 (setq allparms
(assq-delete-all 'width allparms
)))
413 (if (assq 'left frame-initial-geometry-arguments
)
414 (setq allparms
(assq-delete-all 'left allparms
)))
415 (if (assq 'top frame-initial-geometry-arguments
)
416 (setq allparms
(assq-delete-all 'top allparms
)))
418 ;; Find just the parms that have changed since we first
419 ;; made this frame. Those are the ones actually set by
420 ;; the init file. For those parms whose values we already knew
421 ;; (such as those spec'd by command line options)
422 ;; it is undesirable to specify the parm again
423 ;; once the user has seen the frame and been able to alter it
427 (setq oldval
(assq (car entry
) frame-initial-frame-alist
))
428 (setq newval
(cdr (assq (car entry
) allparms
)))
429 (or (and oldval
(eq (cdr oldval
) newval
))
431 (cons (cons (car entry
) newval
) newparms
)))))
432 (setq newparms
(nreverse newparms
))
434 (let ((new-bg (assq 'background-color newparms
)))
435 ;; If the `background-color' parameter is changed, apply
436 ;; it first, then make sure that the `background-mode'
437 ;; parameter and other faces are updated, before applying
438 ;; the other parameters.
440 (modify-frame-parameters frame-initial-frame
442 (unless (assq 'background-mode newparms
)
443 (frame-set-background-mode frame-initial-frame
))
444 (face-set-after-frame-default frame-initial-frame
)
445 (setq newparms
(delq new-bg newparms
)))
446 (modify-frame-parameters frame-initial-frame newparms
)))))
448 ;; Restore the original buffer.
449 (set-buffer old-buffer
)
451 ;; Make sure the initial frame can be GC'd if it is ever deleted.
452 ;; Make sure frame-notice-user-settings does nothing if called twice.
453 (setq frame-notice-user-settings nil
)
454 (setq frame-initial-frame nil
)))
456 (defun make-initial-minibuffer-frame (display)
457 (let ((parms (append minibuffer-frame-alist
'((minibuffer . only
)))))
459 (make-frame-on-display display parms
)
460 (make-frame parms
))))
462 ;;;; Creation of additional frames, and other frame miscellanea
464 (defun modify-all-frames-parameters (alist)
465 "Modify all current and future frames' parameters according to ALIST.
466 This changes `default-frame-alist' and possibly `initial-frame-alist'.
467 Furthermore, this function removes all parameters in ALIST from
468 `window-system-default-frame-alist'.
469 See help of `modify-frame-parameters' for more information."
470 (dolist (frame (frame-list))
471 (modify-frame-parameters frame alist
))
473 (dolist (pair alist
) ;; conses to add/replace
474 ;; initial-frame-alist needs setting only when
475 ;; frame-notice-user-settings is true.
476 (and frame-notice-user-settings
477 (setq initial-frame-alist
478 (assq-delete-all (car pair
) initial-frame-alist
)))
479 (setq default-frame-alist
480 (assq-delete-all (car pair
) default-frame-alist
))
481 ;; Remove any similar settings from the window-system specific
482 ;; parameters---they would override default-frame-alist.
483 (dolist (w window-system-default-frame-alist
)
484 (setcdr w
(assq-delete-all (car pair
) (cdr w
)))))
486 (and frame-notice-user-settings
487 (setq initial-frame-alist
(append initial-frame-alist alist
)))
488 (setq default-frame-alist
(append default-frame-alist alist
)))
490 (defun get-other-frame ()
491 "Return some frame other than the current frame.
492 Create one if necessary. Note that the minibuffer frame, if separate,
493 is not considered (see `next-frame')."
494 (if (equal (next-frame) (selected-frame)) (make-frame) (next-frame)))
496 (defun next-multiframe-window ()
497 "Select the next window, regardless of which frame it is on."
499 (select-window (next-window (selected-window)
500 (> (minibuffer-depth) 0)
502 (select-frame-set-input-focus (selected-frame)))
504 (defun previous-multiframe-window ()
505 "Select the previous window, regardless of which frame it is on."
507 (select-window (previous-window (selected-window)
508 (> (minibuffer-depth) 0)
510 (select-frame-set-input-focus (selected-frame)))
512 (defun window-system-for-display (display)
513 "Return the window system for DISPLAY.
514 Return nil if we don't know how to interpret DISPLAY."
515 ;; MS-Windows doesn't know how to create a GUI frame in a -nw session.
516 (if (and (eq system-type
'windows-nt
)
517 (null (window-system)))
519 (cl-loop for descriptor in display-format-alist
520 for pattern
= (car descriptor
)
521 for system
= (cdr descriptor
)
522 when
(string-match-p pattern display
) return system
)))
524 (defun make-frame-on-display (display &optional parameters
)
525 "Make a frame on display DISPLAY.
526 The optional argument PARAMETERS specifies additional frame parameters."
527 (interactive "sMake frame on display: ")
528 (make-frame (cons (cons 'display display
) parameters
)))
530 (declare-function x-close-connection
"xfns.c" (terminal))
532 (defun close-display-connection (display)
533 "Close the connection to a display, deleting all its associated frames.
534 For DISPLAY, specify either a frame or a display name (a string).
535 If DISPLAY is nil, that stands for the selected frame's display."
538 (let* ((default (frame-parameter nil
'display
))
539 (display (completing-read
540 (format "Close display (default %s): " default
)
542 (mapcar (lambda (frame)
543 (frame-parameter frame
'display
))
547 (if (zerop (length display
)) default display
))))
548 (let ((frames (delq nil
549 (mapcar (lambda (frame)
551 (frame-parameter frame
'display
))
554 (if (and (consp frames
)
555 (not (y-or-n-p (if (cdr frames
)
556 (format "Delete %s frames? " (length frames
))
557 (format "Delete %s ? " (car frames
))))))
559 (mapc 'delete-frame frames
)
560 (x-close-connection display
))))
562 (defun make-frame-command ()
563 "Make a new frame, on the same terminal as the selected frame.
564 If the terminal is a text-only terminal, this also selects the
567 (if (display-graphic-p)
569 (select-frame (make-frame))))
571 (defvar before-make-frame-hook nil
572 "Functions to run before a frame is created.")
574 (defvar after-make-frame-functions nil
575 "Functions to run after a frame is created.
576 The functions are run with one arg, the newly created frame.")
578 (defvar after-setting-font-hook nil
579 "Functions to run after a frame's font has been changed.")
581 ;; Alias, kept temporarily.
582 (define-obsolete-function-alias 'new-frame
'make-frame
"22.1")
584 (defvar frame-inherited-parameters
'()
585 "Parameters `make-frame' copies from the `selected-frame' to the new frame.")
587 (defvar x-display-name
)
589 (defun make-frame (&optional parameters
)
590 "Return a newly created frame displaying the current buffer.
591 Optional argument PARAMETERS is an alist of frame parameters for
592 the new frame. Each element of PARAMETERS should have the
593 form (NAME . VALUE), for example:
595 (name . STRING) The frame should be named STRING.
597 (width . NUMBER) The frame should be NUMBER characters in width.
598 (height . NUMBER) The frame should be NUMBER text lines high.
600 You cannot specify either `width' or `height', you must specify
603 (minibuffer . t) The frame should have a minibuffer.
604 (minibuffer . nil) The frame should have no minibuffer.
605 (minibuffer . only) The frame should contain only a minibuffer.
606 (minibuffer . WINDOW) The frame should use WINDOW as its minibuffer window.
608 (window-system . nil) The frame should be displayed on a terminal device.
609 (window-system . x) The frame should be displayed in an X window.
611 (display . \":0\") The frame should appear on display :0.
613 (terminal . TERMINAL) The frame should use the terminal object TERMINAL.
615 In addition, any parameter specified in `default-frame-alist',
616 but not present in PARAMETERS, is applied.
618 Before creating the frame (via `frame-creation-function-alist'),
619 this function runs the hook `before-make-frame-hook'. After
620 creating the frame, it runs the hook `after-make-frame-functions'
621 with one arg, the newly created frame.
623 If a display parameter is supplied and a window-system is not,
624 guess the window-system from the display.
626 On graphical displays, this function does not itself make the new
627 frame the selected frame. However, the window system may select
628 the new frame according to its own rules."
630 (let* ((display (cdr (assq 'display parameters
)))
632 ((assq 'terminal parameters
)
633 (let ((type (terminal-live-p (cdr (assq 'terminal parameters
)))))
636 ((eq type nil
) (error "Terminal %s does not exist"
637 (cdr (assq 'terminal parameters
))))
639 ((assq 'window-system parameters
)
640 (cdr (assq 'window-system parameters
)))
642 (or (window-system-for-display display
)
643 (error "Don't know how to interpret display %S"
646 (frame-creation-function (cdr (assq w frame-creation-function-alist
)))
647 (oldframe (selected-frame))
650 (unless frame-creation-function
651 (error "Don't know how to create a frame on window system %s" w
))
653 (unless (get w
'window-system-initialized
)
654 (funcall (cdr (assq w window-system-initialization-alist
)) display
)
655 (setq x-display-name display
)
656 (put w
'window-system-initialized t
))
658 ;; Add parameters from `window-system-default-frame-alist'.
659 (dolist (p (cdr (assq w window-system-default-frame-alist
)))
660 (unless (assq (car p
) params
)
662 ;; Add parameters from `default-frame-alist'.
663 (dolist (p default-frame-alist
)
664 (unless (assq (car p
) params
)
666 ;; Now make the frame.
667 (run-hooks 'before-make-frame-hook
)
668 (setq frame
(funcall frame-creation-function params
))
669 (normal-erase-is-backspace-setup-frame frame
)
670 ;; Inherit the original frame's parameters.
671 (dolist (param frame-inherited-parameters
)
672 (unless (assq param parameters
) ;Overridden by explicit parameters.
673 (let ((val (frame-parameter oldframe param
)))
674 (when val
(set-frame-parameter frame param val
)))))
675 (run-hook-with-args 'after-make-frame-functions frame
)
678 (defun filtered-frame-list (predicate)
679 "Return a list of all live frames which satisfy PREDICATE."
680 (let* ((frames (frame-list))
682 (while (consp frames
)
683 (unless (funcall predicate
(car frames
))
685 (setq frames
(cdr frames
)))
688 (defun minibuffer-frame-list ()
689 "Return a list of all frames with their own minibuffers."
692 (eq frame
(window-frame (minibuffer-window frame
))))))
694 ;; Used to be called `terminal-id' in termdev.el.
695 (defun get-device-terminal (device)
696 "Return the terminal corresponding to DEVICE.
697 DEVICE can be a terminal, a frame, nil (meaning the selected frame's terminal),
698 the name of an X display device (HOST.SERVER.SCREEN) or a tty device file."
700 ((or (null device
) (framep device
))
701 (frame-terminal device
))
703 (let ((f (car (filtered-frame-list
705 (or (equal (frame-parameter frame
'display
) device
)
706 (equal (frame-parameter frame
'tty
) device
)))))))
707 (or f
(error "Display %s does not exist" device
))
709 ((terminal-live-p device
) device
)
711 (error "Invalid argument %s in `get-device-terminal'" device
))))
713 (defun frames-on-display-list (&optional device
)
714 "Return a list of all frames on DEVICE.
716 DEVICE should be a terminal, a frame,
717 or a name of an X display or tty (a string of the form
720 If DEVICE is omitted or nil, it defaults to the selected
721 frame's terminal device."
722 (let* ((terminal (get-device-terminal device
))
723 (func #'(lambda (frame)
724 (eq (frame-terminal frame
) terminal
))))
725 (filtered-frame-list func
)))
727 (defun framep-on-display (&optional terminal
)
728 "Return the type of frames on TERMINAL.
729 TERMINAL may be a terminal id, a display name or a frame. If it
730 is a frame, its type is returned. If TERMINAL is omitted or nil,
731 it defaults to the selected frame's terminal device. All frames
732 on a given display are of the same type."
733 (or (terminal-live-p terminal
)
735 (framep (car (frames-on-display-list terminal
)))))
737 (defun frame-remove-geometry-params (param-list)
738 "Return the parameter list PARAM-LIST, but with geometry specs removed.
739 This deletes all bindings in PARAM-LIST for `top', `left', `width',
740 `height', `user-size' and `user-position' parameters.
741 Emacs uses this to avoid overriding explicit moves and resizings from
742 the user during startup."
743 (setq param-list
(cons nil param-list
))
744 (let ((tail param-list
))
745 (while (consp (cdr tail
))
746 (if (and (consp (car (cdr tail
)))
747 (memq (car (car (cdr tail
)))
748 '(height width top left user-position user-size
)))
750 (setq frame-initial-geometry-arguments
751 (cons (car (cdr tail
)) frame-initial-geometry-arguments
))
752 (setcdr tail
(cdr (cdr tail
))))
753 (setq tail
(cdr tail
)))))
754 (setq frame-initial-geometry-arguments
755 (nreverse frame-initial-geometry-arguments
))
758 (declare-function x-focus-frame
"frame.c" (frame))
760 (defun select-frame-set-input-focus (frame &optional norecord
)
761 "Select FRAME, raise it, and set input focus, if possible.
762 If `mouse-autoselect-window' is non-nil, also move mouse pointer
763 to FRAME's selected window. Otherwise, if `focus-follows-mouse'
764 is non-nil, move mouse cursor to FRAME.
766 Optional argument NORECORD means to neither change the order of
767 recently selected windows nor the buffer list."
768 (select-frame frame norecord
)
770 ;; Ensure, if possible, that FRAME gets input focus.
771 (when (memq (window-system frame
) '(x w32 ns
))
772 (x-focus-frame frame
))
773 ;; Move mouse cursor if necessary.
775 (mouse-autoselect-window
776 (let ((edges (window-inside-edges (frame-selected-window frame
))))
777 ;; Move mouse cursor into FRAME's selected window to avoid that
778 ;; Emacs mouse-autoselects another window.
779 (set-mouse-position frame
(nth 2 edges
) (nth 1 edges
))))
781 ;; Move mouse cursor into FRAME to avoid that another frame gets
782 ;; selected by the window manager.
783 (set-mouse-position frame
(1- (frame-width frame
)) 0))))
785 (defun other-frame (arg)
786 "Select the ARGth different visible frame on current display, and raise it.
787 All frames are arranged in a cyclic order.
788 This command selects the frame ARG steps away in that order.
789 A negative ARG moves in the opposite order.
791 To make this command work properly, you must tell Emacs
792 how the system (or the window manager) generally handles
793 focus-switching between windows. If moving the mouse onto a window
794 selects it (gives it focus), set `focus-follows-mouse' to t.
795 Otherwise, that variable should be nil."
797 (let ((frame (selected-frame)))
799 (setq frame
(next-frame frame
))
800 (while (not (eq (frame-visible-p frame
) t
))
801 (setq frame
(next-frame frame
)))
804 (setq frame
(previous-frame frame
))
805 (while (not (eq (frame-visible-p frame
) t
))
806 (setq frame
(previous-frame frame
)))
808 (select-frame-set-input-focus frame
)))
810 (defun iconify-or-deiconify-frame ()
811 "Iconify the selected frame, or deiconify if it's currently an icon."
813 (if (eq (cdr (assq 'visibility
(frame-parameters))) t
)
815 (make-frame-visible)))
817 (defun suspend-frame ()
818 "Do whatever is right to suspend the current frame.
819 Calls `suspend-emacs' if invoked from the controlling tty device,
820 `suspend-tty' from a secondary tty device, and
821 `iconify-or-deiconify-frame' from an X frame."
823 (let ((type (framep (selected-frame))))
825 ((memq type
'(x ns w32
)) (iconify-or-deiconify-frame))
827 (if (controlling-tty-p)
830 (t (suspend-emacs)))))
832 (defun make-frame-names-alist ()
833 ;; Only consider the frames on the same display.
834 (let* ((current-frame (selected-frame))
837 (cons (frame-parameter current-frame
'name
) current-frame
) nil
))
838 (frame (next-frame nil
0)))
839 (while (not (eq frame current-frame
))
841 (push (cons (frame-parameter frame
'name
) frame
) falist
)
842 (setq frame
(next-frame frame
0))))
845 (defvar frame-name-history nil
)
846 (defun select-frame-by-name (name)
847 "Select the frame on the current terminal whose name is NAME and raise it.
848 If there is no frame by that name, signal an error."
850 (let* ((frame-names-alist (make-frame-names-alist))
851 (default (car (car frame-names-alist
)))
852 (input (completing-read
853 (format "Select Frame (default %s): " default
)
854 frame-names-alist nil t nil
'frame-name-history
)))
855 (if (= (length input
) 0)
858 (let* ((frame-names-alist (make-frame-names-alist))
859 (frame (cdr (assoc name frame-names-alist
))))
861 (select-frame-set-input-focus frame
)
862 (error "There is no frame named `%s'" name
))))
865 ;;;; Background mode.
867 (defcustom frame-background-mode nil
868 "The brightness of the background.
869 Set this to the symbol `dark' if your background color is dark,
870 `light' if your background is light, or nil (automatic by default)
871 if you want Emacs to examine the brightness for you.
873 If you change this without using customize, you should use
874 `frame-set-background-mode' to update existing frames;
875 e.g. (mapc 'frame-set-background-mode (frame-list))."
877 :set
#'(lambda (var value
)
878 (set-default var value
)
879 (mapc 'frame-set-background-mode
(frame-list)))
880 :initialize
'custom-initialize-changed
881 :type
'(choice (const dark
)
883 (const :tag
"automatic" nil
)))
885 (declare-function x-get-resource
"frame.c"
886 (attribute class
&optional component subclass
))
888 ;; Only used if window-system is not null.
889 (declare-function x-display-grayscale-p
"xfns.c" (&optional terminal
))
891 (defvar inhibit-frame-set-background-mode nil
)
893 (defun frame-set-background-mode (frame &optional keep-face-specs
)
894 "Set up display-dependent faces on FRAME.
895 Display-dependent faces are those which have different definitions
896 according to the `background-mode' and `display-type' frame parameters.
898 If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
899 face specs for the new background mode."
900 (unless inhibit-frame-set-background-mode
901 (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame
))
902 (bg-color (frame-parameter frame
'background-color
))
903 (tty-type (tty-type frame
))
905 (if (or (window-system frame
)
907 (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)"
911 (non-default-bg-mode (if (eq default-bg-mode
'light
) 'dark
'light
))
913 (cond (frame-default-bg-mode)
914 ((equal bg-color
"unspecified-fg") ; inverted colors
916 ((not (color-values bg-color frame
))
918 ((>= (apply '+ (color-values bg-color frame
))
919 ;; Just looking at the screen, colors whose
920 ;; values add up to .6 of the white total
921 ;; still look dark to me.
922 (* (apply '+ (color-values "white" frame
)) .6))
926 (cond ((null (window-system frame
))
927 (if (tty-display-color-p frame
) 'color
'mono
))
928 ((display-color-p frame
)
930 ((x-display-grayscale-p frame
)
934 (frame-parameter frame
'background-mode
))
936 (frame-parameter frame
'display-type
)))
938 (unless (and (eq bg-mode old-bg-mode
) (eq display-type old-display-type
))
939 (let ((locally-modified-faces nil
)
940 ;; Prevent face-spec-recalc from calling this function
941 ;; again, resulting in a loop (bug#911).
942 (inhibit-frame-set-background-mode t
)
943 (params (list (cons 'background-mode bg-mode
)
944 (cons 'display-type display-type
))))
946 (modify-frame-parameters frame params
)
947 ;; If we are recomputing face specs, first collect a list
948 ;; of faces that don't match their face-specs. These are
949 ;; the faces modified on FRAME, and we avoid changing them
950 ;; below. Use a negative list to avoid consing (we assume
951 ;; most faces are unmodified).
952 (dolist (face (face-list))
953 (and (not (get face
'face-override-spec
))
954 (not (face-spec-match-p face
955 (face-user-default-spec face
)
957 (push face locally-modified-faces
)))
958 ;; Now change to the new frame parameters
959 (modify-frame-parameters frame params
)
960 ;; For all unmodified named faces, choose face specs
961 ;; matching the new frame parameters.
962 (dolist (face (face-list))
963 (unless (memq face locally-modified-faces
)
964 (face-spec-recalc face frame
)))))))))
966 (defun frame-terminal-default-bg-mode (frame)
967 "Return the default background mode of FRAME.
968 This checks the `frame-background-mode' variable, the X resource
969 named \"backgroundMode\" (if FRAME is an X frame), and finally
970 the `background-mode' terminal parameter."
971 (or frame-background-mode
973 (and (window-system frame
)
974 (x-get-resource "backgroundMode" "BackgroundMode"))))
976 (intern (downcase bg-resource
))))
977 (terminal-parameter frame
'background-mode
)))
980 ;;;; Frame configurations
982 (defun current-frame-configuration ()
983 "Return a list describing the positions and states of all frames.
984 Its car is `frame-configuration'.
985 Each element of the cdr is a list of the form (FRAME ALIST WINDOW-CONFIG),
987 FRAME is a frame object,
988 ALIST is an association list specifying some of FRAME's parameters, and
989 WINDOW-CONFIG is a window configuration object for FRAME."
990 (cons 'frame-configuration
991 (mapcar (lambda (frame)
993 (frame-parameters frame
)
994 (current-window-configuration frame
)))
997 (defun set-frame-configuration (configuration &optional nodelete
)
998 "Restore the frames to the state described by CONFIGURATION.
999 Each frame listed in CONFIGURATION has its position, size, window
1000 configuration, and other parameters set as specified in CONFIGURATION.
1001 However, this function does not restore deleted frames.
1003 Ordinarily, this function deletes all existing frames not
1004 listed in CONFIGURATION. But if optional second argument NODELETE
1005 is given and non-nil, the unwanted frames are iconified instead."
1006 (or (frame-configuration-p configuration
)
1007 (signal 'wrong-type-argument
1008 (list 'frame-configuration-p configuration
)))
1009 (let ((config-alist (cdr configuration
))
1011 (dolist (frame (frame-list))
1012 (let ((parameters (assq frame config-alist
)))
1015 (modify-frame-parameters
1017 ;; Since we can't set a frame's minibuffer status,
1018 ;; we might as well omit the parameter altogether.
1019 (let* ((parms (nth 1 parameters
))
1020 (mini (assq 'minibuffer parms
))
1021 (name (assq 'name parms
))
1022 (explicit-name (cdr (assq 'explicit-name parms
))))
1023 (when mini
(setq parms
(delq mini parms
)))
1024 ;; Leave name in iff it was set explicitly.
1025 ;; This should fix the behavior reported in
1026 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg01632.html
1027 (when (and name
(not explicit-name
))
1028 (setq parms
(delq name parms
)))
1030 (set-window-configuration (nth 2 parameters
)))
1031 (setq frames-to-delete
(cons frame frames-to-delete
)))))
1033 ;; Note: making frames invisible here was tried
1034 ;; but led to some strange behavior--each time the frame
1035 ;; was made visible again, the window manager asked afresh
1036 ;; for where to put it.
1041 ;;;; Convenience functions for accessing and interactively changing
1042 ;;;; frame parameters.
1044 (defun frame-height (&optional frame
)
1045 "Return number of lines available for display on FRAME.
1046 If FRAME is omitted, describe the currently selected frame.
1047 Exactly what is included in the return value depends on the
1048 window-system and toolkit in use - see `frame-pixel-height' for
1049 more details. The lines are in units of the default font height.
1051 The result is roughly related to the frame pixel height via
1052 height in pixels = height in lines * `frame-char-height'.
1053 However, this is only approximate, and is complicated e.g. by the
1054 fact that individual window lines and menu bar lines can have
1055 differing font heights."
1056 (cdr (assq 'height
(frame-parameters frame
))))
1058 (defun frame-width (&optional frame
)
1059 "Return number of columns available for display on FRAME.
1060 If FRAME is omitted, describe the currently selected frame."
1061 (cdr (assq 'width
(frame-parameters frame
))))
1063 (declare-function x-list-fonts
"xfaces.c"
1064 (pattern &optional face frame maximum width
))
1066 (define-obsolete-function-alias 'set-default-font
'set-frame-font
"23.1")
1068 (defun set-frame-font (font &optional keep-size frames
)
1069 "Set the default font to FONT.
1070 When called interactively, prompt for the name of a font, and use
1071 that font on the selected frame. When called from Lisp, FONT
1072 should be a font name (a string), a font object, font entity, or
1075 If KEEP-SIZE is nil, keep the number of frame lines and columns
1076 fixed. If KEEP-SIZE is non-nil (or with a prefix argument), try
1077 to keep the current frame size fixed (in pixels) by adjusting the
1078 number of lines and columns.
1080 If FRAMES is nil, apply the font to the selected frame only.
1081 If FRAMES is non-nil, it should be a list of frames to act upon,
1082 or t meaning all existing graphical frames.
1083 Also, if FRAMES is non-nil, alter the user's Customization settings
1084 as though the font-related attributes of the `default' face had been
1085 \"set in this session\", so that the font is applied to future frames."
1087 (let* ((completion-ignore-case t
)
1088 (font (completing-read "Font name: "
1089 ;; x-list-fonts will fail with an error
1090 ;; if this frame doesn't support fonts.
1091 (x-list-fonts "*" nil
(selected-frame))
1093 (frame-parameter nil
'font
))))
1094 (list font current-prefix-arg nil
)))
1095 (when (or (stringp font
) (fontp font
))
1096 (let* ((this-frame (selected-frame))
1097 ;; FRAMES nil means affect the selected frame.
1098 (frame-list (cond ((null frames
)
1104 (dolist (f frame-list
)
1105 (when (display-multi-font-p f
)
1107 (setq height
(* (frame-parameter f
'height
)
1108 (frame-char-height f
))
1109 width
(* (frame-parameter f
'width
)
1110 (frame-char-width f
))))
1111 ;; When set-face-attribute is called for :font, Emacs
1112 ;; guesses the best font according to other face attributes
1113 ;; (:width, :weight, etc.) so reset them too (Bug#2476).
1114 (set-face-attribute 'default f
1115 :width
'normal
:weight
'normal
1116 :slant
'normal
:font font
)
1118 (modify-frame-parameters
1120 (list (cons 'height
(round height
(frame-char-height f
)))
1121 (cons 'width
(round width
(frame-char-width f
))))))))
1123 ;; Alter the user's Custom setting of the `default' face, but
1124 ;; only for font-related attributes.
1125 (let ((specs (cadr (assq 'user
(get 'default
'theme-face
))))
1126 (attrs '(:family
:foundry
:slant
:weight
:height
:width
))
1128 (if (null specs
) (setq specs
'((t nil
))))
1129 (dolist (spec specs
)
1130 ;; Each SPEC has the form (DISPLAY ATTRIBUTE-PLIST)
1131 (let ((display (nth 0 spec
))
1132 (plist (copy-tree (nth 1 spec
))))
1133 ;; Alter only DISPLAY conditions matching this frame.
1134 (when (or (memq display
'(t default
))
1135 (face-spec-set-match-display display this-frame
))
1136 (dolist (attr attrs
)
1137 (setq plist
(plist-put plist attr
1138 (face-attribute 'default attr
)))))
1139 (push (list display plist
) new-specs
)))
1140 (setq new-specs
(nreverse new-specs
))
1141 (put 'default
'customized-face new-specs
)
1142 (custom-push-theme 'theme-face
'default
'user
'set new-specs
)
1143 (put 'default
'face-modified nil
))))
1144 (run-hooks 'after-setting-font-hook
'after-setting-font-hooks
)))
1146 (defun set-frame-parameter (frame parameter value
)
1147 "Set frame parameter PARAMETER to VALUE on FRAME.
1148 If FRAME is nil, it defaults to the selected frame.
1149 See `modify-frame-parameters'."
1150 (modify-frame-parameters frame
(list (cons parameter value
))))
1152 (defun set-background-color (color-name)
1153 "Set the background color of the selected frame to COLOR-NAME.
1154 When called interactively, prompt for the name of the color to use.
1155 To get the frame's current background color, use `frame-parameters'."
1156 (interactive (list (read-color "Background color: ")))
1157 (modify-frame-parameters (selected-frame)
1158 (list (cons 'background-color color-name
)))
1160 (face-set-after-frame-default (selected-frame))))
1162 (defun set-foreground-color (color-name)
1163 "Set the foreground color of the selected frame to COLOR-NAME.
1164 When called interactively, prompt for the name of the color to use.
1165 To get the frame's current foreground color, use `frame-parameters'."
1166 (interactive (list (read-color "Foreground color: ")))
1167 (modify-frame-parameters (selected-frame)
1168 (list (cons 'foreground-color color-name
)))
1170 (face-set-after-frame-default (selected-frame))))
1172 (defun set-cursor-color (color-name)
1173 "Set the text cursor color of the selected frame to COLOR-NAME.
1174 When called interactively, prompt for the name of the color to use.
1175 This works by setting the `cursor-color' frame parameter on the
1178 You can also set the text cursor color, for all frames, by
1179 customizing the `cursor' face."
1180 (interactive (list (read-color "Cursor color: ")))
1181 (modify-frame-parameters (selected-frame)
1182 (list (cons 'cursor-color color-name
))))
1184 (defun set-mouse-color (color-name)
1185 "Set the color of the mouse pointer of the selected frame to COLOR-NAME.
1186 When called interactively, prompt for the name of the color to use.
1187 To get the frame's current mouse color, use `frame-parameters'."
1188 (interactive (list (read-color "Mouse color: ")))
1189 (modify-frame-parameters (selected-frame)
1190 (list (cons 'mouse-color
1192 (cdr (assq 'mouse-color
1193 (frame-parameters))))))))
1195 (defun set-border-color (color-name)
1196 "Set the color of the border of the selected frame to COLOR-NAME.
1197 When called interactively, prompt for the name of the color to use.
1198 To get the frame's current border color, use `frame-parameters'."
1199 (interactive (list (read-color "Border color: ")))
1200 (modify-frame-parameters (selected-frame)
1201 (list (cons 'border-color color-name
))))
1203 (define-minor-mode auto-raise-mode
1204 "Toggle whether or not selected frames should auto-raise.
1205 With a prefix argument ARG, enable Auto Raise mode if ARG is
1206 positive, and disable it otherwise. If called from Lisp, enable
1207 the mode if ARG is omitted or nil.
1209 Auto Raise mode does nothing under most window managers, which
1210 switch focus on mouse clicks. It only has an effect if your
1211 window manager switches focus on mouse movement (in which case
1212 you should also change `focus-follows-mouse' to t). Then,
1213 enabling Auto Raise mode causes any graphical Emacs frame which
1214 acquires focus to be automatically raised.
1216 Note that this minor mode controls Emacs's own auto-raise
1217 feature. Window managers that switch focus on mouse movement
1218 often have their own auto-raise feature."
1219 :variable
(frame-parameter nil
'auto-raise
)
1220 (if (frame-parameter nil
'auto-raise
)
1223 (define-minor-mode auto-lower-mode
1224 "Toggle whether or not the selected frame should auto-lower.
1225 With a prefix argument ARG, enable Auto Lower mode if ARG is
1226 positive, and disable it otherwise. If called from Lisp, enable
1227 the mode if ARG is omitted or nil.
1229 Auto Lower mode does nothing under most window managers, which
1230 switch focus on mouse clicks. It only has an effect if your
1231 window manager switches focus on mouse movement (in which case
1232 you should also change `focus-follows-mouse' to t). Then,
1233 enabling Auto Lower Mode causes any graphical Emacs frame which
1234 loses focus to be automatically lowered.
1236 Note that this minor mode controls Emacs's own auto-lower
1237 feature. Window managers that switch focus on mouse movement
1238 often have their own features for raising or lowering frames."
1239 :variable
(frame-parameter nil
'auto-lower
))
1241 (defun set-frame-name (name)
1242 "Set the name of the selected frame to NAME.
1243 When called interactively, prompt for the name of the frame.
1244 On text terminals, the frame name is displayed on the mode line.
1245 On graphical displays, it is displayed on the frame's title bar."
1246 (interactive "sFrame name: ")
1247 (modify-frame-parameters (selected-frame)
1248 (list (cons 'name name
))))
1250 (defun frame-current-scroll-bars (&optional frame
)
1251 "Return the current scroll-bar settings in frame FRAME.
1252 Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies the
1253 current location of the vertical scroll-bars (left, right, or nil),
1254 and HORIZONTAL specifies the current location of the horizontal scroll
1255 bars (top, bottom, or nil)."
1256 (let ((vert (frame-parameter frame
'vertical-scroll-bars
))
1258 (unless (memq vert
'(left right nil
))
1259 (setq vert default-frame-scroll-bars
))
1262 (defun frame-monitor-attributes (&optional frame
)
1263 "Return the attributes of the physical monitor dominating FRAME.
1264 If FRAME is omitted, describe the currently selected frame.
1266 A frame is dominated by a physical monitor when either the
1267 largest area of the frame resides in the monitor, or the monitor
1268 is the closest to the frame if the frame does not intersect any
1271 See `display-monitor-attributes-list' for the list of attribute
1272 keys and their meanings."
1273 (or frame
(setq frame
(selected-frame)))
1274 (cl-loop for attributes in
(display-monitor-attributes-list frame
)
1275 for frames
= (cdr (assq 'frames attributes
))
1276 if
(memq frame frames
) return attributes
))
1279 ;;;; Frame/display capabilities.
1281 (declare-function msdos-mouse-p
"dosfns.c")
1283 (defun display-mouse-p (&optional display
)
1284 "Return non-nil if DISPLAY has a mouse available.
1285 DISPLAY can be a display name, a frame, or nil (meaning the selected
1287 (let ((frame-type (framep-on-display display
)))
1289 ((eq frame-type
'pc
)
1291 ((eq frame-type
'w32
)
1293 (> w32-num-mouse-buttons
0)))
1294 ((memq frame-type
'(x ns
))
1295 t
) ;; We assume X and NeXTstep *always* have a pointing device
1297 (or (and (featurep 'xt-mouse
)
1299 ;; t-mouse is distributed with the GPM package. It doesn't have
1302 ;; No way to check whether a w32 console has a mouse, assume
1304 (boundp 'w32-use-full-screen-buffer
))))))
1306 (defun display-popup-menus-p (&optional display
)
1307 "Return non-nil if popup menus are supported on DISPLAY.
1308 DISPLAY can be a display name, a frame, or nil (meaning the selected
1310 Support for popup menus requires that the mouse be available."
1311 (display-mouse-p display
))
1313 (defun display-graphic-p (&optional display
)
1314 "Return non-nil if DISPLAY is a graphic display.
1315 Graphical displays are those which are capable of displaying several
1316 frames and several different fonts at once. This is true for displays
1317 that use a window system such as X, and false for text-only terminals.
1318 DISPLAY can be a display name, a frame, or nil (meaning the selected
1320 (not (null (memq (framep-on-display display
) '(x w32 ns
)))))
1322 (defun display-images-p (&optional display
)
1323 "Return non-nil if DISPLAY can display images.
1325 DISPLAY can be a display name, a frame, or nil (meaning the selected
1327 (and (display-graphic-p display
)
1328 (fboundp 'image-mask-p
)
1329 (fboundp 'image-size
)))
1331 (defalias 'display-multi-frame-p
'display-graphic-p
)
1332 (defalias 'display-multi-font-p
'display-graphic-p
)
1334 (defun display-selections-p (&optional display
)
1335 "Return non-nil if DISPLAY supports selections.
1336 A selection is a way to transfer text or other data between programs
1337 via special system buffers called `selection' or `clipboard'.
1338 DISPLAY can be a display name, a frame, or nil (meaning the selected
1340 (let ((frame-type (framep-on-display display
)))
1342 ((eq frame-type
'pc
)
1343 ;; MS-DOS frames support selections when Emacs runs inside
1344 ;; a Windows DOS Box.
1346 (not (null dos-windows-version
))))
1347 ((memq frame-type
'(x w32 ns
))
1352 (declare-function x-display-screens
"xfns.c" (&optional terminal
))
1354 (defun display-screens (&optional display
)
1355 "Return the number of screens associated with DISPLAY.
1356 If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1357 (let ((frame-type (framep-on-display display
)))
1359 ((memq frame-type
'(x w32 ns
))
1360 (x-display-screens display
))
1364 (declare-function x-display-pixel-height
"xfns.c" (&optional terminal
))
1366 (defun display-pixel-height (&optional display
)
1367 "Return the height of DISPLAY's screen in pixels.
1368 If DISPLAY is omitted or nil, it defaults to the selected frame's display.
1370 For character terminals, each character counts as a single pixel.
1372 For graphical terminals, note that on \"multi-monitor\" setups this
1373 refers to the pixel height for all physical monitors associated
1374 with DISPLAY. To get information for each physical monitor, use
1375 `display-monitor-attributes-list'."
1376 (let ((frame-type (framep-on-display display
)))
1378 ((memq frame-type
'(x w32 ns
))
1379 (x-display-pixel-height display
))
1381 (frame-height (if (framep display
) display
(selected-frame)))))))
1383 (declare-function x-display-pixel-width
"xfns.c" (&optional terminal
))
1385 (defun display-pixel-width (&optional display
)
1386 "Return the width of DISPLAY's screen in pixels.
1387 If DISPLAY is omitted or nil, it defaults to the selected frame's display.
1389 For character terminals, each character counts as a single pixel.
1391 For graphical terminals, note that on \"multi-monitor\" setups this
1392 refers to the pixel width for all physical monitors associated
1393 with DISPLAY. To get information for each physical monitor, use
1394 `display-monitor-attributes-list'."
1395 (let ((frame-type (framep-on-display display
)))
1397 ((memq frame-type
'(x w32 ns
))
1398 (x-display-pixel-width display
))
1400 (frame-width (if (framep display
) display
(selected-frame)))))))
1402 (defcustom display-mm-dimensions-alist nil
1403 "Alist for specifying screen dimensions in millimeters.
1404 The functions `display-mm-height' and `display-mm-width' consult
1405 this list before asking the system.
1407 Each element has the form (DISPLAY . (WIDTH . HEIGHT)), e.g.
1408 \(\":0.0\" . (287 . 215)).
1410 If `display' is t, it specifies dimensions for all graphical displays
1411 not explicitly specified."
1413 :type
'(alist :key-type
(choice (string :tag
"Display name")
1414 (const :tag
"Default" t
))
1415 :value-type
(cons :tag
"Dimensions"
1416 (integer :tag
"Width")
1417 (integer :tag
"Height")))
1420 (declare-function x-display-mm-height
"xfns.c" (&optional terminal
))
1422 (defun display-mm-height (&optional display
)
1423 "Return the height of DISPLAY's screen in millimeters.
1424 If the information is unavailable, this function returns nil.
1425 If DISPLAY is omitted or nil, it defaults to the selected frame's display.
1427 You can override what the system thinks the result should be by
1428 adding an entry to `display-mm-dimensions-alist'.
1430 For graphical terminals, note that on \"multi-monitor\" setups this
1431 refers to the height in millimeters for all physical monitors
1432 associated with DISPLAY. To get information for each physical
1433 monitor, use `display-monitor-attributes-list'."
1434 (and (memq (framep-on-display display
) '(x w32 ns
))
1435 (or (cddr (assoc (or display
(frame-parameter nil
'display
))
1436 display-mm-dimensions-alist
))
1437 (cddr (assoc t display-mm-dimensions-alist
))
1438 (x-display-mm-height display
))))
1440 (declare-function x-display-mm-width
"xfns.c" (&optional terminal
))
1442 (defun display-mm-width (&optional display
)
1443 "Return the width of DISPLAY's screen in millimeters.
1444 If the information is unavailable, this function returns nil.
1445 If DISPLAY is omitted or nil, it defaults to the selected frame's display.
1447 You can override what the system thinks the result should be by
1448 adding an entry to `display-mm-dimensions-alist'.
1450 For graphical terminals, note that on \"multi-monitor\" setups this
1451 refers to the width in millimeters for all physical monitors
1452 associated with DISPLAY. To get information for each physical
1453 monitor, use `display-monitor-attributes-list'."
1454 (and (memq (framep-on-display display
) '(x w32 ns
))
1455 (or (cadr (assoc (or display
(frame-parameter nil
'display
))
1456 display-mm-dimensions-alist
))
1457 (cadr (assoc t display-mm-dimensions-alist
))
1458 (x-display-mm-width display
))))
1460 (declare-function x-display-backing-store
"xfns.c" (&optional terminal
))
1462 ;; In NS port, the return value may be `buffered', `retained', or
1463 ;; `non-retained'. See src/nsfns.m.
1464 (defun display-backing-store (&optional display
)
1465 "Return the backing store capability of DISPLAY's screen.
1466 The value may be `always', `when-mapped', `not-useful', or nil if
1467 the question is inapplicable to a certain kind of display.
1468 If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1469 (let ((frame-type (framep-on-display display
)))
1471 ((memq frame-type
'(x w32 ns
))
1472 (x-display-backing-store display
))
1476 (declare-function x-display-save-under
"xfns.c" (&optional terminal
))
1478 (defun display-save-under (&optional display
)
1479 "Return non-nil if DISPLAY's screen supports the SaveUnder feature.
1480 If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1481 (let ((frame-type (framep-on-display display
)))
1483 ((memq frame-type
'(x w32 ns
))
1484 (x-display-save-under display
))
1488 (declare-function x-display-planes
"xfns.c" (&optional terminal
))
1490 (defun display-planes (&optional display
)
1491 "Return the number of planes supported by DISPLAY.
1492 If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1493 (let ((frame-type (framep-on-display display
)))
1495 ((memq frame-type
'(x w32 ns
))
1496 (x-display-planes display
))
1497 ((eq frame-type
'pc
)
1500 (truncate (log (length (tty-color-alist)) 2))))))
1502 (declare-function x-display-color-cells
"xfns.c" (&optional terminal
))
1504 (defun display-color-cells (&optional display
)
1505 "Return the number of color cells supported by DISPLAY.
1506 If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1507 (let ((frame-type (framep-on-display display
)))
1509 ((memq frame-type
'(x w32 ns
))
1510 (x-display-color-cells display
))
1511 ((eq frame-type
'pc
)
1514 (tty-display-color-cells display
)))))
1516 (declare-function x-display-visual-class
"xfns.c" (&optional terminal
))
1518 (defun display-visual-class (&optional display
)
1519 "Return the visual class of DISPLAY.
1520 The value is one of the symbols `static-gray', `gray-scale',
1521 `static-color', `pseudo-color', `true-color', or `direct-color'.
1522 If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1523 (let ((frame-type (framep-on-display display
)))
1525 ((memq frame-type
'(x w32 ns
))
1526 (x-display-visual-class display
))
1527 ((and (memq frame-type
'(pc t
))
1528 (tty-display-color-p display
))
1533 (declare-function x-display-monitor-attributes-list
"xfns.c"
1534 (&optional terminal
))
1535 (declare-function w32-display-monitor-attributes-list
"w32fns.c"
1536 (&optional display
))
1537 (declare-function ns-display-monitor-attributes-list
"nsfns.m"
1538 (&optional terminal
))
1540 (defun display-monitor-attributes-list (&optional display
)
1541 "Return a list of physical monitor attributes on DISPLAY.
1542 Each element of the list represents the attributes of each
1543 physical monitor. The first element corresponds to the primary
1546 Attributes for a physical monitor is represented as an alist of
1547 attribute keys and values as follows:
1549 geometry -- Position and size in pixels in the form of
1551 workarea -- Position and size of the workarea in pixels in the
1552 form of (X Y WIDTH HEIGHT)
1553 mm-size -- Width and height in millimeters in the form of
1555 frames -- List of frames dominated by the physical monitor
1556 name (*) -- Name of the physical monitor as a string
1558 where X, Y, WIDTH, and HEIGHT are integers. Keys labeled
1559 with (*) are optional.
1561 A frame is dominated by a physical monitor when either the
1562 largest area of the frame resides in the monitor, or the monitor
1563 is the closest to the frame if the frame does not intersect any
1564 physical monitors. Every non-tip frame (including invisible one)
1565 in a graphical display is dominated by exactly one physical
1566 monitor at a time, though it can span multiple (or no) physical
1568 If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1569 (let ((frame-type (framep-on-display display
)))
1572 (x-display-monitor-attributes-list display
))
1573 ((eq frame-type
'w32
)
1574 (w32-display-monitor-attributes-list display
))
1575 ((eq frame-type
'ns
)
1576 (ns-display-monitor-attributes-list display
))
1578 (let ((geometry (list 0 0 (display-pixel-width display
)
1579 (display-pixel-height display
))))
1580 `(((geometry .
,geometry
)
1581 (workarea .
,geometry
)
1582 (mm-size .
(,(display-mm-width display
)
1583 ,(display-mm-height display
)))
1584 (frames .
,(frames-on-display-list display
)))))))))
1587 ;;;; Frame geometry values
1589 (defun frame-geom-value-cons (type value
&optional frame
)
1590 "Return equivalent geometry value for FRAME as a cons with car `+'.
1591 A geometry value equivalent to VALUE for FRAME is returned,
1592 where the value is a cons with car `+', not numeric.
1593 TYPE is the car of the original geometry spec (TYPE . VALUE).
1594 It is `top' or `left', depending on which edge VALUE is related to.
1595 VALUE is the cdr of a frame geometry spec: (left/top . VALUE).
1596 If VALUE is a number, then it is converted to a cons value, perhaps
1597 relative to the opposite frame edge from that in the original spec.
1598 FRAME defaults to the selected frame.
1600 Examples (measures in pixels) -
1601 Assuming display height/width=1024, frame height/width=600:
1602 300 inside display edge: 300 => (+ 300)
1604 300 inside opposite display edge: (- 300) => (+ 124)
1606 300 beyond display edge
1607 (= 724 inside opposite display edge): (+ -300) => (+ -300)
1608 300 beyond display edge
1609 (= 724 inside opposite display edge): (- -300) => (+ 724)
1611 In the 3rd, 4th, and 6th examples, the returned value is relative to
1612 the opposite frame edge from the edge indicated in the input spec."
1613 (cond ((and (consp value
) (eq '+ (car value
))) ; e.g. (+ 300), (+ -300)
1615 ((natnump value
) (list '+ value
)) ; e.g. 300 => (+ 300)
1616 (t ; e.g. -300, (- 300), (- -300)
1617 (list '+ (- (if (eq 'left type
) ; => (+ 124), (+ 124), (+ 724)
1618 (x-display-pixel-width)
1619 (x-display-pixel-height))
1620 (if (integerp value
) (- value
) (cadr value
))
1622 (frame-pixel-width frame
)
1623 (frame-pixel-height frame
)))))))
1625 (defun frame-geom-spec-cons (spec &optional frame
)
1626 "Return equivalent geometry spec for FRAME as a cons with car `+'.
1627 A geometry specification equivalent to SPEC for FRAME is returned,
1628 where the value is a cons with car `+', not numeric.
1629 SPEC is a frame geometry spec: (left . VALUE) or (top . VALUE).
1630 If VALUE is a number, then it is converted to a cons value, perhaps
1631 relative to the opposite frame edge from that in the original spec.
1632 FRAME defaults to the selected frame.
1634 Examples (measures in pixels) -
1635 Assuming display height=1024, frame height=600:
1636 top 300 below display top: (top . 300) => (top + 300)
1637 (top + 300) => (top + 300)
1638 bottom 300 above display bottom: (top - 300) => (top + 124)
1639 (top . -300) => (top + 124)
1640 top 300 above display top
1641 (= bottom 724 above display bottom): (top + -300) => (top + -300)
1642 bottom 300 below display bottom
1643 (= top 724 below display top): (top - -300) => (top + 724)
1645 In the 3rd, 4th, and 6th examples, the returned value is relative to
1646 the opposite frame edge from the edge indicated in the input spec."
1647 (cons (car spec
) (frame-geom-value-cons (car spec
) (cdr spec
) frame
)))
1650 (defun delete-other-frames (&optional frame
)
1651 "Delete all frames on the current terminal, except FRAME.
1652 If FRAME uses another frame's minibuffer, the minibuffer frame is
1653 left untouched. FRAME nil or omitted means use the selected frame."
1656 (setq frame
(selected-frame)))
1657 (let* ((mini-frame (window-frame (minibuffer-window frame
)))
1658 (frames (delq mini-frame
(delq frame
(frame-list)))))
1659 ;; Only consider frames on the same terminal.
1660 (dolist (frame (prog1 frames
(setq frames nil
)))
1661 (if (eq (frame-terminal) (frame-terminal frame
))
1662 (push frame frames
)))
1663 ;; Delete mon-minibuffer-only frames first, because `delete-frame'
1664 ;; signals an error when trying to delete a mini-frame that's
1665 ;; still in use by another frame.
1666 (dolist (frame frames
)
1667 (unless (eq (frame-parameter frame
'minibuffer
) 'only
)
1668 (delete-frame frame
)))
1669 ;; Delete minibuffer-only frames.
1670 (dolist (frame frames
)
1671 (when (eq (frame-parameter frame
'minibuffer
) 'only
)
1672 (delete-frame frame
)))))
1674 ;; miscellaneous obsolescence declarations
1675 (define-obsolete-variable-alias 'delete-frame-hook
1676 'delete-frame-functions
"22.1")
1681 (defgroup cursor nil
1682 "Displaying text cursors."
1686 (defcustom blink-cursor-delay
0.5
1687 "Seconds of idle time after which cursor starts to blink."
1691 (defcustom blink-cursor-interval
0.5
1692 "Length of cursor blink interval in seconds."
1696 (defcustom blink-cursor-blinks
10
1697 "How many times to blink before using a solid cursor on NS, X, and MS-Windows.
1698 Use 0 or negative value to blink forever."
1703 (defvar blink-cursor-blinks-done
1
1704 "Number of blinks done since we started blinking on NS, X, and MS-Windows.")
1706 (defvar blink-cursor-idle-timer nil
1707 "Timer started after `blink-cursor-delay' seconds of Emacs idle time.
1708 The function `blink-cursor-start' is called when the timer fires.")
1710 (defvar blink-cursor-timer nil
1711 "Timer started from `blink-cursor-start'.
1712 This timer calls `blink-cursor-timer-function' every
1713 `blink-cursor-interval' seconds.")
1715 (defun blink-cursor-start ()
1716 "Timer function called from the timer `blink-cursor-idle-timer'.
1717 This starts the timer `blink-cursor-timer', which makes the cursor blink
1718 if appropriate. It also arranges to cancel that timer when the next
1719 command starts, by installing a pre-command hook."
1720 (when (null blink-cursor-timer
)
1721 ;; Set up the timer first, so that if this signals an error,
1722 ;; blink-cursor-end is not added to pre-command-hook.
1723 (setq blink-cursor-blinks-done
1)
1724 (setq blink-cursor-timer
1725 (run-with-timer blink-cursor-interval blink-cursor-interval
1726 'blink-cursor-timer-function
))
1727 (add-hook 'pre-command-hook
'blink-cursor-end
)
1728 (internal-show-cursor nil nil
)))
1730 (defun blink-cursor-timer-function ()
1731 "Timer function of timer `blink-cursor-timer'."
1732 (internal-show-cursor nil
(not (internal-show-cursor-p)))
1733 ;; Each blink is two calls to this function.
1734 (setq blink-cursor-blinks-done
(1+ blink-cursor-blinks-done
))
1735 (when (and (> blink-cursor-blinks
0)
1736 (<= (* 2 blink-cursor-blinks
) blink-cursor-blinks-done
))
1737 (blink-cursor-suspend)
1738 (add-hook 'post-command-hook
'blink-cursor-check
)))
1741 (defun blink-cursor-end ()
1742 "Stop cursor blinking.
1743 This is installed as a pre-command hook by `blink-cursor-start'.
1744 When run, it cancels the timer `blink-cursor-timer' and removes
1745 itself as a pre-command hook."
1746 (remove-hook 'pre-command-hook
'blink-cursor-end
)
1747 (internal-show-cursor nil t
)
1748 (when blink-cursor-timer
1749 (cancel-timer blink-cursor-timer
)
1750 (setq blink-cursor-timer nil
)))
1752 (defun blink-cursor-suspend ()
1753 "Suspend cursor blinking.
1754 This is called when no frame has focus and timers can be suspended.
1755 Timers are restarted by `blink-cursor-check', which is called when a
1756 frame receives focus."
1758 (when blink-cursor-idle-timer
1759 (cancel-timer blink-cursor-idle-timer
)
1760 (setq blink-cursor-idle-timer nil
)))
1762 (defun blink-cursor-check ()
1763 "Check if cursor blinking shall be restarted.
1764 This is done when a frame gets focus. Blink timers may be stopped by
1765 `blink-cursor-suspend'."
1766 (when (and blink-cursor-mode
1767 (not blink-cursor-idle-timer
))
1768 (remove-hook 'post-command-hook
'blink-cursor-check
)
1769 (setq blink-cursor-idle-timer
1770 (run-with-idle-timer blink-cursor-delay
1772 'blink-cursor-start
))))
1774 (define-obsolete-variable-alias 'blink-cursor
'blink-cursor-mode
"22.1")
1776 (define-minor-mode blink-cursor-mode
1777 "Toggle cursor blinking (Blink Cursor mode).
1778 With a prefix argument ARG, enable Blink Cursor mode if ARG is
1779 positive, and disable it otherwise. If called from Lisp, enable
1780 the mode if ARG is omitted or nil.
1782 If the value of `blink-cursor-blinks' is positive (10 by default),
1783 the cursor stops blinking after that number of blinks, if Emacs
1784 gets no input during that time.
1786 See also `blink-cursor-interval' and `blink-cursor-delay'.
1788 This command is effective only on graphical frames. On text-only
1789 terminals, cursor blinking is controlled by the terminal."
1790 :init-value
(not (or noninteractive
1792 (eq system-type
'ms-dos
)
1793 (not (memq window-system
'(x w32 ns
)))))
1794 :initialize
'custom-initialize-delay
1797 (blink-cursor-suspend)
1798 (remove-hook 'focus-in-hook
#'blink-cursor-check
)
1799 (remove-hook 'focus-out-hook
#'blink-cursor-suspend
)
1800 (when blink-cursor-mode
1801 (add-hook 'focus-in-hook
#'blink-cursor-check
)
1802 (add-hook 'focus-out-hook
#'blink-cursor-suspend
)
1803 (setq blink-cursor-idle-timer
1804 (run-with-idle-timer blink-cursor-delay
1806 #'blink-cursor-start
))))
1809 ;; Frame maximization/fullscreen
1811 (defun toggle-frame-maximized ()
1812 "Toggle maximization state of the selected frame.
1813 Maximize the selected frame or un-maximize if it is already maximized.
1814 Respect window manager screen decorations.
1815 If the frame is in fullscreen mode, don't change its mode,
1816 just toggle the temporary frame parameter `maximized',
1817 so the frame will go to the right maximization state
1818 after disabling fullscreen mode.
1819 See also `toggle-frame-fullscreen'."
1821 (if (memq (frame-parameter nil
'fullscreen
) '(fullscreen fullboth
))
1822 (modify-frame-parameters
1825 .
,(unless (eq (frame-parameter nil
'maximized
) 'maximized
)
1827 (modify-frame-parameters
1830 .
,(unless (eq (frame-parameter nil
'fullscreen
) 'maximized
)
1833 (defun toggle-frame-fullscreen ()
1834 "Toggle fullscreen mode of the selected frame.
1835 Enable fullscreen mode of the selected frame or disable if it is
1836 already fullscreen. Ignore window manager screen decorations.
1837 When turning on fullscreen mode, remember the previous value of the
1838 maximization state in the temporary frame parameter `maximized'.
1839 Restore the maximization state when turning off fullscreen mode.
1840 See also `toggle-frame-maximized'."
1842 (modify-frame-parameters
1845 .
,(unless (memq (frame-parameter nil
'fullscreen
) '(fullscreen fullboth
))
1846 (frame-parameter nil
'fullscreen
)))
1848 .
,(if (memq (frame-parameter nil
'fullscreen
) '(fullscreen fullboth
))
1849 (if (eq (frame-parameter nil
'maximized
) 'maximized
)
1856 (define-key ctl-x-5-map
"2" 'make-frame-command
)
1857 (define-key ctl-x-5-map
"1" 'delete-other-frames
)
1858 (define-key ctl-x-5-map
"0" 'delete-frame
)
1859 (define-key ctl-x-5-map
"o" 'other-frame
)
1860 (define-key global-map
[f11] 'toggle-frame-fullscreen)
1861 (define-key global-map [(meta f10)] 'toggle-frame-maximized)
1862 (define-key esc-map [f10] 'toggle-frame-maximized)
1867 ;; Only marked as obsolete in 24.3.
1868 (define-obsolete-variable-alias 'automatic-hscrolling
1869 'auto-hscroll-mode "22.1")
1871 (make-variable-buffer-local 'show-trailing-whitespace)
1873 ;; Defined in dispnew.c.
1874 (make-obsolete-variable
1875 'window-system-version "it does not give useful information." "24.3")
1879 ;;; frame.el ends here