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

(msdos-handle-args): Handle and complete long options with
attached arguments.  Support "-name", "-T" and "-rv" options.

1 files changed, 63 insertions, 13 deletions

diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index b5a4aea0bef..5c18716a445 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -398,27 +398,77 @@ 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
-                   (setq default-frame-alist
-                         (cons (cons 'foreground-color (car args))
-                               default-frame-alist)
-                         args (cdr args))))
+               (or argval (setq argval (car args) args (cdr args)))
+               (setq default-frame-alist
+                     (cons (cons 'foreground-color argval)
+                           default-frame-alist)))
               ((or (string= this "-bg") (string= this "-background"))
-               (if args
-                   (setq default-frame-alist
-                         (cons (cons 'background-color (car args))
-                               default-frame-alist)
-                         args (cdr args))))
+               (or argval (setq argval (car args) args (cdr args)))
+               (setq default-frame-alist
+                     (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)))
+        (nreverse rest)))
 
 (setq command-line-args (msdos-handle-args command-line-args))
 ;; ---------------------------------------------------------------------------