From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Matt Swift Newsgroups: gmane.emacs.bugs Subject: patch for startup.el (fix barf when first arg to `command-line-1' is in --opt=val form) Date: Tue, 18 Feb 2003 03:04:04 -0500 Sender: bug-gnu-emacs-bounces+gnu-bug-gnu-emacs=m.gmane.org@gnu.org Message-ID: NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1045555446 12940 80.91.224.249 (18 Feb 2003 08:04:06 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Tue, 18 Feb 2003 08:04:06 +0000 (UTC) Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 18l2hp-0003Gs-01 for ; Tue, 18 Feb 2003 09:02:21 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 18l2jz-00058M-05 for gnu-bug-gnu-emacs@m.gmane.org; Tue, 18 Feb 2003 03:04:36 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10.13) id 18l2jq-00057Q-00 for bug-gnu-emacs@gnu.org; Tue, 18 Feb 2003 03:04:26 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10.13) id 18l2jn-00056g-00 for bug-gnu-emacs@gnu.org; Tue, 18 Feb 2003 03:04:25 -0500 Original-Received: from pool-68-160-54-133.bos.east.verizon.net ([68.160.54.133] helo=beth.swift.xxx) by monty-python.gnu.org with esmtp (Exim 4.10.13) id 18l2jl-00055L-00 for bug-gnu-emacs@gnu.org; Tue, 18 Feb 2003 03:04:21 -0500 Original-Received: from beth.swift.xxx (swift@localhost [127.0.0.1]) h1I844BH013862verify=FAIL) for ; Tue, 18 Feb 2003 03:04:04 -0500 Original-Received: (from swift@localhost) by beth.swift.xxx (8.12.6/8.12.6/Debian-8) id h1I844x3013860; Tue, 18 Feb 2003 03:04:04 -0500 Original-To: bug-gnu-emacs@gnu.org User-Agent: Gnus/5.090016 (Oort Gnus v0.16) Emacs/21.2 X-Mailscanner: clean (beth.swift.xxx) X-BeenThere: bug-gnu-emacs@gnu.org X-Mailman-Version: 2.1b5 Precedence: list List-Id: Bug reports for GNU Emacs, the Swiss army knife of text editors List-Help: List-Post: List-Subscribe: , List-Archive: List-Unsubscribe: , Errors-To: bug-gnu-emacs-bounces+gnu-bug-gnu-emacs=m.gmane.org@gnu.org Xref: main.gmane.org gmane.emacs.bugs:4484 X-Report-Spam: http://spam.gmane.org/gmane.emacs.bugs:4484 This patch is against startup.el 1.312 and is a supserset of the patch I submitted earlier today. 2003-02-18 Matt Swift * startup.el: Make parallel pieces of code in different functions as similar as possible, so a reader can recognize what it's doing more easily. Examples: parsing an --OPT=VAL argument (three instances), use (member x '(a b)) instead of (or (equal x a) \(equal x b)), use `equal' instead of random choice of `equal' `string-equal' and `string='. Rephrase booleans to avoid `(not noninteractive)'. Clarify several booleans using De Morgan's laws. Example: (when (and (not (display-graphic-p)) (not noninteractive)) versus (unless (or (display-graphic-p) noninteractive) Simplify and streamline here and there, e.g., use `push' and `pop' instead of more verbose constructions. (command-line): Fix barf when first command-line option handled by `command-line-1' is in the form --OPT=VAL. (command-line-1): Remove unnecessary variables `extra-load-path' and `initial-load-path'. --- startup.el 4 Feb 2003 12:06:14 -0000 1.312 +++ startup.el 18 Feb 2003 07:19:17 -0000 @@ -575,81 +575,71 @@ (defvar tool-bar-originally-present nil "Non-nil if tool-bars are present before user and site init files are read.") -;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc. +;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc. (defun tty-handle-args (args) - (let ((rest nil)) + (let (rest) (message "%s" args) (while (and args (not (equal (car args) "--"))) - (let* ((this (car args)) - (orig-this this) - completion argval) - (setq args (cdr args)) + (let* ((argi (pop args)) + (orig-argi argi) + argval completion) ;; 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))))) - (when (string-match "^--" this) - (setq completion (try-completion this tty-long-option-alist)) + (when (string-match "^\\(--[^=]*\\)=" argi) + (setq argval (substring argi (match-end 0)) + argi (match-string 1 argi))) + (when (string-match "^--" argi) + (setq completion (try-completion argi tty-long-option-alist)) (if (eq completion t) ;; Exact match for long option. - (setq this (cdr (assoc this tty-long-option-alist))) + (setq argi (cdr (assoc argi tty-long-option-alist))) (if (stringp completion) (let ((elt (assoc completion tty-long-option-alist))) ;; Check for abbreviated long option. (or elt - (error "Option `%s' is ambiguous" this)) - (setq this (cdr elt))) + (error "Option `%s' is ambiguous" argi)) + (setq argi (cdr elt))) ;; Check for a short option. - (setq argval nil this orig-this)))) - (cond ((or (string= this "-fg") (string= this "-foreground")) - (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")) - (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))) - ((string= this "-color") - (if (null argval) - (setq argval 8)) ; default --color means 8 ANSI colors - (setq default-frame-alist - (cons (cons 'tty-color-mode - (cond - ((numberp argval) argval) - ((string-match "-?[0-9]+" argval) - (string-to-number argval)) - (t (intern argval)))) - default-frame-alist))) - (t (setq rest (cons this rest)))))) - (nreverse rest))) + (setq argval nil + argi orig-argi)))) + (cond ((member argi '("-fg" "-foreground")) + (push (cons 'foreground-color (or argval (pop args))) + default-frame-alist)) + ((member argi '("-bg" "-background")) + (push (cons 'background-color (or argval (pop args))) + default-frame-alist)) + ((member argi '("-T" "-name")) + (unless argval (setq argval (pop args))) + (push (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)) + ((member argi '("-r" "-rv" "-reverse")) + (push '(reverse . t) + default-frame-alist)) + ((equal argi "-color") + (unless argval (setq argval 8)) ; default --color means 8 ANSI colors + (push (cons 'tty-color-mode + (cond + ((numberp argval) argval) + ((string-match "-?[0-9]+" argval) + (string-to-number argval)) + (t (intern argval)))) + default-frame-alist)) + (t + (push argi rest))))) + (nreverse rest))) (defun command-line () (setq command-line-default-directory default-directory) @@ -675,14 +665,11 @@ ;; See if we should import version-control from the environment variable. (let ((vc (getenv "VERSION_CONTROL"))) (cond ((eq vc nil)) ;don't do anything if not set - ((or (string= vc "t") - (string= vc "numbered")) + ((member vc '("t" "numbered")) (setq version-control t)) - ((or (string= vc "nil") - (string= vc "existing")) + ((member vc '("nil" "existing")) (setq version-control nil)) - ((or (string= vc "never") - (string= vc "simple")) + ((member vc '("never" "simple")) (setq version-control 'never)))) ;;! This has been commented out; I currently find the behavior when @@ -695,15 +682,15 @@ ;; end-of-line formats that aren't native to this platform. (cond ((memq system-type '(ms-dos windows-nt emx)) - (setq eol-mnemonic-unix "(Unix)") - (setq eol-mnemonic-mac "(Mac)")) + (setq eol-mnemonic-unix "(Unix)" + eol-mnemonic-mac "(Mac)")) ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the ;; abbreviated strings `/' and `:' set in coding.c for them. ((eq system-type 'macos) (setq eol-mnemonic-dos "(DOS)")) - (t ; this is for Unix/GNU/Linux systems - (setq eol-mnemonic-dos "(DOS)") - (setq eol-mnemonic-mac "(Mac)"))) + (t ; this is for Unix/GNU/Linux systems + (setq eol-mnemonic-dos "(DOS)" + eol-mnemonic-mac "(Mac)"))) ;; Read window system's init file if using a window system. (condition-case error @@ -721,21 +708,20 @@ (apply 'concat (cdr error)) (if (memq 'file-error (get (car error) 'error-conditions)) (format "%s: %s" - (nth 1 error) - (mapconcat (lambda (obj) (prin1-to-string obj t)) - (cdr (cdr error)) ", ")) + (nth 1 error) + (mapconcat (lambda (obj) (prin1-to-string obj t)) + (cdr (cdr error)) ", ")) (format "%s: %s" - (get (car error) 'error-message) - (mapconcat (lambda (obj) (prin1-to-string obj t)) - (cdr error) ", ")))) + (get (car error) 'error-message) + (mapconcat (lambda (obj) (prin1-to-string obj t)) + (cdr error) ", ")))) 'external-debugging-output) (terpri 'external-debugging-output) (setq window-system nil) (kill-emacs))) ;; Windowed displays do this inside their *-win.el. - (when (and (not (display-graphic-p)) - (not noninteractive)) + (unless (or (display-graphic-p) noninteractive) (setq command-line-args (tty-handle-args command-line-args))) (set-locale-environment nil) @@ -745,7 +731,7 @@ (while args (setcar args (decode-coding-string (car args) locale-coding-system t)) - (setq args (cdr args)))) + (pop args))) (let ((done nil) (args (cdr command-line-args))) @@ -754,22 +740,23 @@ ;; either from the environment or from the options. (setq init-file-user (if noninteractive nil (user-login-name))) ;; If user has not done su, use current $HOME to find .emacs. - (and init-file-user (string= init-file-user (user-real-login-name)) + (and init-file-user + (equal init-file-user (user-real-login-name)) (setq init-file-user "")) ;; Process the command-line args, and delete the arguments ;; processed. This is consistent with the way main in emacs.c ;; does things. (while (and (not done) args) - (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user") - ("--debug-init") ("--iconic") ("--icon-type"))) - (argi (pop args)) - (argval nil)) + (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--user") + ("--debug-init") ("--iconic") ("--icon-type"))) + (argi (pop args)) + (orig-argi argi) + argval) ;; Handle --OPTION=VALUE format. - (when (and (string-match "\\`--" argi) - (string-match "=" argi)) + (when (string-match "^\\(--[^=]*\\)=" argi) (setq argval (substring argi (match-end 0)) - argi (substring argi 0 (match-beginning 0)))) + argi (match-string 1 argi))) (unless (equal argi "--") (let ((completion (try-completion argi longopts))) (if (eq completion t) @@ -779,54 +766,54 @@ (or elt (error "Option `%s' is ambiguous" argi)) (setq argi (substring (car elt) 1))) - (setq argval nil))))) + (setq argval nil + argi orig-argi))))) (cond ((member argi '("-q" "-no-init-file")) (setq init-file-user nil)) ((member argi '("-u" "-user")) - (or argval - (setq argval (pop args))) - (setq init-file-user argval + (setq init-file-user (or argval (pop args)) argval nil)) - ((string-equal argi "-no-site-file") + ((equal argi "-no-site-file") (setq site-run-file nil)) - ((string-equal argi "-debug-init") + ((equal argi "-debug-init") (setq init-file-debug t)) - ((string-equal argi "-iconic") + ((equal argi "-iconic") (push '(visibility . icon) initial-frame-alist)) - ((or (string-equal argi "-icon-type") - (string-equal argi "-i") - (string-equal argi "-itype")) + ((member argi '("-icon-type" "-i" "-itype")) (push '(icon-type . t) default-frame-alist)) ;; Push the popped arg back on the list of arguments. - (t (push argi args) (setq done t))) + (t + (push argi args) + (setq done t))) ;; Was argval set but not used? (and argval (error "Option `%s' doesn't allow an argument" argi)))) ;; Re-attach the program name to the front of the arg list. - (and command-line-args (setcdr command-line-args args))) + (and command-line-args + (setcdr command-line-args args))) ;; Under X Windows, this creates the X frame and deletes the terminal frame. (when (fboundp 'frame-initialize) (frame-initialize)) ;; If frame was created with a menu bar, set menu-bar-mode on. - (if (and (not noninteractive) - (or (not (memq window-system '(x w32))) - (> (frame-parameter nil 'menu-bar-lines) 0))) - (menu-bar-mode t)) + (unless (or noninteractive + (and (memq window-system '(x w32)) + (<= (frame-parameter nil 'menu-bar-lines) 0))) + (menu-bar-mode t)) ;; If frame was created with a tool bar, switch tool-bar-mode on. - (when (and (not noninteractive) - (display-graphic-p) - (> (frame-parameter nil 'tool-bar-lines) 0)) + (unless (or noninteractive + (not (display-graphic-p)) + (<= (frame-parameter nil 'tool-bar-lines) 0)) (tool-bar-mode 1)) ;; Can't do this init in defcustom because window-system isn't set. - (when (and (not noninteractive) - (not (eq system-type 'ms-dos)) - (memq window-system '(x w32))) + (unless (or noninteractive + (eq system-type 'ms-dos) + (not (memq window-system '(x w32)))) (setq-default blink-cursor t) (blink-cursor-mode 1)) @@ -845,19 +832,19 @@ (setq-default normal-erase-is-backspace t) (normal-erase-is-backspace-mode 1))) - (when (and (not noninteractive) - (display-graphic-p) - (fboundp 'x-show-tip)) + (unless (or noninteractive + (not (display-graphic-p)) + (not (fboundp 'x-show-tip))) (setq-default tooltip-mode t) (tooltip-mode 1)) ;; Register default TTY colors for the case the terminal hasn't a ;; terminal init file. - (or (memq window-system '(x w32)) - ;; We do this regardles of whether the terminal supports colors - ;; or not, since they can switch that support on or off in - ;; mid-session by setting the tty-color-mode frame parameter. - (tty-register-default-colors)) + (unless (memq window-system '(x w32)) + ;; We do this regardles of whether the terminal supports colors + ;; or not, since they can switch that support on or off in + ;; mid-session by setting the tty-color-mode frame parameter. + (tty-register-default-colors)) ;; Record whether the tool-bar is present before the user and site ;; init files are processed. frame-notice-user-settings uses this @@ -867,9 +854,9 @@ (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) (assq 'tool-bar-lines default-frame-alist)))) (setq tool-bar-originally-present - (not (or (null tool-bar-lines) - (null (cdr tool-bar-lines)) - (eq 0 (cdr tool-bar-lines))))))) + (and tool-bar-lines + (cdr tool-bar-lines) + (not (eq 0 (cdr tool-bar-lines))))))) (let ((old-scalable-fonts-allowed scalable-fonts-allowed) (old-font-list-limit font-list-limit) @@ -952,19 +939,19 @@ (sit-for 1)) (setq user-init-file source)))) - (when (and (stringp custom-file) - (not (assoc custom-file load-history))) - ;; If the .emacs file has set `custom-file' but hasn't - ;; loaded the file yet, let's load it. - (load custom-file t t)) - - (or inhibit-default-init - (let ((inhibit-startup-message nil)) - ;; Users are supposed to be told their rights. - ;; (Plus how to get help and how to undo.) - ;; Don't you dare turn this off for anyone - ;; except yourself. - (load "default" t t))))))))) + (when (stringp custom-file) + (unless (assoc custom-file load-history) + ;; If the .emacs file has set `custom-file' but hasn't + ;; loaded the file yet, let's load it. + (load custom-file t t))) + + (unless inhibit-default-init + (let ((inhibit-startup-message nil)) + ;; Users are supposed to be told their rights. + ;; (Plus how to get help and how to undo.) + ;; Don't you dare turn this off for anyone + ;; except yourself. + (load "default" t t))))))))) (if init-file-debug ;; Do this without a condition-case if the user wants to debug. (funcall inner) @@ -1050,15 +1037,18 @@ ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. - (and term-file-prefix (not noninteractive) (not window-system) - (let ((term (getenv "TERM")) - hyphend) - (while (and term - (not (load (concat term-file-prefix term) t t))) - ;; Strip off last hyphen and what follows, then try again - (if (setq hyphend (string-match "[-_][^-_]+$" term)) - (setq term (substring term 0 hyphend)) - (setq term nil))))) + (unless (or noninteractive + window-system + (null term-file-prefix)) + (let ((term (getenv "TERM")) + hyphend) + (while (and term + (not (load (concat term-file-prefix term) t t))) + ;; Strip off last hyphen and what follows, then try again + (setq term + (if (setq hyphend (string-match "[-_][^-_]+$" term)) + (substring term 0 hyphend) + nil))))) ;; Update the out-of-memory error message based on user's key bindings ;; for save-some-buffers. @@ -1074,7 +1064,8 @@ ;; Run emacs-session-restore (session management) if started by ;; the session manager and we have a session manager connection. - (if (and (boundp 'x-session-previous-id) (stringp x-session-previous-id)) + (if (and (boundp 'x-session-previous-id) + (stringp x-session-previous-id)) (emacs-session-restore x-session-previous-id))) (defcustom initial-scratch-message (purecopy "\ @@ -1581,11 +1572,7 @@ (while (and command-line-args-left) (let* ((argi (car command-line-args-left)) (orig-argi argi) - argval completion - ;; List of directories specified in -L/--directory, - ;; in reverse of the order specified. - extra-load-path - (initial-load-path load-path)) + argval completion) (setq command-line-args-left (cdr command-line-args-left)) ;; Do preliminary decoding of the option. @@ -1594,9 +1581,9 @@ (setq argi "") ;; Convert long options to ordinary options ;; and separate out an attached option argument into argval. - (if (string-match "^--[^=]*=" argi) - (setq argval (substring argi (match-end 0)) - argi (substring argi 0 (1- (match-end 0))))) + (when (string-match "^\\(--[^=]*\\)=" argi) + (setq argval (substring argi (match-end 0)) + argi (match-string 1 argi))) (if (equal argi "--") (setq completion nil) (setq completion (try-completion argi longopts))) @@ -1607,7 +1594,8 @@ (or elt (error "Option `%s' is ambiguous" argi)) (setq argi (substring (car elt) 1))) - (setq argval nil argi orig-argi)))) + (setq argval nil + argi orig-argi)))) ;; Execute the option. (cond ((setq tem (assoc argi command-switch-alist)) @@ -1617,61 +1605,43 @@ (funcall (cdr tem) argi)) (funcall (cdr tem) argi))) - ((string-equal argi "-no-splash") + ((equal argi "-no-splash") (setq inhibit-startup-message t)) - ((member argi '("-f" ;what the manual claims + ((member argi '("-f" ; what the manual claims "-funcall" "-e")) ; what the source used to say - (if argval - (setq tem (intern argval)) - (setq tem (intern (car command-line-args-left))) - (setq command-line-args-left (cdr command-line-args-left))) + (setq tem (intern (or argval (pop command-line-args-left)))) (if (arrayp (symbol-function tem)) (command-execute tem) (funcall tem))) ((member argi '("-eval" "-execute")) - (if argval - (setq tem argval) - (setq tem (car command-line-args-left)) - (setq command-line-args-left (cdr command-line-args-left))) - (eval (read tem))) + (eval (read (or argval (pop command-line-args-left))))) ;; Set the default directory as specified in -L. ((member argi '("-L" "-directory")) - (if argval - (setq tem argval) - (setq tem (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) - (setq tem (command-line-normalize-file-name tem)) - (setq extra-load-path - (cons (expand-file-name tem) extra-load-path)) - (setq load-path (append (nreverse extra-load-path) - initial-load-path))) + (setq tem (or argval (pop command-line-args-left))) + (push + (expand-file-name (command-line-normalize-file-name tem)) + load-path)) ((member argi '("-l" "-load")) - (if argval - (setq tem argval) - (setq tem (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) - (let ((file (command-line-normalize-file-name tem))) - ;; Take file from default dir if it exists there; - ;; otherwise let `load' search for it. - (if (file-exists-p (expand-file-name file)) - (setq file (expand-file-name file))) + (let* ((file (command-line-normalize-file-name + (or argval (pop command-line-args-left)))) + ;; Take file from default dir if it exists there; + ;; otherwise let `load' search for it. + (file-ex (expand-file-name file)) + (file (and (file-exists-p file-ex) file-ex))) (load file nil t))) - ((string-equal argi "-insert") - (if argval - (setq tem argval) - (setq tem (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) + ((equal argi "-insert") + (setq tem (or argval (pop command-line-args-left))) (or (stringp tem) (error "File name omitted from `-insert' option")) (insert-file-contents (command-line-normalize-file-name tem))) - ((string-equal argi "-kill") + ((equal argi "-kill") (kill-emacs t)) ((string-match "^\\+[0-9]+\\'" argi) @@ -1688,10 +1658,7 @@ ((member argi '("-find-file" "-file" "-visit")) ;; An explicit option to specify visiting a file. - (if argval - (setq tem argval) - (setq tem (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) + (setq tem (or argval (pop command-line-args-left))) (unless (stringp tem) (error "File name omitted from `%s' option" argi)) (setq file-count (1+ file-count)) @@ -1712,13 +1679,13 @@ (t ;; We have almost exhausted our options. See if the ;; user has made any other command-line options available - (let ((hooks command-line-functions) ;; lrs 7/31/89 + (let ((hooks command-line-functions) ;; lrs 7/31/89 (did-hook nil)) (while (and hooks (not (setq did-hook (funcall (car hooks))))) (setq hooks (cdr hooks))) (if (not did-hook) - ;; Ok, presume that the argument is a file name + ;; Ok, presume that the argument is a file name (progn (if (string-match "\\`-" argi) (error "Unknown option `%s'" argi))