diff lisp/term/pc-win.el @ 20033:2c0e89d1488b

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

--- a/lisp/term/pc-win.el	Sat Oct 11 03:57:20 1997 +0000
+++ b/lisp/term/pc-win.el	Mon Oct 13 16:05:32 1997 +0000
@@ -398,27 +398,77 @@
 (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))
 ;; ---------------------------------------------------------------------------