mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-28 07:45:00 +00:00
Code Issues Releases Activity

(x-long-option-alist): New variable.

Browse Source 
(msdos-handle-args): Handle and complete long options with
attached arguments.  Support "-name", "-T" and "-rv" options.
This commit is contained in:
Eli Zaretskii 1997-10-13 16:05:32 +00:00
parent 12f230a16e
commit c8a6e3b923
1 changed files with 63 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
lisp/term/pc-win.el
View File

@ -398,25 +398,75 @@ This is in addition to the primary selection.")
(fset 'set-mouse-color 'ignore) ; We cannot, I think.
(fset 'set-cursor-color 'ignore) ; Hardware determined by char under.
(fset 'set-border-color 'ignore) ; Not useful.
;; From lisp/term/x-win.el:
(defconst x-long-option-alist
'(("--name" . "-name")
("--title" . "-T")
("--reverse-video" . "-reverse")
("--foreground-color" . "-fg")
("--background-color" . "-bg")))
;; ---------------------------------------------------------------------------
;; Handle the X-like command line parameters "-fg" and "-bg"
;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc.
(defun msdos-handle-args (args)
(let ((rest nil))
(message "%s" args)
(while args
(let ((this (car args)))
(let* ((this (car args))
(orig-this this)
completion argval)
(setq args (cdr args))
;; Check for long options with attached arguments
;; and separate out the attached option argument into argval.
(if (string-match "^--[^=]*=" this)
(setq argval (substring this (match-end 0))
this (substring this 0 (1- (match-end 0)))))
(setq completion (try-completion this x-long-option-alist))
(if (eq completion t)
;; Exact match for long option.
(setq this (cdr (assoc this x-long-option-alist)))
(if (stringp completion)
(let ((elt (assoc completion x-long-option-alist)))
;; Check for abbreviated long option.
(or elt
(error "Option `%s' is ambiguous" this))
(setq this (cdr elt)))
;; Check for a short option.
(setq argval nil this orig-this)))
(cond ((or (string= this "-fg") (string= this "-foreground"))
(if args
(or argval (setq argval (car args) args (cdr args)))
(setq default-frame-alist
(cons (cons 'foreground-color (car args))
default-frame-alist)
args (cdr args))))
(cons (cons 'foreground-color argval)
default-frame-alist)))
((or (string= this "-bg") (string= this "-background"))
(if args
(or argval (setq argval (car args) args (cdr args)))
(setq default-frame-alist
(cons (cons 'background-color (car args))
default-frame-alist)
args (cdr args))))
(cons (cons 'background-color argval)
default-frame-alist)))
((or (string= this "-T") (string= this "-name"))
(or argval (setq argval (car args) args (cdr args)))
(setq default-frame-alist
(cons
(cons 'title
(if (stringp argval)
argval
(let ((case-fold-search t)
i)
(setq argval (invocation-name))
;; Change any . or * characters in name to
;; hyphens, so as to emulate behavior on X.
(while
(setq i (string-match "[.*]" argval))
(aset argval i ?-))
argval)))
default-frame-alist)))
((or (string= this "-r")
(string= this "-rv")
(string= this "-reverse"))
(setq default-frame-alist
(cons '(reverse . t)
default-frame-alist)))
(t (setq rest (cons this rest))))))
(nreverse rest)))