* patch for startup.el (fix barf when first arg to `command-line-1' is in --opt=val form)
@ 2003-02-18 8:04 Matt Swift
2003-02-19 4:40 ` patch for startup.el (fix barf when first arg to`command-line-1' " Richard Stallman
0 siblings, 1 reply; 2+ messages in thread
From: Matt Swift @ 2003-02-18 8:04 UTC (permalink / raw)
This patch is against startup.el 1.312 and is a supserset of the patch
I submitted earlier today.
2003-02-18 Matt Swift <swift@alum.mit.edu>
* 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))
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2003-02-19 4:40 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-02-18 8:04 patch for startup.el (fix barf when first arg to `command-line-1' is in --opt=val form) Matt Swift
2003-02-19 4:40 ` patch for startup.el (fix barf when first arg to`command-line-1' " Richard Stallman
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.