/[emacs]/emacs/lisp/term/w32-win.el
ViewVC logotype

Diff of /emacs/lisp/term/w32-win.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.49 by jasonr, Sun Jan 20 15:34:00 2002 UTC revision 1.50 by jasonr, Sun Feb 17 23:08:14 2002 UTC
# Line 152  the last file dropped is selected." Line 152  the last file dropped is selected."
152    
153  (defvar x-command-line-resources nil)  (defvar x-command-line-resources nil)
154    
 (defconst x-option-alist  
   '(("-bw" .    x-handle-numeric-switch)  
     ("-d" .             x-handle-display)  
     ("-display" .       x-handle-display)  
     ("-name" .  x-handle-name-rn-switch)  
     ("-rn" .    x-handle-name-rn-switch)  
     ("-T" .             x-handle-switch)  
     ("-r" .             x-handle-switch)  
     ("-rv" .    x-handle-switch)  
     ("-reverse" .       x-handle-switch)  
     ("-fn" .    x-handle-switch)  
     ("-font" .  x-handle-switch)  
     ("-ib" .    x-handle-numeric-switch)  
     ("-g" .             x-handle-geometry)  
     ("-geometry" .      x-handle-geometry)  
     ("-fg" .    x-handle-switch)  
     ("-foreground".     x-handle-switch)  
     ("-bg" .    x-handle-switch)  
     ("-background".     x-handle-switch)  
     ("-ms" .    x-handle-switch)  
     ("-itype" . x-handle-switch)  
     ("-i"       .       x-handle-switch)  
     ("-iconic" .        x-handle-iconic)  
     ("-xrm" .       x-handle-xrm-switch)  
     ("-cr" .    x-handle-switch)  
     ("-vb" .    x-handle-switch)  
     ("-hb" .    x-handle-switch)  
     ("-bd" .    x-handle-switch)))  
   
 (defconst x-long-option-alist  
   '(("--border-width" . "-bw")  
     ("--display" .      "-d")  
     ("--name" .         "-name")  
     ("--title" .        "-T")  
     ("--reverse-video" . "-reverse")  
     ("--font" .         "-font")  
     ("--internal-border" . "-ib")  
     ("--geometry" .     "-geometry")  
     ("--foreground-color" . "-fg")  
     ("--background-color" . "-bg")  
     ("--mouse-color" .  "-ms")  
     ("--icon-type" .    "-itype")  
     ("--iconic" .       "-iconic")  
     ("--xrm" .          "-xrm")  
     ("--cursor-color" . "-cr")  
     ("--vertical-scroll-bars" . "-vb")  
     ("--border-color" . "-bd")))  
   
 (defconst x-switch-definitions  
   '(("-name" name)  
     ("-T" name)  
     ("-r" reverse t)  
     ("-rv" reverse t)  
     ("-reverse" reverse t)  
     ("-fn" font)  
     ("-font" font)  
     ("-ib" internal-border-width)  
     ("-fg" foreground-color)  
     ("-foreground" foreground-color)  
     ("-bg" background-color)  
     ("-background" background-color)  
     ("-ms" mouse-color)  
     ("-cr" cursor-color)  
     ("-itype" icon-type t)  
     ("-i" icon-type t)  
     ("-vb" vertical-scroll-bars t)  
     ("-hb" horizontal-scroll-bars t)  
     ("-bd" border-color)  
     ("-bw" border-width)))  
   
   
