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