lisp/frame.el

   1 ;;; frame.el --- multi-frame management independent of window systems.
   2
   3 ;;;; Copyright (C) 1990, 1992, 1993 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
  22 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Code:
  25
  26 (defvar frame-creation-function nil
  27   "Window-system dependent function to call to create a new frame.
  28 The window system startup file should set this to its frame creation
  29 function, which should take an alist of parameters as its argument.")
  30
  31 ;;; The default value for this must ask for a minibuffer.  There must
  32 ;;; always exist a frame with a minibuffer, and after we delete the
  33 ;;; terminal frame, this will be the only frame.
  34 (defvar initial-frame-alist '((minibuffer . t))
  35   "Alist of values used when creating the initial emacs text frame.
  36 These may be set in your init file, like this:
  37  (setq initial-frame-alist '((top . 1) (left . 1) (width . 80) (height . 55)))
  38 These supercede the values given in frame-default-alist.")
  39
  40 (defvar minibuffer-frame-alist nil
  41   "Alist of values to apply to a minibuffer frame.
  42 These may be set in your init file, like this:
  43  (setq minibuffer-frame-alist
  44    '((top . 1) (left . 1) (width . 80) (height . 1)))
  45 These supercede the values given in default-frame-alist.")
  46
  47 (defvar pop-up-frame-alist nil
  48   "Alist of values used when creating pop-up frames.
  49 Pop-up frames are used for completions, help, and the like.
  50 This variable can be set in your init file, like this:
  51   (setq pop-up-frame-alist '((width . 80) (height . 20)))
  52 These supercede the values given in default-frame-alist.")
  53
  54 (setq pop-up-frame-function
  55       (function (lambda ()
  56                   (new-frame pop-up-frame-alist))))
  57
  58 \f
  59 ;;;; Arrangement of frames at startup
  60
  61 ;;; 1) Load the window system startup file from the lisp library and read the
  62 ;;; high-priority arguments (-q and the like).  The window system startup
  63 ;;; file should create any frames specified in the window system defaults.
  64 ;;;
  65 ;;; 2) If no frames have been opened, we open an initial text frame.
  66 ;;;
  67 ;;; 3) Once the init file is done, we apply any newly set parameters
  68 ;;; in initial-frame-alist to the frame.
  69
  70 (add-hook 'before-init-hook 'frame-initialize)
  71 (add-hook 'window-setup-hook 'frame-notice-user-settings)
  72
  73 ;;; If we create the initial frame, this is it.
  74 (defvar frame-initial-frame nil)
  75
  76 ;;; startup.el calls this function before loading the user's init
  77 ;;; file - if there is no frame with a minibuffer open now, create
  78 ;;; one to display messages while loading the init file.
  79 (defun frame-initialize ()
  80
  81   ;; Are we actually running under a window system at all?
  82   (if (and window-system (not noninteractive))
  83       (let ((frames (frame-list)))
  84
  85         ;; Look for a frame that has a minibuffer.
  86         (while (and frames
  87                     (or (eq (car frames) terminal-frame)
  88                         (not (cdr (assq 'minibuffer
  89                                         (frame-parameters
  90                                          (car frames)))))))
  91           (setq frames (cdr frames)))
  92
  93         ;; If there was none, then we need to create the opening frame.
  94         (or frames
  95             (setq default-minibuffer-frame
  96                   (setq frame-initial-frame
  97                         (new-frame initial-frame-alist))))
  98
  99         ;; At this point, we know that we have a frame open, so we
 100         ;; can delete the terminal frame.
 101         (delete-frame terminal-frame)
 102         (setq terminal-frame nil))
 103
 104     ;; No, we're not running a window system.  Arrange to cause errors.
 105     (setq frame-creation-function
 106           (function
 107            (lambda (parameters)
 108              (error
 109               "Can't create multiple frames without a window system."))))))
 110
 111 ;;; startup.el calls this function after loading the user's init file.
 112 ;;; If we created a minibuffer before knowing if we had permission, we
 113 ;;; need to see if it should go away or change.  Create a text frame
 114 ;;; here.
 115 (defun frame-notice-user-settings ()
 116   (if (frame-live-p frame-initial-frame)
 117       (progn
 118         ;; If the user wants a minibuffer-only frame, we'll have to
 119         ;; make a new one; you can't remove or add a root window to/from
 120         ;; an existing frame.
 121         ;; NOTE: default-frame-alist was nil when we created the
 122         ;; existing frame.  We need to explicitly include
 123         ;; default-frame-alist in the parameters of the screen we
 124         ;; create here, so that its new value, gleaned from the user's
 125         ;; .emacs file, will be applied to the existing screen.
 126         (if (eq (cdr (or (assq 'minibuffer initial-frame-alist)
 127                          '(minibuffer . t)))
 128                      'only)
 129             (progn
 130               (setq default-minibuffer-frame
 131                     (new-frame
 132                      (append initial-frame-alist
 133                              default-frame-alist
 134                              (frame-parameters frame-initial-frame))))
 135
 136               ;; Redirect events enqueued at this frame to the new frame.
 137               ;; Is this a good idea?
 138               (redirect-frame-focus frame-initial-frame
 139                                     default-minibuffer-frame)
 140
 141               (delete-frame frame-initial-frame))
 142           (modify-frame-parameters frame-initial-frame
 143                                    (append initial-frame-alist
 144                                            default-frame-alist)))))
 145
 146   ;; Make sure the initial frame can be GC'd if it is ever deleted.
 147   (makunbound 'frame-initial-frame))
 148
 149 \f
 150 ;;;; Creation of additional frames
 151
 152 ;;; Return some frame other than the current frame,
 153 ;;; creating one if neccessary.  Note that the minibuffer frame, if
 154 ;;; separate, is not considered (see next-frame).
 155 (defun get-other-frame ()
 156   (let ((s (if (equal (next-frame (selected-frame)) (selected-frame))
 157                (new-frame)
 158              (next-frame (selected-frame)))))
 159     s))
 160
 161 (defun next-multiframe-window ()
 162   "Select the next window, regardless of which frame it is on."
 163   (interactive)
 164   (select-window (next-window (selected-window)
 165                               (> (minibuffer-depth) 0)
 166                               t)))
 167
 168 (defun previous-multiframe-window ()
 169   "Select the previous window, regardless of which frame it is on."
 170   (interactive)
 171   (select-window (previous-window (selected-window)
 172                                   (> (minibuffer-depth) 0)
 173                                   t)))
 174
 175 (defun new-frame (&optional parameters)
 176   "Create a new frame, displaying the current buffer.
 177
 178 Optional argument PARAMETERS is an alist of parameters for the new
 179 frame.  Specifically, PARAMETERS is a list of pairs, each having one
 180 of the following forms:
 181
 182 (name . STRING) - The frame should be named STRING.
 183
 184 (height . NUMBER) - The frame should be NUMBER text lines high.  If
 185         this parameter is present, the width parameter must also be
 186         given.
 187
 188 (width . NUMBER) - The frame should be NUMBER characters in width.
 189         If this parameter is present, the height parameter must also
 190         be given.
 191
 192 (minibuffer . t) - the frame should have a minibuffer
 193 (minibuffer . none) - the frame should have no minibuffer
 194 (minibuffer . only) - the frame should contain only a minibuffer
 195 (minibuffer . WINDOW) - the frame should use WINDOW as its minibuffer window.
 196
 197 (NAME . VALUE), specifying the parameter and the value it should have.
 198 NAME should be one of the following symbols:
 199   name          VALUE
 200
 201 The documentation for the function x-create-frame describes
 202 additional frame parameters that Emacs will recognize when running
 203 under the X Window System."
 204   (interactive)
 205   (funcall frame-creation-function parameters))
 206
 207 \f
 208 ;;;; Frame configurations
 209
 210 (defun current-frame-configuration ()
 211   "Return a list describing the positions and states of all frames.
 212 Each element is a list of the form (FRAME ALIST WINDOW-CONFIG), where
 213 FRAME is a frame object, ALIST is an association list specifying
 214 some of FRAME's parameters, and WINDOW-CONFIG is a window
 215 configuration object for FRAME."
 216   (mapcar (function
 217            (lambda (frame)
 218              (list frame
 219                    (frame-parameters frame)
 220                    (current-window-configuration frame))))
 221           (frame-list)))
 222
 223 (defun set-frame-configuration (configuration)
 224   "Restore the frames to the state described by CONFIGURATION.
 225 Each frame listed in CONFIGURATION has its position, size, window
 226 configuration, and other parameters set as specified in CONFIGURATION."
 227   (let (frames-to-delete)
 228     (mapcar (function
 229              (lambda (frame)
 230                (let ((parameters (assq frame configuration)))
 231                  (if parameters
 232                      (progn
 233                        (modify-frame-parameters frame (nth 1 parameters))
 234                        (set-window-configuration (nth 2 parameters)))
 235                    (setq frames-to-delete (cons frame frames-to-delete))))))
 236             (frame-list))
 237     (mapcar 'delete-frame frames-to-delete)))
 238
 239 \f
 240 ;;;; Convenience functions for accessing and interactively changing
 241 ;;;; frame parameters.
 242
 243 (defun frame-height (&optional frame)
 244   "Return number of lines available for display on FRAME.
 245 If FRAME is omitted, describe the currently selected frame."
 246   (cdr (assq 'height (frame-parameters frame))))
 247
 248 (defun frame-width (&optional frame)
 249   "Return number of columns available for display on FRAME.
 250 If FRAME is omitted, describe the currently selected frame."
 251   (cdr (assq 'width (frame-parameters frame))))
 252
 253 (defun set-default-font (font-name)
 254   (interactive "sFont name: ")
 255   (modify-frame-parameters (selected-frame)
 256                             (list (cons 'font font-name))))
 257
 258 (defun set-frame-background (color-name)
 259   (interactive "sColor: ")
 260   (modify-frame-parameters (selected-frame)
 261                             (list (cons 'background-color color-name))))
 262
 263 (defun set-frame-foreground (color-name)
 264   (interactive "sColor: ")
 265   (modify-frame-parameters (selected-frame)
 266                             (list (cons 'foreground-color color-name))))
 267
 268 (defun set-cursor-color (color-name)
 269   (interactive "sColor: ")
 270   (modify-frame-parameters (selected-frame)
 271                             (list (cons 'cursor-color color-name))))
 272
 273 (defun set-pointer-color (color-name)
 274   (interactive "sColor: ")
 275   (modify-frame-parameters (selected-frame)
 276                             (list (cons 'mouse-color color-name))))
 277
 278 (defun set-auto-raise (toggle)
 279   (interactive "xt or nil? ")
 280   (modify-frame-parameters (selected-frame)
 281                             (list (cons 'auto-raise toggle))))
 282
 283 (defun set-auto-lower (toggle)
 284   (interactive "xt or nil? ")
 285   (modify-frame-parameters (selected-frame)
 286                             (list (cons 'auto-lower toggle))))
 287
 288 (defun set-vertical-bar (toggle)
 289   (interactive "xt or nil? ")
 290   (modify-frame-parameters (selected-frame)
 291                             (list (cons 'vertical-scroll-bar toggle))))
 292
 293 (defun set-horizontal-bar (toggle)
 294   (interactive "xt or nil? ")
 295   (modify-frame-parameters (selected-frame)
 296                             (list (cons 'horizontal-scroll-bar toggle))))
 297 \f
 298 ;;;; Aliases for backward compatibility with Emacs 18.
 299 (fset 'screen-height 'frame-height)
 300 (fset 'screen-width 'frame-width)
 301
 302 (defun set-screen-width (cols &optional pretend)
 303   "Obsolete function to change the size of the screen to COLS columns.\n\
 304 Optional second arg non-nil means that redisplay should use COLS columns\n\
 305 but that the idea of the actual width of the frame should not be changed.\n\
 306 This function is provided only for compatibility with Emacs 18; new code\n\
 307 should use `set-frame-width instead'."
 308   (set-frame-width (selected-frame) cols pretend))
 309
 310 (defun set-screen-height (lines &optional pretend)
 311   "Obsolete function to change the height of the screen to LINES lines.\n\
 312 Optional second arg non-nil means that redisplay should use LINES lines\n\
 313 but that the idea of the actual height of the screen should not be changed.\n\
 314 This function is provided only for compatibility with Emacs 18; new code\n\
 315 should use `set-frame-width' instead."
 316   (set-frame-height (selected-frame) lines pretend))
 317
 318 (make-obsolete 'screen-height 'frame-height)
 319 (make-obsolete 'screen-width  'frame-width)
 320 (make-obsolete 'set-screen-width 'set-frame-width)
 321 (make-obsolete 'set-screen-height 'set-frame-height)
 322
 323 \f
 324 ;;;; Key bindings
 325 (defvar ctl-x-5-map (make-sparse-keymap)
 326   "Keymap for frame commands.")
 327 (fset 'ctl-x-5-prefix ctl-x-5-map)
 328 (define-key ctl-x-map "5" 'ctl-x-5-prefix)
 329
 330 (define-key ctl-x-5-map "2" 'new-frame)
 331 (define-key ctl-x-5-map "0" 'delete-frame)
 332
 333 (provide 'frame)
 334
 335 ;;; frame.el ends here