Line data Source code
1 : ;;; frame.el --- multi-frame management independent of window systems -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 1993-1994, 1996-1997, 2000-2017 Free Software
4 : ;; Foundation, Inc.
5 :
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Keywords: internal
8 : ;; Package: emacs
9 :
10 : ;; This file is part of GNU Emacs.
11 :
12 : ;; GNU Emacs is free software: you can redistribute it and/or modify
13 : ;; it under the terms of the GNU General Public License as published by
14 : ;; the Free Software Foundation, either version 3 of the License, or
15 : ;; (at your option) any later version.
16 :
17 : ;; GNU Emacs is distributed in the hope that it will be useful,
18 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 : ;; GNU General Public License for more details.
21 :
22 : ;; You should have received a copy of the GNU General Public License
23 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 :
25 : ;;; Commentary:
26 :
27 : ;;; Code:
28 : (eval-when-compile (require 'cl-lib))
29 :
30 : (cl-defgeneric frame-creation-function (params)
31 : "Method for window-system dependent functions to create a new frame.
32 : The window system startup file should add its frame creation
33 : function to this method, which should take an alist of parameters
34 : as its argument.")
35 :
36 : (cl-generic-define-context-rewriter window-system (value)
37 : ;; If `value' is a `consp', it's probably an old-style specializer,
38 : ;; so just use it, and anyway `eql' isn't very useful on cons cells.
39 18 : `(window-system ,(if (consp value) value `(eql ,value))))
40 :
41 : (cl-defmethod frame-creation-function (params &context (window-system nil))
42 : ;; It's tempting to get rid of tty-create-frame-with-faces and turn it into
43 : ;; this method (i.e. move this method to faces.el), but faces.el is loaded
44 : ;; much earlier from loadup.el (before cl-generic and even before
45 : ;; cl-preloaded), so we'd first have to reorder that part.
46 0 : (tty-create-frame-with-faces params))
47 :
48 : (defvar window-system-default-frame-alist nil
49 : "Window-system dependent default frame parameters.
50 : The value should be an alist of elements (WINDOW-SYSTEM . ALIST),
51 : where WINDOW-SYSTEM is a window system symbol (as returned by `framep')
52 : and ALIST is a frame parameter alist like `default-frame-alist'.
53 : Then, for frames on WINDOW-SYSTEM, any parameters specified in
54 : ALIST supersede the corresponding parameters specified in
55 : `default-frame-alist'.")
56 :
57 : (defvar display-format-alist nil
58 : "Alist of patterns to decode display names.
59 : The car of each entry is a regular expression matching a display
60 : name string. The cdr is a symbol giving the window-system that
61 : handles the corresponding kind of display.")
62 :
63 : ;; The initial value given here used to ask for a minibuffer.
64 : ;; But that's not necessary, because the default is to have one.
65 : ;; By not specifying it here, we let an X resource specify it.
66 : (defcustom initial-frame-alist nil
67 : "Alist of parameters for the initial X window frame.
68 : You can set this in your init file; for example,
69 :
70 : (setq initial-frame-alist
71 : \\='((top . 1) (left . 1) (width . 80) (height . 55)))
72 :
73 : Parameters specified here supersede the values given in
74 : `default-frame-alist'.
75 :
76 : If the value calls for a frame without a minibuffer, and you have
77 : not created a minibuffer frame on your own, a minibuffer frame is
78 : created according to `minibuffer-frame-alist'.
79 :
80 : You can specify geometry-related options for just the initial
81 : frame by setting this variable in your init file; however, they
82 : won't take effect until Emacs reads your init file, which happens
83 : after creating the initial frame. If you want the initial frame
84 : to have the proper geometry as soon as it appears, you need to
85 : use this three-step process:
86 : * Specify X resources to give the geometry you want.
87 : * Set `default-frame-alist' to override these options so that they
88 : don't affect subsequent frames.
89 : * Set `initial-frame-alist' in a way that matches the X resources,
90 : to override what you put in `default-frame-alist'."
91 : :type '(repeat (cons :format "%v"
92 : (symbol :tag "Parameter")
93 : (sexp :tag "Value")))
94 : :group 'frames)
95 :
96 : (defcustom minibuffer-frame-alist '((width . 80) (height . 2))
97 : "Alist of parameters for the initial minibuffer frame.
98 : This is the minibuffer frame created if `initial-frame-alist'
99 : calls for a frame without a minibuffer. The parameters specified
100 : here supersede those given in `default-frame-alist', for the
101 : initial minibuffer frame.
102 :
103 : You can set this in your init file; for example,
104 :
105 : (setq minibuffer-frame-alist
106 : \\='((top . 1) (left . 1) (width . 80) (height . 2)))
107 :
108 : It is not necessary to include (minibuffer . only); that is
109 : appended when the minibuffer frame is created."
110 : :type '(repeat (cons :format "%v"
111 : (symbol :tag "Parameter")
112 : (sexp :tag "Value")))
113 : :group 'frames)
114 :
115 : (defun handle-delete-frame (event)
116 : "Handle delete-frame events from the X server."
117 : (interactive "e")
118 0 : (let* ((frame (posn-window (event-start event))))
119 0 : (if (catch 'other-frame
120 0 : (dolist (frame-1 (frame-list))
121 : ;; A valid "other" frame is visible, has its `delete-before'
122 : ;; parameter unset and is not a child frame.
123 0 : (when (and (not (eq frame-1 frame))
124 0 : (frame-visible-p frame-1)
125 0 : (not (frame-parent frame-1))
126 0 : (not (frame-parameter frame-1 'delete-before)))
127 0 : (throw 'other-frame t))))
128 0 : (delete-frame frame t)
129 : ;; Gildea@x.org says it is ok to ask questions before terminating.
130 0 : (save-buffers-kill-emacs))))
131 :
132 : (defun handle-focus-in (_event)
133 : "Handle a focus-in event.
134 : Focus-in events are usually bound to this function.
135 : Focus-in events occur when a frame has focus, but a switch-frame event
136 : is not generated.
137 : This function runs the hook `focus-in-hook'."
138 : (interactive "e")
139 0 : (run-hooks 'focus-in-hook))
140 :
141 : (defun handle-focus-out (_event)
142 : "Handle a focus-out event.
143 : Focus-out events are usually bound to this function.
144 : Focus-out events occur when no frame has focus.
145 : This function runs the hook `focus-out-hook'."
146 : (interactive "e")
147 0 : (run-hooks 'focus-out-hook))
148 :
149 : (defun handle-move-frame (event)
150 : "Handle a move-frame event.
151 : This function runs the abnormal hook `move-frame-functions'."
152 : (interactive "e")
153 0 : (let ((frame (posn-window (event-start event))))
154 0 : (run-hook-with-args 'move-frame-functions frame)))
155 :
156 : ;;;; Arrangement of frames at startup
157 :
158 : ;; 1) Load the window system startup file from the lisp library and read the
159 : ;; high-priority arguments (-q and the like). The window system startup
160 : ;; file should create any frames specified in the window system defaults.
161 : ;;
162 : ;; 2) If no frames have been opened, we open an initial text frame.
163 : ;;
164 : ;; 3) Once the init file is done, we apply any newly set parameters
165 : ;; in initial-frame-alist to the frame.
166 :
167 : ;; If we create the initial frame, this is it.
168 : (defvar frame-initial-frame nil)
169 :
170 : ;; Record the parameters used in frame-initialize to make the initial frame.
171 : (defvar frame-initial-frame-alist)
172 :
173 : (defvar frame-initial-geometry-arguments nil)
174 :
175 : ;; startup.el calls this function before loading the user's init
176 : ;; file - if there is no frame with a minibuffer open now, create
177 : ;; one to display messages while loading the init file.
178 : (defun frame-initialize ()
179 : "Create an initial frame if necessary."
180 : ;; Are we actually running under a window system at all?
181 0 : (if (and initial-window-system
182 0 : (not noninteractive)
183 0 : (not (eq initial-window-system 'pc)))
184 0 : (progn
185 : ;; If there is no frame with a minibuffer besides the terminal
186 : ;; frame, then we need to create the opening frame. Make sure
187 : ;; it has a minibuffer, but let initial-frame-alist omit the
188 : ;; minibuffer spec.
189 0 : (or (delq terminal-frame (minibuffer-frame-list))
190 0 : (progn
191 0 : (setq frame-initial-frame-alist
192 0 : (append initial-frame-alist default-frame-alist nil))
193 0 : (setq frame-initial-frame-alist
194 0 : (cons (cons 'window-system initial-window-system)
195 0 : frame-initial-frame-alist))
196 0 : (setq default-minibuffer-frame
197 0 : (setq frame-initial-frame
198 0 : (make-frame frame-initial-frame-alist)))
199 : ;; Delete any specifications for window geometry parameters
200 : ;; so that we won't reapply them in frame-notice-user-settings.
201 : ;; It would be wrong to reapply them then,
202 : ;; because that would override explicit user resizing.
203 0 : (setq initial-frame-alist
204 0 : (frame-remove-geometry-params initial-frame-alist))))
205 : ;; Copy the environment of the Emacs process into the new frame.
206 0 : (set-frame-parameter frame-initial-frame 'environment
207 0 : (frame-parameter terminal-frame 'environment))
208 : ;; At this point, we know that we have a frame open, so we
209 : ;; can delete the terminal frame.
210 0 : (delete-frame terminal-frame)
211 0 : (setq terminal-frame nil))))
212 :
213 : (defvar frame-notice-user-settings t
214 : "Non-nil means function `frame-notice-user-settings' wasn't run yet.")
215 :
216 : (declare-function tool-bar-mode "tool-bar" (&optional arg))
217 : (declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
218 :
219 : (defalias 'tool-bar-lines-needed 'tool-bar-height)
220 :
221 : ;; startup.el calls this function after loading the user's init
222 : ;; file. Now default-frame-alist and initial-frame-alist contain
223 : ;; information to which we must react; do what needs to be done.
224 : (defun frame-notice-user-settings ()
225 : "Act on user's init file settings of frame parameters.
226 : React to settings of `initial-frame-alist',
227 : `window-system-default-frame-alist' and `default-frame-alist'
228 : there (in decreasing order of priority)."
229 : ;; Creating and deleting frames may shift the selected frame around,
230 : ;; and thus the current buffer. Protect against that. We don't
231 : ;; want to use save-excursion here, because that may also try to set
232 : ;; the buffer of the selected window, which fails when the selected
233 : ;; window is the minibuffer.
234 0 : (let ((old-buffer (current-buffer))
235 : (window-system-frame-alist
236 0 : (cdr (assq initial-window-system
237 0 : window-system-default-frame-alist))))
238 :
239 0 : (when (and frame-notice-user-settings
240 0 : (null frame-initial-frame))
241 : ;; This case happens when we don't have a window system, and
242 : ;; also for MS-DOS frames.
243 0 : (let ((parms (frame-parameters)))
244 : ;; Don't change the frame names.
245 0 : (setq parms (delq (assq 'name parms) parms))
246 : ;; Can't modify the minibuffer parameter, so don't try.
247 0 : (setq parms (delq (assq 'minibuffer parms) parms))
248 0 : (modify-frame-parameters
249 : nil
250 0 : (if initial-window-system
251 0 : parms
252 : ;; initial-frame-alist and default-frame-alist were already
253 : ;; applied in pc-win.el.
254 0 : (append initial-frame-alist window-system-frame-alist
255 0 : default-frame-alist parms nil)))
256 0 : (if (null initial-window-system) ;; MS-DOS does this differently in pc-win.el
257 0 : (let ((newparms (frame-parameters))
258 0 : (frame (selected-frame)))
259 0 : (tty-handle-reverse-video frame newparms)
260 : ;; tty-handle-reverse-video might change the frame's
261 : ;; color parameters, and we need to use the updated
262 : ;; value below.
263 0 : (setq newparms (frame-parameters))
264 : ;; If we changed the background color, we need to update
265 : ;; the background-mode parameter, and maybe some faces,
266 : ;; too.
267 0 : (when (assq 'background-color newparms)
268 0 : (unless (or (assq 'background-mode initial-frame-alist)
269 0 : (assq 'background-mode default-frame-alist))
270 0 : (frame-set-background-mode frame))
271 0 : (face-set-after-frame-default frame newparms))))))
272 :
273 : ;; If the initial frame is still around, apply initial-frame-alist
274 : ;; and default-frame-alist to it.
275 0 : (when (frame-live-p frame-initial-frame)
276 : ;; When tool-bar has been switched off, correct the frame size
277 : ;; by the lines added in x-create-frame for the tool-bar and
278 : ;; switch `tool-bar-mode' off.
279 0 : (when (display-graphic-p)
280 0 : (let* ((init-lines
281 0 : (assq 'tool-bar-lines initial-frame-alist))
282 : (other-lines
283 0 : (or (assq 'tool-bar-lines window-system-frame-alist)
284 0 : (assq 'tool-bar-lines default-frame-alist)))
285 0 : (lines (or init-lines other-lines))
286 0 : (height (tool-bar-height frame-initial-frame t)))
287 : ;; Adjust frame top if either zero (nil) tool bar lines have
288 : ;; been requested in the most relevant of the frame's alists
289 : ;; or tool bar mode has been explicitly turned off in the
290 : ;; user's init file.
291 0 : (when (and (> height 0)
292 0 : (or (and lines
293 0 : (or (null (cdr lines))
294 0 : (eq 0 (cdr lines))))
295 0 : (not tool-bar-mode)))
296 0 : (let* ((initial-top
297 0 : (cdr (assq 'top frame-initial-geometry-arguments)))
298 0 : (top (frame-parameter frame-initial-frame 'top)))
299 0 : (when (and (consp initial-top) (eq '- (car initial-top)))
300 0 : (let ((adjusted-top
301 0 : (cond
302 0 : ((and (consp top) (eq '+ (car top)))
303 0 : (list '+ (+ (cadr top) height)))
304 0 : ((and (consp top) (eq '- (car top)))
305 0 : (list '- (- (cadr top) height)))
306 0 : (t (+ top height)))))
307 0 : (modify-frame-parameters
308 0 : frame-initial-frame `((top . ,adjusted-top))))))
309 : ;; Reset `tool-bar-mode' when zero tool bar lines have been
310 : ;; requested for the window-system or default frame alists.
311 0 : (when (and tool-bar-mode
312 0 : (and other-lines
313 0 : (or (null (cdr other-lines))
314 0 : (eq 0 (cdr other-lines)))))
315 0 : (tool-bar-mode -1)))))
316 :
317 : ;; The initial frame we create above always has a minibuffer.
318 : ;; If the user wants to remove it, or make it a minibuffer-only
319 : ;; frame, then we'll have to delete the current frame and make a
320 : ;; new one; you can't remove or add a root window to/from an
321 : ;; existing frame.
322 : ;;
323 : ;; NOTE: default-frame-alist was nil when we created the
324 : ;; existing frame. We need to explicitly include
325 : ;; default-frame-alist in the parameters of the screen we
326 : ;; create here, so that its new value, gleaned from the user's
327 : ;; init file, will be applied to the existing screen.
328 0 : (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
329 0 : (assq 'minibuffer window-system-frame-alist)
330 0 : (assq 'minibuffer default-frame-alist)
331 0 : '(minibuffer . t)))
332 0 : t))
333 : ;; Create the new frame.
334 0 : (let (parms new)
335 : ;; MS-Windows needs this to avoid inflooping below.
336 0 : (if (eq system-type 'windows-nt)
337 0 : (sit-for 0 t))
338 : ;; If the frame isn't visible yet, wait till it is.
339 : ;; If the user has to position the window,
340 : ;; Emacs doesn't know its real position until
341 : ;; the frame is seen to be visible.
342 0 : (while (not (cdr (assq 'visibility
343 0 : (frame-parameters frame-initial-frame))))
344 0 : (sleep-for 1))
345 0 : (setq parms (frame-parameters frame-initial-frame))
346 :
347 : ;; Get rid of `name' unless it was specified explicitly before.
348 0 : (or (assq 'name frame-initial-frame-alist)
349 0 : (setq parms (delq (assq 'name parms) parms)))
350 : ;; An explicit parent-id is a request to XEmbed the frame.
351 0 : (or (assq 'parent-id frame-initial-frame-alist)
352 0 : (setq parms (delq (assq 'parent-id parms) parms)))
353 :
354 0 : (setq parms (append initial-frame-alist
355 0 : window-system-frame-alist
356 0 : default-frame-alist
357 0 : parms
358 0 : nil))
359 :
360 : ;; Get rid of `reverse', because that was handled
361 : ;; when we first made the frame.
362 0 : (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms)))
363 :
364 0 : (if (assq 'height frame-initial-geometry-arguments)
365 0 : (setq parms (assq-delete-all 'height parms)))
366 0 : (if (assq 'width frame-initial-geometry-arguments)
367 0 : (setq parms (assq-delete-all 'width parms)))
368 0 : (if (assq 'left frame-initial-geometry-arguments)
369 0 : (setq parms (assq-delete-all 'left parms)))
370 0 : (if (assq 'top frame-initial-geometry-arguments)
371 0 : (setq parms (assq-delete-all 'top parms)))
372 0 : (setq new
373 0 : (make-frame
374 : ;; Use the geometry args that created the existing
375 : ;; frame, rather than the parms we get for it.
376 0 : (append frame-initial-geometry-arguments
377 : '((user-size . t) (user-position . t))
378 0 : parms)))
379 : ;; The initial frame, which we are about to delete, may be
380 : ;; the only frame with a minibuffer. If it is, create a
381 : ;; new one.
382 0 : (or (delq frame-initial-frame (minibuffer-frame-list))
383 0 : (make-initial-minibuffer-frame nil))
384 :
385 : ;; If the initial frame is serving as a surrogate
386 : ;; minibuffer frame for any frames, we need to wean them
387 : ;; onto a new frame. The default-minibuffer-frame
388 : ;; variable must be handled similarly.
389 0 : (let ((users-of-initial
390 0 : (filtered-frame-list
391 : (lambda (frame)
392 0 : (and (not (eq frame frame-initial-frame))
393 0 : (eq (window-frame
394 0 : (minibuffer-window frame))
395 0 : frame-initial-frame))))))
396 0 : (if (or users-of-initial
397 0 : (eq default-minibuffer-frame frame-initial-frame))
398 :
399 : ;; Choose an appropriate frame. Prefer frames which
400 : ;; are only minibuffers.
401 0 : (let* ((new-surrogate
402 0 : (car
403 0 : (or (filtered-frame-list
404 : (lambda (frame)
405 0 : (eq (cdr (assq 'minibuffer
406 0 : (frame-parameters frame)))
407 0 : 'only)))
408 0 : (minibuffer-frame-list))))
409 0 : (new-minibuffer (minibuffer-window new-surrogate)))
410 :
411 0 : (if (eq default-minibuffer-frame frame-initial-frame)
412 0 : (setq default-minibuffer-frame new-surrogate))
413 :
414 : ;; Wean the frames using frame-initial-frame as
415 : ;; their minibuffer frame.
416 0 : (dolist (frame users-of-initial)
417 0 : (modify-frame-parameters
418 0 : frame (list (cons 'minibuffer new-minibuffer)))))))
419 :
420 : ;; Redirect events enqueued at this frame to the new frame.
421 : ;; Is this a good idea?
422 0 : (redirect-frame-focus frame-initial-frame new)
423 :
424 : ;; Finally, get rid of the old frame.
425 0 : (delete-frame frame-initial-frame t))
426 :
427 : ;; Otherwise, we don't need all that rigmarole; just apply
428 : ;; the new parameters.
429 0 : (let (newparms allparms tail)
430 0 : (setq allparms (append initial-frame-alist
431 0 : window-system-frame-alist
432 0 : default-frame-alist nil))
433 0 : (if (assq 'height frame-initial-geometry-arguments)
434 0 : (setq allparms (assq-delete-all 'height allparms)))
435 0 : (if (assq 'width frame-initial-geometry-arguments)
436 0 : (setq allparms (assq-delete-all 'width allparms)))
437 0 : (if (assq 'left frame-initial-geometry-arguments)
438 0 : (setq allparms (assq-delete-all 'left allparms)))
439 0 : (if (assq 'top frame-initial-geometry-arguments)
440 0 : (setq allparms (assq-delete-all 'top allparms)))
441 0 : (setq tail allparms)
442 : ;; Find just the parms that have changed since we first
443 : ;; made this frame. Those are the ones actually set by
444 : ;; the init file. For those parms whose values we already knew
445 : ;; (such as those spec'd by command line options)
446 : ;; it is undesirable to specify the parm again
447 : ;; once the user has seen the frame and been able to alter it
448 : ;; manually.
449 0 : (let (newval oldval)
450 0 : (dolist (entry tail)
451 0 : (setq oldval (assq (car entry) frame-initial-frame-alist))
452 0 : (setq newval (cdr (assq (car entry) allparms)))
453 0 : (or (and oldval (eq (cdr oldval) newval))
454 0 : (setq newparms
455 0 : (cons (cons (car entry) newval) newparms)))))
456 0 : (setq newparms (nreverse newparms))
457 :
458 0 : (let ((new-bg (assq 'background-color newparms)))
459 : ;; If the `background-color' parameter is changed, apply
460 : ;; it first, then make sure that the `background-mode'
461 : ;; parameter and other faces are updated, before applying
462 : ;; the other parameters.
463 0 : (when new-bg
464 0 : (modify-frame-parameters frame-initial-frame
465 0 : (list new-bg))
466 0 : (unless (assq 'background-mode newparms)
467 0 : (frame-set-background-mode frame-initial-frame))
468 0 : (face-set-after-frame-default frame-initial-frame)
469 0 : (setq newparms (delq new-bg newparms)))
470 :
471 0 : (when (numberp (car frame-size-history))
472 0 : (setq frame-size-history
473 0 : (cons (1- (car frame-size-history))
474 0 : (cons
475 0 : (list frame-initial-frame
476 : "FRAME-NOTICE-USER"
477 0 : nil newparms)
478 0 : (cdr frame-size-history)))))
479 :
480 0 : (modify-frame-parameters frame-initial-frame newparms)))))
481 :
482 : ;; Restore the original buffer.
483 0 : (set-buffer old-buffer)
484 :
485 : ;; Make sure the initial frame can be GC'd if it is ever deleted.
486 : ;; Make sure frame-notice-user-settings does nothing if called twice.
487 0 : (setq frame-notice-user-settings nil)
488 0 : (setq frame-initial-frame nil)))
489 :
490 : (defun make-initial-minibuffer-frame (display)
491 0 : (let ((parms (append minibuffer-frame-alist '((minibuffer . only)))))
492 0 : (if display
493 0 : (make-frame-on-display display parms)
494 0 : (make-frame parms))))
495 :
496 : ;;;; Creation of additional frames, and other frame miscellanea
497 :
498 : (defun modify-all-frames-parameters (alist)
499 : "Modify all current and future frames' parameters according to ALIST.
500 : This changes `default-frame-alist' and possibly `initial-frame-alist'.
501 : Furthermore, this function removes all parameters in ALIST from
502 : `window-system-default-frame-alist'.
503 : See help of `modify-frame-parameters' for more information."
504 1 : (dolist (frame (frame-list))
505 1 : (modify-frame-parameters frame alist))
506 :
507 1 : (dolist (pair alist) ;; conses to add/replace
508 : ;; initial-frame-alist needs setting only when
509 : ;; frame-notice-user-settings is true.
510 2 : (and frame-notice-user-settings
511 2 : (setq initial-frame-alist
512 2 : (assq-delete-all (car pair) initial-frame-alist)))
513 2 : (setq default-frame-alist
514 2 : (assq-delete-all (car pair) default-frame-alist))
515 : ;; Remove any similar settings from the window-system specific
516 : ;; parameters---they would override default-frame-alist.
517 2 : (dolist (w window-system-default-frame-alist)
518 2 : (setcdr w (assq-delete-all (car pair) (cdr w)))))
519 :
520 1 : (and frame-notice-user-settings
521 1 : (setq initial-frame-alist (append initial-frame-alist alist)))
522 1 : (setq default-frame-alist (append default-frame-alist alist)))
523 :
524 : (defun get-other-frame ()
525 : "Return some frame other than the current frame.
526 : Create one if necessary. Note that the minibuffer frame, if separate,
527 : is not considered (see `next-frame')."
528 0 : (if (equal (next-frame) (selected-frame)) (make-frame) (next-frame)))
529 :
530 : (defun next-multiframe-window ()
531 : "Select the next window, regardless of which frame it is on."
532 : (interactive)
533 0 : (select-window (next-window (selected-window)
534 0 : (> (minibuffer-depth) 0)
535 0 : 0))
536 0 : (select-frame-set-input-focus (selected-frame)))
537 :
538 : (defun previous-multiframe-window ()
539 : "Select the previous window, regardless of which frame it is on."
540 : (interactive)
541 0 : (select-window (previous-window (selected-window)
542 0 : (> (minibuffer-depth) 0)
543 0 : 0))
544 0 : (select-frame-set-input-focus (selected-frame)))
545 :
546 : (defun window-system-for-display (display)
547 : "Return the window system for DISPLAY.
548 : Return nil if we don't know how to interpret DISPLAY."
549 : ;; MS-Windows doesn't know how to create a GUI frame in a -nw session.
550 0 : (if (and (eq system-type 'windows-nt)
551 0 : (null (window-system))
552 0 : (not (daemonp)))
553 : nil
554 0 : (cl-loop for descriptor in display-format-alist
555 0 : for pattern = (car descriptor)
556 0 : for system = (cdr descriptor)
557 0 : when (string-match-p pattern display) return system)))
558 :
559 : (defun make-frame-on-display (display &optional parameters)
560 : "Make a frame on display DISPLAY.
561 : The optional argument PARAMETERS specifies additional frame parameters."
562 : (interactive "sMake frame on display: ")
563 0 : (make-frame (cons (cons 'display display) parameters)))
564 :
565 : (declare-function x-close-connection "xfns.c" (terminal))
566 :
567 : (defun close-display-connection (display)
568 : "Close the connection to a display, deleting all its associated frames.
569 : For DISPLAY, specify either a frame or a display name (a string).
570 : If DISPLAY is nil, that stands for the selected frame's display."
571 : (interactive
572 0 : (list
573 0 : (let* ((default (frame-parameter nil 'display))
574 0 : (display (completing-read
575 0 : (format "Close display (default %s): " default)
576 0 : (delete-dups
577 0 : (mapcar (lambda (frame)
578 0 : (frame-parameter frame 'display))
579 0 : (frame-list)))
580 : nil t nil nil
581 0 : default)))
582 0 : (if (zerop (length display)) default display))))
583 0 : (let ((frames (delq nil
584 0 : (mapcar (lambda (frame)
585 0 : (if (equal display
586 0 : (frame-parameter frame 'display))
587 0 : frame))
588 0 : (frame-list)))))
589 0 : (if (and (consp frames)
590 0 : (not (y-or-n-p (if (cdr frames)
591 0 : (format "Delete %s frames? " (length frames))
592 0 : (format "Delete %s ? " (car frames))))))
593 0 : (error "Abort!")
594 0 : (mapc 'delete-frame frames)
595 0 : (x-close-connection display))))
596 :
597 : (defun make-frame-command ()
598 : "Make a new frame, on the same terminal as the selected frame.
599 : If the terminal is a text-only terminal, this also selects the
600 : new frame."
601 : (interactive)
602 0 : (if (display-graphic-p)
603 0 : (make-frame)
604 0 : (select-frame (make-frame))))
605 :
606 : (defvar before-make-frame-hook nil
607 : "Functions to run before a frame is created.")
608 :
609 : (defvar after-make-frame-functions nil
610 : "Functions to run after a frame is created.
611 : The functions are run with one arg, the newly created frame.")
612 :
613 : (defvar after-setting-font-hook nil
614 : "Functions to run after a frame's font has been changed.")
615 :
616 : ;; Alias, kept temporarily.
617 : (define-obsolete-function-alias 'new-frame 'make-frame "22.1")
618 :
619 : (defvar frame-inherited-parameters '()
620 : "Parameters `make-frame' copies from the `selected-frame' to the new frame.")
621 :
622 : (defvar x-display-name)
623 :
624 : (defun make-frame (&optional parameters)
625 : "Return a newly created frame displaying the current buffer.
626 : Optional argument PARAMETERS is an alist of frame parameters for
627 : the new frame. Each element of PARAMETERS should have the
628 : form (NAME . VALUE), for example:
629 :
630 : (name . STRING) The frame should be named STRING.
631 :
632 : (width . NUMBER) The frame should be NUMBER characters in width.
633 : (height . NUMBER) The frame should be NUMBER text lines high.
634 :
635 : You cannot specify either `width' or `height', you must specify
636 : neither or both.
637 :
638 : (minibuffer . t) The frame should have a minibuffer.
639 : (minibuffer . nil) The frame should have no minibuffer.
640 : (minibuffer . only) The frame should contain only a minibuffer.
641 : (minibuffer . WINDOW) The frame should use WINDOW as its minibuffer window.
642 :
643 : (window-system . nil) The frame should be displayed on a terminal device.
644 : (window-system . x) The frame should be displayed in an X window.
645 :
646 : (display . \":0\") The frame should appear on display :0.
647 :
648 : (terminal . TERMINAL) The frame should use the terminal object TERMINAL.
649 :
650 : In addition, any parameter specified in `default-frame-alist',
651 : but not present in PARAMETERS, is applied.
652 :
653 : Before creating the frame (via `frame-creation-function-alist'),
654 : this function runs the hook `before-make-frame-hook'. After
655 : creating the frame, it runs the hook `after-make-frame-functions'
656 : with one arg, the newly created frame.
657 :
658 : If a display parameter is supplied and a window-system is not,
659 : guess the window-system from the display.
660 :
661 : On graphical displays, this function does not itself make the new
662 : frame the selected frame. However, the window system may select
663 : the new frame according to its own rules."
664 : (interactive)
665 0 : (let* ((display (cdr (assq 'display parameters)))
666 0 : (w (cond
667 0 : ((assq 'terminal parameters)
668 0 : (let ((type (terminal-live-p
669 0 : (cdr (assq 'terminal parameters)))))
670 0 : (cond
671 0 : ((eq t type) nil)
672 0 : ((null type) (error "Terminal %s does not exist"
673 0 : (cdr (assq 'terminal parameters))))
674 0 : (t type))))
675 0 : ((assq 'window-system parameters)
676 0 : (cdr (assq 'window-system parameters)))
677 0 : (display
678 0 : (or (window-system-for-display display)
679 0 : (error "Don't know how to interpret display %S"
680 0 : display)))
681 0 : (t window-system)))
682 0 : (oldframe (selected-frame))
683 0 : (params parameters)
684 : frame)
685 :
686 0 : (unless (get w 'window-system-initialized)
687 0 : (let ((window-system w)) ;Hack attack!
688 0 : (window-system-initialization display))
689 0 : (setq x-display-name display)
690 0 : (put w 'window-system-initialized t))
691 :
692 : ;; Add parameters from `window-system-default-frame-alist'.
693 0 : (dolist (p (cdr (assq w window-system-default-frame-alist)))
694 0 : (unless (assq (car p) params)
695 0 : (push p params)))
696 : ;; Add parameters from `default-frame-alist'.
697 0 : (dolist (p default-frame-alist)
698 0 : (unless (assq (car p) params)
699 0 : (push p params)))
700 : ;; Now make the frame.
701 0 : (run-hooks 'before-make-frame-hook)
702 :
703 : ;; (setq frame-size-history '(1000))
704 :
705 0 : (setq frame (let ((window-system w)) ;Hack attack!
706 0 : (frame-creation-function params)))
707 0 : (normal-erase-is-backspace-setup-frame frame)
708 : ;; Inherit the original frame's parameters.
709 0 : (dolist (param frame-inherited-parameters)
710 0 : (unless (assq param parameters) ;Overridden by explicit parameters.
711 0 : (let ((val (frame-parameter oldframe param)))
712 0 : (when val (set-frame-parameter frame param val)))))
713 :
714 0 : (when (numberp (car frame-size-history))
715 0 : (setq frame-size-history
716 0 : (cons (1- (car frame-size-history))
717 0 : (cons (list frame "MAKE-FRAME")
718 0 : (cdr frame-size-history)))))
719 :
720 : ;; We can run `window-configuration-change-hook' for this frame now.
721 0 : (frame-after-make-frame frame t)
722 0 : (run-hook-with-args 'after-make-frame-functions frame)
723 0 : frame))
724 :
725 : (defun filtered-frame-list (predicate)
726 : "Return a list of all live frames which satisfy PREDICATE."
727 33 : (let* ((frames (frame-list))
728 33 : (list frames))
729 66 : (while (consp frames)
730 33 : (unless (funcall predicate (car frames))
731 33 : (setcar frames nil))
732 33 : (setq frames (cdr frames)))
733 33 : (delq nil list)))
734 :
735 : (defun minibuffer-frame-list ()
736 : "Return a list of all frames with their own minibuffers."
737 0 : (filtered-frame-list
738 : (lambda (frame)
739 0 : (eq frame (window-frame (minibuffer-window frame))))))
740 :
741 : ;; Used to be called `terminal-id' in termdev.el.
742 : (defun get-device-terminal (device)
743 : "Return the terminal corresponding to DEVICE.
744 : DEVICE can be a terminal, a frame, nil (meaning the selected frame's terminal),
745 : the name of an X display device (HOST.SERVER.SCREEN) or a tty device file."
746 33 : (cond
747 33 : ((or (null device) (framep device))
748 0 : (frame-terminal device))
749 33 : ((stringp device)
750 0 : (let ((f (car (filtered-frame-list
751 : (lambda (frame)
752 0 : (or (equal (frame-parameter frame 'display) device)
753 0 : (equal (frame-parameter frame 'tty) device)))))))
754 0 : (or f (error "Display %s does not exist" device))
755 0 : (frame-terminal f)))
756 33 : ((terminal-live-p device) device)
757 : (t
758 33 : (error "Invalid argument %s in `get-device-terminal'" device))))
759 :
760 : (defun frames-on-display-list (&optional device)
761 : "Return a list of all frames on DEVICE.
762 :
763 : DEVICE should be a terminal, a frame,
764 : or a name of an X display or tty (a string of the form
765 : HOST:SERVER.SCREEN).
766 :
767 : If DEVICE is omitted or nil, it defaults to the selected
768 : frame's terminal device."
769 33 : (let* ((terminal (get-device-terminal device))
770 33 : (func #'(lambda (frame)
771 66 : (eq (frame-terminal frame) terminal))))
772 33 : (filtered-frame-list func)))
773 :
774 : (defun framep-on-display (&optional terminal)
775 : "Return the type of frames on TERMINAL.
776 : TERMINAL may be a terminal id, a display name or a frame. If it
777 : is a frame, its type is returned. If TERMINAL is omitted or nil,
778 : it defaults to the selected frame's terminal device. All frames
779 : on a given display are of the same type."
780 1 : (or (terminal-live-p terminal)
781 0 : (framep terminal)
782 1 : (framep (car (frames-on-display-list terminal)))))
783 :
784 : (defun frame-remove-geometry-params (param-list)
785 : "Return the parameter list PARAM-LIST, but with geometry specs removed.
786 : This deletes all bindings in PARAM-LIST for `top', `left', `width',
787 : `height', `user-size' and `user-position' parameters.
788 : Emacs uses this to avoid overriding explicit moves and resizings from
789 : the user during startup."
790 0 : (setq param-list (cons nil param-list))
791 0 : (let ((tail param-list))
792 0 : (while (consp (cdr tail))
793 0 : (if (and (consp (car (cdr tail)))
794 0 : (memq (car (car (cdr tail)))
795 0 : '(height width top left user-position user-size)))
796 0 : (progn
797 0 : (setq frame-initial-geometry-arguments
798 0 : (cons (car (cdr tail)) frame-initial-geometry-arguments))
799 0 : (setcdr tail (cdr (cdr tail))))
800 0 : (setq tail (cdr tail)))))
801 0 : (setq frame-initial-geometry-arguments
802 0 : (nreverse frame-initial-geometry-arguments))
803 0 : (cdr param-list))
804 :
805 : (declare-function x-focus-frame "frame.c" (frame))
806 :
807 : (defun select-frame-set-input-focus (frame &optional norecord)
808 : "Select FRAME, raise it, and set input focus, if possible.
809 : If `mouse-autoselect-window' is non-nil, also move mouse pointer
810 : to FRAME's selected window. Otherwise, if `focus-follows-mouse'
811 : is non-nil, move mouse cursor to FRAME.
812 :
813 : Optional argument NORECORD means to neither change the order of
814 : recently selected windows nor the buffer list."
815 0 : (select-frame frame norecord)
816 0 : (raise-frame frame)
817 : ;; Ensure, if possible, that FRAME gets input focus.
818 0 : (when (memq (window-system frame) '(x w32 ns))
819 0 : (x-focus-frame frame))
820 : ;; Move mouse cursor if necessary.
821 0 : (cond
822 0 : (mouse-autoselect-window
823 0 : (let ((edges (window-inside-edges (frame-selected-window frame))))
824 : ;; Move mouse cursor into FRAME's selected window to avoid that
825 : ;; Emacs mouse-autoselects another window.
826 0 : (set-mouse-position frame (nth 2 edges) (nth 1 edges))))
827 0 : (focus-follows-mouse
828 : ;; Move mouse cursor into FRAME to avoid that another frame gets
829 : ;; selected by the window manager.
830 0 : (set-mouse-position frame (1- (frame-width frame)) 0))))
831 :
832 : (defun other-frame (arg)
833 : "Select the ARGth different visible frame on current display, and raise it.
834 : All frames are arranged in a cyclic order.
835 : This command selects the frame ARG steps away in that order.
836 : A negative ARG moves in the opposite order.
837 :
838 : To make this command work properly, you must tell Emacs how the
839 : system (or the window manager) generally handles focus-switching
840 : between windows. If moving the mouse onto a window selects
841 : it (gives it focus), set `focus-follows-mouse' to t. Otherwise,
842 : that variable should be nil."
843 : (interactive "p")
844 0 : (let ((sframe (selected-frame))
845 0 : (frame (selected-frame)))
846 0 : (while (> arg 0)
847 0 : (setq frame (next-frame frame))
848 0 : (while (and (not (eq frame sframe))
849 0 : (not (eq (frame-visible-p frame) t)))
850 0 : (setq frame (next-frame frame)))
851 0 : (setq arg (1- arg)))
852 0 : (while (< arg 0)
853 0 : (setq frame (previous-frame frame))
854 0 : (while (and (not (eq frame sframe))
855 0 : (not (eq (frame-visible-p frame) t)))
856 0 : (setq frame (previous-frame frame)))
857 0 : (setq arg (1+ arg)))
858 0 : (select-frame-set-input-focus frame)))
859 :
860 : (defun iconify-or-deiconify-frame ()
861 : "Iconify the selected frame, or deiconify if it's currently an icon."
862 : (interactive)
863 0 : (if (eq (cdr (assq 'visibility (frame-parameters))) t)
864 0 : (iconify-frame)
865 0 : (make-frame-visible)))
866 :
867 : (defun suspend-frame ()
868 : "Do whatever is right to suspend the current frame.
869 : Calls `suspend-emacs' if invoked from the controlling tty device,
870 : `suspend-tty' from a secondary tty device, and
871 : `iconify-or-deiconify-frame' from an X frame."
872 : (interactive)
873 0 : (let ((type (framep (selected-frame))))
874 0 : (cond
875 0 : ((memq type '(x ns w32)) (iconify-or-deiconify-frame))
876 0 : ((eq type t)
877 0 : (if (controlling-tty-p)
878 0 : (suspend-emacs)
879 0 : (suspend-tty)))
880 0 : (t (suspend-emacs)))))
881 :
882 : (defun make-frame-names-alist ()
883 : ;; Only consider the frames on the same display.
884 0 : (let* ((current-frame (selected-frame))
885 : (falist
886 0 : (cons
887 0 : (cons (frame-parameter current-frame 'name) current-frame) nil))
888 0 : (frame (next-frame nil 0)))
889 0 : (while (not (eq frame current-frame))
890 0 : (progn
891 0 : (push (cons (frame-parameter frame 'name) frame) falist)
892 0 : (setq frame (next-frame frame 0))))
893 0 : falist))
894 :
895 : (defvar frame-name-history nil)
896 : (defun select-frame-by-name (name)
897 : "Select the frame on the current terminal whose name is NAME and raise it.
898 : If there is no frame by that name, signal an error."
899 : (interactive
900 0 : (let* ((frame-names-alist (make-frame-names-alist))
901 0 : (default (car (car frame-names-alist)))
902 0 : (input (completing-read
903 0 : (format "Select Frame (default %s): " default)
904 0 : frame-names-alist nil t nil 'frame-name-history)))
905 0 : (if (= (length input) 0)
906 0 : (list default)
907 0 : (list input))))
908 0 : (let* ((frame-names-alist (make-frame-names-alist))
909 0 : (frame (cdr (assoc name frame-names-alist))))
910 0 : (if frame
911 0 : (select-frame-set-input-focus frame)
912 0 : (error "There is no frame named `%s'" name))))
913 :
914 :
915 : ;;;; Background mode.
916 :
917 : (defcustom frame-background-mode nil
918 : "The brightness of the background.
919 : Set this to the symbol `dark' if your background color is dark,
920 : `light' if your background is light, or nil (automatic by default)
921 : if you want Emacs to examine the brightness for you.
922 :
923 : If you change this without using customize, you should use
924 : `frame-set-background-mode' to update existing frames;
925 : e.g. (mapc \\='frame-set-background-mode (frame-list))."
926 : :group 'faces
927 : :set #'(lambda (var value)
928 : (set-default var value)
929 : (mapc 'frame-set-background-mode (frame-list)))
930 : :initialize 'custom-initialize-changed
931 : :type '(choice (const dark)
932 : (const light)
933 : (const :tag "automatic" nil)))
934 :
935 : (declare-function x-get-resource "frame.c"
936 : (attribute class &optional component subclass))
937 :
938 : ;; Only used if window-system is not null.
939 : (declare-function x-display-grayscale-p "xfns.c" (&optional terminal))
940 :
941 : (defvar inhibit-frame-set-background-mode nil)
942 :
943 : (defun frame-set-background-mode (frame &optional keep-face-specs)
944 : "Set up display-dependent faces on FRAME.
945 : Display-dependent faces are those which have different definitions
946 : according to the `background-mode' and `display-type' frame parameters.
947 :
948 : If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate
949 : face specs for the new background mode."
950 0 : (unless inhibit-frame-set-background-mode
951 0 : (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
952 0 : (bg-color (frame-parameter frame 'background-color))
953 0 : (tty-type (tty-type frame))
954 : (default-bg-mode
955 0 : (if (or (window-system frame)
956 0 : (and tty-type
957 0 : (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)"
958 0 : tty-type)))
959 : 'light
960 0 : 'dark))
961 0 : (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light))
962 : (bg-mode
963 0 : (cond (frame-default-bg-mode)
964 0 : ((equal bg-color "unspecified-fg") ; inverted colors
965 0 : non-default-bg-mode)
966 0 : ((not (color-values bg-color frame))
967 0 : default-bg-mode)
968 0 : ((>= (apply '+ (color-values bg-color frame))
969 : ;; Just looking at the screen, colors whose
970 : ;; values add up to .6 of the white total
971 : ;; still look dark to me.
972 0 : (* (apply '+ (color-values "white" frame)) .6))
973 : 'light)
974 0 : (t 'dark)))
975 : (display-type
976 0 : (cond ((null (window-system frame))
977 0 : (if (tty-display-color-p frame) 'color 'mono))
978 0 : ((display-color-p frame)
979 : 'color)
980 0 : ((x-display-grayscale-p frame)
981 : 'grayscale)
982 0 : (t 'mono)))
983 : (old-bg-mode
984 0 : (frame-parameter frame 'background-mode))
985 : (old-display-type
986 0 : (frame-parameter frame 'display-type)))
987 :
988 0 : (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type))
989 0 : (let ((locally-modified-faces nil)
990 : ;; Prevent face-spec-recalc from calling this function
991 : ;; again, resulting in a loop (bug#911).
992 : (inhibit-frame-set-background-mode t)
993 0 : (params (list (cons 'background-mode bg-mode)
994 0 : (cons 'display-type display-type))))
995 0 : (if keep-face-specs
996 0 : (modify-frame-parameters frame params)
997 : ;; If we are recomputing face specs, first collect a list
998 : ;; of faces that don't match their face-specs. These are
999 : ;; the faces modified on FRAME, and we avoid changing them
1000 : ;; below. Use a negative list to avoid consing (we assume
1001 : ;; most faces are unmodified).
1002 0 : (dolist (face (face-list))
1003 0 : (and (not (get face 'face-override-spec))
1004 0 : (not (face-spec-match-p face
1005 0 : (face-user-default-spec face)
1006 0 : (selected-frame)))
1007 0 : (push face locally-modified-faces)))
1008 : ;; Now change to the new frame parameters
1009 0 : (modify-frame-parameters frame params)
1010 : ;; For all unmodified named faces, choose face specs
1011 : ;; matching the new frame parameters.
1012 0 : (dolist (face (face-list))
1013 0 : (unless (memq face locally-modified-faces)
1014 0 : (face-spec-recalc face frame)))))))))
1015 :
1016 : (defun frame-terminal-default-bg-mode (frame)
1017 : "Return the default background mode of FRAME.
1018 : This checks the `frame-background-mode' variable, the X resource
1019 : named \"backgroundMode\" (if FRAME is an X frame), and finally
1020 : the `background-mode' terminal parameter."
1021 0 : (or frame-background-mode
1022 0 : (let ((bg-resource
1023 0 : (and (window-system frame)
1024 0 : (x-get-resource "backgroundMode" "BackgroundMode"))))
1025 0 : (if bg-resource
1026 0 : (intern (downcase bg-resource))))
1027 0 : (terminal-parameter frame 'background-mode)))
1028 :
1029 :
1030 : ;;;; Frame configurations
1031 :
1032 : (defun current-frame-configuration ()
1033 : "Return a list describing the positions and states of all frames.
1034 : Its car is `frame-configuration'.
1035 : Each element of the cdr is a list of the form (FRAME ALIST WINDOW-CONFIG),
1036 : where
1037 : FRAME is a frame object,
1038 : ALIST is an association list specifying some of FRAME's parameters, and
1039 : WINDOW-CONFIG is a window configuration object for FRAME."
1040 0 : (cons 'frame-configuration
1041 0 : (mapcar (lambda (frame)
1042 0 : (list frame
1043 0 : (frame-parameters frame)
1044 0 : (current-window-configuration frame)))
1045 0 : (frame-list))))
1046 :
1047 : (defun set-frame-configuration (configuration &optional nodelete)
1048 : "Restore the frames to the state described by CONFIGURATION.
1049 : Each frame listed in CONFIGURATION has its position, size, window
1050 : configuration, and other parameters set as specified in CONFIGURATION.
1051 : However, this function does not restore deleted frames.
1052 :
1053 : Ordinarily, this function deletes all existing frames not
1054 : listed in CONFIGURATION. But if optional second argument NODELETE
1055 : is given and non-nil, the unwanted frames are iconified instead."
1056 0 : (or (frame-configuration-p configuration)
1057 0 : (signal 'wrong-type-argument
1058 0 : (list 'frame-configuration-p configuration)))
1059 0 : (let ((config-alist (cdr configuration))
1060 : frames-to-delete)
1061 0 : (dolist (frame (frame-list))
1062 0 : (let ((parameters (assq frame config-alist)))
1063 0 : (if parameters
1064 0 : (progn
1065 0 : (modify-frame-parameters
1066 0 : frame
1067 : ;; Since we can't set a frame's minibuffer status,
1068 : ;; we might as well omit the parameter altogether.
1069 0 : (let* ((parms (nth 1 parameters))
1070 0 : (mini (assq 'minibuffer parms))
1071 0 : (name (assq 'name parms))
1072 0 : (explicit-name (cdr (assq 'explicit-name parms))))
1073 0 : (when mini (setq parms (delq mini parms)))
1074 : ;; Leave name in iff it was set explicitly.
1075 : ;; This should fix the behavior reported in
1076 : ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg01632.html
1077 0 : (when (and name (not explicit-name))
1078 0 : (setq parms (delq name parms)))
1079 0 : parms))
1080 0 : (set-window-configuration (nth 2 parameters)))
1081 0 : (setq frames-to-delete (cons frame frames-to-delete)))))
1082 0 : (mapc (if nodelete
1083 : ;; Note: making frames invisible here was tried
1084 : ;; but led to some strange behavior--each time the frame
1085 : ;; was made visible again, the window manager asked afresh
1086 : ;; for where to put it.
1087 : 'iconify-frame
1088 0 : 'delete-frame)
1089 0 : frames-to-delete)))
1090 :
1091 : ;;;; Convenience functions for accessing and interactively changing
1092 : ;;;; frame parameters.
1093 :
1094 : (defun frame-height (&optional frame)
1095 : "Return number of lines available for display on FRAME.
1096 : If FRAME is omitted, describe the currently selected frame.
1097 : Exactly what is included in the return value depends on the
1098 : window-system and toolkit in use - see `frame-pixel-height' for
1099 : more details. The lines are in units of the default font height.
1100 :
1101 : The result is roughly related to the frame pixel height via
1102 : height in pixels = height in lines * `frame-char-height'.
1103 : However, this is only approximate, and is complicated e.g. by the
1104 : fact that individual window lines and menu bar lines can have
1105 : differing font heights."
1106 2 : (cdr (assq 'height (frame-parameters frame))))
1107 :
1108 : (defun frame-width (&optional frame)
1109 : "Return number of columns available for display on FRAME.
1110 : If FRAME is omitted, describe the currently selected frame."
1111 0 : (cdr (assq 'width (frame-parameters frame))))
1112 :
1113 : (defalias 'frame-border-width 'frame-internal-border-width)
1114 : (defalias 'frame-pixel-width 'frame-native-width)
1115 : (defalias 'frame-pixel-height 'frame-native-height)
1116 :
1117 : (defun frame-inner-width (&optional frame)
1118 : "Return inner width of FRAME in pixels.
1119 : FRAME defaults to the selected frame."
1120 0 : (setq frame (window-normalize-frame frame))
1121 0 : (- (frame-native-width frame)
1122 0 : (* 2 (frame-internal-border-width frame))))
1123 :
1124 : (defun frame-inner-height (&optional frame)
1125 : "Return inner height of FRAME in pixels.
1126 : FRAME defaults to the selected frame."
1127 0 : (setq frame (window-normalize-frame frame))
1128 0 : (- (frame-native-height frame)
1129 0 : (* 2 (frame-internal-border-width frame))))
1130 :
1131 : (defun frame-outer-width (&optional frame)
1132 : "Return outer width of FRAME in pixels.
1133 : FRAME defaults to the selected frame."
1134 0 : (setq frame (window-normalize-frame frame))
1135 0 : (let ((edges (frame-edges frame 'outer-edges)))
1136 0 : (- (nth 2 edges) (nth 0 edges))))
1137 :
1138 : (defun frame-outer-height (&optional frame)
1139 : "Return outer height of FRAME in pixels.
1140 : FRAME defaults to the selected frame."
1141 0 : (setq frame (window-normalize-frame frame))
1142 0 : (let ((edges (frame-edges frame 'outer-edges)))
1143 0 : (- (nth 3 edges) (nth 1 edges))))
1144 :
1145 : (declare-function x-list-fonts "xfaces.c"
1146 : (pattern &optional face frame maximum width))
1147 :
1148 : (define-obsolete-function-alias 'set-default-font 'set-frame-font "23.1")
1149 :
1150 : (defun set-frame-font (font &optional keep-size frames)
1151 : "Set the default font to FONT.
1152 : When called interactively, prompt for the name of a font, and use
1153 : that font on the selected frame. When called from Lisp, FONT
1154 : should be a font name (a string), a font object, font entity, or
1155 : font spec.
1156 :
1157 : If KEEP-SIZE is nil, keep the number of frame lines and columns
1158 : fixed. If KEEP-SIZE is non-nil (or with a prefix argument), try
1159 : to keep the current frame size fixed (in pixels) by adjusting the
1160 : number of lines and columns.
1161 :
1162 : If FRAMES is nil, apply the font to the selected frame only.
1163 : If FRAMES is non-nil, it should be a list of frames to act upon,
1164 : or t meaning all existing graphical frames.
1165 : Also, if FRAMES is non-nil, alter the user's Customization settings
1166 : as though the font-related attributes of the `default' face had been
1167 : \"set in this session\", so that the font is applied to future frames."
1168 : (interactive
1169 0 : (let* ((completion-ignore-case t)
1170 0 : (font (completing-read "Font name: "
1171 : ;; x-list-fonts will fail with an error
1172 : ;; if this frame doesn't support fonts.
1173 0 : (x-list-fonts "*" nil (selected-frame))
1174 : nil nil nil nil
1175 0 : (frame-parameter nil 'font))))
1176 0 : (list font current-prefix-arg nil)))
1177 0 : (when (or (stringp font) (fontp font))
1178 0 : (let* ((this-frame (selected-frame))
1179 : ;; FRAMES nil means affect the selected frame.
1180 0 : (frame-list (cond ((null frames)
1181 0 : (list this-frame))
1182 0 : ((eq frames t)
1183 0 : (frame-list))
1184 0 : (t frames)))
1185 : height width)
1186 0 : (dolist (f frame-list)
1187 0 : (when (display-multi-font-p f)
1188 0 : (if keep-size
1189 0 : (setq height (* (frame-parameter f 'height)
1190 0 : (frame-char-height f))
1191 0 : width (* (frame-parameter f 'width)
1192 0 : (frame-char-width f))))
1193 : ;; When set-face-attribute is called for :font, Emacs
1194 : ;; guesses the best font according to other face attributes
1195 : ;; (:width, :weight, etc.) so reset them too (Bug#2476).
1196 0 : (set-face-attribute 'default f
1197 : :width 'normal :weight 'normal
1198 0 : :slant 'normal :font font)
1199 0 : (if keep-size
1200 0 : (modify-frame-parameters
1201 0 : f
1202 0 : (list (cons 'height (round height (frame-char-height f)))
1203 0 : (cons 'width (round width (frame-char-width f))))))))
1204 0 : (when frames
1205 : ;; Alter the user's Custom setting of the `default' face, but
1206 : ;; only for font-related attributes.
1207 0 : (let ((specs (cadr (assq 'user (get 'default 'theme-face))))
1208 : (attrs '(:family :foundry :slant :weight :height :width))
1209 : (new-specs nil))
1210 0 : (if (null specs) (setq specs '((t nil))))
1211 0 : (dolist (spec specs)
1212 : ;; Each SPEC has the form (DISPLAY ATTRIBUTE-PLIST)
1213 0 : (let ((display (nth 0 spec))
1214 0 : (plist (copy-tree (nth 1 spec))))
1215 : ;; Alter only DISPLAY conditions matching this frame.
1216 0 : (when (or (memq display '(t default))
1217 0 : (face-spec-set-match-display display this-frame))
1218 0 : (dolist (attr attrs)
1219 0 : (setq plist (plist-put plist attr
1220 0 : (face-attribute 'default attr)))))
1221 0 : (push (list display plist) new-specs)))
1222 0 : (setq new-specs (nreverse new-specs))
1223 0 : (put 'default 'customized-face new-specs)
1224 0 : (custom-push-theme 'theme-face 'default 'user 'set new-specs)
1225 0 : (put 'default 'face-modified nil))))
1226 0 : (run-hooks 'after-setting-font-hook 'after-setting-font-hooks)))
1227 :
1228 : (defun set-frame-parameter (frame parameter value)
1229 : "Set frame parameter PARAMETER to VALUE on FRAME.
1230 : If FRAME is nil, it defaults to the selected frame.
1231 : See `modify-frame-parameters'."
1232 0 : (modify-frame-parameters frame (list (cons parameter value))))
1233 :
1234 : (defun set-background-color (color-name)
1235 : "Set the background color of the selected frame to COLOR-NAME.
1236 : When called interactively, prompt for the name of the color to use.
1237 : To get the frame's current background color, use `frame-parameters'."
1238 0 : (interactive (list (read-color "Background color: ")))
1239 0 : (modify-frame-parameters (selected-frame)
1240 0 : (list (cons 'background-color color-name)))
1241 0 : (or window-system
1242 0 : (face-set-after-frame-default (selected-frame)
1243 0 : (list
1244 0 : (cons 'background-color color-name)
1245 : ;; Pass the foreground-color as
1246 : ;; well, if defined, to avoid
1247 : ;; losing it when faces are reset
1248 : ;; to their defaults.
1249 0 : (assq 'foreground-color
1250 0 : (frame-parameters))))))
1251 :
1252 : (defun set-foreground-color (color-name)
1253 : "Set the foreground color of the selected frame to COLOR-NAME.
1254 : When called interactively, prompt for the name of the color to use.
1255 : To get the frame's current foreground color, use `frame-parameters'."
1256 0 : (interactive (list (read-color "Foreground color: ")))
1257 0 : (modify-frame-parameters (selected-frame)
1258 0 : (list (cons 'foreground-color color-name)))
1259 0 : (or window-system
1260 0 : (face-set-after-frame-default (selected-frame)
1261 0 : (list
1262 0 : (cons 'foreground-color color-name)
1263 : ;; Pass the background-color as
1264 : ;; well, if defined, to avoid
1265 : ;; losing it when faces are reset
1266 : ;; to their defaults.
1267 0 : (assq 'background-color
1268 0 : (frame-parameters))))))
1269 :
1270 : (defun set-cursor-color (color-name)
1271 : "Set the text cursor color of the selected frame to COLOR-NAME.
1272 : When called interactively, prompt for the name of the color to use.
1273 : This works by setting the `cursor-color' frame parameter on the
1274 : selected frame.
1275 :
1276 : You can also set the text cursor color, for all frames, by
1277 : customizing the `cursor' face."
1278 0 : (interactive (list (read-color "Cursor color: ")))
1279 0 : (modify-frame-parameters (selected-frame)
1280 0 : (list (cons 'cursor-color color-name))))
1281 :
1282 : (defun set-mouse-color (color-name)
1283 : "Set the color of the mouse pointer of the selected frame to COLOR-NAME.
1284 : When called interactively, prompt for the name of the color to use.
1285 : To get the frame's current mouse color, use `frame-parameters'."
1286 0 : (interactive (list (read-color "Mouse color: ")))
1287 0 : (modify-frame-parameters (selected-frame)
1288 0 : (list (cons 'mouse-color
1289 0 : (or color-name
1290 0 : (cdr (assq 'mouse-color
1291 0 : (frame-parameters))))))))
1292 :
1293 : (defun set-border-color (color-name)
1294 : "Set the color of the border of the selected frame to COLOR-NAME.
1295 : When called interactively, prompt for the name of the color to use.
1296 : To get the frame's current border color, use `frame-parameters'."
1297 0 : (interactive (list (read-color "Border color: ")))
1298 0 : (modify-frame-parameters (selected-frame)
1299 0 : (list (cons 'border-color color-name))))
1300 :
1301 : (define-minor-mode auto-raise-mode
1302 : "Toggle whether or not selected frames should auto-raise.
1303 : With a prefix argument ARG, enable Auto Raise mode if ARG is
1304 : positive, and disable it otherwise. If called from Lisp, enable
1305 : the mode if ARG is omitted or nil.
1306 :
1307 : Auto Raise mode does nothing under most window managers, which
1308 : switch focus on mouse clicks. It only has an effect if your
1309 : window manager switches focus on mouse movement (in which case
1310 : you should also change `focus-follows-mouse' to t). Then,
1311 : enabling Auto Raise mode causes any graphical Emacs frame which
1312 : acquires focus to be automatically raised.
1313 :
1314 : Note that this minor mode controls Emacs's own auto-raise
1315 : feature. Window managers that switch focus on mouse movement
1316 : often have their own auto-raise feature."
1317 : :variable (frame-parameter nil 'auto-raise)
1318 0 : (if (frame-parameter nil 'auto-raise)
1319 0 : (raise-frame)))
1320 :
1321 : (define-minor-mode auto-lower-mode
1322 : "Toggle whether or not the selected frame should auto-lower.
1323 : With a prefix argument ARG, enable Auto Lower mode if ARG is
1324 : positive, and disable it otherwise. If called from Lisp, enable
1325 : the mode if ARG is omitted or nil.
1326 :
1327 : Auto Lower mode does nothing under most window managers, which
1328 : switch focus on mouse clicks. It only has an effect if your
1329 : window manager switches focus on mouse movement (in which case
1330 : you should also change `focus-follows-mouse' to t). Then,
1331 : enabling Auto Lower Mode causes any graphical Emacs frame which
1332 : loses focus to be automatically lowered.
1333 :
1334 : Note that this minor mode controls Emacs's own auto-lower
1335 : feature. Window managers that switch focus on mouse movement
1336 : often have their own features for raising or lowering frames."
1337 : :variable (frame-parameter nil 'auto-lower))
1338 :
1339 : (defun set-frame-name (name)
1340 : "Set the name of the selected frame to NAME.
1341 : When called interactively, prompt for the name of the frame.
1342 : On text terminals, the frame name is displayed on the mode line.
1343 : On graphical displays, it is displayed on the frame's title bar."
1344 : (interactive "sFrame name: ")
1345 0 : (modify-frame-parameters (selected-frame)
1346 0 : (list (cons 'name name))))
1347 :
1348 : (defun frame-current-scroll-bars (&optional frame)
1349 : "Return the current scroll-bar types for frame FRAME.
1350 : Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies
1351 : the current location of the vertical scroll-bars (`left', `right'
1352 : or nil), and HORIZONTAL specifies the current location of the
1353 : horizontal scroll bars (`bottom' or nil). FRAME must specify a
1354 : live frame and defaults to the selected one."
1355 0 : (let* ((frame (window-normalize-frame frame))
1356 0 : (vertical (frame-parameter frame 'vertical-scroll-bars))
1357 0 : (horizontal (frame-parameter frame 'horizontal-scroll-bars)))
1358 0 : (unless (memq vertical '(left right nil))
1359 0 : (setq vertical default-frame-scroll-bars))
1360 0 : (cons vertical (and horizontal 'bottom))))
1361 :
1362 : (declare-function x-frame-geometry "xfns.c" (&optional frame))
1363 : (declare-function w32-frame-geometry "w32fns.c" (&optional frame))
1364 : (declare-function ns-frame-geometry "nsfns.m" (&optional frame))
1365 :
1366 : (defun frame-geometry (&optional frame)
1367 : "Return geometric attributes of FRAME.
1368 : FRAME must be a live frame and defaults to the selected one. The return
1369 : value is an association list of the attributes listed below. All height
1370 : and width values are in pixels.
1371 :
1372 : `outer-position' is a cons of the outer left and top edges of FRAME
1373 : relative to the origin - the position (0, 0) - of FRAME's display.
1374 :
1375 : `outer-size' is a cons of the outer width and height of FRAME. The
1376 : outer size includes the title bar and the external borders as well as
1377 : any menu and/or tool bar of frame.
1378 :
1379 : `external-border-size' is a cons of the horizontal and vertical width of
1380 : FRAME's external borders as supplied by the window manager.
1381 :
1382 : `title-bar-size' is a cons of the width and height of the title bar of
1383 : FRAME as supplied by the window manager. If both of them are zero,
1384 : FRAME has no title bar. If only the width is zero, Emacs was not
1385 : able to retrieve the width information.
1386 :
1387 : `menu-bar-external', if non-nil, means the menu bar is external (never
1388 : included in the inner edges of FRAME).
1389 :
1390 : `menu-bar-size' is a cons of the width and height of the menu bar of
1391 : FRAME.
1392 :
1393 : `tool-bar-external', if non-nil, means the tool bar is external (never
1394 : included in the inner edges of FRAME).
1395 :
1396 : `tool-bar-position' tells on which side the tool bar on FRAME is and can
1397 : be one of `left', `top', `right' or `bottom'. If this is nil, FRAME
1398 : has no tool bar.
1399 :
1400 : `tool-bar-size' is a cons of the width and height of the tool bar of
1401 : FRAME.
1402 :
1403 : `internal-border-width' is the width of the internal border of
1404 : FRAME."
1405 0 : (let* ((frame (window-normalize-frame frame))
1406 0 : (frame-type (framep-on-display frame)))
1407 0 : (cond
1408 0 : ((eq frame-type 'x)
1409 0 : (x-frame-geometry frame))
1410 0 : ((eq frame-type 'w32)
1411 0 : (w32-frame-geometry frame))
1412 0 : ((eq frame-type 'ns)
1413 0 : (ns-frame-geometry frame))
1414 : (t
1415 0 : (list
1416 : '(outer-position 0 . 0)
1417 0 : (cons 'outer-size (cons (frame-width frame) (frame-height frame)))
1418 : '(external-border-size 0 . 0)
1419 : '(outer-border-width . 0)
1420 : '(title-bar-size 0 . 0)
1421 : '(menu-bar-external . nil)
1422 0 : (let ((menu-bar-lines (frame-parameter frame 'menu-bar-lines)))
1423 0 : (cons 'menu-bar-size
1424 0 : (if menu-bar-lines
1425 0 : (cons (frame-width frame) 1)
1426 0 : 1 0)))
1427 : '(tool-bar-external . nil)
1428 : '(tool-bar-position . nil)
1429 : '(tool-bar-size 0 . 0)
1430 0 : (cons 'internal-border-width
1431 0 : (frame-parameter frame 'internal-border-width)))))))
1432 :
1433 : (defun frame--size-history (&optional frame)
1434 : "Print history of resize operations for FRAME.
1435 : Print prettified version of `frame-size-history' into a buffer
1436 : called *frame-size-history*. Optional argument FRAME denotes the
1437 : frame whose history will be printed. FRAME defaults to the
1438 : selected frame."
1439 0 : (let ((history (reverse frame-size-history))
1440 : entry)
1441 0 : (setq frame (window-normalize-frame frame))
1442 0 : (with-current-buffer (get-buffer-create "*frame-size-history*")
1443 0 : (erase-buffer)
1444 0 : (insert (format "Frame size history of %s\n" frame))
1445 0 : (while (listp (setq entry (pop history)))
1446 0 : (when (eq (car entry) frame)
1447 0 : (pop entry)
1448 0 : (insert (format "%s" (pop entry)))
1449 0 : (move-to-column 24 t)
1450 0 : (while entry
1451 0 : (insert (format " %s" (pop entry))))
1452 0 : (insert "\n"))))))
1453 :
1454 : (declare-function x-frame-edges "xfns.c" (&optional frame type))
1455 : (declare-function w32-frame-edges "w32fns.c" (&optional frame type))
1456 : (declare-function ns-frame-edges "nsfns.m" (&optional frame type))
1457 :
1458 : (defun frame-edges (&optional frame type)
1459 : "Return coordinates of FRAME's edges.
1460 : FRAME must be a live frame and defaults to the selected one. The
1461 : list returned has the form (LEFT TOP RIGHT BOTTOM) where all
1462 : values are in pixels relative to the origin - the position (0, 0)
1463 : - of FRAME's display. For terminal frames all values are
1464 : relative to LEFT and TOP which are both zero.
1465 :
1466 : Optional argument TYPE specifies the type of the edges. TYPE
1467 : `outer-edges' means to return the outer edges of FRAME. TYPE
1468 : `native-edges' (or nil) means to return the native edges of
1469 : FRAME. TYPE `inner-edges' means to return the inner edges of
1470 : FRAME."
1471 0 : (let* ((frame (window-normalize-frame frame))
1472 0 : (frame-type (framep-on-display frame)))
1473 0 : (cond
1474 0 : ((eq frame-type 'x)
1475 0 : (x-frame-edges frame type))
1476 0 : ((eq frame-type 'w32)
1477 0 : (w32-frame-edges frame type))
1478 0 : ((eq frame-type 'ns)
1479 0 : (ns-frame-edges frame type))
1480 : (t
1481 0 : (list 0 0 (frame-width frame) (frame-height frame))))))
1482 :
1483 : (declare-function w32-mouse-absolute-pixel-position "w32fns.c")
1484 : (declare-function x-mouse-absolute-pixel-position "xfns.c")
1485 : (declare-function ns-mouse-absolute-pixel-position "nsfns.c")
1486 :
1487 : (defun mouse-absolute-pixel-position ()
1488 : "Return absolute position of mouse cursor in pixels.
1489 : The position is returned as a cons cell (X . Y) of the
1490 : coordinates of the mouse cursor position in pixels relative to a
1491 : position (0, 0) of the selected frame's terminal."
1492 0 : (let ((frame-type (framep-on-display)))
1493 0 : (cond
1494 0 : ((eq frame-type 'x)
1495 0 : (x-mouse-absolute-pixel-position))
1496 0 : ((eq frame-type 'w32)
1497 0 : (w32-mouse-absolute-pixel-position))
1498 0 : ((eq frame-type 'ns)
1499 0 : (ns-mouse-absolute-pixel-position))
1500 : (t
1501 0 : (cons 0 0)))))
1502 :
1503 : (declare-function ns-set-mouse-absolute-pixel-position "nsfns.m" (x y))
1504 : (declare-function w32-set-mouse-absolute-pixel-position "w32fns.c" (x y))
1505 : (declare-function x-set-mouse-absolute-pixel-position "xfns.c" (x y))
1506 :
1507 : (defun set-mouse-absolute-pixel-position (x y)
1508 : "Move mouse pointer to absolute pixel position (X, Y).
1509 : The coordinates X and Y are interpreted in pixels relative to a
1510 : position (0, 0) of the selected frame's terminal."
1511 0 : (let ((frame-type (framep-on-display)))
1512 0 : (cond
1513 0 : ((eq frame-type 'ns)
1514 0 : (ns-set-mouse-absolute-pixel-position x y))
1515 0 : ((eq frame-type 'x)
1516 0 : (x-set-mouse-absolute-pixel-position x y))
1517 0 : ((eq frame-type 'w32)
1518 0 : (w32-set-mouse-absolute-pixel-position x y)))))
1519 :
1520 : (defun frame-monitor-attributes (&optional frame)
1521 : "Return the attributes of the physical monitor dominating FRAME.
1522 : If FRAME is omitted or nil, describe the currently selected frame.
1523 :
1524 : A frame is dominated by a physical monitor when either the
1525 : largest area of the frame resides in the monitor, or the monitor
1526 : is the closest to the frame if the frame does not intersect any
1527 : physical monitors.
1528 :
1529 : See `display-monitor-attributes-list' for the list of attribute
1530 : keys and their meanings."
1531 0 : (or frame (setq frame (selected-frame)))
1532 0 : (cl-loop for attributes in (display-monitor-attributes-list frame)
1533 0 : for frames = (cdr (assq 'frames attributes))
1534 0 : if (memq frame frames) return attributes))
1535 :
1536 : (defun frame-monitor-attribute (attribute &optional frame x y)
1537 : "Return the value of ATTRIBUTE on FRAME's monitor.
1538 : If FRAME is omitted or nil, use currently selected frame.
1539 :
1540 : By default, the current monitor is the physical monitor
1541 : dominating the selected frame. A frame is dominated by a
1542 : physical monitor when either the largest area of the frame
1543 : resides in the monitor, or the monitor is the closest to the
1544 : frame if the frame does not intersect any physical monitors.
1545 :
1546 : If X and Y are both numbers, then ignore the value of FRAME; the
1547 : monitor is determined to be the physical monitor that contains
1548 : the pixel coordinate (X, Y).
1549 :
1550 : See `display-monitor-attributes-list' for the list of attribute
1551 : keys and their meanings."
1552 0 : (if (and (numberp x)
1553 0 : (numberp y))
1554 0 : (cl-loop for monitor in (display-monitor-attributes-list)
1555 0 : for geometry = (alist-get 'geometry monitor)
1556 0 : for min-x = (pop geometry)
1557 0 : for min-y = (pop geometry)
1558 0 : for max-x = (+ min-x (pop geometry))
1559 0 : for max-y = (+ min-y (car geometry))
1560 0 : when (and (<= min-x x)
1561 0 : (< x max-x)
1562 0 : (<= min-y y)
1563 0 : (< y max-y))
1564 0 : return (alist-get attribute monitor))
1565 0 : (alist-get attribute (frame-monitor-attributes frame))))
1566 :
1567 : (defun frame-monitor-geometry (&optional frame x y)
1568 : "Return the geometry of FRAME's monitor.
1569 : FRAME can be a frame name, a terminal name, or a frame.
1570 : If FRAME is omitted or nil, use the currently selected frame.
1571 :
1572 : By default, the current monitor is said to be the physical
1573 : monitor dominating the selected frame. A frame is dominated by
1574 : a physical monitor when either the largest area of the frame resides
1575 : in the monitor, or the monitor is the closest to the frame if the
1576 : frame does not intersect any physical monitors.
1577 :
1578 : If X and Y are both numbers, then ignore the value of FRAME; the
1579 : monitor is determined to be the physical monitor that contains
1580 : the pixel coordinate (X, Y).
1581 :
1582 : See `display-monitor-attributes-list' for information on the
1583 : geometry attribute."
1584 0 : (frame-monitor-attribute 'geometry frame x y))
1585 :
1586 : (defun frame-monitor-workarea (&optional frame x y)
1587 : "Return the workarea of FRAME's monitor.
1588 : FRAME can be a frame name, a terminal name, or a frame.
1589 : If FRAME is omitted or nil, use currently selected frame.
1590 :
1591 : By default, the current monitor is said to be the physical
1592 : monitor dominating the selected frame. A frame is dominated by
1593 : a physical monitor when either the largest area of the frame resides
1594 : in the monitor, or the monitor is the closest to the frame if the
1595 : frame does not intersect any physical monitors.
1596 :
1597 : If X and Y are both numbers, then ignore the value of FRAME; the
1598 : monitor is determined to be the physical monitor that contains
1599 : the pixel coordinate (X, Y).
1600 :
1601 : See `display-monitor-attributes-list' for information on the
1602 : workarea attribute."
1603 0 : (frame-monitor-attribute 'workarea frame x y))
1604 :
1605 : (declare-function x-frame-list-z-order "xfns.c" (&optional display))
1606 : (declare-function w32-frame-list-z-order "w32fns.c" (&optional display))
1607 : (declare-function ns-frame-list-z-order "nsfns.m" (&optional display))
1608 :
1609 : (defun frame-list-z-order (&optional display)
1610 : "Return list of Emacs' frames, in Z (stacking) order.
1611 : The optional argument DISPLAY specifies which display to poll.
1612 : DISPLAY should be either a frame or a display name (a string).
1613 : If omitted or nil, that stands for the selected frame's display.
1614 :
1615 : Frames are listed from topmost (first) to bottommost (last). As
1616 : a special case, if DISPLAY is non-nil and specifies a live frame,
1617 : return the child frames of that frame in Z (stacking) order.
1618 :
1619 : Return nil if DISPLAY contains no Emacs frame."
1620 0 : (let ((frame-type (framep-on-display display)))
1621 0 : (cond
1622 0 : ((eq frame-type 'x)
1623 0 : (x-frame-list-z-order display))
1624 0 : ((eq frame-type 'w32)
1625 0 : (w32-frame-list-z-order display))
1626 0 : ((eq frame-type 'ns)
1627 0 : (ns-frame-list-z-order display)))))
1628 :
1629 : (declare-function x-frame-restack "xfns.c" (frame1 frame2 &optional above))
1630 : (declare-function w32-frame-restack "w32fns.c" (frame1 frame2 &optional above))
1631 : (declare-function ns-frame-restack "nsfns.m" (frame1 frame2 &optional above))
1632 :
1633 : (defun frame-restack (frame1 frame2 &optional above)
1634 : "Restack FRAME1 below FRAME2.
1635 : This implies that if both frames are visible and the display
1636 : areas of these frames overlap, FRAME2 will (partially) obscure
1637 : FRAME1. If the optional third argument ABOVE is non-nil, restack
1638 : FRAME1 above FRAME2. This means that if both frames are visible
1639 : and the display areas of these frames overlap, FRAME1 will
1640 : \(partially) obscure FRAME2.
1641 :
1642 : This may be thought of as an atomic action performed in two
1643 : steps: The first step removes FRAME1's window-system window from
1644 : the display. The second step reinserts FRAME1's window
1645 : below (above if ABOVE is true) that of FRAME2. Hence the
1646 : position of FRAME2 in its display's Z (stacking) order relative
1647 : to all other frames excluding FRAME1 remains unaltered.
1648 :
1649 : Some window managers may refuse to restack windows. "
1650 0 : (if (and (frame-live-p frame1)
1651 0 : (frame-live-p frame2)
1652 0 : (equal (frame-parameter frame1 'display)
1653 0 : (frame-parameter frame2 'display)))
1654 0 : (let ((frame-type (framep-on-display frame1)))
1655 0 : (cond
1656 0 : ((eq frame-type 'x)
1657 0 : (x-frame-restack frame1 frame2 above))
1658 0 : ((eq frame-type 'w32)
1659 0 : (w32-frame-restack frame1 frame2 above))
1660 0 : ((eq frame-type 'ns)
1661 0 : (ns-frame-restack frame1 frame2 above))))
1662 0 : (error "Cannot restack frames")))
1663 :
1664 : (defun frame-size-changed-p (&optional frame)
1665 : "Return non-nil when the size of FRAME has changed.
1666 : More precisely, return non-nil when the inner width or height of
1667 : FRAME has changed since `window-size-change-functions' was run
1668 : for FRAME."
1669 0 : (let* ((frame (window-normalize-frame frame))
1670 0 : (root (frame-root-window frame))
1671 0 : (mini (minibuffer-window frame))
1672 : (mini-height-before-size-change 0)
1673 : (mini-height 0))
1674 : ;; FRAME's minibuffer window counts iff it's on FRAME and FRAME is
1675 : ;; not a minibuffer-only frame.
1676 0 : (when (and (eq (window-frame mini) frame) (not (eq mini root)))
1677 0 : (setq mini-height-before-size-change
1678 0 : (window-pixel-height-before-size-change mini))
1679 0 : (setq mini-height (window-pixel-height mini)))
1680 : ;; Return non-nil when either the width of the root or the sum of
1681 : ;; the heights of root and minibuffer window changed.
1682 0 : (or (/= (window-pixel-width-before-size-change root)
1683 0 : (window-pixel-width root))
1684 0 : (/= (+ (window-pixel-height-before-size-change root)
1685 0 : mini-height-before-size-change)
1686 0 : (+ (window-pixel-height root) mini-height)))))
1687 :
1688 : ;;;; Frame/display capabilities.
1689 :
1690 : (declare-function msdos-mouse-p "dosfns.c")
1691 :
1692 : (defun display-mouse-p (&optional display)
1693 : "Return non-nil if DISPLAY has a mouse available.
1694 : DISPLAY can be a display name, a frame, or nil (meaning the selected
1695 : frame's display)."
1696 0 : (let ((frame-type (framep-on-display display)))
1697 0 : (cond
1698 0 : ((eq frame-type 'pc)
1699 0 : (msdos-mouse-p))
1700 0 : ((eq frame-type 'w32)
1701 0 : (with-no-warnings
1702 0 : (> w32-num-mouse-buttons 0)))
1703 0 : ((memq frame-type '(x ns))
1704 : t) ;; We assume X and NeXTstep *always* have a pointing device
1705 : (t
1706 0 : (or (and (featurep 'xt-mouse)
1707 0 : xterm-mouse-mode)
1708 : ;; t-mouse is distributed with the GPM package. It doesn't have
1709 : ;; a toggle.
1710 0 : (featurep 't-mouse)
1711 : ;; No way to check whether a w32 console has a mouse, assume
1712 : ;; it always does.
1713 0 : (boundp 'w32-use-full-screen-buffer))))))
1714 :
1715 : (defun display-popup-menus-p (&optional display)
1716 : "Return non-nil if popup menus are supported on DISPLAY.
1717 : DISPLAY can be a display name, a frame, or nil (meaning the selected
1718 : frame's display).
1719 : Support for popup menus requires that the mouse be available."
1720 0 : (display-mouse-p display))
1721 :
1722 : (defun display-graphic-p (&optional display)
1723 : "Return non-nil if DISPLAY is a graphic display.
1724 : Graphical displays are those which are capable of displaying several
1725 : frames and several different fonts at once. This is true for displays
1726 : that use a window system such as X, and false for text-only terminals.
1727 : DISPLAY can be a display name, a frame, or nil (meaning the selected
1728 : frame's display)."
1729 0 : (not (null (memq (framep-on-display display) '(x w32 ns)))))
1730 :
1731 : (defun display-images-p (&optional display)
1732 : "Return non-nil if DISPLAY can display images.
1733 :
1734 : DISPLAY can be a display name, a frame, or nil (meaning the selected
1735 : frame's display)."
1736 0 : (and (display-graphic-p display)
1737 0 : (fboundp 'image-mask-p)
1738 0 : (fboundp 'image-size)))
1739 :
1740 : (defalias 'display-multi-frame-p 'display-graphic-p)
1741 : (defalias 'display-multi-font-p 'display-graphic-p)
1742 :
1743 : (defun display-selections-p (&optional display)
1744 : "Return non-nil if DISPLAY supports selections.
1745 : A selection is a way to transfer text or other data between programs
1746 : via special system buffers called `selection' or `clipboard'.
1747 : DISPLAY can be a display name, a frame, or nil (meaning the selected
1748 : frame's display)."
1749 0 : (let ((frame-type (framep-on-display display)))
1750 0 : (cond
1751 0 : ((eq frame-type 'pc)
1752 : ;; MS-DOS frames support selections when Emacs runs inside
1753 : ;; a Windows DOS Box.
1754 0 : (with-no-warnings
1755 0 : (not (null dos-windows-version))))
1756 0 : ((memq frame-type '(x w32 ns))
1757 : t)
1758 : (t
1759 0 : nil))))
1760 :
1761 : (declare-function x-display-screens "xfns.c" (&optional terminal))
1762 :
1763 : (defun display-screens (&optional display)
1764 : "Return the number of screens associated with DISPLAY.
1765 : DISPLAY should be either a frame or a display name (a string).
1766 : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1767 0 : (let ((frame-type (framep-on-display display)))
1768 0 : (cond
1769 0 : ((memq frame-type '(x w32 ns))
1770 0 : (x-display-screens display))
1771 : (t
1772 0 : 1))))
1773 :
1774 : (declare-function x-display-pixel-height "xfns.c" (&optional terminal))
1775 :
1776 : (defun display-pixel-height (&optional display)
1777 : "Return the height of DISPLAY's screen in pixels.
1778 : DISPLAY can be a display name or a frame.
1779 : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
1780 :
1781 : For character terminals, each character counts as a single pixel.
1782 :
1783 : For graphical terminals, note that on \"multi-monitor\" setups this
1784 : refers to the pixel height for all physical monitors associated
1785 : with DISPLAY. To get information for each physical monitor, use
1786 : `display-monitor-attributes-list'."
1787 0 : (let ((frame-type (framep-on-display display)))
1788 0 : (cond
1789 0 : ((memq frame-type '(x w32 ns))
1790 0 : (x-display-pixel-height display))
1791 : (t
1792 0 : (frame-height (if (framep display) display (selected-frame)))))))
1793 :
1794 : (declare-function x-display-pixel-width "xfns.c" (&optional terminal))
1795 :
1796 : (defun display-pixel-width (&optional display)
1797 : "Return the width of DISPLAY's screen in pixels.
1798 : DISPLAY can be a display name or a frame.
1799 : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
1800 :
1801 : For character terminals, each character counts as a single pixel.
1802 :
1803 : For graphical terminals, note that on \"multi-monitor\" setups this
1804 : refers to the pixel width for all physical monitors associated
1805 : with DISPLAY. To get information for each physical monitor, use
1806 : `display-monitor-attributes-list'."
1807 0 : (let ((frame-type (framep-on-display display)))
1808 0 : (cond
1809 0 : ((memq frame-type '(x w32 ns))
1810 0 : (x-display-pixel-width display))
1811 : (t
1812 0 : (frame-width (if (framep display) display (selected-frame)))))))
1813 :
1814 : (defcustom display-mm-dimensions-alist nil
1815 : "Alist for specifying screen dimensions in millimeters.
1816 : The functions `display-mm-height' and `display-mm-width' consult
1817 : this list before asking the system.
1818 :
1819 : Each element has the form (DISPLAY . (WIDTH . HEIGHT)), e.g.
1820 : \(\":0.0\" . (287 . 215)).
1821 :
1822 : If `display' is t, it specifies dimensions for all graphical displays
1823 : not explicitly specified."
1824 : :version "22.1"
1825 : :type '(alist :key-type (choice (string :tag "Display name")
1826 : (const :tag "Default" t))
1827 : :value-type (cons :tag "Dimensions"
1828 : (integer :tag "Width")
1829 : (integer :tag "Height")))
1830 : :group 'frames)
1831 :
1832 : (declare-function x-display-mm-height "xfns.c" (&optional terminal))
1833 :
1834 : (defun display-mm-height (&optional display)
1835 : "Return the height of DISPLAY's screen in millimeters.
1836 : If the information is unavailable, this function returns nil.
1837 : DISPLAY can be a display name or a frame.
1838 : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
1839 :
1840 : You can override what the system thinks the result should be by
1841 : adding an entry to `display-mm-dimensions-alist'.
1842 :
1843 : For graphical terminals, note that on \"multi-monitor\" setups this
1844 : refers to the height in millimeters for all physical monitors
1845 : associated with DISPLAY. To get information for each physical
1846 : monitor, use `display-monitor-attributes-list'."
1847 0 : (and (memq (framep-on-display display) '(x w32 ns))
1848 0 : (or (cddr (assoc (or display (frame-parameter nil 'display))
1849 0 : display-mm-dimensions-alist))
1850 0 : (cddr (assoc t display-mm-dimensions-alist))
1851 0 : (x-display-mm-height display))))
1852 :
1853 : (declare-function x-display-mm-width "xfns.c" (&optional terminal))
1854 :
1855 : (defun display-mm-width (&optional display)
1856 : "Return the width of DISPLAY's screen in millimeters.
1857 : If the information is unavailable, this function returns nil.
1858 : DISPLAY can be a display name or a frame.
1859 : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
1860 :
1861 : You can override what the system thinks the result should be by
1862 : adding an entry to `display-mm-dimensions-alist'.
1863 :
1864 : For graphical terminals, note that on \"multi-monitor\" setups this
1865 : refers to the width in millimeters for all physical monitors
1866 : associated with DISPLAY. To get information for each physical
1867 : monitor, use `display-monitor-attributes-list'."
1868 0 : (and (memq (framep-on-display display) '(x w32 ns))
1869 0 : (or (cadr (assoc (or display (frame-parameter nil 'display))
1870 0 : display-mm-dimensions-alist))
1871 0 : (cadr (assoc t display-mm-dimensions-alist))
1872 0 : (x-display-mm-width display))))
1873 :
1874 : (declare-function x-display-backing-store "xfns.c" (&optional terminal))
1875 :
1876 : ;; In NS port, the return value may be `buffered', `retained', or
1877 : ;; `non-retained'. See src/nsfns.m.
1878 : (defun display-backing-store (&optional display)
1879 : "Return the backing store capability of DISPLAY's screen.
1880 : The value may be `always', `when-mapped', `not-useful', or nil if
1881 : the question is inapplicable to a certain kind of display.
1882 : DISPLAY can be a display name or a frame.
1883 : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1884 0 : (let ((frame-type (framep-on-display display)))
1885 0 : (cond
1886 0 : ((memq frame-type '(x w32 ns))
1887 0 : (x-display-backing-store display))
1888 : (t
1889 0 : 'not-useful))))
1890 :
1891 : (declare-function x-display-save-under "xfns.c" (&optional terminal))
1892 :
1893 : (defun display-save-under (&optional display)
1894 : "Return non-nil if DISPLAY's screen supports the SaveUnder feature.
1895 : DISPLAY can be a display name or a frame.
1896 : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1897 0 : (let ((frame-type (framep-on-display display)))
1898 0 : (cond
1899 0 : ((memq frame-type '(x w32 ns))
1900 0 : (x-display-save-under display))
1901 : (t
1902 0 : 'not-useful))))
1903 :
1904 : (declare-function x-display-planes "xfns.c" (&optional terminal))
1905 :
1906 : (defun display-planes (&optional display)
1907 : "Return the number of planes supported by DISPLAY.
1908 : DISPLAY can be a display name or a frame.
1909 : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1910 0 : (let ((frame-type (framep-on-display display)))
1911 0 : (cond
1912 0 : ((memq frame-type '(x w32 ns))
1913 0 : (x-display-planes display))
1914 0 : ((eq frame-type 'pc)
1915 : 4)
1916 : (t
1917 0 : (truncate (log (length (tty-color-alist)) 2))))))
1918 :
1919 : (declare-function x-display-color-cells "xfns.c" (&optional terminal))
1920 :
1921 : (defun display-color-cells (&optional display)
1922 : "Return the number of color cells supported by DISPLAY.
1923 : DISPLAY can be a display name or a frame.
1924 : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1925 0 : (let ((frame-type (framep-on-display display)))
1926 0 : (cond
1927 0 : ((memq frame-type '(x w32 ns))
1928 0 : (x-display-color-cells display))
1929 0 : ((eq frame-type 'pc)
1930 : 16)
1931 : (t
1932 0 : (tty-display-color-cells display)))))
1933 :
1934 : (declare-function x-display-visual-class "xfns.c" (&optional terminal))
1935 :
1936 : (defun display-visual-class (&optional display)
1937 : "Return the visual class of DISPLAY.
1938 : The value is one of the symbols `static-gray', `gray-scale',
1939 : `static-color', `pseudo-color', `true-color', or `direct-color'.
1940 : DISPLAY can be a display name or a frame.
1941 : If DISPLAY is omitted or nil, it defaults to the selected frame's display."
1942 0 : (let ((frame-type (framep-on-display display)))
1943 0 : (cond
1944 0 : ((memq frame-type '(x w32 ns))
1945 0 : (x-display-visual-class display))
1946 0 : ((and (memq frame-type '(pc t))
1947 0 : (tty-display-color-p display))
1948 : 'static-color)
1949 : (t
1950 0 : 'static-gray))))
1951 :
1952 : (declare-function x-display-monitor-attributes-list "xfns.c"
1953 : (&optional terminal))
1954 : (declare-function w32-display-monitor-attributes-list "w32fns.c"
1955 : (&optional display))
1956 : (declare-function ns-display-monitor-attributes-list "nsfns.m"
1957 : (&optional terminal))
1958 :
1959 : (defun display-monitor-attributes-list (&optional display)
1960 : "Return a list of physical monitor attributes on DISPLAY.
1961 : DISPLAY can be a display name, a terminal name, or a frame.
1962 : If DISPLAY is omitted or nil, it defaults to the selected frame's display.
1963 : Each element of the list represents the attributes of a physical
1964 : monitor. The first element corresponds to the primary monitor.
1965 :
1966 : The attributes for a physical monitor are represented as an alist
1967 : of attribute keys and values as follows:
1968 :
1969 : geometry -- Position and size in pixels in the form of (X Y WIDTH HEIGHT)
1970 : workarea -- Position and size of the work area in pixels in the
1971 : form of (X Y WIDTH HEIGHT)
1972 : mm-size -- Width and height in millimeters in the form of
1973 : (WIDTH HEIGHT)
1974 : frames -- List of frames dominated by the physical monitor
1975 : name (*) -- Name of the physical monitor as a string
1976 : source (*) -- Source of multi-monitor information as a string
1977 :
1978 : where X, Y, WIDTH, and HEIGHT are integers. X and Y are coordinates
1979 : of the top-left corner, and might be negative for monitors other than
1980 : the primary one. Keys labeled with (*) are optional.
1981 :
1982 : The \"work area\" is a measure of the \"usable\" display space.
1983 : It may be less than the total screen size, owing to space taken up
1984 : by window manager features (docks, taskbars, etc.). The precise
1985 : details depend on the platform and environment.
1986 :
1987 : The `source' attribute describes the source from which the information
1988 : was obtained. On X, this may be one of: \"Gdk\", \"XRandr\", \"Xinerama\",
1989 : or \"fallback\".
1990 :
1991 : A frame is dominated by a physical monitor when either the
1992 : largest area of the frame resides in the monitor, or the monitor
1993 : is the closest to the frame if the frame does not intersect any
1994 : physical monitors. Every (non-tooltip) frame (including invisible ones)
1995 : in a graphical display is dominated by exactly one physical
1996 : monitor at a time, though it can span multiple (or no) physical
1997 : monitors."
1998 0 : (let ((frame-type (framep-on-display display)))
1999 0 : (cond
2000 0 : ((eq frame-type 'x)
2001 0 : (x-display-monitor-attributes-list display))
2002 0 : ((eq frame-type 'w32)
2003 0 : (w32-display-monitor-attributes-list display))
2004 0 : ((eq frame-type 'ns)
2005 0 : (ns-display-monitor-attributes-list display))
2006 : (t
2007 0 : (let ((geometry (list 0 0 (display-pixel-width display)
2008 0 : (display-pixel-height display))))
2009 0 : `(((geometry . ,geometry)
2010 0 : (workarea . ,geometry)
2011 0 : (mm-size . (,(display-mm-width display)
2012 0 : ,(display-mm-height display)))
2013 0 : (frames . ,(frames-on-display-list display)))))))))
2014 :
2015 :
2016 : ;;;; Frame geometry values
2017 :
2018 : (defun frame-geom-value-cons (type value &optional frame)
2019 : "Return equivalent geometry value for FRAME as a cons with car `+'.
2020 : A geometry value equivalent to VALUE for FRAME is returned,
2021 : where the value is a cons with car `+', not numeric.
2022 : TYPE is the car of the original geometry spec (TYPE . VALUE).
2023 : It is `top' or `left', depending on which edge VALUE is related to.
2024 : VALUE is the cdr of a frame geometry spec: (left/top . VALUE).
2025 : If VALUE is a number, then it is converted to a cons value, perhaps
2026 : relative to the opposite frame edge from that in the original spec.
2027 : FRAME defaults to the selected frame.
2028 :
2029 : Examples (measures in pixels) -
2030 : Assuming display height/width=1024, frame height/width=600:
2031 : 300 inside display edge: 300 => (+ 300)
2032 : (+ 300) => (+ 300)
2033 : 300 inside opposite display edge: (- 300) => (+ 124)
2034 : -300 => (+ 124)
2035 : 300 beyond display edge
2036 : (= 724 inside opposite display edge): (+ -300) => (+ -300)
2037 : 300 beyond display edge
2038 : (= 724 inside opposite display edge): (- -300) => (+ 724)
2039 :
2040 : In the 3rd, 4th, and 6th examples, the returned value is relative to
2041 : the opposite frame edge from the edge indicated in the input spec."
2042 0 : (cond ((and (consp value) (eq '+ (car value))) ; e.g. (+ 300), (+ -300)
2043 0 : value)
2044 0 : ((natnump value) (list '+ value)) ; e.g. 300 => (+ 300)
2045 : (t ; e.g. -300, (- 300), (- -300)
2046 0 : (list '+ (- (if (eq 'left type) ; => (+ 124), (+ 124), (+ 724)
2047 0 : (x-display-pixel-width)
2048 0 : (x-display-pixel-height))
2049 0 : (if (integerp value) (- value) (cadr value))
2050 0 : (if (eq 'left type)
2051 0 : (frame-pixel-width frame)
2052 0 : (frame-pixel-height frame)))))))
2053 :
2054 : (defun frame-geom-spec-cons (spec &optional frame)
2055 : "Return equivalent geometry spec for FRAME as a cons with car `+'.
2056 : A geometry specification equivalent to SPEC for FRAME is returned,
2057 : where the value is a cons with car `+', not numeric.
2058 : SPEC is a frame geometry spec: (left . VALUE) or (top . VALUE).
2059 : If VALUE is a number, then it is converted to a cons value, perhaps
2060 : relative to the opposite frame edge from that in the original spec.
2061 : FRAME defaults to the selected frame.
2062 :
2063 : Examples (measures in pixels) -
2064 : Assuming display height=1024, frame height=600:
2065 : top 300 below display top: (top . 300) => (top + 300)
2066 : (top + 300) => (top + 300)
2067 : bottom 300 above display bottom: (top - 300) => (top + 124)
2068 : (top . -300) => (top + 124)
2069 : top 300 above display top
2070 : (= bottom 724 above display bottom): (top + -300) => (top + -300)
2071 : bottom 300 below display bottom
2072 : (= top 724 below display top): (top - -300) => (top + 724)
2073 :
2074 : In the 3rd, 4th, and 6th examples, the returned value is relative to
2075 : the opposite frame edge from the edge indicated in the input spec."
2076 0 : (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame)))
2077 :
2078 : (defun delete-other-frames (&optional frame)
2079 : "Delete all frames on FRAME's terminal, except FRAME.
2080 : If FRAME uses another frame's minibuffer, the minibuffer frame is
2081 : left untouched. Do not delete any of FRAME's child frames. If
2082 : FRAME is a child frame, delete its siblings only. FRAME must be
2083 : a live frame and defaults to the selected one."
2084 : (interactive)
2085 0 : (setq frame (window-normalize-frame frame))
2086 0 : (let ((minibuffer-frame (window-frame (minibuffer-window frame)))
2087 0 : (this (next-frame frame t))
2088 0 : (parent (frame-parent frame))
2089 : next)
2090 : ;; In a first round consider minibuffer-less frames only.
2091 0 : (while (not (eq this frame))
2092 0 : (setq next (next-frame this t))
2093 0 : (unless (or (eq (window-frame (minibuffer-window this)) this)
2094 : ;; When FRAME is a child frame, delete its siblings
2095 : ;; only.
2096 0 : (and parent (not (eq (frame-parent this) parent)))
2097 : ;; Do not delete a child frame of FRAME.
2098 0 : (eq (frame-parent this) frame))
2099 0 : (delete-frame this))
2100 0 : (setq this next))
2101 : ;; In a second round consider all remaining frames.
2102 0 : (setq this (next-frame frame t))
2103 0 : (while (not (eq this frame))
2104 0 : (setq next (next-frame this t))
2105 0 : (unless (or (eq this minibuffer-frame)
2106 : ;; When FRAME is a child frame, delete its siblings
2107 : ;; only.
2108 0 : (and parent (not (eq (frame-parent this) parent)))
2109 : ;; Do not delete a child frame of FRAME.
2110 0 : (eq (frame-parent this) frame))
2111 0 : (delete-frame this))
2112 0 : (setq this next))))
2113 :
2114 : ;; miscellaneous obsolescence declarations
2115 : (define-obsolete-variable-alias 'delete-frame-hook
2116 : 'delete-frame-functions "22.1")
2117 :
2118 :
2119 : ;;; Window dividers.
2120 : (defgroup window-divider nil
2121 : "Window dividers."
2122 : :version "25.1"
2123 : :group 'frames
2124 : :group 'windows)
2125 :
2126 : (defcustom window-divider-default-places 'right-only
2127 : "Default positions of window dividers.
2128 : Possible values are `bottom-only' (dividers on the bottom of each
2129 : window only), `right-only' (dividers on the right of each window
2130 : only), and t (dividers on the bottom and on the right of each
2131 : window). The default is `right-only'.
2132 :
2133 : The value takes effect if and only if dividers are enabled by
2134 : `window-divider-mode'.
2135 :
2136 : To position dividers on frames individually, use the frame
2137 : parameters `bottom-divider-width' and `right-divider-width'."
2138 : :type '(choice (const :tag "Bottom only" bottom-only)
2139 : (const :tag "Right only" right-only)
2140 : (const :tag "Bottom and right" t))
2141 : :initialize 'custom-initialize-default
2142 : :set (lambda (symbol value)
2143 : (set-default symbol value)
2144 : (when window-divider-mode
2145 : (window-divider-mode-apply t)))
2146 : :version "25.1")
2147 :
2148 : (defun window-divider-width-valid-p (value)
2149 : "Return non-nil if VALUE is a positive number."
2150 0 : (and (numberp value) (> value 0)))
2151 :
2152 : (defcustom window-divider-default-bottom-width 6
2153 : "Default width of dividers on bottom of windows.
2154 : The value must be a positive integer and takes effect when bottom
2155 : dividers are displayed by `window-divider-mode'.
2156 :
2157 : To adjust bottom dividers for frames individually, use the frame
2158 : parameter `bottom-divider-width'."
2159 : :type '(restricted-sexp
2160 : :tag "Default width of bottom dividers"
2161 : :match-alternatives (window-divider-width-valid-p))
2162 : :initialize 'custom-initialize-default
2163 : :set (lambda (symbol value)
2164 : (set-default symbol value)
2165 : (when window-divider-mode
2166 : (window-divider-mode-apply t)))
2167 : :version "25.1")
2168 :
2169 : (defcustom window-divider-default-right-width 6
2170 : "Default width of dividers on the right of windows.
2171 : The value must be a positive integer and takes effect when right
2172 : dividers are displayed by `window-divider-mode'.
2173 :
2174 : To adjust right dividers for frames individually, use the frame
2175 : parameter `right-divider-width'."
2176 : :type '(restricted-sexp
2177 : :tag "Default width of right dividers"
2178 : :match-alternatives (window-divider-width-valid-p))
2179 : :initialize 'custom-initialize-default
2180 : :set (lambda (symbol value)
2181 : (set-default symbol value)
2182 : (when window-divider-mode
2183 : (window-divider-mode-apply t)))
2184 : :version "25.1")
2185 :
2186 : (defun window-divider-mode-apply (enable)
2187 : "Apply window divider places and widths to all frames.
2188 : If ENABLE is nil, apply default places and widths. Else reset
2189 : all divider widths to zero."
2190 0 : (let ((bottom (if (and enable
2191 0 : (memq window-divider-default-places
2192 0 : '(bottom-only t)))
2193 0 : window-divider-default-bottom-width
2194 0 : 0))
2195 0 : (right (if (and enable
2196 0 : (memq window-divider-default-places
2197 0 : '(right-only t)))
2198 0 : window-divider-default-right-width
2199 0 : 0)))
2200 0 : (modify-all-frames-parameters
2201 0 : (list (cons 'bottom-divider-width bottom)
2202 0 : (cons 'right-divider-width right)))
2203 0 : (setq default-frame-alist
2204 0 : (assq-delete-all
2205 0 : 'bottom-divider-width default-frame-alist))
2206 0 : (setq default-frame-alist
2207 0 : (assq-delete-all
2208 0 : 'right-divider-width default-frame-alist))
2209 0 : (when (> bottom 0)
2210 0 : (setq default-frame-alist
2211 0 : (cons
2212 0 : (cons 'bottom-divider-width bottom)
2213 0 : default-frame-alist)))
2214 0 : (when (> right 0)
2215 0 : (setq default-frame-alist
2216 0 : (cons
2217 0 : (cons 'right-divider-width right)
2218 0 : default-frame-alist)))))
2219 :
2220 : (define-minor-mode window-divider-mode
2221 : "Display dividers between windows (Window Divider mode).
2222 : With a prefix argument ARG, enable Window Divider mode if ARG is
2223 : positive, and disable it otherwise. If called from Lisp, enable
2224 : the mode if ARG is omitted or nil.
2225 :
2226 : The option `window-divider-default-places' specifies on which
2227 : side of a window dividers are displayed. The options
2228 : `window-divider-default-bottom-width' and
2229 : `window-divider-default-right-width' specify their respective
2230 : widths."
2231 : :group 'window-divider
2232 : :global t
2233 0 : (window-divider-mode-apply window-divider-mode))
2234 :
2235 : ;; Blinking cursor
2236 :
2237 : (defvar blink-cursor-idle-timer nil
2238 : "Timer started after `blink-cursor-delay' seconds of Emacs idle time.
2239 : The function `blink-cursor-start' is called when the timer fires.")
2240 :
2241 : (defvar blink-cursor-timer nil
2242 : "Timer started from `blink-cursor-start'.
2243 : This timer calls `blink-cursor-timer-function' every
2244 : `blink-cursor-interval' seconds.")
2245 :
2246 : (defgroup cursor nil
2247 : "Displaying text cursors."
2248 : :version "21.1"
2249 : :group 'frames)
2250 :
2251 : (defcustom blink-cursor-delay 0.5
2252 : "Seconds of idle time before the first blink of the cursor.
2253 : Values smaller than 0.2 sec are treated as 0.2 sec."
2254 : :type 'number
2255 : :group 'cursor
2256 : :set (lambda (symbol value)
2257 : (set-default symbol value)
2258 : (when blink-cursor-idle-timer (blink-cursor--start-idle-timer))))
2259 :
2260 : (defcustom blink-cursor-interval 0.5
2261 : "Length of cursor blink interval in seconds."
2262 : :type 'number
2263 : :group 'cursor
2264 : :set (lambda (symbol value)
2265 : (set-default symbol value)
2266 : (when blink-cursor-timer (blink-cursor--start-timer))))
2267 :
2268 : (defcustom blink-cursor-blinks 10
2269 : "How many times to blink before using a solid cursor on NS, X, and MS-Windows.
2270 : Use 0 or negative value to blink forever."
2271 : :version "24.4"
2272 : :type 'integer
2273 : :group 'cursor)
2274 :
2275 : (defvar blink-cursor-blinks-done 1
2276 : "Number of blinks done since we started blinking on NS, X, and MS-Windows.")
2277 :
2278 : (defun blink-cursor--start-idle-timer ()
2279 : "Start the `blink-cursor-idle-timer'."
2280 0 : (when blink-cursor-idle-timer (cancel-timer blink-cursor-idle-timer))
2281 0 : (setq blink-cursor-idle-timer
2282 : ;; The 0.2 sec limitation from below is to avoid erratic
2283 : ;; behavior (or downright failure to display the cursor
2284 : ;; during command execution) if they set blink-cursor-delay
2285 : ;; to a very small or even zero value.
2286 0 : (run-with-idle-timer (max 0.2 blink-cursor-delay)
2287 0 : :repeat #'blink-cursor-start)))
2288 :
2289 : (defun blink-cursor--start-timer ()
2290 : "Start the `blink-cursor-timer'."
2291 0 : (when blink-cursor-timer (cancel-timer blink-cursor-timer))
2292 0 : (setq blink-cursor-timer
2293 0 : (run-with-timer blink-cursor-interval blink-cursor-interval
2294 0 : #'blink-cursor-timer-function)))
2295 :
2296 : (defun blink-cursor-start ()
2297 : "Timer function called from the timer `blink-cursor-idle-timer'.
2298 : This starts the timer `blink-cursor-timer', which makes the cursor blink
2299 : if appropriate. It also arranges to cancel that timer when the next
2300 : command starts, by installing a pre-command hook."
2301 0 : (when (null blink-cursor-timer)
2302 : ;; Set up the timer first, so that if this signals an error,
2303 : ;; blink-cursor-end is not added to pre-command-hook.
2304 0 : (setq blink-cursor-blinks-done 1)
2305 0 : (blink-cursor--start-timer)
2306 0 : (add-hook 'pre-command-hook 'blink-cursor-end)
2307 0 : (internal-show-cursor nil nil)))
2308 :
2309 : (defun blink-cursor-timer-function ()
2310 : "Timer function of timer `blink-cursor-timer'."
2311 0 : (internal-show-cursor nil (not (internal-show-cursor-p)))
2312 : ;; Suspend counting blinks when the w32 menu-bar menu is displayed,
2313 : ;; since otherwise menu tooltips will behave erratically.
2314 0 : (or (and (fboundp 'w32--menu-bar-in-use)
2315 0 : (w32--menu-bar-in-use))
2316 0 : (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done)))
2317 : ;; Each blink is two calls to this function.
2318 0 : (when (and (> blink-cursor-blinks 0)
2319 0 : (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
2320 0 : (blink-cursor-suspend)
2321 0 : (add-hook 'post-command-hook 'blink-cursor-check)))
2322 :
2323 :
2324 : (defun blink-cursor-end ()
2325 : "Stop cursor blinking.
2326 : This is installed as a pre-command hook by `blink-cursor-start'.
2327 : When run, it cancels the timer `blink-cursor-timer' and removes
2328 : itself as a pre-command hook."
2329 0 : (remove-hook 'pre-command-hook 'blink-cursor-end)
2330 0 : (internal-show-cursor nil t)
2331 0 : (when blink-cursor-timer
2332 0 : (cancel-timer blink-cursor-timer)
2333 0 : (setq blink-cursor-timer nil)))
2334 :
2335 : (defun blink-cursor-suspend ()
2336 : "Suspend cursor blinking.
2337 : This is called when no frame has focus and timers can be suspended.
2338 : Timers are restarted by `blink-cursor-check', which is called when a
2339 : frame receives focus."
2340 0 : (blink-cursor-end)
2341 0 : (when blink-cursor-idle-timer
2342 0 : (cancel-timer blink-cursor-idle-timer)
2343 0 : (setq blink-cursor-idle-timer nil)))
2344 :
2345 : (defun blink-cursor-check ()
2346 : "Check if cursor blinking shall be restarted.
2347 : This is done when a frame gets focus. Blink timers may be stopped by
2348 : `blink-cursor-suspend'."
2349 0 : (when (and blink-cursor-mode
2350 0 : (not blink-cursor-idle-timer))
2351 0 : (remove-hook 'post-command-hook 'blink-cursor-check)
2352 0 : (blink-cursor--start-idle-timer)))
2353 :
2354 : (define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1")
2355 :
2356 : (define-minor-mode blink-cursor-mode
2357 : "Toggle cursor blinking (Blink Cursor mode).
2358 : With a prefix argument ARG, enable Blink Cursor mode if ARG is
2359 : positive, and disable it otherwise. If called from Lisp, enable
2360 : the mode if ARG is omitted or nil.
2361 :
2362 : If the value of `blink-cursor-blinks' is positive (10 by default),
2363 : the cursor stops blinking after that number of blinks, if Emacs
2364 : gets no input during that time.
2365 :
2366 : See also `blink-cursor-interval' and `blink-cursor-delay'.
2367 :
2368 : This command is effective only on graphical frames. On text-only
2369 : terminals, cursor blinking is controlled by the terminal."
2370 : :init-value (not (or noninteractive
2371 : no-blinking-cursor
2372 : (eq system-type 'ms-dos)
2373 : (not (memq window-system '(x w32 ns)))))
2374 : :initialize 'custom-initialize-delay
2375 : :group 'cursor
2376 : :global t
2377 0 : (blink-cursor-suspend)
2378 0 : (remove-hook 'focus-in-hook #'blink-cursor-check)
2379 0 : (remove-hook 'focus-out-hook #'blink-cursor-suspend)
2380 0 : (when blink-cursor-mode
2381 0 : (add-hook 'focus-in-hook #'blink-cursor-check)
2382 0 : (add-hook 'focus-out-hook #'blink-cursor-suspend)
2383 0 : (blink-cursor--start-idle-timer)))
2384 :
2385 :
2386 :
2387 : ;; Frame maximization/fullscreen
2388 :
2389 : (defun toggle-frame-maximized ()
2390 : "Toggle maximization state of selected frame.
2391 : Maximize selected frame or un-maximize if it is already maximized.
2392 :
2393 : If the frame is in fullscreen state, don't change its state, but
2394 : set the frame's `fullscreen-restore' parameter to `maximized', so
2395 : the frame will be maximized after disabling fullscreen state.
2396 :
2397 : Note that with some window managers you may have to set
2398 : `frame-resize-pixelwise' to non-nil in order to make a frame
2399 : appear truly maximized. In addition, you may have to set
2400 : `x-frame-normalize-before-maximize' in order to enable
2401 : transitions from one fullscreen state to another.
2402 :
2403 : See also `toggle-frame-fullscreen'."
2404 : (interactive)
2405 0 : (let ((fullscreen (frame-parameter nil 'fullscreen)))
2406 0 : (cond
2407 0 : ((memq fullscreen '(fullscreen fullboth))
2408 0 : (set-frame-parameter nil 'fullscreen-restore 'maximized))
2409 0 : ((eq fullscreen 'maximized)
2410 0 : (set-frame-parameter nil 'fullscreen nil))
2411 : (t
2412 0 : (set-frame-parameter nil 'fullscreen 'maximized)))))
2413 :
2414 : (defun toggle-frame-fullscreen ()
2415 : "Toggle fullscreen state of selected frame.
2416 : Make selected frame fullscreen or restore its previous size if it
2417 : is already fullscreen.
2418 :
2419 : Before making the frame fullscreen remember the current value of
2420 : the frame's `fullscreen' parameter in the `fullscreen-restore'
2421 : parameter of the frame. That value is used to restore the
2422 : frame's fullscreen state when toggling fullscreen the next time.
2423 :
2424 : Note that with some window managers you may have to set
2425 : `frame-resize-pixelwise' to non-nil in order to make a frame
2426 : appear truly fullscreen. In addition, you may have to set
2427 : `x-frame-normalize-before-maximize' in order to enable
2428 : transitions from one fullscreen state to another.
2429 :
2430 : See also `toggle-frame-maximized'."
2431 : (interactive)
2432 0 : (let ((fullscreen (frame-parameter nil 'fullscreen)))
2433 0 : (if (memq fullscreen '(fullscreen fullboth))
2434 0 : (let ((fullscreen-restore (frame-parameter nil 'fullscreen-restore)))
2435 0 : (if (memq fullscreen-restore '(maximized fullheight fullwidth))
2436 0 : (set-frame-parameter nil 'fullscreen fullscreen-restore)
2437 0 : (set-frame-parameter nil 'fullscreen nil)))
2438 0 : (modify-frame-parameters
2439 0 : nil `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))))
2440 :
2441 : ;;;; Key bindings
2442 :
2443 : (define-key ctl-x-5-map "2" 'make-frame-command)
2444 : (define-key ctl-x-5-map "1" 'delete-other-frames)
2445 : (define-key ctl-x-5-map "0" 'delete-frame)
2446 : (define-key ctl-x-5-map "o" 'other-frame)
2447 : (define-key global-map [f11] 'toggle-frame-fullscreen)
2448 : (define-key global-map [(meta f10)] 'toggle-frame-maximized)
2449 : (define-key esc-map [f10] 'toggle-frame-maximized)
2450 :
2451 :
2452 : ;; Misc.
2453 :
2454 : ;; Only marked as obsolete in 24.3.
2455 : (define-obsolete-variable-alias 'automatic-hscrolling
2456 : 'auto-hscroll-mode "22.1")
2457 :
2458 : (make-variable-buffer-local 'show-trailing-whitespace)
2459 :
2460 : ;; Defined in dispnew.c.
2461 : (make-obsolete-variable
2462 : 'window-system-version "it does not give useful information." "24.3")
2463 :
2464 : ;; Variables whose change of value should trigger redisplay of the
2465 : ;; current buffer.
2466 : ;; To test whether a given variable needs to be added to this list,
2467 : ;; write a simple interactive function that changes the variable's
2468 : ;; value and bind that function to a simple key, like F5. If typing
2469 : ;; F5 then produces the correct effect, the variable doesn't need
2470 : ;; to be in this list; otherwise, it does.
2471 : (mapc (lambda (var)
2472 : (add-variable-watcher var (symbol-function 'set-buffer-redisplay)))
2473 : '(line-spacing
2474 : overline-margin
2475 : line-prefix
2476 : wrap-prefix
2477 : truncate-lines
2478 : display-line-numbers
2479 : display-line-numbers-width
2480 : display-line-numbers-current-absolute
2481 : display-line-numbers-widen
2482 : bidi-paragraph-direction
2483 : bidi-display-reordering))
2484 :
2485 : (provide 'frame)
2486 :
2487 : ;;; frame.el ends here
|