aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJason Rumney2002-02-17 23:08:14 +0000
committerJason Rumney2002-02-17 23:08:14 +0000
commit3d27abc47b38f1b165683e985b957438f81fdb78 (patch)
tree6f79a8bc290f0620a9a358175c6d54653d881529
parent9ef4c8ea419653295aa52ac836623b57fb21340d (diff)
downloademacs-3d27abc47b38f1b165683e985b957438f81fdb78.tar.gz
emacs-3d27abc47b38f1b165683e985b957438f81fdb78.zip
(x-option-alist, x-long-option-alist)
(x-switch-definitions): Remove, use command-line-x-option-alist instead to be consistent with X. (x-handle-initial-switch): New function.
-rw-r--r--lisp/term/w32-win.el192
1 files changed, 70 insertions, 122 deletions
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index db7089af7a1..69285ff0017 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -152,113 +152,63 @@ the last file dropped is selected."
152 152
153(defvar x-command-line-resources nil) 153(defvar x-command-line-resources nil)
154 154
155(defconst x-option-alist
156 '(("-bw" . x-handle-numeric-switch)
157 ("-d" . x-handle-display)
158 ("-display" . x-handle-display)
159 ("-name" . x-handle-name-rn-switch)
160 ("-rn" . x-handle-name-rn-switch)
161 ("-T" . x-handle-switch)
162 ("-r" . x-handle-switch)
163 ("-rv" . x-handle-switch)
164 ("-reverse" . x-handle-switch)
165 ("-fn" . x-handle-switch)
166 ("-font" . x-handle-switch)
167 ("-ib" . x-handle-numeric-switch)
168 ("-g" . x-handle-geometry)
169 ("-geometry" . x-handle-geometry)
170 ("-fg" . x-handle-switch)
171 ("-foreground". x-handle-switch)
172 ("-bg" . x-handle-switch)
173 ("-background". x-handle-switch)
174 ("-ms" . x-handle-switch)
175 ("-itype" . x-handle-switch)
176 ("-i" . x-handle-switch)
177 ("-iconic" . x-handle-iconic)
178 ("-xrm" . x-handle-xrm-switch)
179 ("-cr" . x-handle-switch)
180 ("-vb" . x-handle-switch)
181 ("-hb" . x-handle-switch)
182 ("-bd" . x-handle-switch)))
183
184(defconst x-long-option-alist
185 '(("--border-width" . "-bw")
186 ("--display" . "-d")
187 ("--name" . "-name")
188 ("--title" . "-T")
189 ("--reverse-video" . "-reverse")
190 ("--font" . "-font")
191 ("--internal-border" . "-ib")
192 ("--geometry" . "-geometry")
193 ("--foreground-color" . "-fg")
194 ("--background-color" . "-bg")
195 ("--mouse-color" . "-ms")
196 ("--icon-type" . "-itype")
197 ("--iconic" . "-iconic")
198 ("--xrm" . "-xrm")
199 ("--cursor-color" . "-cr")
200 ("--vertical-scroll-bars" . "-vb")
201 ("--border-color" . "-bd")))
202
203(defconst x-switch-definitions
204 '(("-name" name)
205 ("-T" name)
206 ("-r" reverse t)
207 ("-rv" reverse t)
208 ("-reverse" reverse t)
209 ("-fn" font)
210 ("-font" font)
211 ("-ib" internal-border-width)
212 ("-fg" foreground-color)
213 ("-foreground" foreground-color)
214 ("-bg" background-color)
215 ("-background" background-color)
216 ("-ms" mouse-color)
217 ("-cr" cursor-color)
218 ("-itype" icon-type t)
219 ("-i" icon-type t)
220 ("-vb" vertical-scroll-bars t)
221 ("-hb" horizontal-scroll-bars t)
222 ("-bd" border-color)
223 ("-bw" border-width)))
224
225
226(defun x-handle-switch (switch) 155(defun x-handle-switch (switch)
227 "Handle SWITCH of the form \"-switch value\" or \"-switch\"." 156 "Handle SWITCH of the form \"-switch value\" or \"-switch\"."
228 (let ((aelt (assoc switch x-switch-definitions))) 157 (let ((aelt (assoc switch command-line-x-option-alist)))
229 (if aelt 158 (if aelt
230 (if (nth 2 aelt) 159 (let ((param (nth 3 aelt))
160 (value (nth 4 aelt)))
161 (if value
162 (setq default-frame-alist
163 (cons (cons param value)
164 default-frame-alist))
231 (setq default-frame-alist 165 (setq default-frame-alist
232 (cons (cons (nth 1 aelt) (nth 2 aelt)) 166 (cons (cons param
167 (car x-invocation-args))
233 default-frame-alist)) 168 default-frame-alist))
234 (setq default-frame-alist 169 x-invocation-args (cdr x-invocation-args))))))
235 (cons (cons (nth 1 aelt)
236 (car x-invocation-args))
237 default-frame-alist)
238 x-invocation-args (cdr x-invocation-args))))))
239
240(defun x-handle-iconic (switch)
241 "Make \"-iconic\" SWITCH apply only to the initial frame."
242 (setq initial-frame-alist
243 (cons '(visibility . icon) initial-frame-alist)))
244
245 170
246(defun x-handle-numeric-switch (switch) 171(defun x-handle-numeric-switch (switch)
247 "Handle SWITCH of the form \"-switch n\"." 172 "Handle SWITCH of the form \"-switch n\"."
248 (let ((aelt (assoc switch x-switch-definitions))) 173 (let ((aelt (assoc switch command-line-x-option-alist)))
249 (if aelt 174 (if aelt
175 (let ((param (nth 3 aelt)))
250 (setq default-frame-alist 176 (setq default-frame-alist
251 (cons (cons (nth 1 aelt) 177 (cons (cons param
252 (string-to-int (car x-invocation-args))) 178 (string-to-int (car x-invocation-args)))
253 default-frame-alist) 179 default-frame-alist)
254 x-invocation-args 180 x-invocation-args
255 (cdr x-invocation-args))))) 181 (cdr x-invocation-args))))))
182
183;; Handle options that apply to initial frame only
184(defun x-handle-initial-switch (switch)
185 (let ((aelt (assoc switch command-line-x-option-alist)))
186 (if aelt
187 (let ((param (nth 3 aelt))
188 (value (nth 4 aelt)))
189 (if value
190 (setq initial-frame-alist
191 (cons (cons param value)
192 initial-frame-alist))
193 (setq initial-frame-alist
194 (cons (cons param
195 (car x-invocation-args))
196 initial-frame-alist)
197 x-invocation-args (cdr x-invocation-args)))))))
198
199(defun x-handle-iconic (switch)
200 "Make \"-iconic\" SWITCH apply only to the initial frame."
201 (setq initial-frame-alist
202 (cons '(visibility . icon) initial-frame-alist)))
256 203
257(defun x-handle-xrm-switch (switch) 204(defun x-handle-xrm-switch (switch)
258 "Handle the \"-xrm\" SWITCH." 205 "Handle the \"-xrm\" SWITCH."
259 (or (consp x-invocation-args) 206 (or (consp x-invocation-args)
260 (error "%s: missing argument to `%s' option" (invocation-name) switch)) 207 (error "%s: missing argument to `%s' option" (invocation-name) switch))
261 (setq x-command-line-resources (car x-invocation-args)) 208 (setq x-command-line-resources
209 (if (null x-command-line-resources)
210 (car x-invocation-args)
211 (concat x-command-line-resources "\n" (car x-invocation-args))))
262 (setq x-invocation-args (cdr x-invocation-args))) 212 (setq x-invocation-args (cdr x-invocation-args)))
263 213
264(defun x-handle-geometry (switch) 214(defun x-handle-geometry (switch)
@@ -282,18 +232,16 @@ the last file dropped is selected."
282 (if top (list top))))) 232 (if top (list top)))))
283 (setq x-invocation-args (cdr x-invocation-args)))) 233 (setq x-invocation-args (cdr x-invocation-args))))
284 234
285(defun x-handle-name-rn-switch (switch) 235(defun x-handle-name-switch (switch)
286 "Handle a \"-name\" or \"-rn\" SWITCH." 236 "Handle a \"-name\" SWITCH."
287;; Handle the -name and -rn options. Set the variable x-resource-name 237;; Handle the -name option. Set the variable x-resource-name
288;; to the option's operand; if the switch was `-name', set the name of 238;; to the option's operand; set the name of the initial frame, too.
289;; the initial frame, too.
290 (or (consp x-invocation-args) 239 (or (consp x-invocation-args)
291 (error "%s: missing argument to `%s' option" (invocation-name) switch)) 240 (error "%s: missing argument to `%s' option" (invocation-name) switch))
292 (setq x-resource-name (car x-invocation-args) 241 (setq x-resource-name (car x-invocation-args)
293 x-invocation-args (cdr x-invocation-args)) 242 x-invocation-args (cdr x-invocation-args))
294 (if (string= switch "-name") 243 (setq initial-frame-alist (cons (cons 'name x-resource-name)
295 (setq initial-frame-alist (cons (cons 'name x-resource-name) 244 initial-frame-alist)))
296 initial-frame-alist))))
297 245
298(defvar x-display-name nil 246(defvar x-display-name nil
299 "The display name specifying server and frame.") 247 "The display name specifying server and frame.")
@@ -303,50 +251,50 @@ the last file dropped is selected."
303 (setq x-display-name (car x-invocation-args) 251 (setq x-display-name (car x-invocation-args)
304 x-invocation-args (cdr x-invocation-args))) 252 x-invocation-args (cdr x-invocation-args)))
305 253
306(defvar x-invocation-args nil)
307
308(defun x-handle-args (args) 254(defun x-handle-args (args)
309 "Process the X-related command line options in ARGS. 255 "Process the X-related command line options in ARGS.
310This is done before the user's startup file is loaded. They are copied to 256This is done before the user's startup file is loaded. They are copied to
311x-invocation args from which the X-related things are extracted, first 257`x-invocation args' from which the X-related things are extracted, first
312the switch (e.g., \"-fg\") in the following code, and possible values 258the switch (e.g., \"-fg\") in the following code, and possible values
313\(e.g., \"black\") in the option handler code (e.g., x-handle-switch). 259\(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
314This returns ARGS with the arguments that have been processed removed." 260This returns ARGS with the arguments that have been processed removed."
261 ;; We use ARGS to accumulate the args that we don't handle here, to return.
315 (setq x-invocation-args args 262 (setq x-invocation-args args
316 args nil) 263 args nil)
317 (while x-invocation-args 264 (while (and x-invocation-args
265 (not (equal (car x-invocation-args) "--")))
318 (let* ((this-switch (car x-invocation-args)) 266 (let* ((this-switch (car x-invocation-args))
319 (orig-this-switch this-switch) 267 (orig-this-switch this-switch)
320 completion argval aelt) 268 completion argval aelt handler)
321 (setq x-invocation-args (cdr x-invocation-args)) 269 (setq x-invocation-args (cdr x-invocation-args))
322 ;; Check for long options with attached arguments 270 ;; Check for long options with attached arguments
323 ;; and separate out the attached option argument into argval. 271 ;; and separate out the attached option argument into argval.
324 (if (string-match "^--[^=]*=" this-switch) 272 (if (string-match "^--[^=]*=" this-switch)
325 (setq argval (substring this-switch (match-end 0)) 273 (setq argval (substring this-switch (match-end 0))
326 this-switch (substring this-switch 0 (1- (match-end 0))))) 274 this-switch (substring this-switch 0 (1- (match-end 0)))))
327 (setq completion (try-completion this-switch x-long-option-alist)) 275 ;; Complete names of long options.
328 (if (eq completion t) 276 (if (string-match "^--" this-switch)
329 ;; Exact match for long option. 277 (progn
330 (setq this-switch (cdr (assoc this-switch x-long-option-alist))) 278 (setq completion (try-completion this-switch command-line-x-option-alist))
331 (if (stringp completion) 279 (if (eq completion t)
332 (let ((elt (assoc completion x-long-option-alist))) 280 ;; Exact match for long option.
333 ;; Check for abbreviated long option. 281 nil
334 (or elt 282 (if (stringp completion)
335 (error "Option `%s' is ambiguous" this-switch)) 283 (let ((elt (assoc completion command-line-x-option-alist)))
336 (setq this-switch (cdr elt))) 284 ;; Check for abbreviated long option.
337 ;; Check for a short option. 285 (or elt
338 (setq argval nil this-switch orig-this-switch))) 286 (error "Option `%s' is ambiguous" this-switch))
339 (setq aelt (assoc this-switch x-option-alist)) 287 (setq this-switch completion))))))
340 (if aelt 288 (setq aelt (assoc this-switch command-line-x-option-alist))
289 (if aelt (setq handler (nth 2 aelt)))
290 (if handler
341 (if argval 291 (if argval
342 (let ((x-invocation-args 292 (let ((x-invocation-args
343 (cons argval x-invocation-args))) 293 (cons argval x-invocation-args)))
344 (funcall (cdr aelt) this-switch)) 294 (funcall handler this-switch))
345 (funcall (cdr aelt) this-switch)) 295 (funcall handler this-switch))
346 (setq args (cons this-switch args))))) 296 (setq args (cons orig-this-switch args)))))
347 (setq args (nreverse args))) 297 (nconc (nreverse args) x-invocation-args))
348
349
350 298
351;; 299;;
352;; Available colors 300;; Available colors