diff options
| author | Jason Rumney | 2002-02-17 23:08:14 +0000 |
|---|---|---|
| committer | Jason Rumney | 2002-02-17 23:08:14 +0000 |
| commit | 3d27abc47b38f1b165683e985b957438f81fdb78 (patch) | |
| tree | 6f79a8bc290f0620a9a358175c6d54653d881529 | |
| parent | 9ef4c8ea419653295aa52ac836623b57fb21340d (diff) | |
| download | emacs-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.el | 192 |
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. |
| 310 | This is done before the user's startup file is loaded. They are copied to | 256 | This is done before the user's startup file is loaded. They are copied to |
| 311 | x-invocation args from which the X-related things are extracted, first | 257 | `x-invocation args' from which the X-related things are extracted, first |
| 312 | the switch (e.g., \"-fg\") in the following code, and possible values | 258 | the 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). |
| 314 | This returns ARGS with the arguments that have been processed removed." | 260 | 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. | ||
| 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 |