155  (defun x-handle-switch (switch)  (defun x-handle-switch (switch)
156    "Handle SWITCH of the form \"-switch value\" or \"-switch\"."    "Handle SWITCH of the form \"-switch value\" or \"-switch\"."
157    (let ((aelt (assoc switch x-switch-definitions)))    (let ((aelt (assoc switch command-line-x-option-alist)))
158      (if aelt      (if aelt
159          (if (nth 2 aelt)          (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))
165              (setq default-frame-alist              (setq default-frame-alist
166                    (cons (cons (nth 1 aelt) (nth 2 aelt))                    (cons (cons param
167                                  (car x-invocation-args))
168                          default-frame-alist))                          default-frame-alist))
169            (setq default-frame-alist              x-invocation-args (cdr x-invocation-args))))))
                 (cons (cons (nth 1 aelt)  
                             (car x-invocation-args))  
                       default-frame-alist)  
                 x-invocation-args (cdr x-invocation-args))))))  
   
 (defun x-handle-iconic (switch)  
   "Make \"-iconic\" SWITCH apply only to the initial frame."  
   (setq initial-frame-alist  
         (cons '(visibility . icon) initial-frame-alist)))  
   
170    
171  (defun x-handle-numeric-switch (switch)  (defun x-handle-numeric-switch (switch)
172    "Handle SWITCH of the form \"-switch n\"."    "Handle SWITCH of the form \"-switch n\"."
173    (let ((aelt (assoc switch x-switch-definitions)))    (let ((aelt (assoc switch command-line-x-option-alist)))
174      (if aelt      (if aelt
175            (let ((param (nth 3 aelt)))
176          (setq default-frame-alist          (setq default-frame-alist
177                (cons (cons (nth 1 aelt)                (cons (cons param
178                            (string-to-int (car x-invocation-args)))                            (string-to-int (car x-invocation-args)))
179                      default-frame-alist)                      default-frame-alist)
180                x-invocation-args                x-invocation-args
181                (cdr x-invocation-args)))))                (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)))
203    
204  (defun x-handle-xrm-switch (switch)  (defun x-handle-xrm-switch (switch)
205    "Handle the \"-xrm\" SWITCH."    "Handle the \"-xrm\" SWITCH."
206    (or (consp x-invocation-args)    (or (consp x-invocation-args)
207        (error "%s: missing argument to `%s' option" (invocation-name) switch))        (error "%s: missing argument to `%s' option" (invocation-name) switch))
208    (setq x-command-line-resources (car x-invocation-args))    (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))))
212    (setq x-invocation-args (cdr x-invocation-args)))    (setq x-invocation-args (cdr x-invocation-args)))
213    
214  (defun x-handle-geometry (switch)  (defun x-handle-geometry (switch)
# Line 282  the last file dropped is selected." Line 232  the last file dropped is selected."
232                        (if top (list top)))))                        (if top (list top)))))
233      (setq x-invocation-args (cdr x-invocation-args))))      (setq x-invocation-args (cdr x-invocation-args))))
234    
235  (defun x-handle-name-rn-switch (switch)  (defun x-handle-name-switch (switch)
236    "Handle a \"-name\" or \"-rn\" SWITCH."    "Handle a \"-name\" SWITCH."
237  ;; Handle the -name and -rn options.  Set the variable x-resource-name  ;; Handle the -name option.  Set the variable x-resource-name
238  ;; to the option's operand; if the switch was `-name', set the name of  ;; to the option's operand; set the name of the initial frame, too.
 ;; the initial frame, too.  
239    (or (consp x-invocation-args)    (or (consp x-invocation-args)
240        (error "%s: missing argument to `%s' option" (invocation-name) switch))        (error "%s: missing argument to `%s' option" (invocation-name) switch))
241    (setq x-resource-name (car x-invocation-args)    (setq x-resource-name (car x-invocation-args)
242          x-invocation-args (cdr x-invocation-args))          x-invocation-args (cdr x-invocation-args))
243    (if (string= switch "-name")    (setq initial-frame-alist (cons (cons 'name x-resource-name)
244        (setq initial-frame-alist (cons (cons 'name x-resource-name)                                    initial-frame-alist)))
                                       initial-frame-alist))))  
245    
246  (defvar x-display-name nil  (defvar x-display-name nil
247    "The display name specifying server and frame.")    "The display name specifying server and frame.")
# Line 303  the last file dropped is selected." Line 251  the last file dropped is selected."
251    (setq x-display-name (car x-invocation-args)    (setq x-display-name (car x-invocation-args)
252          x-invocation-args (cdr x-invocation-args)))          x-invocation-args (cdr x-invocation-args)))
253    
 (defvar x-invocation-args nil)  
   
254  (defun x-handle-args (args)  (defun x-handle-args (args)
255    "Process the X-related command line options in ARGS.    "Process the X-related command line options in ARGS.
256  This is done before the user's startup file is loaded.  They are copied to  This is done before the user's startup file is loaded.  They are copied to
257  x-invocation args from which the X-related things are extracted, first  `x-invocation args' from which the X-related things are extracted, first
258  the switch (e.g., \"-fg\") in the following code, and possible values  the switch (e.g., \"-fg\") in the following code, and possible values
259  \(e.g., \"black\") in the option handler code (e.g., x-handle-switch).  \(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
260  This returns ARGS with the arguments that have been processed removed."  This 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.
262    (setq x-invocation-args args    (setq x-invocation-args args
263          args nil)          args nil)
264    (while x-invocation-args    (while (and x-invocation-args
265                  (not (equal (car x-invocation-args) "--")))
266      (let* ((this-switch (car x-invocation-args))      (let* ((this-switch (car x-invocation-args))
267             (orig-this-switch this-switch)             (orig-this-switch this-switch)
268             completion argval aelt)             completion argval aelt handler)
269        (setq x-invocation-args (cdr x-invocation-args))        (setq x-invocation-args (cdr x-invocation-args))
270        ;; Check for long options with attached arguments        ;; Check for long options with attached arguments
271        ;; and separate out the attached option argument into argval.        ;; and separate out the attached option argument into argval.
272        (if (string-match "^--[^=]*=" this-switch)        (if (string-match "^--[^=]*=" this-switch)
273            (setq argval (substring this-switch (match-end 0))            (setq argval (substring this-switch (match-end 0))
274                  this-switch (substring this-switch 0 (1- (match-end 0)))))                  this-switch (substring this-switch 0 (1- (match-end 0)))))
275        (setq completion (try-completion this-switch x-long-option-alist))        ;; Complete names of long options.
276        (if (eq completion t)        (if (string-match "^--" this-switch)
277            ;; Exact match for long option.            (progn
278            (setq this-switch (cdr (assoc this-switch x-long-option-alist)))              (setq completion (try-completion this-switch command-line-x-option-alist))
279          (if (stringp completion)              (if (eq completion t)
280              (let ((elt (assoc completion x-long-option-alist)))                  ;; Exact match for long option.
281                ;; Check for abbreviated long option.                  nil
282                (or elt                (if (stringp completion)
283                    (error "Option `%s' is ambiguous" this-switch))                    (let ((elt (assoc completion command-line-x-option-alist)))
284                (setq this-switch (cdr elt)))                      ;; Check for abbreviated long option.
285            ;; Check for a short option.                      (or elt
286            (setq argval nil this-switch orig-this-switch)))                          (error "Option `%s' is ambiguous" this-switch))
287        (setq aelt (assoc this-switch x-option-alist))                      (setq this-switch completion))))))
288        (if aelt        (setq aelt (assoc this-switch command-line-x-option-alist))
289          (if aelt (setq handler (nth 2 aelt)))
290          (if handler
291            (if argval            (if argval
292                (let ((x-invocation-args                (let ((x-invocation-args
293                       (cons argval x-invocation-args)))                       (cons argval x-invocation-args)))
294                  (funcall (cdr aelt) this-switch))                  (funcall handler this-switch))
295              (funcall (cdr aelt) this-switch))              (funcall handler this-switch))
296          (setq args (cons this-switch args)))))          (setq args (cons orig-this-switch args)))))
297    (setq args (nreverse args)))    (nconc (nreverse args) x-invocation-args))
   
   
298    
299  ;;  ;;
300  ;; Available colors  ;; Available colors

Legend:
Removed from v.1.49  
changed lines
  Added in v.1.50

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26