procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* startup.el: Streamline code in several functions and use a more

Browse source 
consistent idiom within the file, for ease of reading and
	maintenance.  Rephrase booleans to avoid `(not noninteractive)'.
	Clarify several booleans expressions using De Morgan's laws.

	(command-line): Fix barf when first command-line option handled by
	`command-line-1' is in the form --OPT=VAL.
	(command-line-1): Restore intended behavior of the --directory/-L
	command-line option: "-L a -L b -L c" on the command-line now puts
	'(a b c) at the front of `load-path'.
This commit is contained in:
Matthew Swift 2003-02-26 10:59:58 +00:00
parent f9d56d5997
commit bca8c7be06
1 changed files with 304 additions and 323 deletions
Download patch file Download diff file Expand all files Collapse all files

627
lisp/startup.el
View file

@ -580,81 +580,71 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(defvar tool-bar-originally-present nil (defvar tool-bar-originally-present nil
"Non-nil if tool-bars are present before user and site init files are read.") "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) (defun tty-handle-args (args)
(let ((rest nil)) (let (rest)
(message "%s" args) (message "%s" args)
(while (and args (while (and args
(not (equal (car args) "--"))) (not (equal (car args) "--")))
(let* ((this (car args)) (let* ((argi (pop args))
(orig-this this) (orig-argi argi)
completion argval) argval completion)
(setq args (cdr args))
;; Check for long options with attached arguments ;; Check for long options with attached arguments
;; and separate out the attached option argument into argval. ;; and separate out the attached option argument into argval.
(if (string-match "^--[^=]*=" this) (when (string-match "^\\(--[^=]*\\)=" argi)
(setq argval (substring this (match-end 0)) (setq argval (substring argi (match-end 0))
this (substring this 0 (1- (match-end 0))))) argi (match-string 1 argi)))
(when (string-match "^--" this) (when (string-match "^--" argi)
(setq completion (try-completion this tty-long-option-alist)) (setq completion (try-completion argi tty-long-option-alist))
(if (eq completion t) (if (eq completion t)
;; Exact match for long option. ;; 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) (if (stringp completion)
(let ((elt (assoc completion tty-long-option-alist))) (let ((elt (assoc completion tty-long-option-alist)))
;; Check for abbreviated long option. ;; Check for abbreviated long option.
(or elt (or elt
(error "Option `%s' is ambiguous" this)) (error "Option `%s' is ambiguous" argi))
(setq this (cdr elt))) (setq argi (cdr elt)))
;; Check for a short option. ;; Check for a short option.
(setq argval nil this orig-this)))) (setq argval nil
(cond ((or (string= this "-fg") (string= this "-foreground")) argi orig-argi))))
(or argval (setq argval (car args) args (cdr args))) (cond ((member argi '("-fg" "-foreground"))
(setq default-frame-alist (push (cons 'foreground-color (or argval (pop args)))
(cons (cons 'foreground-color argval) default-frame-alist))
default-frame-alist))) ((member argi '("-bg" "-background"))
((or (string= this "-bg") (string= this "-background")) (push (cons 'background-color (or argval (pop args)))
(or argval (setq argval (car args) args (cdr args))) default-frame-alist))
(setq default-frame-alist ((member argi '("-T" "-name"))
(cons (cons 'background-color argval) (unless argval (setq argval (pop args)))
default-frame-alist))) (push (cons 'title
((or (string= this "-T") (string= this "-name")) (if (stringp argval)
(or argval (setq argval (car args) args (cdr args))) argval
(setq default-frame-alist (let ((case-fold-search t)
(cons i)
(cons 'title (setq argval (invocation-name))
(if (stringp argval)
argval
(let ((case-fold-search t)
i)
(setq argval (invocation-name))
;; Change any . or * characters in name to ;; Change any . or * characters in name to
;; hyphens, so as to emulate behavior on X. ;; hyphens, so as to emulate behavior on X.
(while (while
(setq i (string-match "[.*]" argval)) (setq i (string-match "[.*]" argval))
(aset argval i ?-)) (aset argval i ?-))
argval))) argval)))
default-frame-alist))) default-frame-alist))
((or (string= this "-r") ((member argi '("-r" "-rv" "-reverse"))
(string= this "-rv") (push '(reverse . t)
(string= this "-reverse")) default-frame-alist))
(setq default-frame-alist ((equal argi "-color")
(cons '(reverse . t) (unless argval (setq argval 8)) ; default --color means 8 ANSI colors
default-frame-alist))) (push (cons 'tty-color-mode
((string= this "-color") (cond
(if (null argval) ((numberp argval) argval)
(setq argval 8)) ; default --color means 8 ANSI colors ((string-match "-?[0-9]+" argval)
(setq default-frame-alist (string-to-number argval))
(cons (cons 'tty-color-mode (t (intern argval))))
(cond default-frame-alist))
((numberp argval) argval) (t
((string-match "-?[0-9]+" argval) (push argi rest)))))
(string-to-number argval)) (nreverse rest)))
(t (intern argval))))
default-frame-alist)))
(t (setq rest (cons this rest))))))
(nreverse rest)))
(defun command-line () (defun command-line ()
(setq command-line-default-directory default-directory) (setq command-line-default-directory default-directory)
@ -680,14 +670,11 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
;; See if we should import version-control from the environment variable. ;; See if we should import version-control from the environment variable.
(let ((vc (getenv "VERSION_CONTROL"))) (let ((vc (getenv "VERSION_CONTROL")))
(cond ((eq vc nil)) ;don't do anything if not set (cond ((eq vc nil)) ;don't do anything if not set
((or (string= vc "t") ((member vc '("t" "numbered"))
(string= vc "numbered"))
(setq version-control t)) (setq version-control t))
((or (string= vc "nil") ((member vc '("nil" "existing"))
(string= vc "existing"))
(setq version-control nil)) (setq version-control nil))
((or (string= vc "never") ((member vc '("never" "simple"))
(string= vc "simple"))
(setq version-control 'never)))) (setq version-control 'never))))
;;! This has been commented out; I currently find the behavior when ;;! This has been commented out; I currently find the behavior when
@ -700,15 +687,15 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
;; end-of-line formats that aren't native to this platform. ;; end-of-line formats that aren't native to this platform.
(cond (cond
((memq system-type '(ms-dos windows-nt emx)) ((memq system-type '(ms-dos windows-nt emx))
(setq eol-mnemonic-unix "(Unix)") (setq eol-mnemonic-unix "(Unix)"
(setq eol-mnemonic-mac "(Mac)")) eol-mnemonic-mac "(Mac)"))
;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the
;; abbreviated strings `/' and `:' set in coding.c for them. ;; abbreviated strings `/' and `:' set in coding.c for them.
((eq system-type 'macos) ((eq system-type 'macos)
(setq eol-mnemonic-dos "(DOS)")) (setq eol-mnemonic-dos "(DOS)"))
(t ; this is for Unix/GNU/Linux systems (t ; this is for Unix/GNU/Linux systems
(setq eol-mnemonic-dos "(DOS)") (setq eol-mnemonic-dos "(DOS)"
(setq eol-mnemonic-mac "(Mac)"))) eol-mnemonic-mac "(Mac)")))
;; Read window system's init file if using a window system. ;; Read window system's init file if using a window system.
(condition-case error (condition-case error
@ -726,21 +713,20 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(apply 'concat (cdr error)) (apply 'concat (cdr error))
(if (memq 'file-error (get (car error) 'error-conditions)) (if (memq 'file-error (get (car error) 'error-conditions))
(format "%s: %s" (format "%s: %s"
(nth 1 error) (nth 1 error)
(mapconcat (lambda (obj) (prin1-to-string obj t)) (mapconcat (lambda (obj) (prin1-to-string obj t))
(cdr (cdr error)) ", ")) (cdr (cdr error)) ", "))
(format "%s: %s" (format "%s: %s"
(get (car error) 'error-message) (get (car error) 'error-message)
(mapconcat (lambda (obj) (prin1-to-string obj t)) (mapconcat (lambda (obj) (prin1-to-string obj t))
(cdr error) ", ")))) (cdr error) ", "))))
'external-debugging-output) 'external-debugging-output)
(terpri 'external-debugging-output) (terpri 'external-debugging-output)
(setq window-system nil) (setq window-system nil)
(kill-emacs))) (kill-emacs)))
;; Windowed displays do this inside their *-win.el. ;; Windowed displays do this inside their *-win.el.
(when (and (not (display-graphic-p)) (unless (or (display-graphic-p) noninteractive)
(not noninteractive))
(setq command-line-args (tty-handle-args command-line-args))) (setq command-line-args (tty-handle-args command-line-args)))
(set-locale-environment nil) (set-locale-environment nil)
@ -750,7 +736,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(while args (while args
(setcar args (setcar args
(decode-coding-string (car args) locale-coding-system t)) (decode-coding-string (car args) locale-coding-system t))
(setq args (cdr args)))) (pop args)))
(let ((done nil) (let ((done nil)
(args (cdr command-line-args))) (args (cdr command-line-args)))
@ -759,22 +745,23 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
;; either from the environment or from the options. ;; either from the environment or from the options.
(setq init-file-user (if noninteractive nil (user-login-name))) (setq init-file-user (if noninteractive nil (user-login-name)))
;; If user has not done su, use current $HOME to find .emacs. ;; 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 "")) (setq init-file-user ""))
;; Process the command-line args, and delete the arguments ;; Process the command-line args, and delete the arguments
;; processed. This is consistent with the way main in emacs.c ;; processed. This is consistent with the way main in emacs.c
;; does things. ;; does things.
(while (and (not done) args) (while (and (not done) args)
(let ((longopts '(("--no-init-file") ("--no-site-file") ("--user") (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
("--debug-init") ("--iconic") ("--icon-type"))) ("--debug-init") ("--iconic") ("--icon-type")))
(argi (pop args)) (argi (pop args))
(argval nil)) (orig-argi argi)
argval)
;; Handle --OPTION=VALUE format. ;; Handle --OPTION=VALUE format.
(when (and (string-match "\\`--" argi) (when (string-match "^\\(--[^=]*\\)=" argi)
(string-match "=" argi))
(setq argval (substring argi (match-end 0)) (setq argval (substring argi (match-end 0))
argi (substring argi 0 (match-beginning 0)))) argi (match-string 1 argi)))
(unless (equal argi "--") (unless (equal argi "--")
(let ((completion (try-completion argi longopts))) (let ((completion (try-completion argi longopts)))
(if (eq completion t) (if (eq completion t)
@ -784,54 +771,54 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(or elt (or elt
(error "Option `%s' is ambiguous" argi)) (error "Option `%s' is ambiguous" argi))
(setq argi (substring (car elt) 1))) (setq argi (substring (car elt) 1)))
(setq argval nil))))) (setq argval nil
argi orig-argi)))))
(cond (cond
((member argi '("-q" "-no-init-file")) ((member argi '("-q" "-no-init-file"))
(setq init-file-user nil)) (setq init-file-user nil))
((member argi '("-u" "-user")) ((member argi '("-u" "-user"))
(or argval (setq init-file-user (or argval (pop args))
(setq argval (pop args)))
(setq init-file-user argval
argval nil)) argval nil))
((string-equal argi "-no-site-file") ((equal argi "-no-site-file")
(setq site-run-file nil)) (setq site-run-file nil))
((string-equal argi "-debug-init") ((equal argi "-debug-init")
(setq init-file-debug t)) (setq init-file-debug t))
((string-equal argi "-iconic") ((equal argi "-iconic")
(push '(visibility . icon) initial-frame-alist)) (push '(visibility . icon) initial-frame-alist))
((or (string-equal argi "-icon-type") ((member argi '("-icon-type" "-i" "-itype"))
(string-equal argi "-i")
(string-equal argi "-itype"))
(push '(icon-type . t) default-frame-alist)) (push '(icon-type . t) default-frame-alist))
;; Push the popped arg back on the list of arguments. ;; 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? ;; Was argval set but not used?
(and argval (and argval
(error "Option `%s' doesn't allow an argument" argi)))) (error "Option `%s' doesn't allow an argument" argi))))
;; Re-attach the program name to the front of the arg list. ;; 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. ;; Under X Windows, this creates the X frame and deletes the terminal frame.
(when (fboundp 'frame-initialize) (when (fboundp 'frame-initialize)
(frame-initialize)) (frame-initialize))
;; If frame was created with a menu bar, set menu-bar-mode on. ;; If frame was created with a menu bar, set menu-bar-mode on.
(if (and (not noninteractive) (unless (or noninteractive
(or (not (memq window-system '(x w32))) (and (memq window-system '(x w32))
(> (frame-parameter nil 'menu-bar-lines) 0))) (<= (frame-parameter nil 'menu-bar-lines) 0)))
(menu-bar-mode t)) (menu-bar-mode t))
;; If frame was created with a tool bar, switch tool-bar-mode on. ;; If frame was created with a tool bar, switch tool-bar-mode on.
(when (and (not noninteractive) (unless (or noninteractive
(display-graphic-p) (not (display-graphic-p))
(> (frame-parameter nil 'tool-bar-lines) 0)) (<= (frame-parameter nil 'tool-bar-lines) 0))
(tool-bar-mode 1)) (tool-bar-mode 1))
;; Can't do this init in defcustom because window-system isn't set. ;; Can't do this init in defcustom because window-system isn't set.
(when (and (not noninteractive) (unless (or noninteractive
(not (eq system-type 'ms-dos)) (eq system-type 'ms-dos)
(memq window-system '(x w32))) (not (memq window-system '(x w32))))
(setq-default blink-cursor t) (setq-default blink-cursor t)
(blink-cursor-mode 1)) (blink-cursor-mode 1))
@ -850,19 +837,19 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(setq-default normal-erase-is-backspace t) (setq-default normal-erase-is-backspace t)
(normal-erase-is-backspace-mode 1))) (normal-erase-is-backspace-mode 1)))
(when (and (not noninteractive) (unless (or noninteractive
(display-graphic-p) (not (display-graphic-p))
(fboundp 'x-show-tip)) (not (fboundp 'x-show-tip)))
(setq-default tooltip-mode t) (setq-default tooltip-mode t)
(tooltip-mode 1)) (tooltip-mode 1))
;; Register default TTY colors for the case the terminal hasn't a ;; Register default TTY colors for the case the terminal hasn't a
;; terminal init file. ;; terminal init file.
(or (memq window-system '(x w32)) (unless (memq window-system '(x w32))
;; We do this regardles of whether the terminal supports colors ;; We do this regardles of whether the terminal supports colors
;; or not, since they can switch that support on or off in ;; or not, since they can switch that support on or off in
;; mid-session by setting the tty-color-mode frame parameter. ;; mid-session by setting the tty-color-mode frame parameter.
(tty-register-default-colors)) (tty-register-default-colors))
;; Record whether the tool-bar is present before the user and site ;; Record whether the tool-bar is present before the user and site
;; init files are processed. frame-notice-user-settings uses this ;; init files are processed. frame-notice-user-settings uses this
@ -872,9 +859,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist)
(assq 'tool-bar-lines default-frame-alist)))) (assq 'tool-bar-lines default-frame-alist))))
(setq tool-bar-originally-present (setq tool-bar-originally-present
(not (or (null tool-bar-lines) (and tool-bar-lines
(null (cdr tool-bar-lines)) (cdr tool-bar-lines)
(eq 0 (cdr tool-bar-lines))))))) (not (eq 0 (cdr tool-bar-lines)))))))
(let ((old-scalable-fonts-allowed scalable-fonts-allowed) (let ((old-scalable-fonts-allowed scalable-fonts-allowed)
(old-font-list-limit font-list-limit) (old-font-list-limit font-list-limit)
@ -957,19 +944,19 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
(sit-for 1)) (sit-for 1))
(setq user-init-file source)))) (setq user-init-file source))))
(when (and (stringp custom-file) (when (stringp custom-file)
(not (assoc custom-file load-history))) (unless (assoc custom-file load-history)
;; If the .emacs file has set `custom-file' but hasn't ;; If the .emacs file has set `custom-file' but hasn't
;; loaded the file yet, let's load it. ;; loaded the file yet, let's load it.
(load custom-file t t)) (load custom-file t t)))
(or inhibit-default-init (unless inhibit-default-init
(let ((inhibit-startup-message nil)) (let ((inhibit-startup-message nil))
;; Users are supposed to be told their rights. ;; Users are supposed to be told their rights.
;; (Plus how to get help and how to undo.) ;; (Plus how to get help and how to undo.)
;; Don't you dare turn this off for anyone ;; Don't you dare turn this off for anyone
;; except yourself. ;; except yourself.
(load "default" t t))))))))) (load "default" t t)))))))))
(if init-file-debug (if init-file-debug
;; Do this without a condition-case if the user wants to debug. ;; Do this without a condition-case if the user wants to debug.
(funcall inner) (funcall inner)
@ -1055,15 +1042,18 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
;; Load library for our terminal type. ;; Load library for our terminal type.
;; User init file can set term-file-prefix to nil to prevent this. ;; User init file can set term-file-prefix to nil to prevent this.
(and term-file-prefix (not noninteractive) (not window-system) (unless (or noninteractive
(let ((term (getenv "TERM")) window-system
hyphend) (null term-file-prefix))
(while (and term (let ((term (getenv "TERM"))
(not (load (concat term-file-prefix term) t t))) hyphend)
;; Strip off last hyphen and what follows, then try again (while (and term
(if (setq hyphend (string-match "[-_][^-_]+$" term)) (not (load (concat term-file-prefix term) t t)))
(setq term (substring term 0 hyphend)) ;; Strip off last hyphen and what follows, then try again
(setq term nil))))) (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 ;; Update the out-of-memory error message based on user's key bindings
;; for save-some-buffers. ;; for save-some-buffers.
@ -1079,7 +1069,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
;; Run emacs-session-restore (session management) if started by ;; Run emacs-session-restore (session management) if started by
;; the session manager and we have a session manager connection. ;; 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))) (emacs-session-restore x-session-previous-id)))
(defcustom initial-scratch-message (purecopy "\ (defcustom initial-scratch-message (purecopy "\
@ -1528,7 +1519,7 @@ normal otherwise."
user-init-file user-init-file
(or (and (get 'inhibit-startup-echo-area-message 'saved-value) (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
(equal inhibit-startup-echo-area-message (equal inhibit-startup-echo-area-message
(if (string= init-file-user "") (if (equal init-file-user "")
(user-login-name) (user-login-name)
init-file-user))) init-file-user)))
;; Wasn't set with custom; see if .emacs has a setq. ;; Wasn't set with custom; see if .emacs has a setq.
@ -1544,7 +1535,7 @@ normal otherwise."
"inhibit-startup-echo-area-message[ \t\n]+" "inhibit-startup-echo-area-message[ \t\n]+"
(regexp-quote (regexp-quote
(prin1-to-string (prin1-to-string
(if (string= init-file-user "") (if (equal init-file-user "")
(user-login-name) (user-login-name)
init-file-user))) init-file-user)))
"[ \t\n]*)") "[ \t\n]*)")
@ -1555,199 +1546,189 @@ normal otherwise."
;; Delay 2 seconds after an init file error message ;; Delay 2 seconds after an init file error message
;; was displayed, so user can read it. ;; was displayed, so user can read it.
(if init-file-had-error (when init-file-had-error
(sit-for 2)) (sit-for 2))
(if command-line-args-left (when command-line-args-left
;; We have command args; process them. ;; We have command args; process them.
(let ((dir command-line-default-directory) (let ((dir command-line-default-directory)
(file-count 0) (file-count 0)
first-file-buffer first-file-buffer
tem tem
just-files ;; t if this follows the magic -- option. ;; The directories listed in --directory/-L options will *appear*
;; This includes our standard options' long versions ;; at the front of `load-path' in the order they appear on the
;; and long versions of what's on command-switch-alist. ;; command-line. We cannot do this by *placing* them at the front
(longopts ;; in the order they appear, so we need this variable to hold them,
(append '(("--funcall") ("--load") ("--insert") ("--kill") ;; temporarily.
("--directory") ("--eval") ("--execute") ("--no-splash") extra-load-path
("--find-file") ("--visit") ("--file")) just-files ;; t if this follows the magic -- option.
(mapcar (lambda (elt) ;; This includes our standard options' long versions
(list (concat "-" (car elt)))) ;; and long versions of what's on command-switch-alist.
command-switch-alist))) (longopts
(line 0) (append '(("--funcall") ("--load") ("--insert") ("--kill")
(column 0)) ("--directory") ("--eval") ("--execute") ("--no-splash")
("--find-file") ("--visit") ("--file"))
(mapcar (lambda (elt)
(list (concat "-" (car elt))))
command-switch-alist)))
(line 0)
(column 0))
;; Add the long X options to longopts. ;; Add the long X options to longopts.
(dolist (tem command-line-x-option-alist) (dolist (tem command-line-x-option-alist)
(if (string-match "^--" (car tem)) (if (string-match "^--" (car tem))
(push (list (car tem)) longopts))) (push (list (car tem)) longopts)))
;; Loop, processing options. ;; Loop, processing options.
(while (and command-line-args-left) (while command-line-args-left
(let* ((argi (car command-line-args-left)) (let* ((argi (car command-line-args-left))
(orig-argi argi) (orig-argi argi)
argval completion argval completion)
;; List of directories specified in -L/--directory, (setq command-line-args-left (cdr command-line-args-left))
;; in reverse of the order specified.
extra-load-path
(initial-load-path load-path))
(setq command-line-args-left (cdr command-line-args-left))
;; Do preliminary decoding of the option. ;; Do preliminary decoding of the option.
(if just-files (if just-files
;; After --, don't look for options; treat all args as files. ;; After --, don't look for options; treat all args as files.
(setq argi "") (setq argi "")
;; Convert long options to ordinary options ;; Convert long options to ordinary options
;; and separate out an attached option argument into argval. ;; and separate out an attached option argument into argval.
(if (string-match "^--[^=]*=" argi) (when (string-match "^\\(--[^=]*\\)=" argi)
(setq argval (substring argi (match-end 0)) (setq argval (substring argi (match-end 0))
argi (substring argi 0 (1- (match-end 0))))) argi (match-string 1 argi)))
(if (equal argi "--") (if (equal argi "--")
(setq completion nil) (setq completion nil)
(setq completion (try-completion argi longopts))) (setq completion (try-completion argi longopts)))
(if (eq completion t) (if (eq completion t)
(setq argi (substring argi 1)) (setq argi (substring argi 1))
(if (stringp completion) (if (stringp completion)
(let ((elt (assoc completion longopts))) (let ((elt (assoc completion longopts)))
(or elt (or elt
(error "Option `%s' is ambiguous" argi)) (error "Option `%s' is ambiguous" argi))
(setq argi (substring (car elt) 1))) (setq argi (substring (car elt) 1)))
(setq argval nil argi orig-argi)))) (setq argval nil
argi orig-argi))))
;; Execute the option. ;; Execute the option.
(cond ((setq tem (assoc argi command-switch-alist)) (cond ((setq tem (assoc argi command-switch-alist))
(if argval (if argval
(let ((command-line-args-left (let ((command-line-args-left
(cons argval command-line-args-left))) (cons argval command-line-args-left)))
(funcall (cdr tem) argi)) (funcall (cdr tem) argi))
(funcall (cdr tem) argi))) (funcall (cdr tem) argi)))
((string-equal argi "-no-splash") ((equal argi "-no-splash")
(setq inhibit-startup-message t)) (setq inhibit-startup-message t))
((member argi '("-f" ;what the manual claims ((member argi '("-f" ; what the manual claims
"-funcall" "-funcall"
"-e")) ; what the source used to say "-e")) ; what the source used to say
(if argval (setq tem (intern (or argval (pop command-line-args-left))))
(setq tem (intern argval)) (if (arrayp (symbol-function tem))
(setq tem (intern (car command-line-args-left))) (command-execute tem)
(setq command-line-args-left (cdr command-line-args-left))) (funcall tem)))
(if (arrayp (symbol-function tem))
(command-execute tem)
(funcall tem)))
((member argi '("-eval" "-execute")) ((member argi '("-eval" "-execute"))
(if argval (eval (read (or argval (pop command-line-args-left)))))
(setq tem argval) ;; Set the default directory as specified in -L.
(setq tem (car command-line-args-left))
(setq command-line-args-left (cdr command-line-args-left)))
(eval (read tem)))
;; Set the default directory as specified in -L.
((member argi '("-L" "-directory")) ((member argi '("-L" "-directory"))
(if argval (setq tem (or argval (pop command-line-args-left)))
(setq tem argval) ;; We will reverse `extra-load-path' and prepend it to
(setq tem (car command-line-args-left) ;; `load-path' after all the arguments have been processed.
command-line-args-left (cdr command-line-args-left))) (push
(setq tem (command-line-normalize-file-name tem)) (expand-file-name (command-line-normalize-file-name tem))
(setq extra-load-path extra-load-path))
(cons (expand-file-name tem) extra-load-path))
(setq load-path (append (nreverse extra-load-path)
initial-load-path)))
((member argi '("-l" "-load")) ((member argi '("-l" "-load"))
(if argval (let* ((file (command-line-normalize-file-name
(setq tem argval) (or argval (pop command-line-args-left))))
(setq tem (car command-line-args-left) ;; Take file from default dir if it exists there;
command-line-args-left (cdr command-line-args-left))) ;; otherwise let `load' search for it.
(let ((file (command-line-normalize-file-name tem))) (file-ex (expand-file-name file)))
;; Take file from default dir if it exists there; (when (file-exists-p file-ex)
;; otherwise let `load' search for it. (setq file file-ex))
(if (file-exists-p (expand-file-name file)) (load file nil t)))
(setq file (expand-file-name file)))
(load file nil t)))
((string-equal argi "-insert") ((equal argi "-insert")
(if argval (setq tem (or argval (pop command-line-args-left)))
(setq tem argval) (or (stringp tem)
(setq tem (car command-line-args-left) (error "File name omitted from `-insert' option"))
command-line-args-left (cdr command-line-args-left))) (insert-file-contents (command-line-normalize-file-name tem)))
(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)) (kill-emacs t))
((string-match "^\\+[0-9]+\\'" argi) ((string-match "^\\+[0-9]+\\'" argi)
(setq line (string-to-int argi))) (setq line (string-to-int argi)))
((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi)
(setq line (string-to-int (match-string 1 argi)) (setq line (string-to-int (match-string 1 argi))
column (string-to-int (match-string 2 argi)))) column (string-to-int (match-string 2 argi))))
((setq tem (assoc argi command-line-x-option-alist)) ((setq tem (assoc argi command-line-x-option-alist))
;; Ignore X-windows options and their args if not using X. ;; Ignore X-windows options and their args if not using X.
(setq command-line-args-left (setq command-line-args-left
(nthcdr (nth 1 tem) command-line-args-left))) (nthcdr (nth 1 tem) command-line-args-left)))
((member argi '("-find-file" "-file" "-visit")) ((member argi '("-find-file" "-file" "-visit"))
;; An explicit option to specify visiting a file. ;; An explicit option to specify visiting a file.
(if argval (setq tem (or argval (pop command-line-args-left)))
(setq tem argval) (unless (stringp tem)
(setq tem (car command-line-args-left) (error "File name omitted from `%s' option" argi))
command-line-args-left (cdr command-line-args-left))) (setq file-count (1+ file-count))
(unless (stringp tem) (let ((file (expand-file-name
(error "File name omitted from `%s' option" argi)) (command-line-normalize-file-name tem) dir)))
(setq file-count (1+ file-count)) (if (= file-count 1)
(let ((file (expand-file-name (setq first-file-buffer (find-file file))
(command-line-normalize-file-name tem) dir))) (find-file-other-window file)))
(if (= file-count 1) (or (zerop line)
(setq first-file-buffer (find-file file)) (goto-line line))
(find-file-other-window file))) (setq line 0)
(or (zerop line) (unless (< column 1)
(goto-line line)) (move-to-column (1- column)))
(setq line 0) (setq column 0))
(unless (< column 1)
(move-to-column (1- column)))
(setq column 0))
((equal argi "--") ((equal argi "--")
(setq just-files t)) (setq just-files t))
(t (t
;; We have almost exhausted our options. See if the ;; We have almost exhausted our options. See if the
;; user has made any other command-line options available ;; 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)) (did-hook nil))
(while (and hooks (while (and hooks
(not (setq did-hook (funcall (car hooks))))) (not (setq did-hook (funcall (car hooks)))))
(setq hooks (cdr hooks))) (setq hooks (cdr hooks)))
(if (not did-hook) (if (not did-hook)
;; Ok, presume that the argument is a file name ;; Presume that the argument is a file name.
(progn (progn
(if (string-match "\\`-" argi) (if (string-match "\\`-" argi)
(error "Unknown option `%s'" argi)) (error "Unknown option `%s'" argi))
(setq file-count (1+ file-count)) (setq file-count (1+ file-count))
(let ((file (let ((file
(expand-file-name (expand-file-name
(command-line-normalize-file-name orig-argi) (command-line-normalize-file-name orig-argi)
dir))) dir)))
(if (= file-count 1) (if (= file-count 1)
(setq first-file-buffer (find-file file)) (setq first-file-buffer (find-file file))
(find-file-other-window file))) (find-file-other-window file)))
(or (zerop line) (or (zerop line)
(goto-line line)) (goto-line line))
(setq line 0) (setq line 0)
(unless (< column 1) (unless (< column 1)
(move-to-column (1- column))) (move-to-column (1- column)))
(setq column 0)))))))) (setq column 0))))))))
;; If 3 or more files visited, and not all visible,
;; show user what they all are. But leave the last one current. ;; See --directory/-L option above.
(and (> file-count 2) (when extra-load-path
(not noninteractive) (setq load-path (append (nreverse extra-load-path) load-path)))
(not inhibit-startup-buffer-menu)
(or (get-buffer-window first-file-buffer) ;; If 3 or more files visited, and not all visible,
(list-buffers))))) ;; show user what they all are. But leave the last one current.
(and (> file-count 2)
(not noninteractive)
(not inhibit-startup-buffer-menu)
(or (get-buffer-window first-file-buffer)
(list-buffers)))))
;; Maybe display a startup screen. ;; Maybe display a startup screen.
(when (and (not inhibit-startup-message) (not noninteractive) (when (and (not inhibit-startup-message) (not noninteractive)
@ -1789,7 +1770,7 @@ normal otherwise."
;; If *scratch* is selected and it is empty, insert an ;; If *scratch* is selected and it is empty, insert an
;; initial message saying not to create a file there. ;; initial message saying not to create a file there.
(when (and initial-scratch-message (when (and initial-scratch-message
(string= (buffer-name) "*scratch*") (equal (buffer-name) "*scratch*")
(= 0 (buffer-size))) (= 0 (buffer-size)))
(insert initial-scratch-message) (insert initial-scratch-message)
(set-buffer-modified-p nil)) (set-buffer-modified-p nil))