1 ;; Parse switches controlling how Emacs interfaces with X window system.
2 ;; Copyright (C) 1990 Free Software Foundation, Inc.
4 ;; This file is part of GNU Emacs.
6 ;; GNU Emacs is distributed in the hope that it will be useful,
7 ;; but WITHOUT ANY WARRANTY. No author or distributor
8 ;; accepts responsibility to anyone for the consequences of using it
9 ;; or for whether it serves any particular purpose or works at all,
10 ;; unless he says so in writing. Refer to the GNU Emacs General Public
11 ;; License for full details.
13 ;; Everyone is granted permission to copy, modify and redistribute
14 ;; GNU Emacs, but only under the conditions described in the
15 ;; GNU Emacs General Public License. A copy of this license is
16 ;; supposed to have been given to you along with GNU Emacs so you
17 ;; can know your rights and responsibilities. It should be in a
18 ;; file named COPYING. Among other things, the copyright notice
19 ;; and this notice must be preserved on all copies.
22 ;; X-win.el: this file is loaded from ../lisp/startup.el when it recognizes
23 ;; that X windows are to be used. Command line switches are parsed and those
24 ;; pertaining to X are processed and removed from the command line. The
25 ;; X display is opened and hooks are set for popping up the initial window.
27 ;; startup.el will then examine startup files, and eventually call the hooks
28 ;; which create the first window (s).
30 ;; These are the standard X switches from the Xt Initialize.c file of
33 ;; Command line Resource Manager string
36 ;; +synchronous *synchronous
37 ;; -background *background
40 ;; -bordercolor *borderColor
41 ;; -borderwidth .borderWidth
47 ;; -foreground *foreground
48 ;; -geometry .geometry
51 ;; -reverse *reverseVideo
53 ;; -selectionTimeout .selectionTimeout
54 ;; -synchronous *synchronous
58 ;; An alist of X options and the function which handles them. See
61 (if (not (eq window-system 'x))
62 (error "Loading x-win.el but not compiled for X"))
64 ;; This is a temporary work-around while we the separate keymap
65 ;; stuff isn't yet fixed. These variables aren't used anymore,
66 ;; but the lisp code wants them to exist. -JimB
67 (setq global-mouse-map (make-sparse-keymap))
68 (setq global-function-map (make-sparse-keymap))
73 (setq command-switch-alist
74 (append '(("-dm" . x-establish-daemon-mode)
75 ("-bw" . x-handle-numeric-switch)
76 ("-d" . x-handle-display)
77 ("-display" . x-handle-display)
78 ("-name" . x-handle-switch)
79 ("-T" . x-handle-switch)
80 ("-r" . x-handle-switch)
81 ("-rv" . x-handle-switch)
82 ("-reverse" . x-handle-switch)
83 ("-fn" . x-handle-switch)
84 ("-font" . x-handle-switch)
85 ("-ib" . x-handle-switch)
86 ("-g" . x-handle-geometry)
87 ("-geometry" . x-handle-geometry)
88 ("-fg" . x-handle-switch)
89 ("-foreground". x-handle-switch)
90 ("-bg" . x-handle-switch)
91 ("-background". x-handle-switch)
92 ("-ms" . x-handle-switch)
93 ("-ib" . x-handle-switch)
94 ("-iconic" . x-handle-switch)
95 ("-cr" . x-handle-switch)
96 ("-vb" . x-handle-switch)
97 ("-hb" . x-handle-switch)
98 ("-bd" . x-handle-switch))
99 command-switch-alist))
101 (defconst x-switch-definitions
109 ("-ib" internal-border-width)
110 ("-fg" foreground-color)
111 ("-foreground" foreground-color)
112 ("-bg" background-color)
113 ("-background" background-color)
117 ("-iconic" iconic-startup t)
118 ("-vb" vertical-scroll-bar t)
119 ("-hb" horizontal-scroll-bar t)
121 ("-bw" border-width)))
123 ;; Handler for switches of the form "-switch value" or "-switch".
124 (defun x-handle-switch (switch)
125 (let ((aelt (assoc switch x-switch-definitions)))
128 (setq screen-default-alist
129 (cons (cons (nth 1 aelt) (nth 2 aelt))
130 screen-default-alist))
131 (setq screen-default-alist
132 (cons (cons (nth 1 aelt)
133 (car x-invocation-args))
134 screen-default-alist)
135 x-invocation-args (cdr x-invocation-args))))))
137 ;; Handler for switches of the form "-switch n"
138 (defun x-handle-numeric-switch (switch)
139 (let ((aelt (assoc switch x-switch-definitions)))
141 (setq screen-default-alist
142 (cons (cons (nth 1 aelt)
143 (string-to-int (car x-invocation-args)))
144 screen-default-alist)
146 (cdr x-invocation-args)))))
148 ;; Handle the geometry option
149 (defun x-handle-geometry (switch)
150 (setq initial-screen-alist (append initial-screen-alist
151 (x-geometry (car x-invocation-args)))
152 x-invocation-args (cdr x-invocation-args)))
154 ;; The daemon stuff isn't really useful at the moment.
155 (defvar x-daemon-mode nil
156 "When set, means initially create just a minibuffer.")
158 (defun x-establish-daemon-mode (switch)
159 (setq x-daemon-mode t))
161 (defvar x-display-name nil
162 "The X display name specifying server and X screen.")
164 (defun x-handle-display (switch)
165 (setq x-display-name (car x-invocation-args)
166 x-invocation-args (cdr x-invocation-args)))
168 (defvar x-invocation-args nil)
170 (defun x-handle-args ()
171 "Here the X-related command line options are processed, before the user's
172 startup file is loaded. These are present in ARGS (see startup.el).
173 They are copied to x-invocation args from which the X-related things
174 are extracted, first the switch (e.g., \"-fg\") in the following code,
175 and possible values (e.g., \"black\") in the option handler code (e.g.,
177 When finished, only things not pertaining to X (e.g., \"-q\", filenames)
179 (setq x-invocation-args args
181 (while x-invocation-args
182 (let* ((this-switch (car x-invocation-args))
183 (aelt (assoc this-switch command-switch-alist)))
184 (setq x-invocation-args (cdr x-invocation-args))
186 (funcall (cdr aelt) this-switch)
187 (setq args (cons this-switch args)))))
188 (setq args (nreverse args)))
191 ;; Handle Xresources.
193 (defun x-read-resources ()
194 "Reread the X defaults from the X server and install them in
195 `screen-default-alist', to be used in new screens."
198 (lambda (key-resname-default)
199 (let* ((key (nth 0 key-resname-default))
200 (tail (assq key screen-default-alist))
202 (or (x-get-resource (nth 1 key-resname-default))
203 (nth 3 key-resname-default))))
204 (if tail (setcdr tail value)
205 (setq screen-default-alist
206 (cons (cons key value)
207 screen-default-alist))))))
208 '((font "font" "9x15")
209 (background-color "background" "white")
210 (border-width "#BorderWidth" 2)
211 (internal-border-width "#InternalBorderWidth" 1)
213 (foreground-color "foreground" "black")
214 (mouse-color "mouse" "black")
215 (cursor-color "cursor" "black")
216 (border-color "border" "black"))))
219 ;; This is the function which creates the first X window. It is called
220 ;; from startup.el before the user's init file is processed.
222 (defun x-pop-initial-window ()
223 ;; see screen.el for this function
224 (pop-initial-screen (append initial-screen-alist
225 screen-default-alist))
226 (delete-screen terminal-screen))
230 ;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.
233 (defconst x-pointer-X-cursor 0)
234 (defconst x-pointer-arrow 2)
235 (defconst x-pointer-based-arrow-down 4)
236 (defconst x-pointer-based-arrow-up 6)
237 (defconst x-pointer-boat 8)
238 (defconst x-pointer-bogosity 10)
239 (defconst x-pointer-bottom-left-corner 12)
240 (defconst x-pointer-bottom-right-corner 14)
241 (defconst x-pointer-bottom-side 16)
242 (defconst x-pointer-bottom-tee 18)
243 (defconst x-pointer-box-spiral 20)
244 (defconst x-pointer-center-ptr 22)
245 (defconst x-pointer-circle 24)
246 (defconst x-pointer-clock 26)
247 (defconst x-pointer-coffee-mug 28)
248 (defconst x-pointer-cross 30)
249 (defconst x-pointer-cross-reverse 32)
250 (defconst x-pointer-crosshair 34)
251 (defconst x-pointer-diamond-cross 36)
252 (defconst x-pointer-dot 38)
253 (defconst x-pointer-dotbox 40)
254 (defconst x-pointer-double-arrow 42)
255 (defconst x-pointer-draft-large 44)
256 (defconst x-pointer-draft-small 46)
257 (defconst x-pointer-draped-box 48)
258 (defconst x-pointer-exchange 50)
259 (defconst x-pointer-fleur 52)
260 (defconst x-pointer-gobbler 54)
261 (defconst x-pointer-gumby 56)
262 (defconst x-pointer-hand1 58)
263 (defconst x-pointer-hand2 60)
264 (defconst x-pointer-heart 62)
265 (defconst x-pointer-icon 64)
266 (defconst x-pointer-iron-cross 66)
267 (defconst x-pointer-left-ptr 68)
268 (defconst x-pointer-left-side 70)
269 (defconst x-pointer-left-tee 72)
270 (defconst x-pointer-leftbutton 74)
271 (defconst x-pointer-ll-angle 76)
272 (defconst x-pointer-lr-angle 78)
273 (defconst x-pointer-man 80)
274 (defconst x-pointer-middlebutton 82)
275 (defconst x-pointer-mouse 84)
276 (defconst x-pointer-pencil 86)
277 (defconst x-pointer-pirate 88)
278 (defconst x-pointer-plus 90)
279 (defconst x-pointer-question-arrow 92)
280 (defconst x-pointer-right-ptr 94)
281 (defconst x-pointer-right-side 96)
282 (defconst x-pointer-right-tee 98)
283 (defconst x-pointer-rightbutton 100)
284 (defconst x-pointer-rtl-logo 102)
285 (defconst x-pointer-sailboat 104)
286 (defconst x-pointer-sb-down-arrow 106)
287 (defconst x-pointer-sb-h-double-arrow 108)
288 (defconst x-pointer-sb-left-arrow 110)
289 (defconst x-pointer-sb-right-arrow 112)
290 (defconst x-pointer-sb-up-arrow 114)
291 (defconst x-pointer-sb-v-double-arrow 116)
292 (defconst x-pointer-shuttle 118)
293 (defconst x-pointer-sizing 120)
294 (defconst x-pointer-spider 122)
295 (defconst x-pointer-spraycan 124)
296 (defconst x-pointer-star 126)
297 (defconst x-pointer-target 128)
298 (defconst x-pointer-tcross 130)
299 (defconst x-pointer-top-left-arrow 132)
300 (defconst x-pointer-top-left-corner 134)
301 (defconst x-pointer-top-right-corner 136)
302 (defconst x-pointer-top-side 138)
303 (defconst x-pointer-top-tee 140)
304 (defconst x-pointer-trek 142)
305 (defconst x-pointer-ul-angle 144)
306 (defconst x-pointer-umbrella 146)
307 (defconst x-pointer-ur-angle 148)
308 (defconst x-pointer-watch 150)
309 (defconst x-pointer-xterm 152)
315 (defvar x-colors '("aquamarine"
373 "medium forest green"
377 "medium spring green"
457 "The full list of X colors from the rgb.text file.")
459 (defun x-defined-colors ()
460 "Return a list of colors supported by the current X-Display."
461 (let ((all-colors x-colors)
463 (defined-colors nil))
465 (setq this-color (car all-colors)
466 all-colors (cdr all-colors))
467 (and (x-defined-color this-color)
468 (setq defined-colors (cons this-color defined-colors))))
473 ;; Function key processing under X. Function keys are received through
474 ;; in the input stream as Lisp symbols.
477 (defun define-function-key (map sym definition)
478 (let ((exist (assq sym (cdr map))))
480 (setcdr exist definition)
482 (cons (cons sym definition)
485 ;; For unused keysyms. If this happens, it's probably a server or
488 (defun weird-x-keysym ()
490 (error "Bizarre X keysym received."))
491 (define-function-key global-function-map 'xk-not-serious 'weird-x-keysym)
493 ;; Keypad type things
495 (define-function-key global-function-map 'xk-home 'beginning-of-line)
496 (define-function-key global-function-map 'xk-left 'backward-char)
497 (define-function-key global-function-map 'xk-up 'previous-line)
498 (define-function-key global-function-map 'xk-right 'forward-char)
499 (define-function-key global-function-map 'xk-down 'next-line)
500 (define-function-key global-function-map 'xk-prior 'previous-line)
501 (define-function-key global-function-map 'xk-next 'next-line)
502 (define-function-key global-function-map 'xk-end 'end-of-line)
503 (define-function-key global-function-map 'xk-begin 'beginning-of-line)
507 (define-function-key global-function-map 'xk-select nil)
508 (define-function-key global-function-map 'xk-print nil)
509 (define-function-key global-function-map 'xk-execute nil)
510 (define-function-key global-function-map 'xk-insert nil)
511 (define-function-key global-function-map 'xk-undo nil)
512 (define-function-key global-function-map 'xk-redo nil)
513 (define-function-key global-function-map 'xk-menu nil)
514 (define-function-key global-function-map 'xk-find nil)
515 (define-function-key global-function-map 'xk-cancel nil)
516 (define-function-key global-function-map 'xk-help nil)
517 (define-function-key global-function-map 'xk-break nil)
521 (define-function-key global-function-map 'xk-kp-space
522 '(lambda nil (interactive)
524 (define-function-key global-function-map 'xk-kp-tab
525 '(lambda nil (interactive)
527 (define-function-key global-function-map 'xk-kp-enter
528 '(lambda nil (interactive)
531 (define-function-key global-function-map 'xk-kp-f1 nil)
532 (define-function-key global-function-map 'xk-kp-f2 nil)
533 (define-function-key global-function-map 'xk-kp-f3 nil)
534 (define-function-key global-function-map 'xk-kp-f4 nil)
536 (define-function-key global-function-map 'xk-kp-equal
537 '(lambda nil (interactive)
539 (define-function-key global-function-map 'xk-kp-multiply
540 '(lambda nil (interactive)
542 (define-function-key global-function-map 'xk-kp-add
543 '(lambda nil (interactive)
545 (define-function-key global-function-map 'xk-kp-separator
546 '(lambda nil (interactive)
548 (define-function-key global-function-map 'xk-kp-subtract
549 '(lambda nil (interactive)
551 (define-function-key global-function-map 'xk-kp-decimal
552 '(lambda nil (interactive)
554 (define-function-key global-function-map 'xk-kp-divide
555 '(lambda nil (interactive)
558 (define-function-key global-function-map 'xk-kp-0
559 '(lambda nil (interactive)
561 (define-function-key global-function-map 'xk-kp-1
562 '(lambda nil (interactive)
564 (define-function-key global-function-map 'xk-kp-2
565 '(lambda nil (interactive)
567 (define-function-key global-function-map 'xk-kp-3
568 '(lambda nil (interactive)
570 (define-function-key global-function-map 'xk-kp-4
571 '(lambda nil (interactive)
573 (define-function-key global-function-map 'xk-kp-5
574 '(lambda nil (interactive)
576 (define-function-key global-function-map 'xk-kp-6
577 '(lambda nil (interactive)
579 (define-function-key global-function-map 'xk-kp-7
580 '(lambda nil (interactive)
582 (define-function-key global-function-map 'xk-kp-8
583 '(lambda nil (interactive)
585 (define-function-key global-function-map 'xk-kp-9
586 '(lambda nil (interactive)
591 (define-function-key global-function-map 'xk-f1 'rmail)
592 (define-function-key global-function-map 'xk-f2 nil)
593 (define-function-key global-function-map 'xk-f3 nil)
594 (define-function-key global-function-map 'xk-f4 nil)
595 (define-function-key global-function-map 'xk-f5 nil)
596 (define-function-key global-function-map 'xk-f6 nil)
597 (define-function-key global-function-map 'xk-f7 nil)
598 (define-function-key global-function-map 'xk-f8 nil)
599 (define-function-key global-function-map 'xk-f9 nil)
600 (define-function-key global-function-map 'xk-f10 nil)
601 (define-function-key global-function-map 'xk-f11 nil)
602 (define-function-key global-function-map 'xk-f12 nil)
603 (define-function-key global-function-map 'xk-f13 nil)
604 (define-function-key global-function-map 'xk-f14 nil)
605 (define-function-key global-function-map 'xk-f15 nil)
606 (define-function-key global-function-map 'xk-f16 nil)
607 (define-function-key global-function-map 'xk-f17 nil)
608 (define-function-key global-function-map 'xk-f18 nil)
609 (define-function-key global-function-map 'xk-f19 nil)
610 (define-function-key global-function-map 'xk-f20 nil)
611 (define-function-key global-function-map 'xk-f21 nil)
612 (define-function-key global-function-map 'xk-f22 nil)
613 (define-function-key global-function-map 'xk-f23 nil)
614 (define-function-key global-function-map 'xk-f24 nil)
615 (define-function-key global-function-map 'xk-f25 nil)
616 (define-function-key global-function-map 'xk-f26 nil)
617 (define-function-key global-function-map 'xk-f27 nil)
618 (define-function-key global-function-map 'xk-f28 nil)
619 (define-function-key global-function-map 'xk-f29 nil)
620 (define-function-key global-function-map 'xk-f30 nil)
621 (define-function-key global-function-map 'xk-f31 nil)
622 (define-function-key global-function-map 'xk-f32 nil)
623 (define-function-key global-function-map 'xk-f33 nil)
624 (define-function-key global-function-map 'xk-f34 nil)
625 (define-function-key global-function-map 'xk-f35 nil)
627 ;;; Do the actual X Windows setup here; the above code just defines
628 ;;; functions and variables that we use now.
630 ;; xterm.c depends on using interrupt-driven input.
631 (set-input-mode t nil t)
634 (x-open-connection (or x-display-name
635 (setq x-display-name (getenv "DISPLAY"))))
636 (x-pop-initial-window)
640 (error "Suspending an emacs running under X makes no sense")))
642 (define-key global-map "\C-z" 'iconify-emacs)