aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1995-12-29 21:09:34 +0000
committerRichard M. Stallman1995-12-29 21:09:34 +0000
commit80128ceb0479868600b90eb9f1eddcf102d72cdb (patch)
treea3e0d9576a418b6ce8d3c7699a62ed9bc195abb0
parent90681ae2ef19f34cadf4751820ffbc2ddad19c17 (diff)
downloademacs-80128ceb0479868600b90eb9f1eddcf102d72cdb.tar.gz
emacs-80128ceb0479868600b90eb9f1eddcf102d72cdb.zip
(x-handle-switch, x-handle-numeric-switch)
(x-handle-args): Use command-line-x-option-alist. (x-option-alist, x-switch-definitions, x-long-option-alist): Deleted.
-rw-r--r--lisp/term/x-win.el159
1 files changed, 45 insertions, 114 deletions
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 9aa3b7d5791..1e8cb5a5cba 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -78,106 +78,39 @@
78 78
79(defvar x-command-line-resources nil) 79(defvar x-command-line-resources nil)
80 80
81(defconst x-option-alist
82 '(("-bw" . x-handle-numeric-switch)
83 ("-d" . x-handle-display)
84 ("-display" . x-handle-display)
85 ("-name" . x-handle-name-rn-switch)
86 ("-rn" . x-handle-name-rn-switch)
87 ("-T" . x-handle-switch)
88 ("-r" . x-handle-switch)
89 ("-rv" . x-handle-switch)
90 ("-reverse" . x-handle-switch)
91 ("-fn" . x-handle-switch)
92 ("-font" . x-handle-switch)
93 ("-ib" . x-handle-numeric-switch)
94 ("-g" . x-handle-geometry)
95 ("-geometry" . x-handle-geometry)
96 ("-fg" . x-handle-switch)
97 ("-foreground". x-handle-switch)
98 ("-bg" . x-handle-switch)
99 ("-background". x-handle-switch)
100 ("-ms" . x-handle-switch)
101 ("-itype" . x-handle-switch)
102 ("-i" . x-handle-switch)
103 ("-iconic" . x-handle-iconic)
104 ("-xrm" . x-handle-xrm-switch)
105 ("-cr" . x-handle-switch)
106 ("-vb" . x-handle-switch)
107 ("-hb" . x-handle-switch)
108 ("-bd" . x-handle-switch)))
109
110(defconst x-long-option-alist
111 '(("--border-width" . "-bw")
112 ("--display" . "-d")
113 ("--name" . "-name")
114 ("--title" . "-T")
115 ("--reverse-video" . "-reverse")
116 ("--font" . "-font")
117 ("--internal-border" . "-ib")
118 ("--geometry" . "-geometry")
119 ("--foreground-color" . "-fg")
120 ("--background-color" . "-bg")
121 ("--mouse-color" . "-ms")
122 ("--icon-type" . "-itype")
123 ("--iconic" . "-iconic")
124 ("--xrm" . "-xrm")
125 ("--cursor-color" . "-cr")
126 ("--vertical-scroll-bars" . "-vb")
127 ("--border-color" . "-bd")))
128
129(defconst x-switch-definitions
130 '(("-name" name)
131 ("-T" name)
132 ("-r" reverse t)
133 ("-rv" reverse t)
134 ("-reverse" reverse t)
135 ("-fn" font)
136 ("-font" font)
137 ("-ib" internal-border-width)
138 ("-fg" foreground-color)
139 ("-foreground" foreground-color)
140 ("-bg" background-color)
141 ("-background" background-color)
142 ("-ms" mouse-color)
143 ("-cr" cursor-color)
144 ("-itype" icon-type t)
145 ("-i" icon-type t)
146 ("-vb" vertical-scroll-bars t)
147 ("-hb" horizontal-scroll-bars t)
148 ("-bd" border-color)
149 ("-bw" border-width)))
150
151;; Handler for switches of the form "-switch value" or "-switch". 81;; Handler for switches of the form "-switch value" or "-switch".
152(defun x-handle-switch (switch) 82(defun x-handle-switch (switch)
153 (let ((aelt (assoc switch x-switch-definitions))) 83 (let ((aelt (assoc switch command-line-x-option-alist)))
154 (if aelt 84 (if aelt
155 (if (nth 2 aelt) 85 (let ((param (nth 3 aelt))
86 (value (nth 4 aelt)))
87 (if value
88 (setq default-frame-alist
89 (cons (cons param value)
90 default-frame-alist))
156 (setq default-frame-alist 91 (setq default-frame-alist
157 (cons (cons (nth 1 aelt) (nth 2 aelt)) 92 (cons (cons param
158 default-frame-alist)) 93 (car x-invocation-args))
94 default-frame-alist)
95 x-invocation-args (cdr x-invocation-args)))))))
96
97;; Handler for switches of the form "-switch n"
98(defun x-handle-numeric-switch (switch)
99 (let ((aelt (assoc switch command-line-x-option-alist)))
100 (if aelt
101 (let ((param (nth 3 aelt)))
159 (setq default-frame-alist 102 (setq default-frame-alist
160 (cons (cons (nth 1 aelt) 103 (cons (cons param
161 (car x-invocation-args)) 104 (string-to-int (car x-invocation-args)))
162 default-frame-alist) 105 default-frame-alist)
163 x-invocation-args (cdr x-invocation-args)))))) 106 x-invocation-args
107 (cdr x-invocation-args))))))
164 108
165;; Make -iconic apply only to the initial frame! 109;; Make -iconic apply only to the initial frame!
166(defun x-handle-iconic (switch) 110(defun x-handle-iconic (switch)
167 (setq initial-frame-alist 111 (setq initial-frame-alist
168 (cons '(visibility . icon) initial-frame-alist))) 112 (cons '(visibility . icon) initial-frame-alist)))
169 113
170;; Handler for switches of the form "-switch n"
171(defun x-handle-numeric-switch (switch)
172 (let ((aelt (assoc switch x-switch-definitions)))
173 (if aelt
174 (setq default-frame-alist
175 (cons (cons (nth 1 aelt)
176 (string-to-int (car x-invocation-args)))
177 default-frame-alist)
178 x-invocation-args
179 (cdr x-invocation-args)))))
180
181;; Handle the -xrm option. 114;; Handle the -xrm option.
182(defun x-handle-xrm-switch (switch) 115(defun x-handle-xrm-switch (switch)
183 (or (consp x-invocation-args) 116 (or (consp x-invocation-args)
@@ -216,51 +149,49 @@
216 (setq x-display-name (car x-invocation-args) 149 (setq x-display-name (car x-invocation-args)
217 x-invocation-args (cdr x-invocation-args))) 150 x-invocation-args (cdr x-invocation-args)))
218 151
219(defvar x-invocation-args nil)
220
221(defun x-handle-args (args) 152(defun x-handle-args (args)
222 "Process the X-related command line options in ARGS. 153 "Process the X-related command line options in ARGS.
223This is done before the user's startup file is loaded. They are copied to 154This is done before the user's startup file is loaded. They are copied to
224x-invocation args from which the X-related things are extracted, first 155`x-invocation-args', from which the X-related things are extracted, first
225the switch (e.g., \"-fg\") in the following code, and possible values 156the switch (e.g., \"-fg\") in the following code, and possible values
226\(e.g., \"black\") in the option handler code (e.g., x-handle-switch). 157\(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
227This returns ARGS with the arguments that have been processed removed." 158This function returns ARGS minus the arguments that have been processed."
228 (message "%s" args) 159 ;; We use ARGS to accumulate the args that we don't handle here, to return.
229 (setq x-invocation-args args 160 (setq x-invocation-args args
230 args nil) 161 args nil)
231 (while x-invocation-args 162 (while x-invocation-args
232 (let* ((this-switch (car x-invocation-args)) 163 (let* ((this-switch (car x-invocation-args))
233 (orig-this-switch this-switch) 164 (orig-this-switch this-switch)
234 completion argval aelt) 165 completion argval aelt handler)
235 (setq x-invocation-args (cdr x-invocation-args)) 166 (setq x-invocation-args (cdr x-invocation-args))
236 ;; Check for long options with attached arguments 167 ;; Check for long options with attached arguments
237 ;; and separate out the attached option argument into argval. 168 ;; and separate out the attached option argument into argval.
238 (if (string-match "^--[^=]*=" this-switch) 169 (if (string-match "^--[^=]*=" this-switch)
239 (setq argval (substring this-switch (match-end 0)) 170 (setq argval (substring this-switch (match-end 0))
240 this-switch (substring this-switch 0 (1- (match-end 0))))) 171 this-switch (substring this-switch 0 (1- (match-end 0)))))
241 (setq completion (try-completion this-switch x-long-option-alist)) 172 ;; Complete names of long options.
242 (if (eq completion t) 173 (if (string-match "^--" this-switch)
243 ;; Exact match for long option. 174 (progn
244 (setq this-switch (cdr (assoc this-switch x-long-option-alist))) 175 (setq completion (try-completion this-switch command-line-x-option-alist))
245 (if (stringp completion) 176 (if (eq completion t)
246 (let ((elt (assoc completion x-long-option-alist))) 177 ;; Exact match for long option.
247 ;; Check for abbreviated long option. 178 nil
248 (or elt 179 (if (stringp completion)
249 (error "Option `%s' is ambiguous" this-switch)) 180 (let ((elt (assoc completion command-line-x-option-alist)))
250 (setq this-switch (cdr elt))) 181 ;; Check for abbreviated long option.
251 ;; Check for a short option. 182 (or elt
252 (setq argval nil this-switch orig-this-switch))) 183 (error "Option `%s' is ambiguous" this-switch))
253 (setq aelt (assoc this-switch x-option-alist)) 184 (setq this-switch completion))))))
254 (if aelt 185 (setq aelt (assoc this-switch command-line-x-option-alist))
186 (if aelt (setq handler (nth 2 aelt)))
187 (if handler
255 (if argval 188 (if argval
256 (let ((x-invocation-args 189 (let ((x-invocation-args
257 (cons argval x-invocation-args))) 190 (cons argval x-invocation-args)))
258 (funcall (cdr aelt) this-switch)) 191 (funcall handler this-switch))
259 (funcall (cdr aelt) this-switch)) 192 (funcall handler this-switch))
260 (setq args (cons this-switch args))))) 193 (setq args (cons orig-this-switch args)))))
261 (setq args (nreverse args))) 194 (nreverse args))
262
263
264 195
265;; 196;;
266;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them. 197;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.