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 '(("-bw" . x-handle-numeric-switch
)
75 ("-d" . x-handle-display
)
76 ("-display" . x-handle-display
)
77 ("-name" . x-handle-switch
)
78 ("-T" . x-handle-switch
)
79 ("-r" . x-handle-switch
)
80 ("-rv" . x-handle-switch
)
81 ("-reverse" . x-handle-switch
)
82 ("-fn" . x-handle-switch
)
83 ("-font" . x-handle-switch
)
84 ("-ib" . x-handle-switch
)
85 ("-g" . x-handle-geometry
)
86 ("-geometry" . x-handle-geometry
)
87 ("-fg" . x-handle-switch
)
88 ("-foreground". x-handle-switch
)
89 ("-bg" . x-handle-switch
)
90 ("-background". x-handle-switch
)
91 ("-ms" . x-handle-switch
)
92 ("-ib" . x-handle-switch
)
93 ("-iconic" . x-handle-switch
)
94 ("-cr" . x-handle-switch
)
95 ("-vb" . x-handle-switch
)
96 ("-hb" . x-handle-switch
)
97 ("-bd" . x-handle-switch
))
98 command-switch-alist
))
100 (defconst x-switch-definitions
108 ("-ib" internal-border-width
)
109 ("-fg" foreground-color
)
110 ("-foreground" foreground-color
)
111 ("-bg" background-color
)
112 ("-background" background-color
)
116 ("-iconic" iconic-startup t
)
117 ("-vb" vertical-scroll-bar t
)
118 ("-hb" horizontal-scroll-bar t
)
120 ("-bw" border-width
)))
122 ;; Handler for switches of the form "-switch value" or "-switch".
123 (defun x-handle-switch (switch)
124 (let ((aelt (assoc switch x-switch-definitions
)))
127 (setq screen-default-alist
128 (cons (cons (nth 1 aelt
) (nth 2 aelt
))
129 screen-default-alist
))
130 (setq screen-default-alist
131 (cons (cons (nth 1 aelt
)
132 (car x-invocation-args
))
133 screen-default-alist
)
134 x-invocation-args
(cdr x-invocation-args
))))))
136 ;; Handler for switches of the form "-switch n"
137 (defun x-handle-numeric-switch (switch)
138 (let ((aelt (assoc switch x-switch-definitions
)))
140 (setq screen-default-alist
141 (cons (cons (nth 1 aelt
)
142 (string-to-int (car x-invocation-args
)))
143 screen-default-alist
)
145 (cdr x-invocation-args
)))))
147 ;; Handle the geometry option
148 (defun x-handle-geometry (switch)
149 (setq initial-screen-alist
(append initial-screen-alist
150 (x-geometry (car x-invocation-args
)))
151 x-invocation-args
(cdr x-invocation-args
)))
153 (defvar x-display-name nil
154 "The X display name specifying server and X screen.")
156 (defun x-handle-display (switch)
157 (setq x-display-name
(car x-invocation-args
)
158 x-invocation-args
(cdr x-invocation-args
)))
160 (defvar x-invocation-args nil
)
162 (defun x-handle-args (args)
163 "Here the X-related command line options in ARGS are processed,
164 before the user's startup file is loaded. They are copied to
165 x-invocation args from which the X-related things are extracted, first
166 the switch (e.g., \"-fg\") in the following code, and possible values
167 (e.g., \"black\") in the option handler code (e.g., x-handle-switch).
168 This returns ARGS with the arguments that have been processed removed."
169 (setq x-invocation-args args
171 (while x-invocation-args
172 (let* ((this-switch (car x-invocation-args
))
173 (aelt (assoc this-switch command-switch-alist
)))
174 (setq x-invocation-args
(cdr x-invocation-args
))
176 (funcall (cdr aelt
) this-switch
)
177 (setq args
(cons this-switch args
)))))
178 (setq args
(nreverse args
)))
181 ;; Handle Xresources.
183 (defun x-read-resources ()
184 "Reread the X defaults from the X server and install them in
185 `screen-default-alist', to be used in new screens."
188 (lambda (key-resname-default)
189 (let* ((key (nth 0 key-resname-default
))
190 (tail (assq key screen-default-alist
))
192 (or (x-get-resource (nth 1 key-resname-default
))
193 (nth 2 key-resname-default
))))
194 (if tail
(setcdr tail value
)
195 (setq screen-default-alist
196 (cons (cons key value
)
197 screen-default-alist
))))))
198 '((font "font" "9x15")
199 (background-color "background" "white")
200 (border-width "#BorderWidth" 2)
201 (internal-border-width "#InternalBorderWidth" 1)
203 (foreground-color "foreground" "black")
204 (mouse-color "mouse" "black")
205 (cursor-color "cursor" "black")
206 (border-color "border" "black")))
207 (setq x-screen-defaults screen-default-alist
))
210 ;; This is the function which creates the first X window. It is called
211 ;; from startup.el before the user's init file is processed.
213 (defun x-pop-initial-window ()
214 ;; see screen.el for this function
215 (pop-initial-screen (append initial-screen-alist
216 screen-default-alist
))
217 (delete-screen terminal-screen
))
221 ;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.
224 (defconst x-pointer-X-cursor
0)
225 (defconst x-pointer-arrow
2)
226 (defconst x-pointer-based-arrow-down
4)
227 (defconst x-pointer-based-arrow-up
6)
228 (defconst x-pointer-boat
8)
229 (defconst x-pointer-bogosity
10)
230 (defconst x-pointer-bottom-left-corner
12)
231 (defconst x-pointer-bottom-right-corner
14)
232 (defconst x-pointer-bottom-side
16)
233 (defconst x-pointer-bottom-tee
18)
234 (defconst x-pointer-box-spiral
20)
235 (defconst x-pointer-center-ptr
22)
236 (defconst x-pointer-circle
24)
237 (defconst x-pointer-clock
26)
238 (defconst x-pointer-coffee-mug
28)
239 (defconst x-pointer-cross
30)
240 (defconst x-pointer-cross-reverse
32)
241 (defconst x-pointer-crosshair
34)
242 (defconst x-pointer-diamond-cross
36)
243 (defconst x-pointer-dot
38)
244 (defconst x-pointer-dotbox
40)
245 (defconst x-pointer-double-arrow
42)
246 (defconst x-pointer-draft-large
44)
247 (defconst x-pointer-draft-small
46)
248 (defconst x-pointer-draped-box
48)
249 (defconst x-pointer-exchange
50)
250 (defconst x-pointer-fleur
52)
251 (defconst x-pointer-gobbler
54)
252 (defconst x-pointer-gumby
56)
253 (defconst x-pointer-hand1
58)
254 (defconst x-pointer-hand2
60)
255 (defconst x-pointer-heart
62)
256 (defconst x-pointer-icon
64)
257 (defconst x-pointer-iron-cross
66)
258 (defconst x-pointer-left-ptr
68)
259 (defconst x-pointer-left-side
70)
260 (defconst x-pointer-left-tee
72)
261 (defconst x-pointer-leftbutton
74)
262 (defconst x-pointer-ll-angle
76)
263 (defconst x-pointer-lr-angle
78)
264 (defconst x-pointer-man
80)
265 (defconst x-pointer-middlebutton
82)
266 (defconst x-pointer-mouse
84)
267 (defconst x-pointer-pencil
86)
268 (defconst x-pointer-pirate
88)
269 (defconst x-pointer-plus
90)
270 (defconst x-pointer-question-arrow
92)
271 (defconst x-pointer-right-ptr
94)
272 (defconst x-pointer-right-side
96)
273 (defconst x-pointer-right-tee
98)
274 (defconst x-pointer-rightbutton
100)
275 (defconst x-pointer-rtl-logo
102)
276 (defconst x-pointer-sailboat
104)
277 (defconst x-pointer-sb-down-arrow
106)
278 (defconst x-pointer-sb-h-double-arrow
108)
279 (defconst x-pointer-sb-left-arrow
110)
280 (defconst x-pointer-sb-right-arrow
112)
281 (defconst x-pointer-sb-up-arrow
114)
282 (defconst x-pointer-sb-v-double-arrow
116)
283 (defconst x-pointer-shuttle
118)
284 (defconst x-pointer-sizing
120)
285 (defconst x-pointer-spider
122)
286 (defconst x-pointer-spraycan
124)
287 (defconst x-pointer-star
126)
288 (defconst x-pointer-target
128)
289 (defconst x-pointer-tcross
130)
290 (defconst x-pointer-top-left-arrow
132)
291 (defconst x-pointer-top-left-corner
134)
292 (defconst x-pointer-top-right-corner
136)
293 (defconst x-pointer-top-side
138)
294 (defconst x-pointer-top-tee
140)
295 (defconst x-pointer-trek
142)
296 (defconst x-pointer-ul-angle
144)
297 (defconst x-pointer-umbrella
146)
298 (defconst x-pointer-ur-angle
148)
299 (defconst x-pointer-watch
150)
300 (defconst x-pointer-xterm
152)
306 (defvar x-colors
'("aquamarine"
364 "medium forest green"
368 "medium spring green"
448 "The full list of X colors from the rgb.text file.")
450 (defun x-defined-colors ()
451 "Return a list of colors supported by the current X-Display."
452 (let ((all-colors x-colors
)
454 (defined-colors nil
))
456 (setq this-color
(car all-colors
)
457 all-colors
(cdr all-colors
))
458 (and (x-defined-color this-color
)
459 (setq defined-colors
(cons this-color defined-colors
))))
464 ;; Function key processing under X. Function keys are received through
465 ;; in the input stream as Lisp symbols.
468 (defun define-function-key (map sym definition
)
469 (let ((exist (assq sym
(cdr map
))))
471 (setcdr exist definition
)
473 (cons (cons sym definition
)
476 ;; For unused keysyms. If this happens, it's probably a server or
479 (defun weird-x-keysym ()
481 (error "Bizarre X keysym received."))
482 (define-function-key global-function-map
'xk-not-serious
'weird-x-keysym
)
484 ;; Keypad type things
486 (define-function-key global-function-map
'xk-home
'beginning-of-line
)
487 (define-function-key global-function-map
'xk-left
'backward-char
)
488 (define-function-key global-function-map
'xk-up
'previous-line
)
489 (define-function-key global-function-map
'xk-right
'forward-char
)
490 (define-function-key global-function-map
'xk-down
'next-line
)
491 (define-function-key global-function-map
'xk-prior
'previous-line
)
492 (define-function-key global-function-map
'xk-next
'next-line
)
493 (define-function-key global-function-map
'xk-end
'end-of-line
)
494 (define-function-key global-function-map
'xk-begin
'beginning-of-line
)
498 (define-function-key global-function-map
'xk-select nil
)
499 (define-function-key global-function-map
'xk-print nil
)
500 (define-function-key global-function-map
'xk-execute nil
)
501 (define-function-key global-function-map
'xk-insert nil
)
502 (define-function-key global-function-map
'xk-undo nil
)
503 (define-function-key global-function-map
'xk-redo nil
)
504 (define-function-key global-function-map
'xk-menu nil
)
505 (define-function-key global-function-map
'xk-find nil
)
506 (define-function-key global-function-map
'xk-cancel nil
)
507 (define-function-key global-function-map
'xk-help nil
)
508 (define-function-key global-function-map
'xk-break nil
)
512 (define-function-key global-function-map
'xk-kp-space
513 '(lambda nil
(interactive)
515 (define-function-key global-function-map
'xk-kp-tab
516 '(lambda nil
(interactive)
518 (define-function-key global-function-map
'xk-kp-enter
519 '(lambda nil
(interactive)
522 (define-function-key global-function-map
'xk-kp-f1 nil
)
523 (define-function-key global-function-map
'xk-kp-f2 nil
)
524 (define-function-key global-function-map
'xk-kp-f3 nil
)
525 (define-function-key global-function-map
'xk-kp-f4 nil
)
527 (define-function-key global-function-map
'xk-kp-equal
528 '(lambda nil
(interactive)
530 (define-function-key global-function-map
'xk-kp-multiply
531 '(lambda nil
(interactive)
533 (define-function-key global-function-map
'xk-kp-add
534 '(lambda nil
(interactive)
536 (define-function-key global-function-map
'xk-kp-separator
537 '(lambda nil
(interactive)
539 (define-function-key global-function-map
'xk-kp-subtract
540 '(lambda nil
(interactive)
542 (define-function-key global-function-map
'xk-kp-decimal
543 '(lambda nil
(interactive)
545 (define-function-key global-function-map
'xk-kp-divide
546 '(lambda nil
(interactive)
549 (define-function-key global-function-map
'xk-kp-0
550 '(lambda nil
(interactive)
552 (define-function-key global-function-map
'xk-kp-1
553 '(lambda nil
(interactive)
555 (define-function-key global-function-map
'xk-kp-2
556 '(lambda nil
(interactive)
558 (define-function-key global-function-map
'xk-kp-3
559 '(lambda nil
(interactive)
561 (define-function-key global-function-map
'xk-kp-4
562 '(lambda nil
(interactive)
564 (define-function-key global-function-map
'xk-kp-5
565 '(lambda nil
(interactive)
567 (define-function-key global-function-map
'xk-kp-6
568 '(lambda nil
(interactive)
570 (define-function-key global-function-map
'xk-kp-7
571 '(lambda nil
(interactive)
573 (define-function-key global-function-map
'xk-kp-8
574 '(lambda nil
(interactive)
576 (define-function-key global-function-map
'xk-kp-9
577 '(lambda nil
(interactive)
582 (define-function-key global-function-map
'xk-f1
'rmail
)
583 (define-function-key global-function-map
'xk-f2 nil
)
584 (define-function-key global-function-map
'xk-f3 nil
)
585 (define-function-key global-function-map
'xk-f4 nil
)
586 (define-function-key global-function-map
'xk-f5 nil
)
587 (define-function-key global-function-map
'xk-f6 nil
)
588 (define-function-key global-function-map
'xk-f7 nil
)
589 (define-function-key global-function-map
'xk-f8 nil
)
590 (define-function-key global-function-map
'xk-f9 nil
)
591 (define-function-key global-function-map
'xk-f10 nil
)
592 (define-function-key global-function-map
'xk-f11 nil
)
593 (define-function-key global-function-map
'xk-f12 nil
)
594 (define-function-key global-function-map
'xk-f13 nil
)
595 (define-function-key global-function-map
'xk-f14 nil
)
596 (define-function-key global-function-map
'xk-f15 nil
)
597 (define-function-key global-function-map
'xk-f16 nil
)
598 (define-function-key global-function-map
'xk-f17 nil
)
599 (define-function-key global-function-map
'xk-f18 nil
)
600 (define-function-key global-function-map
'xk-f19 nil
)
601 (define-function-key global-function-map
'xk-f20 nil
)
602 (define-function-key global-function-map
'xk-f21 nil
)
603 (define-function-key global-function-map
'xk-f22 nil
)
604 (define-function-key global-function-map
'xk-f23 nil
)
605 (define-function-key global-function-map
'xk-f24 nil
)
606 (define-function-key global-function-map
'xk-f25 nil
)
607 (define-function-key global-function-map
'xk-f26 nil
)
608 (define-function-key global-function-map
'xk-f27 nil
)
609 (define-function-key global-function-map
'xk-f28 nil
)
610 (define-function-key global-function-map
'xk-f29 nil
)
611 (define-function-key global-function-map
'xk-f30 nil
)
612 (define-function-key global-function-map
'xk-f31 nil
)
613 (define-function-key global-function-map
'xk-f32 nil
)
614 (define-function-key global-function-map
'xk-f33 nil
)
615 (define-function-key global-function-map
'xk-f34 nil
)
616 (define-function-key global-function-map
'xk-f35 nil
)
618 ;;; Do the actual X Windows setup here; the above code just defines
619 ;;; functions and variables that we use now.
621 (setq command-line-args
(x-handle-args command-line-args
))
622 (x-open-connection (or x-display-name
623 (setq x-display-name
(getenv "DISPLAY"))))
625 ;; xterm.c depends on using interrupt-driven input, but we don't want
626 ;; the fcntls to apply to the terminal, so we do this after opening
628 (set-input-mode t nil t
)
630 (setq screen-creation-function
'x-create-screen
)
632 ;(x-pop-initial-window)
636 (error "Suspending an emacs running under X makes no sense")))
638 ;;; Turn off window-splitting optimization; X is usually fast enough
639 ;;; that this is only annoying.
640 (setq split-window-keep-point t
)
642 (define-key global-map
"\C-z" 'iconify-emacs
)