lisp/frame.el

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