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"))
67 (setq command-switch-alist
68 (append '(("-bw" . x-handle-numeric-switch
)
69 ("-d" . x-handle-display
)
70 ("-display" . x-handle-display
)
71 ("-name" . x-handle-switch
)
72 ("-T" . x-handle-switch
)
73 ("-r" . x-handle-switch
)
74 ("-rv" . x-handle-switch
)
75 ("-reverse" . x-handle-switch
)
76 ("-fn" . x-handle-switch
)
77 ("-font" . x-handle-switch
)
78 ("-ib" . x-handle-switch
)
79 ("-g" . x-handle-geometry
)
80 ("-geometry" . x-handle-geometry
)
81 ("-fg" . x-handle-switch
)
82 ("-foreground". x-handle-switch
)
83 ("-bg" . x-handle-switch
)
84 ("-background". x-handle-switch
)
85 ("-ms" . x-handle-switch
)
86 ("-ib" . x-handle-switch
)
87 ("-iconic" . x-handle-switch
)
88 ("-cr" . x-handle-switch
)
89 ("-vb" . x-handle-switch
)
90 ("-hb" . x-handle-switch
)
91 ("-bd" . x-handle-switch
))
92 command-switch-alist
))
94 (defconst x-switch-definitions
102 ("-ib" internal-border-width
)
103 ("-fg" foreground-color
)
104 ("-foreground" foreground-color
)
105 ("-bg" background-color
)
106 ("-background" background-color
)
110 ("-iconic" iconic-startup t
)
111 ("-vb" vertical-scroll-bar t
)
112 ("-hb" horizontal-scroll-bar t
)
114 ("-bw" border-width
)))
116 ;; Handler for switches of the form "-switch value" or "-switch".
117 (defun x-handle-switch (switch)
118 (let ((aelt (assoc switch x-switch-definitions
)))
121 (setq default-screen-alist
122 (cons (cons (nth 1 aelt
) (nth 2 aelt
))
123 default-screen-alist
))
124 (setq default-screen-alist
125 (cons (cons (nth 1 aelt
)
126 (car x-invocation-args
))
127 default-screen-alist
)
128 x-invocation-args
(cdr x-invocation-args
))))))
130 ;; Handler for switches of the form "-switch n"
131 (defun x-handle-numeric-switch (switch)
132 (let ((aelt (assoc switch x-switch-definitions
)))
134 (setq default-screen-alist
135 (cons (cons (nth 1 aelt
)
136 (string-to-int (car x-invocation-args
)))
137 default-screen-alist
)
139 (cdr x-invocation-args
)))))
141 ;; Handle the geometry option
142 (defun x-handle-geometry (switch)
143 (setq initial-screen-alist
(append initial-screen-alist
144 (x-geometry (car x-invocation-args
)))
145 x-invocation-args
(cdr x-invocation-args
)))
147 (defvar x-display-name nil
148 "The X display name specifying server and X screen.")
150 (defun x-handle-display (switch)
151 (setq x-display-name
(car x-invocation-args
)
152 x-invocation-args
(cdr x-invocation-args
)))
154 (defvar x-invocation-args nil
)
156 (defun x-handle-args (args)
157 "Here the X-related command line options in ARGS are processed,
158 before the user's startup file is loaded. They are copied to
159 x-invocation args from which the X-related things are extracted, first
160 the switch (e.g., \"-fg\") in the following code, and possible values
161 (e.g., \"black\") in the option handler code (e.g., x-handle-switch).
162 This returns ARGS with the arguments that have been processed removed."
163 (setq x-invocation-args args
165 (while x-invocation-args
166 (let* ((this-switch (car x-invocation-args
))
167 (aelt (assoc this-switch command-switch-alist
)))
168 (setq x-invocation-args
(cdr x-invocation-args
))
170 (funcall (cdr aelt
) this-switch
)
171 (setq args
(cons this-switch args
)))))
172 (setq args
(nreverse args
)))
177 ;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.
180 (defconst x-pointer-X-cursor
0)
181 (defconst x-pointer-arrow
2)
182 (defconst x-pointer-based-arrow-down
4)
183 (defconst x-pointer-based-arrow-up
6)
184 (defconst x-pointer-boat
8)
185 (defconst x-pointer-bogosity
10)
186 (defconst x-pointer-bottom-left-corner
12)
187 (defconst x-pointer-bottom-right-corner
14)
188 (defconst x-pointer-bottom-side
16)
189 (defconst x-pointer-bottom-tee
18)
190 (defconst x-pointer-box-spiral
20)
191 (defconst x-pointer-center-ptr
22)
192 (defconst x-pointer-circle
24)
193 (defconst x-pointer-clock
26)
194 (defconst x-pointer-coffee-mug
28)
195 (defconst x-pointer-cross
30)
196 (defconst x-pointer-cross-reverse
32)
197 (defconst x-pointer-crosshair
34)
198 (defconst x-pointer-diamond-cross
36)
199 (defconst x-pointer-dot
38)
200 (defconst x-pointer-dotbox
40)
201 (defconst x-pointer-double-arrow
42)
202 (defconst x-pointer-draft-large
44)
203 (defconst x-pointer-draft-small
46)
204 (defconst x-pointer-draped-box
48)
205 (defconst x-pointer-exchange
50)
206 (defconst x-pointer-fleur
52)
207 (defconst x-pointer-gobbler
54)
208 (defconst x-pointer-gumby
56)
209 (defconst x-pointer-hand1
58)
210 (defconst x-pointer-hand2
60)
211 (defconst x-pointer-heart
62)
212 (defconst x-pointer-icon
64)
213 (defconst x-pointer-iron-cross
66)
214 (defconst x-pointer-left-ptr
68)
215 (defconst x-pointer-left-side
70)
216 (defconst x-pointer-left-tee
72)
217 (defconst x-pointer-leftbutton
74)
218 (defconst x-pointer-ll-angle
76)
219 (defconst x-pointer-lr-angle
78)
220 (defconst x-pointer-man
80)
221 (defconst x-pointer-middlebutton
82)
222 (defconst x-pointer-mouse
84)
223 (defconst x-pointer-pencil
86)
224 (defconst x-pointer-pirate
88)
225 (defconst x-pointer-plus
90)
226 (defconst x-pointer-question-arrow
92)
227 (defconst x-pointer-right-ptr
94)
228 (defconst x-pointer-right-side
96)
229 (defconst x-pointer-right-tee
98)
230 (defconst x-pointer-rightbutton
100)
231 (defconst x-pointer-rtl-logo
102)
232 (defconst x-pointer-sailboat
104)
233 (defconst x-pointer-sb-down-arrow
106)
234 (defconst x-pointer-sb-h-double-arrow
108)
235 (defconst x-pointer-sb-left-arrow
110)
236 (defconst x-pointer-sb-right-arrow
112)
237 (defconst x-pointer-sb-up-arrow
114)
238 (defconst x-pointer-sb-v-double-arrow
116)
239 (defconst x-pointer-shuttle
118)
240 (defconst x-pointer-sizing
120)
241 (defconst x-pointer-spider
122)
242 (defconst x-pointer-spraycan
124)
243 (defconst x-pointer-star
126)
244 (defconst x-pointer-target
128)
245 (defconst x-pointer-tcross
130)
246 (defconst x-pointer-top-left-arrow
132)
247 (defconst x-pointer-top-left-corner
134)
248 (defconst x-pointer-top-right-corner
136)
249 (defconst x-pointer-top-side
138)
250 (defconst x-pointer-top-tee
140)
251 (defconst x-pointer-trek
142)
252 (defconst x-pointer-ul-angle
144)
253 (defconst x-pointer-umbrella
146)
254 (defconst x-pointer-ur-angle
148)
255 (defconst x-pointer-watch
150)
256 (defconst x-pointer-xterm
152)
262 (defvar x-colors
'("aquamarine"
320 "medium forest green"
324 "medium spring green"
404 "The full list of X colors from the rgb.text file.")
406 (defun x-defined-colors ()
407 "Return a list of colors supported by the current X-Display."
408 (let ((all-colors x-colors
)
410 (defined-colors nil
))
412 (setq this-color
(car all-colors
)
413 all-colors
(cdr all-colors
))
414 (and (x-defined-color this-color
)
415 (setq defined-colors
(cons this-color defined-colors
))))
420 ;;; Give some common function keys reasonable definitions.
421 (define-key global-map
[home] 'beginning-of-line)
422 (define-key global-map [left] 'backward-char)
423 (define-key global-map [up] 'previous-line)
424 (define-key global-map [right] 'forward-char)
425 (define-key global-map [down] 'next-line)
426 (define-key global-map [prior] 'scroll-down)
427 (define-key global-map [next] 'scroll-up)
428 (define-key global-map [begin] 'beginning-of-buffer)
429 (define-key global-map [end] 'end-of-buffer)
432 ;;; Do the actual X Windows setup here; the above code just defines
433 ;;; functions and variables that we use now.
435 (setq command-line-args (x-handle-args command-line-args))
436 (x-open-connection (or x-display-name
437 (setq x-display-name (getenv "DISPLAY"))))
439 ;; xterm.c depends on using interrupt-driven input, but we don't want
440 ;; the fcntls to apply to the terminal, so we do this after opening
442 (set-input-mode t nil t)
444 (setq screen-creation-function 'x-create-screen)
447 (error "Suspending an emacs running under X makes no sense")))
448 (setq interprogram-cut-function 'x-own-selection)
450 ;;; Turn off window-splitting optimization; X is usually fast enough
451 ;;; that this is only annoying.
452 (setq split-window-keep-point t)