lisp/frame.el

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