lisp/frame.el

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