Commit | Line | Data |
---|---|---|
64c669bc JB |
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 | |
df11cb7f | 91 | (setq default-minibuffer-screen |
64c669bc JB |
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 | |
9198945a MB |
102 | (function |
103 | (lambda (parameters) | |
104 | (error | |
105 | "Can't create multiple screens without a window system.")))))) | |
64c669bc JB |
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 | |
df11cb7f JB |
122 | (setq default-minibuffer-screen |
123 | (new-screen | |
124 | (append initial-screen-alist | |
125 | (screen-parameters screen-initial-screen)))) | |
64c669bc JB |
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 | (interactive) | |
162 | (funcall screen-creation-function parameters)) | |
163 | ||
164 | \f | |
165 | ;;;; Iconification | |
166 | ||
167 | ;;; A possible enhancement for the below: if you iconify a surrogate | |
168 | ;;; minibuffer screen, iconify all of its minibuffer's users too; | |
169 | ;;; de-iconify them as a group. This will need to wait until screens | |
170 | ;;; have mapping and unmapping hooks. | |
171 | ||
172 | (defun iconify () | |
173 | "Iconify or deiconify the selected screen." | |
174 | (interactive) | |
175 | (let ((screen (selected-screen))) | |
176 | (if (eq (screen-visible-p screen) t) | |
177 | (iconify-screen screen) | |
178 | (deiconify-screen screen)))) | |
179 | ||
180 | \f | |
181 | ;;;; Convenience functions for dynamically changing screen parameters | |
182 | ||
183 | (defun set-screen-height (h) | |
184 | (interactive "NHeight: ") | |
185 | (let* ((screen (selected-screen)) | |
186 | (width (cdr (assoc 'width (screen-parameters (selected-screen)))))) | |
187 | (set-screen-size (selected-screen) width h))) | |
188 | ||
189 | (defun set-screen-width (w) | |
190 | (interactive "NWidth: ") | |
191 | (let* ((screen (selected-screen)) | |
192 | (height (cdr (assoc 'height (screen-parameters (selected-screen)))))) | |
193 | (set-screen-size (selected-screen) w height))) | |
194 | ||
195 | (defun set-default-font (font-name) | |
196 | (interactive "sFont name: ") | |
197 | (modify-screen-parameters (selected-screen) | |
198 | (list (cons 'font font-name)))) | |
199 | ||
200 | (defun set-screen-background (color-name) | |
201 | (interactive "sColor: ") | |
202 | (modify-screen-parameters (selected-screen) | |
203 | (list (cons 'background-color color-name)))) | |
204 | ||
205 | (defun set-screen-foreground (color-name) | |
206 | (interactive "sColor: ") | |
207 | (modify-screen-parameters (selected-screen) | |
208 | (list (cons 'foreground-color color-name)))) | |
209 | ||
210 | (defun set-cursor-color (color-name) | |
211 | (interactive "sColor: ") | |
212 | (modify-screen-parameters (selected-screen) | |
213 | (list (cons 'cursor-color color-name)))) | |
214 | ||
215 | (defun set-pointer-color (color-name) | |
216 | (interactive "sColor: ") | |
217 | (modify-screen-parameters (selected-screen) | |
218 | (list (cons 'mouse-color color-name)))) | |
219 | ||
220 | (defun set-auto-raise (toggle) | |
221 | (interactive "xt or nil? ") | |
222 | (modify-screen-parameters (selected-screen) | |
223 | (list (cons 'auto-raise toggle)))) | |
224 | ||
225 | (defun set-auto-lower (toggle) | |
226 | (interactive "xt or nil? ") | |
227 | (modify-screen-parameters (selected-screen) | |
228 | (list (cons 'auto-lower toggle)))) | |
229 | ||
230 | (defun set-vertical-bar (toggle) | |
231 | (interactive "xt or nil? ") | |
232 | (modify-screen-parameters (selected-screen) | |
233 | (list (cons 'vertical-scroll-bar toggle)))) | |
234 | ||
235 | (defun set-horizontal-bar (toggle) | |
236 | (interactive "xt or nil? ") | |
237 | (modify-screen-parameters (selected-screen) | |
238 | (list (cons 'horizontal-scroll-bar toggle)))) | |
239 | \f | |
240 | ;;;; Key bindings | |
241 | (define-prefix-command 'ctl-x-3-map) | |
242 | (define-key ctl-x-map "3" 'ctl-x-3-map) | |
243 | ||
244 | (define-key global-map "\C-z" 'iconify) | |
245 | (define-key ctl-x-3-map "2" 'new-screen) | |
246 | (define-key ctl-x-3-map "0" 'delete-screen) |