1 ;;; x-win.el --- parse switches controlling interface with X window system
6 ;; Copyright (C) 1993 Free Software Foundation, Inc.
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY. No author or distributor
12 ;; accepts responsibility to anyone for the consequences of using it
13 ;; or for whether it serves any particular purpose or works at all,
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public
15 ;; License for full details.
17 ;; Everyone is granted permission to copy, modify and redistribute
18 ;; GNU Emacs, but only under the conditions described in the
19 ;; GNU Emacs General Public License. A copy of this license is
20 ;; supposed to have been given to you along with GNU Emacs so you
21 ;; can know your rights and responsibilities. It should be in a
22 ;; file named COPYING. Among other things, the copyright notice
23 ;; and this notice must be preserved on all copies.
27 ;; X-win.el: this file is loaded from ../lisp/startup.el when it recognizes
28 ;; that X windows are to be used. Command line switches are parsed and those
29 ;; pertaining to X are processed and removed from the command line. The
30 ;; X display is opened and hooks are set for popping up the initial window.
32 ;; startup.el will then examine startup files, and eventually call the hooks
33 ;; which create the first window (s).
37 ;; These are the standard X switches from the Xt Initialize.c file of
40 ;; Command line Resource Manager string
43 ;; +synchronous *synchronous
44 ;; -background *background
47 ;; -bordercolor *borderColor
48 ;; -borderwidth .borderWidth
54 ;; -foreground *foreground
55 ;; -geometry .geometry
58 ;; -reverse *reverseVideo
60 ;; -selectionTimeout .selectionTimeout
61 ;; -synchronous *synchronous
64 ;; An alist of X options and the function which handles them. See
67 (if (not (eq window-system 'x))
68 (error "Loading x-win.el but not compiled for X"))
74 (setq command-switch-alist
75 (append '(("-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 ("-itype" . 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)
116 ("-itype" icon-type t)
117 ("-iconic" iconic-startup t)
118 ("-vb" vertical-scroll-bars t)
119 ("-hb" horizontal-scroll-bars 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 default-frame-alist
129 (cons (cons (nth 1 aelt) (nth 2 aelt))
130 default-frame-alist))
131 (setq default-frame-alist
132 (cons (cons (nth 1 aelt)
133 (car x-invocation-args))
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 default-frame-alist
142 (cons (cons (nth 1 aelt)
143 (string-to-int (car x-invocation-args)))
146 (cdr x-invocation-args)))))
148 ;; Handle the geometry option
149 (defun x-handle-geometry (switch)
150 (setq initial-frame-alist
151 (append initial-frame-alist
152 (x-parse-geometry (car x-invocation-args)))
153 x-invocation-args (cdr x-invocation-args)))
155 (defvar x-display-name nil
156 "The X display name specifying server and X frame.")
158 (defun x-handle-display (switch)
159 (setq x-display-name (car x-invocation-args)
160 x-invocation-args (cdr x-invocation-args)))
162 (defvar x-invocation-args nil)
164 (defun x-handle-args (args)
165 "Here the X-related command line options in ARGS are processed,
166 before the user's startup file is loaded. They are copied to
167 x-invocation args from which the X-related things are extracted, first
168 the switch (e.g., \"-fg\") in the following code, and possible values
169 (e.g., \"black\") in the option handler code (e.g., x-handle-switch).
170 This returns ARGS with the arguments that have been processed removed."
171 (setq x-invocation-args args
173 (while x-invocation-args
174 (let* ((this-switch (car x-invocation-args))
175 (aelt (assoc this-switch command-switch-alist)))
176 (setq x-invocation-args (cdr x-invocation-args))
178 (funcall (cdr aelt) this-switch)
179 (setq args (cons this-switch args)))))
180 (setq args (nreverse args)))
185 ;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.
188 (defconst x-pointer-X-cursor 0)
189 (defconst x-pointer-arrow 2)
190 (defconst x-pointer-based-arrow-down 4)
191 (defconst x-pointer-based-arrow-up 6)
192 (defconst x-pointer-boat 8)
193 (defconst x-pointer-bogosity 10)
194 (defconst x-pointer-bottom-left-corner 12)
195 (defconst x-pointer-bottom-right-corner 14)
196 (defconst x-pointer-bottom-side 16)
197 (defconst x-pointer-bottom-tee 18)
198 (defconst x-pointer-box-spiral 20)
199 (defconst x-pointer-center-ptr 22)
200 (defconst x-pointer-circle 24)
201 (defconst x-pointer-clock 26)
202 (defconst x-pointer-coffee-mug 28)
203 (defconst x-pointer-cross 30)
204 (defconst x-pointer-cross-reverse 32)
205 (defconst x-pointer-crosshair 34)
206 (defconst x-pointer-diamond-cross 36)
207 (defconst x-pointer-dot 38)
208 (defconst x-pointer-dotbox 40)
209 (defconst x-pointer-double-arrow 42)
210 (defconst x-pointer-draft-large 44)
211 (defconst x-pointer-draft-small 46)
212 (defconst x-pointer-draped-box 48)
213 (defconst x-pointer-exchange 50)
214 (defconst x-pointer-fleur 52)
215 (defconst x-pointer-gobbler 54)
216 (defconst x-pointer-gumby 56)
217 (defconst x-pointer-hand1 58)
218 (defconst x-pointer-hand2 60)
219 (defconst x-pointer-heart 62)
220 (defconst x-pointer-icon 64)
221 (defconst x-pointer-iron-cross 66)
222 (defconst x-pointer-left-ptr 68)
223 (defconst x-pointer-left-side 70)
224 (defconst x-pointer-left-tee 72)
225 (defconst x-pointer-leftbutton 74)
226 (defconst x-pointer-ll-angle 76)
227 (defconst x-pointer-lr-angle 78)
228 (defconst x-pointer-man 80)
229 (defconst x-pointer-middlebutton 82)
230 (defconst x-pointer-mouse 84)
231 (defconst x-pointer-pencil 86)
232 (defconst x-pointer-pirate 88)
233 (defconst x-pointer-plus 90)
234 (defconst x-pointer-question-arrow 92)
235 (defconst x-pointer-right-ptr 94)
236 (defconst x-pointer-right-side 96)
237 (defconst x-pointer-right-tee 98)
238 (defconst x-pointer-rightbutton 100)
239 (defconst x-pointer-rtl-logo 102)
240 (defconst x-pointer-sailboat 104)
241 (defconst x-pointer-sb-down-arrow 106)
242 (defconst x-pointer-sb-h-double-arrow 108)
243 (defconst x-pointer-sb-left-arrow 110)
244 (defconst x-pointer-sb-right-arrow 112)
245 (defconst x-pointer-sb-up-arrow 114)
246 (defconst x-pointer-sb-v-double-arrow 116)
247 (defconst x-pointer-shuttle 118)
248 (defconst x-pointer-sizing 120)
249 (defconst x-pointer-spider 122)
250 (defconst x-pointer-spraycan 124)
251 (defconst x-pointer-star 126)
252 (defconst x-pointer-target 128)
253 (defconst x-pointer-tcross 130)
254 (defconst x-pointer-top-left-arrow 132)
255 (defconst x-pointer-top-left-corner 134)
256 (defconst x-pointer-top-right-corner 136)
257 (defconst x-pointer-top-side 138)
258 (defconst x-pointer-top-tee 140)
259 (defconst x-pointer-trek 142)
260 (defconst x-pointer-ul-angle 144)
261 (defconst x-pointer-umbrella 146)
262 (defconst x-pointer-ur-angle 148)
263 (defconst x-pointer-watch 150)
264 (defconst x-pointer-xterm 152)
270 (defvar x-colors '("aquamarine"
328 "medium forest green"
332 "medium spring green"
412 "The full list of X colors from the rgb.text file.")
414 (defun x-defined-colors ()
415 "Return a list of colors supported by the current X-Display."
416 (let ((all-colors x-colors)
418 (defined-colors nil))
420 (setq this-color (car all-colors)
421 all-colors (cdr all-colors))
422 (and (x-color-defined-p this-color)
423 (setq defined-colors (cons this-color defined-colors))))
428 ;;; Give some common function keys reasonable definitions.
429 (define-key global-map [home] 'beginning-of-line)
430 (define-key global-map [left] 'backward-char)
431 (define-key global-map [up] 'previous-line)
432 (define-key global-map [right] 'forward-char)
433 (define-key global-map [down] 'next-line)
434 (define-key global-map [prior] 'scroll-down)
435 (define-key global-map [next] 'scroll-up)
436 ;; We use a different symbol to prevent
437 ;; doc strings from listing M-next as the preferred way to do this.
438 (fset 'advertised-scroll-other-window 'scroll-other-window)
439 (define-key global-map [M-next] 'scroll-other-window)
440 (define-key global-map [begin] 'beginning-of-buffer)
441 (define-key global-map [end] 'end-of-buffer)
443 (define-key global-map "\C-z" 'iconify-frame)
445 ;; Map certain keypad keys into ASCII characters
446 ;; that people usually expect.
447 (define-key function-key-map [backspace] [127])
448 (define-key function-key-map [delete] [127])
449 (define-key function-key-map [tab] [?\t])
450 (define-key function-key-map [linefeed] [?\n])
451 (define-key function-key-map [clear] [11])
452 (define-key function-key-map [return] [13])
453 (define-key function-key-map [escape] [?\e])
454 (define-key function-key-map [M-backspace] [?\M-\d])
455 (define-key function-key-map [M-delete] [?\M-\d])
456 (define-key function-key-map [M-tab] [?\M-\t])
457 (define-key function-key-map [M-linefeed] [?\M-\n])
458 (define-key function-key-map [M-clear] [?\M-\013])
459 (define-key function-key-map [M-return] [?\M-\015])
460 (define-key function-key-map [M-escape] [?\M-\e])
462 ;; These tell read-char how to convert
463 ;; these special chars to ASCII.
464 (put 'backspace 'ascii-character 127)
465 (put 'delete 'ascii-character 127)
466 (put 'tab 'ascii-character ?\t)
467 (put 'linefeed 'ascii-character ?\n)
468 (put 'clear 'ascii-character 12)
469 (put 'return 'ascii-character 13)
470 (put 'escape 'ascii-character ?\e)
472 ;;;; Selections and cut buffers
474 ;;; We keep track of the last text selected here, so we can check the
475 ;;; current selection against it, and avoid passing back our own text
476 ;;; from x-cut-buffer-or-selection-value.
477 (defvar x-last-selected-text nil)
479 ;;; Make TEXT, a string, the primary and clipboard X selections.
480 ;;; If you are running xclipboard, this means you can effectively
481 ;;; have a window on a copy of the kill-ring.
482 ;;; Also, set the value of X cut buffer 0, for backward compatibility
483 ;;; with older X applications.
484 (defun x-select-text (text)
485 (x-set-cut-buffer text)
486 (x-set-selection 'CLIPBOARD text)
487 (x-set-selection 'PRIMARY text)
488 (setq x-last-selected-text text))
490 ;;; Return the value of the current X selection. For compatibility
491 ;;; with older X applications, this checks cut buffer 0 before
492 ;;; retrieving the value of the primary selection.
493 (defun x-cut-buffer-or-selection-value ()
496 ;; Consult the cut buffer, then the selection. Treat empty strings
497 ;; as if they were unset.
498 (setq text (x-get-cut-buffer 0))
499 (if (string= text "") (setq text nil))
500 (or text (setq text (x-get-selection 'PRIMARY)))
501 (if (string= text "") (setq text nil))
505 ((eq text x-last-selected-text) nil)
506 ((string= text x-last-selected-text)
507 ;; Record the newer string, so subsequent calls can use the `eq' test.
508 (setq x-last-selected-text text)
511 (setq x-last-selected-text text)))))
514 ;;; Do the actual X Windows setup here; the above code just defines
515 ;;; functions and variables that we use now.
517 (setq command-line-args (x-handle-args command-line-args))
518 (x-open-connection (or x-display-name
519 (setq x-display-name (getenv "DISPLAY"))))
521 (setq frame-creation-function 'x-create-frame)
523 (defun x-win-suspend-error ()
524 (error "Suspending an emacs running under X makes no sense"))
525 (add-hook 'suspend-hook 'x-win-suspend-error)
529 ;;; Arrange for the kill and yank functions to set and check the clipboard.
530 (setq interprogram-cut-function 'x-select-text)
531 (setq interprogram-paste-function 'x-cut-buffer-or-selection-value)
533 ;;; Turn off window-splitting optimization; X is usually fast enough
534 ;;; that this is only annoying.
535 (setq split-window-keep-point t)
537 ;;; x-win.el ends here