394
|
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
|
|
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 global-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 (lambda (parameters)
|
|
103 (error
|
|
104 "Can't create multiple screens 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 screen
|
|
109 ;;; here.
|
|
110 (defun screen-notice-user-settings ()
|
|
111 (if screen-initial-screen
|
|
112 (progn
|
|
113
|
|
114 ;; If the user wants a minibuffer-only screen, we'll have to
|
|
115 ;; make a new one; you can't remove or add a root window to/from
|
|
116 ;; an existing screen.
|
|
117 (if (eq (cdr (or (assq 'minibuffer initial-screen-alist)
|
|
118 '(minibuffer . t)))
|
|
119 'only)
|
|
120 (progn
|
|
121 (setq global-minibuffer-screen
|
|
122 (new-screen initial-screen-alist))
|
|
123 (delete-screen screen-initial-screen))
|
|
124 (modify-screen-parameters screen-initial-screen
|
|
125 initial-screen-alist))))
|
|
126
|
|
127 ;; Make sure the initial screen can be GC'd if it is ever deleted.
|
|
128 (makunbound 'screen-initial-screen))
|
|
129
|
|
130
|
|
131 ;;;; Creation of additional screens
|
|
132
|
|
133 ;;; Return some screen other than the current screen,
|
|
134 ;;; creating one if neccessary. Note that the minibuffer screen, if
|
|
135 ;;; separate, is not considered (see next-screen).
|
|
136 (defun get-screen ()
|
|
137 (let ((s (if (equal (next-screen (selected-screen)) (selected-screen))
|
|
138 (new-screen)
|
|
139 (next-screen (selected-screen)))))
|
|
140 s))
|
|
141
|
|
142 (defun next-multiscreen-window ()
|
|
143 "Select the next window, regardless of which screen it is on."
|
|
144 (interactive)
|
|
145 (select-window (next-window (selected-window)
|
|
146 (> (minibuffer-depth) 0)
|
|
147 t)))
|
|
148
|
|
149 (defun previous-multiscreen-window ()
|
|
150 "Select the previous window, regardless of which screen it is on."
|
|
151 (interactive)
|
|
152 (select-window (previous-window (selected-window)
|
|
153 (> (minibuffer-depth) 0)
|
|
154 t)))
|
|
155
|
|
156 (defun new-screen (&optional parameters)
|
|
157 "Create a new screen, displaying the current buffer."
|
|
158 (interactive)
|
|
159 (funcall screen-creation-function parameters))
|
|
160
|
|
161
|
|
162 ;;;; Iconification
|
|
163
|
|
164 ;;; A possible enhancement for the below: if you iconify a surrogate
|
|
165 ;;; minibuffer screen, iconify all of its minibuffer's users too;
|
|
166 ;;; de-iconify them as a group. This will need to wait until screens
|
|
167 ;;; have mapping and unmapping hooks.
|
|
168
|
|
169 (defun iconify ()
|
|
170 "Iconify or deiconify the selected screen."
|
|
171 (interactive)
|
|
172 (let ((screen (selected-screen)))
|
|
173 (if (eq (screen-visible-p screen) t)
|
|
174 (iconify-screen screen)
|
|
175 (deiconify-screen screen))))
|
|
176
|
|
177
|
|
178 ;;;; Convenience functions for dynamically changing screen parameters
|
|
179
|
|
180 (defun set-screen-height (h)
|
|
181 (interactive "NHeight: ")
|
|
182 (let* ((screen (selected-screen))
|
|
183 (width (cdr (assoc 'width (screen-parameters (selected-screen))))))
|
|
184 (set-screen-size (selected-screen) width h)))
|
|
185
|
|
186 (defun set-screen-width (w)
|
|
187 (interactive "NWidth: ")
|
|
188 (let* ((screen (selected-screen))
|
|
189 (height (cdr (assoc 'height (screen-parameters (selected-screen))))))
|
|
190 (set-screen-size (selected-screen) w height)))
|
|
191
|
|
192 (defun set-default-font (font-name)
|
|
193 (interactive "sFont name: ")
|
|
194 (modify-screen-parameters (selected-screen)
|
|
195 (list (cons 'font font-name))))
|
|
196
|
|
197 (defun set-screen-background (color-name)
|
|
198 (interactive "sColor: ")
|
|
199 (modify-screen-parameters (selected-screen)
|
|
200 (list (cons 'background-color color-name))))
|
|
201
|
|
202 (defun set-screen-foreground (color-name)
|
|
203 (interactive "sColor: ")
|
|
204 (modify-screen-parameters (selected-screen)
|
|
205 (list (cons 'foreground-color color-name))))
|
|
206
|
|
207 (defun set-cursor-color (color-name)
|
|
208 (interactive "sColor: ")
|
|
209 (modify-screen-parameters (selected-screen)
|
|
210 (list (cons 'cursor-color color-name))))
|
|
211
|
|
212 (defun set-pointer-color (color-name)
|
|
213 (interactive "sColor: ")
|
|
214 (modify-screen-parameters (selected-screen)
|
|
215 (list (cons 'mouse-color color-name))))
|
|
216
|
|
217 (defun set-auto-raise (toggle)
|
|
218 (interactive "xt or nil? ")
|
|
219 (modify-screen-parameters (selected-screen)
|
|
220 (list (cons 'auto-raise toggle))))
|
|
221
|
|
222 (defun set-auto-lower (toggle)
|
|
223 (interactive "xt or nil? ")
|
|
224 (modify-screen-parameters (selected-screen)
|
|
225 (list (cons 'auto-lower toggle))))
|
|
226
|
|
227 (defun set-vertical-bar (toggle)
|
|
228 (interactive "xt or nil? ")
|
|
229 (modify-screen-parameters (selected-screen)
|
|
230 (list (cons 'vertical-scroll-bar toggle))))
|
|
231
|
|
232 (defun set-horizontal-bar (toggle)
|
|
233 (interactive "xt or nil? ")
|
|
234 (modify-screen-parameters (selected-screen)
|
|
235 (list (cons 'horizontal-scroll-bar toggle))))
|
|
236
|
|
237 ;;;; Key bindings
|
|
238 (define-prefix-command 'ctl-x-3-map)
|
|
239 (define-key ctl-x-map "3" 'ctl-x-3-map)
|
|
240
|
|
241 (define-key global-map "\C-z" 'iconify)
|
|
242 (define-key ctl-x-3-map "2" 'new-screen)
|
|
243 (define-key ctl-x-3-map "0" 'delete-screen)
|