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