]> code.delx.au - gnu-emacs/blob - lisp/frame.el
(make-frame-command): Treat msdos like no window system.
[gnu-emacs] / lisp / frame.el
1 ;;; frame.el --- multi-frame management independent of window systems.
2
3 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
4
5 ;; Maintainer: FSF
6 ;; Keywords: internal
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Code:
26
27 (defvar frame-creation-function nil
28 "Window-system dependent function to call to create a new frame.
29 The window system startup file should set this to its frame creation
30 function, which should take an alist of parameters as its argument.")
31
32 ;;; The initial value given here for this must ask for a minibuffer.
33 ;;; There must always exist a frame with a minibuffer, and after we
34 ;;; delete the terminal frame, this will be the only frame.
35 (defvar initial-frame-alist '((minibuffer . t))
36 "Alist of frame parameters for creating the initial X window frame.
37 You can set this in your `.emacs' file; for example,
38 (setq initial-frame-alist '((top . 1) (left . 1) (width . 80) (height . 55)))
39 Parameters specified here supersede the values given in `default-frame-alist'.
40
41 If the value calls for a frame without a minibuffer, and you have not created
42 a minibuffer frame on your own, one is created according to
43 `minibuffer-frame-alist'.
44
45 You can specify geometry-related options for just the initial frame
46 by setting this variable in your `.emacs' file; however, they won't
47 take effect until Emacs reads `.emacs', which happens after first creating
48 the frame. If you want the frame to have the proper geometry as soon
49 as it appears, you need to use this three-step process:
50 * Specify X resources to give the geometry you want.
51 * Set `default-frame-alist' to override these options so that they
52 don't affect subsequent frames.
53 * Set `initial-frame-alist' in a way that matches the X resources,
54 to override what you put in `default-frame-alist'.")
55
56 (defvar minibuffer-frame-alist '((width . 80) (height . 2))
57 "Alist of frame parameters for initially creating a minibuffer frame.
58 You can set this in your `.emacs' file; for example,
59 (setq minibuffer-frame-alist
60 '((top . 1) (left . 1) (width . 80) (height . 2)))
61 Parameters specified here supersede the values given in
62 `default-frame-alist'.")
63
64 (defvar pop-up-frame-alist nil
65 "Alist of frame parameters used when creating pop-up frames.
66 Pop-up frames are used for completions, help, and the like.
67 This variable can be set in your init file, like this:
68 (setq pop-up-frame-alist '((width . 80) (height . 20)))
69 These supersede the values given in `default-frame-alist'.")
70
71 (setq pop-up-frame-function
72 (function (lambda ()
73 (make-frame pop-up-frame-alist))))
74
75 (defvar special-display-frame-alist
76 '((height . 14) (width . 80) (unsplittable . t))
77 "*Alist of frame parameters used when creating special frames.
78 Special frames are used for buffers whose names are in
79 `special-display-buffer-names' and for buffers whose names match
80 one of the regular expressions in `special-display-regexps'.
81 This variable can be set in your init file, like this:
82 (setq special-display-frame-alist '((width . 80) (height . 20)))
83 These supersede the values given in `default-frame-alist'.")
84
85 ;; Display BUFFER in its own frame, reusing an existing window if any.
86 ;; Return the window chosen.
87 ;; Currently we do not insist on selecting the window within its frame.
88 ;; If ARGS is an alist, use it as a list of frame parameter specs.
89 ;; If ARGS is a list whose car is a symbol,
90 ;; use (car ARGS) as a function to do the work.
91 ;; Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args.
92 (defun special-display-popup-frame (buffer &optional args)
93 (if (and args (symbolp (car args)))
94 (apply (car args) buffer (cdr args))
95 (let ((window (get-buffer-window buffer t)))
96 (if window
97 ;; If we have a window already, make it visible.
98 (let ((frame (window-frame window)))
99 (make-frame-visible frame)
100 (raise-frame frame)
101 window)
102 ;; If no window yet, make one in a new frame.
103 (let ((frame (make-frame (append args special-display-frame-alist))))
104 (set-window-buffer (frame-selected-window frame) buffer)
105 (set-window-dedicated-p (frame-selected-window frame) t)
106 (frame-selected-window frame))))))
107
108 ;; Handle delete-frame events from the X server.
109 (defun handle-delete-frame (event)
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
154 ;; Are we actually running under a window system at all?
155 (if (and window-system (not noninteractive))
156 (progn
157 ;; Turn on special-display processing only if there's a window system.
158 (setq special-display-function 'special-display-popup-frame)
159
160 ;; If there is no frame with a minibuffer besides the terminal
161 ;; frame, then we need to create the opening frame. Make sure
162 ;; it has a minibuffer, but let initial-frame-alist omit the
163 ;; minibuffer spec.
164 (or (delq terminal-frame (minibuffer-frame-list))
165 (progn
166 (setq frame-initial-frame-alist
167 (append initial-frame-alist default-frame-alist))
168 ;; Record these with their default values
169 ;; if they don't have any values explicitly.
170 (or (assq 'vertical-scroll-bars frame-initial-frame-alist)
171 (setq frame-initial-frame-alist
172 (cons '(vertical-scroll-bars . t)
173 frame-initial-frame-alist)))
174 (or (assq 'horizontal-scroll-bars frame-initial-frame-alist)
175 (setq frame-initial-frame-alist
176 (cons '(horizontal-scroll-bars . t)
177 frame-initial-frame-alist)))
178 (setq default-minibuffer-frame
179 (setq frame-initial-frame
180 (make-frame initial-frame-alist)))
181 ;; Delete any specifications for window geometry parameters
182 ;; so that we won't reapply them in frame-notice-user-settings.
183 ;; It would be wrong to reapply them then,
184 ;; because that would override explicit user resizing.
185 (setq initial-frame-alist
186 (frame-remove-geometry-params initial-frame-alist))))
187 ;; At this point, we know that we have a frame open, so we
188 ;; can delete the terminal frame.
189 (delete-frame terminal-frame)
190 (setq terminal-frame nil))
191
192 ;; No, we're not running a window system. Use make-terminal-frame if
193 ;; we support that feature, otherwise arrange to cause errors.
194 (setq frame-creation-function
195 (if (fboundp 'make-terminal-frame)
196 'make-terminal-frame
197 (function
198 (lambda (parameters)
199 (error
200 "Can't create multiple frames without a window system")))))))
201
202 ;;; startup.el calls this function after loading the user's init
203 ;;; file. Now default-frame-alist and initial-frame-alist contain
204 ;;; information to which we must react; do what needs to be done.
205 (defun frame-notice-user-settings ()
206
207 ;; Make menu-bar-mode and default-frame-alist consistent.
208 (if (boundp 'menu-bar-mode)
209 (let ((default (assq 'menu-bar-lines default-frame-alist)))
210 (if default
211 (setq menu-bar-mode (not (eq (cdr default) 0)))
212 (setq default-frame-alist
213 (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
214 default-frame-alist)))))
215
216 ;; Creating and deleting frames may shift the selected frame around,
217 ;; and thus the current buffer. Protect against that. We don't
218 ;; want to use save-excursion here, because that may also try to set
219 ;; the buffer of the selected window, which fails when the selected
220 ;; window is the minibuffer.
221 (let ((old-buffer (current-buffer)))
222
223 ;; If the initial frame is still around, apply initial-frame-alist
224 ;; and default-frame-alist to it.
225 (if (frame-live-p frame-initial-frame)
226
227 ;; The initial frame we create above always has a minibuffer.
228 ;; If the user wants to remove it, or make it a minibuffer-only
229 ;; frame, then we'll have to delete the current frame and make a
230 ;; new one; you can't remove or add a root window to/from an
231 ;; existing frame.
232 ;;
233 ;; NOTE: default-frame-alist was nil when we created the
234 ;; existing frame. We need to explicitly include
235 ;; default-frame-alist in the parameters of the screen we
236 ;; create here, so that its new value, gleaned from the user's
237 ;; .emacs file, will be applied to the existing screen.
238 (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
239 (assq 'minibuffer default-frame-alist)
240 '(minibuffer . t)))
241 t))
242 ;; Create the new frame.
243 (let (parms new)
244 ;; If the frame isn't visible yet, wait till it is.
245 ;; If the user has to position the window,
246 ;; Emacs doesn't know its real position until
247 ;; the frame is seen to be visible.
248 (while (not (cdr (assq 'visibility
249 (frame-parameters frame-initial-frame))))
250 (sleep-for 1))
251 (setq parms (frame-parameters frame-initial-frame))
252 ;; Get rid of `name' unless it was specified explicitly before.
253 (or (assq 'name frame-initial-frame-alist)
254 (setq parms (delq (assq 'name parms) parms)))
255 (setq parms (append initial-frame-alist
256 default-frame-alist
257 parms
258 nil))
259 ;; Get rid of `reverse', because that was handled
260 ;; when we first made the frame.
261 (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms)))
262 (if (assq 'height frame-initial-geometry-arguments)
263 (setq parms (frame-delete-all 'height parms)))
264 (if (assq 'width frame-initial-geometry-arguments)
265 (setq parms (frame-delete-all 'width parms)))
266 (if (assq 'left frame-initial-geometry-arguments)
267 (setq parms (frame-delete-all 'left parms)))
268 (if (assq 'top frame-initial-geometry-arguments)
269 (setq parms (frame-delete-all 'top parms)))
270 (setq new
271 (make-frame
272 ;; Use the geometry args that created the existing
273 ;; frame, rather than the parms we get for it.
274 (append frame-initial-geometry-arguments
275 '((user-size . t) (user-position . t))
276 parms)))
277 ;; The initial frame, which we are about to delete, may be
278 ;; the only frame with a minibuffer. If it is, create a
279 ;; new one.
280 (or (delq frame-initial-frame (minibuffer-frame-list))
281 (make-initial-minibuffer-frame nil))
282
283 ;; If the initial frame is serving as a surrogate
284 ;; minibuffer frame for any frames, we need to wean them
285 ;; onto a new frame. The default-minibuffer-frame
286 ;; variable must be handled similarly.
287 (let ((users-of-initial
288 (filtered-frame-list
289 (function (lambda (frame)
290 (and (not (eq frame frame-initial-frame))
291 (eq (window-frame
292 (minibuffer-window frame))
293 frame-initial-frame)))))))
294 (if (or users-of-initial
295 (eq default-minibuffer-frame frame-initial-frame))
296
297 ;; Choose an appropriate frame. Prefer frames which
298 ;; are only minibuffers.
299 (let* ((new-surrogate
300 (car
301 (or (filtered-frame-list
302 (function
303 (lambda (frame)
304 (eq (cdr (assq 'minibuffer
305 (frame-parameters frame)))
306 'only))))
307 (minibuffer-frame-list))))
308 (new-minibuffer (minibuffer-window new-surrogate)))
309
310 (if (eq default-minibuffer-frame frame-initial-frame)
311 (setq default-minibuffer-frame new-surrogate))
312
313 ;; Wean the frames using frame-initial-frame as
314 ;; their minibuffer frame.
315 (mapcar
316 (function
317 (lambda (frame)
318 (modify-frame-parameters
319 frame (list (cons 'minibuffer new-minibuffer)))))
320 users-of-initial))))
321
322 ;; Redirect events enqueued at this frame to the new frame.
323 ;; Is this a good idea?
324 (redirect-frame-focus frame-initial-frame new)
325
326 ;; Finally, get rid of the old frame.
327 (delete-frame frame-initial-frame t))
328
329 ;; Otherwise, we don't need all that rigamarole; just apply
330 ;; the new parameters.
331 (let (newparms allparms tail)
332 (setq allparms (append initial-frame-alist
333 default-frame-alist))
334 (if (assq 'height frame-initial-geometry-arguments)
335 (setq allparms (frame-delete-all 'height allparms)))
336 (if (assq 'width frame-initial-geometry-arguments)
337 (setq allparms (frame-delete-all 'width allparms)))
338 (if (assq 'left frame-initial-geometry-arguments)
339 (setq allparms (frame-delete-all 'left allparms)))
340 (if (assq 'top frame-initial-geometry-arguments)
341 (setq allparms (frame-delete-all 'top allparms)))
342 (setq tail allparms)
343 ;; Find just the parms that have changed since we first
344 ;; made this frame. Those are the ones actually set by
345 ;; the init file. For those parms whose values we already knew
346 ;; (such as those spec'd by command line options)
347 ;; it is undesirable to specify the parm again
348 ;; once the user has seen the frame and been able to alter it
349 ;; manually.
350 (while tail
351 (let (newval oldval)
352 (setq oldval (assq (car (car tail))
353 frame-initial-frame-alist))
354 (setq newval (cdr (assq (car (car tail)) allparms)))
355 (or (and oldval (eq (cdr oldval) newval))
356 (setq newparms
357 (cons (cons (car (car tail)) newval) newparms))))
358 (setq tail (cdr tail)))
359 (setq newparms (nreverse newparms))
360 (modify-frame-parameters frame-initial-frame
361 newparms)
362 (if (assq 'font newparms)
363 (frame-update-faces frame-initial-frame)))))
364
365 ;; Restore the original buffer.
366 (set-buffer old-buffer)
367
368 ;; Make sure the initial frame can be GC'd if it is ever deleted.
369 ;; Make sure frame-notice-user-settings does nothing if called twice.
370 (setq frame-initial-frame nil)))
371
372 (defun make-initial-minibuffer-frame (display)
373 (let ((parms (append minibuffer-frame-alist '((minibuffer . only)))))
374 (if display
375 (make-frame-on-display display parms)
376 (make-frame parms))))
377
378 ;; Delete from ALIST all elements whose car is KEY.
379 ;; Return the modified alist.
380 (defun frame-delete-all (key alist)
381 (setq alist (copy-sequence alist))
382 (let ((tail alist))
383 (while tail
384 (if (eq (car (car tail)) key)
385 (setq alist (delq (car tail) alist)))
386 (setq tail (cdr tail)))
387 alist))
388 \f
389 ;;;; Creation of additional frames, and other frame miscellanea
390
391 ;;; Return some frame other than the current frame, creating one if
392 ;;; necessary. Note that the minibuffer frame, if separate, is not
393 ;;; considered (see next-frame).
394 (defun get-other-frame ()
395 (let ((s (if (equal (next-frame (selected-frame)) (selected-frame))
396 (make-frame)
397 (next-frame (selected-frame)))))
398 s))
399
400 (defun next-multiframe-window ()
401 "Select the next window, regardless of which frame it is on."
402 (interactive)
403 (select-window (next-window (selected-window)
404 (> (minibuffer-depth) 0)
405 t)))
406
407 (defun previous-multiframe-window ()
408 "Select the previous window, regardless of which frame it is on."
409 (interactive)
410 (select-window (previous-window (selected-window)
411 (> (minibuffer-depth) 0)
412 t)))
413
414 (defun make-frame-on-display (display &optional parameters)
415 "Make a frame on display DISPLAY.
416 The optional second argument PARAMETERS specifies additional frame parameters."
417 (interactive "sMake frame on display: ")
418 (make-frame (cons (cons 'display display) parameters)))
419
420 (defun make-frame-command ()
421 "Make a new frame, and select it if the terminal displays only one frame."
422 (interactive)
423 (if (and window-system (not (eq window-system 'pc)))
424 (make-frame)
425 (select-frame (make-frame))))
426
427 ;; Alias, kept temporarily.
428 (defalias 'new-frame 'make-frame)
429 (defun make-frame (&optional parameters)
430 "Create a new frame, displaying the current buffer.
431
432 Optional argument PARAMETERS is an alist of parameters for the new
433 frame. Specifically, PARAMETERS is a list of pairs, each having
434 the form (NAME . VALUE).
435
436 Here are some of the parameters allowed (not a complete list):
437
438 \(name . STRING) - The frame should be named STRING.
439
440 \(height . NUMBER) - The frame should be NUMBER text lines high. If
441 this parameter is present, the width parameter must also be
442 given.
443
444 \(width . NUMBER) - The frame should be NUMBER characters in width.
445 If this parameter is present, the height parameter must also
446 be given.
447
448 \(minibuffer . t) - the frame should have a minibuffer
449 \(minibuffer . nil) - the frame should have no minibuffer
450 \(minibuffer . only) - the frame should contain only a minibuffer
451 \(minibuffer . WINDOW) - the frame should use WINDOW as its minibuffer window."
452 (interactive)
453 (let ((nframe))
454 (run-hooks 'before-make-frame-hook)
455 (setq nframe (funcall frame-creation-function parameters))
456 (run-hooks 'after-make-frame-hook)
457 nframe))
458
459 (defun filtered-frame-list (predicate)
460 "Return a list of all live frames which satisfy PREDICATE."
461 (let ((frames (frame-list))
462 good-frames)
463 (while (consp frames)
464 (if (funcall predicate (car frames))
465 (setq good-frames (cons (car frames) good-frames)))
466 (setq frames (cdr frames)))
467 good-frames))
468
469 (defun minibuffer-frame-list ()
470 "Return a list of all frames with their own minibuffers."
471 (filtered-frame-list
472 (function (lambda (frame)
473 (eq frame (window-frame (minibuffer-window frame)))))))
474
475 (defun frame-remove-geometry-params (param-list)
476 "Return the parameter list PARAM-LIST, but with geometry specs removed.
477 This deletes all bindings in PARAM-LIST for `top', `left', `width',
478 `height', `user-size' and `user-position' parameters.
479 Emacs uses this to avoid overriding explicit moves and resizings from
480 the user during startup."
481 (setq param-list (cons nil param-list))
482 (let ((tail param-list))
483 (while (consp (cdr tail))
484 (if (and (consp (car (cdr tail)))
485 (memq (car (car (cdr tail)))
486 '(height width top left user-position user-size)))
487 (progn
488 (setq frame-initial-geometry-arguments
489 (cons (car (cdr tail)) frame-initial-geometry-arguments))
490 (setcdr tail (cdr (cdr tail))))
491 (setq tail (cdr tail)))))
492 (setq frame-initial-geometry-arguments
493 (nreverse frame-initial-geometry-arguments))
494 (cdr param-list))
495
496
497 (defun other-frame (arg)
498 "Select the ARG'th different visible frame, and raise it.
499 All frames are arranged in a cyclic order.
500 This command selects the frame ARG steps away in that order.
501 A negative ARG moves in the opposite order."
502 (interactive "p")
503 (let ((frame (selected-frame)))
504 (while (> arg 0)
505 (setq frame (next-frame frame))
506 (while (not (eq (frame-visible-p frame) t))
507 (setq frame (next-frame frame)))
508 (setq arg (1- arg)))
509 (while (< arg 0)
510 (setq frame (previous-frame frame))
511 (while (not (eq (frame-visible-p frame) t))
512 (setq frame (previous-frame frame)))
513 (setq arg (1+ arg)))
514 (raise-frame frame)
515 (select-frame frame)
516 (set-mouse-position (selected-frame) (1- (frame-width)) 0)
517 (if (fboundp 'unfocus-frame)
518 (unfocus-frame))))
519 \f
520 ;;;; Frame configurations
521
522 (defun current-frame-configuration ()
523 "Return a list describing the positions and states of all frames.
524 Its car is `frame-configuration'.
525 Each element of the cdr is a list of the form (FRAME ALIST WINDOW-CONFIG),
526 where
527 FRAME is a frame object,
528 ALIST is an association list specifying some of FRAME's parameters, and
529 WINDOW-CONFIG is a window configuration object for FRAME."
530 (cons 'frame-configuration
531 (mapcar (function
532 (lambda (frame)
533 (list frame
534 (frame-parameters frame)
535 (current-window-configuration frame))))
536 (frame-list))))
537
538 (defun set-frame-configuration (configuration &optional nodelete)
539 "Restore the frames to the state described by CONFIGURATION.
540 Each frame listed in CONFIGURATION has its position, size, window
541 configuration, and other parameters set as specified in CONFIGURATION.
542 Ordinarily, this function deletes all existing frames not
543 listed in CONFIGURATION. But if optional second argument NODELETE
544 is given and non-nil, the unwanted frames are iconified instead."
545 (or (frame-configuration-p configuration)
546 (signal 'wrong-type-argument
547 (list 'frame-configuration-p configuration)))
548 (let ((config-alist (cdr configuration))
549 frames-to-delete)
550 (mapcar (function
551 (lambda (frame)
552 (let ((parameters (assq frame config-alist)))
553 (if parameters
554 (progn
555 (modify-frame-parameters
556 frame
557 ;; Since we can't set a frame's minibuffer status,
558 ;; we might as well omit the parameter altogether.
559 (let* ((parms (nth 1 parameters))
560 (mini (assq 'minibuffer parms)))
561 (if mini (setq parms (delq mini parms)))
562 parms))
563 (set-window-configuration (nth 2 parameters)))
564 (setq frames-to-delete (cons frame frames-to-delete))))))
565 (frame-list))
566 (if nodelete
567 ;; Note: making frames invisible here was tried
568 ;; but led to some strange behavior--each time the frame
569 ;; was made visible again, the window manager asked afresh
570 ;; for where to put it.
571 (mapcar 'iconify-frame frames-to-delete)
572 (mapcar 'delete-frame frames-to-delete))))
573 \f
574 ;;;; Convenience functions for accessing and interactively changing
575 ;;;; frame parameters.
576
577 (defun frame-height (&optional frame)
578 "Return number of lines available for display on FRAME.
579 If FRAME is omitted, describe the currently selected frame."
580 (cdr (assq 'height (frame-parameters frame))))
581
582 (defun frame-width (&optional frame)
583 "Return number of columns available for display on FRAME.
584 If FRAME is omitted, describe the currently selected frame."
585 (cdr (assq 'width (frame-parameters frame))))
586
587 (defun set-default-font (font-name)
588 "Set the font of the selected frame to FONT.
589 When called interactively, prompt for the name of the font to use."
590 (interactive "sFont name: ")
591 (modify-frame-parameters (selected-frame)
592 (list (cons 'font font-name)))
593 ;; Update faces that want a bold or italic version of the default font.
594 (frame-update-faces (selected-frame)))
595
596 (defun set-background-color (color-name)
597 "Set the background color of the selected frame to COLOR.
598 When called interactively, prompt for the name of the color to use."
599 (interactive "sColor: ")
600 (modify-frame-parameters (selected-frame)
601 (list (cons 'background-color color-name)))
602 (frame-update-face-colors (selected-frame)))
603
604 (defun set-foreground-color (color-name)
605 "Set the foreground color of the selected frame to COLOR.
606 When called interactively, prompt for the name of the color to use."
607 (interactive "sColor: ")
608 (modify-frame-parameters (selected-frame)
609 (list (cons 'foreground-color color-name)))
610 (frame-update-face-colors (selected-frame)))
611
612 (defun set-cursor-color (color-name)
613 "Set the text cursor color of the selected frame to COLOR.
614 When called interactively, prompt for the name of the color to use."
615 (interactive "sColor: ")
616 (modify-frame-parameters (selected-frame)
617 (list (cons 'cursor-color color-name))))
618
619 (defun set-mouse-color (color-name)
620 "Set the color of the mouse pointer of the selected frame to COLOR.
621 When called interactively, prompt for the name of the color to use."
622 (interactive "sColor: ")
623 (modify-frame-parameters (selected-frame)
624 (list (cons 'mouse-color color-name))))
625
626 (defun set-border-color (color-name)
627 "Set the color of the border of the selected frame to COLOR.
628 When called interactively, prompt for the name of the color to use."
629 (interactive "sColor: ")
630 (modify-frame-parameters (selected-frame)
631 (list (cons 'border-color color-name))))
632
633 (defun auto-raise-mode (arg)
634 "Toggle whether or not the selected frame should auto-raise.
635 With arg, turn auto-raise mode on if and only if arg is positive.
636 Note that this controls Emacs's own auto-raise feature.
637 Some window managers allow you to enable auto-raise for certain windows.
638 You can use that for Emacs windows if you wish, but if you do,
639 that is beyond the control of Emacs and this command has no effect on it."
640 (interactive "P")
641 (if (null arg)
642 (setq arg
643 (if (cdr (assq 'auto-raise (frame-parameters (selected-frame))))
644 -1 1)))
645 (modify-frame-parameters (selected-frame)
646 (list (cons 'auto-raise (> arg 0)))))
647
648 (defun auto-lower-mode (arg)
649 "Toggle whether or not the selected frame should auto-lower.
650 With arg, turn auto-lower mode on if and only if arg is positive.
651 Note that this controls Emacs's own auto-lower feature.
652 Some window managers allow you to enable auto-lower for certain windows.
653 You can use that for Emacs windows if you wish, but if you do,
654 that is beyond the control of Emacs and this command has no effect on it."
655 (interactive "P")
656 (if (null arg)
657 (setq arg
658 (if (cdr (assq 'auto-lower (frame-parameters (selected-frame))))
659 -1 1)))
660 (modify-frame-parameters (selected-frame)
661 (list (cons 'auto-lower (> arg 0)))))
662
663 (defun toggle-scroll-bar (arg)
664 "Toggle whether or not the selected frame has vertical scroll bars.
665 With arg, turn vertical scroll bars on if and only if arg is positive."
666 (interactive "P")
667 (if (null arg)
668 (setq arg
669 (if (cdr (assq 'vertical-scroll-bars
670 (frame-parameters (selected-frame))))
671 -1 1)))
672 (modify-frame-parameters (selected-frame)
673 (list (cons 'vertical-scroll-bars (> arg 0)))))
674
675 (defun toggle-horizontal-scroll-bar (arg)
676 "Toggle whether or not the selected frame has horizontal scroll bars.
677 With arg, turn horizontal scroll bars on if and only if arg is positive.
678 Horizontal scroll bars aren't implemented yet."
679 (interactive "P")
680 (error "Horizontal scroll bars aren't implemented yet"))
681
682 \f
683 ;;;; Aliases for backward compatibility with Emacs 18.
684 (defalias 'screen-height 'frame-height)
685 (defalias 'screen-width 'frame-width)
686
687 (defun set-screen-width (cols &optional pretend)
688 "Obsolete function to change the size of the screen to COLS columns.\n\
689 Optional second arg non-nil means that redisplay should use COLS columns\n\
690 but that the idea of the actual width of the frame should not be changed.\n\
691 This function is provided only for compatibility with Emacs 18; new code\n\
692 should use `set-frame-width instead'."
693 (set-frame-width (selected-frame) cols pretend))
694
695 (defun set-screen-height (lines &optional pretend)
696 "Obsolete function to change the height of the screen to LINES lines.\n\
697 Optional second arg non-nil means that redisplay should use LINES lines\n\
698 but that the idea of the actual height of the screen should not be changed.\n\
699 This function is provided only for compatibility with Emacs 18; new code\n\
700 should use `set-frame-width' instead."
701 (set-frame-height (selected-frame) lines pretend))
702
703 (make-obsolete 'screen-height 'frame-height)
704 (make-obsolete 'screen-width 'frame-width)
705 (make-obsolete 'set-screen-width 'set-frame-width)
706 (make-obsolete 'set-screen-height 'set-frame-height)
707
708 \f
709 ;;;; Key bindings
710 (defvar ctl-x-5-map (make-sparse-keymap)
711 "Keymap for frame commands.")
712 (defalias 'ctl-x-5-prefix ctl-x-5-map)
713 (define-key ctl-x-map "5" 'ctl-x-5-prefix)
714
715 (define-key ctl-x-5-map "2" 'make-frame-command)
716 (define-key ctl-x-5-map "0" 'delete-frame)
717 (define-key ctl-x-5-map "o" 'other-frame)
718
719 (provide 'frame)
720
721 ;;; frame.el ends here