Mercurial > emacs
changeset 84463:999e91a73e9d
(startup-screen-inhibit-startup-screen)
(pure-space-overflow-message): New vars.
(fancy-splash-insert): Allow functions for face and link specs.
(fancy-splash-head): Remove unused arg. Move splash text...
(fancy-startup-text, fancy-about-text): ...here.
(fancy-startup-tail): Rename from fancy-splash-tail.
(fancy-startup-screen, fancy-about-screen): Split off from
fancy-splash-screens.
(display-startup-screen): New function.
(display-about-screen): Rename from display-splash-screen.
(command-line-1): Use concise startup screen if necessary.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Mon, 10 Sep 2007 22:07:27 +0000 |
| parents | ccff7ec2f3d8 |
| children | ccd6d86fd9a6 |
| files | lisp/startup.el |
| diffstat | 1 files changed, 422 insertions(+), 383 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/startup.el Mon Sep 10 22:07:16 2007 +0000 +++ b/lisp/startup.el Mon Sep 10 22:07:27 2007 +0000 @@ -72,6 +72,8 @@ (defvaralias 'inhibit-splash-screen 'inhibit-startup-screen) (defvaralias 'inhibit-startup-message 'inhibit-startup-screen) +(defvar startup-screen-inhibit-startup-screen nil) + (defcustom inhibit-startup-echo-area-message nil "*Non-nil inhibits the initial startup echo area message. Setting this variable takes effect @@ -316,6 +318,10 @@ (defvar pure-space-overflow nil "Non-nil if building Emacs overflowed pure space.") +(defvar pure-space-overflow-message "\ +Warning Warning!!! Pure space overflow !!!Warning Warning +\(See the node Pure Storage in the Lisp manual for details.)\n") + (defvar tutorial-directory nil "Directory containing the Emacs TUTORIAL files.") @@ -1136,9 +1142,21 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar fancy-startup-text - '((:face variable-pitch + '((:face '(variable-pitch :foreground "red") + "Welcome to " + :link ("GNU Emacs" (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))) + ", one component of the " + :link + (lambda () + (if (eq system-type 'gnu/linux) + '("GNU/Linux" (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))) + '("GNU" (lambda (button) (describe-project))))) + " operating system.\n" + :face 'variable-pitch "To quit a partially entered command, type " + :face 'default "Control-g" + :face 'variable-pitch ".\n\n" :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) - "\tLearn basic Emacs keystroke commands" + "\tLearn basic keystroke commands" (lambda () (let* ((en "TUTORIAL") (tut (or (get-language-info current-language-environment @@ -1169,25 +1187,35 @@ :face variable-pitch :link ("Copying Conditions" (lambda (button) (describe-copying))) "\tConditions for redistributing and changing Emacs\n" - :link ("More Manuals / Ordering" (lambda (button) (view-order-manuals))) - "\tThe FSF sells printed copies of several manuals for Emacs\n" - "\n" - "To start... " - :link ("Open a File" - (lambda (button) (call-interactively 'find-file))) - " " - :link ("Open Home Directory" - (lambda (button) (dired "~"))) - " " - :link ("Customize Startup" - (lambda (button) (customize-group 'initialization))) + :link ("Ordering Manuals" (lambda (button) (view-order-manuals))) + "\tPurchasing printed copies of manuals\n" "\n")) "A list of texts to show in the middle part of splash screens. Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") (defvar fancy-about-text - '((:face variable-pitch + '((:face '(variable-pitch :foreground "red") + "This is " + :link ("GNU Emacs" (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))) + ", one component of the " + :link + (lambda () + (if (eq system-type 'gnu/linux) + '("GNU/Linux" (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))) + '("GNU" (lambda (button) (describe-project))))) + " operating system.\n" + :face (lambda () + (list 'variable-pitch :foreground + (if (eq (frame-parameter nil 'background-mode) 'dark) + "cyan" "darkblue"))) + "\n" + (lambda () (emacs-version)) + "\n" + :face '(variable-pitch :height 0.5) + (lambda () emacs-copyright) + "\n\n" + :face variable-pitch :link ("Authors" (lambda (button) (view-file (expand-file-name "AUTHORS" data-directory)) @@ -1269,17 +1297,25 @@ (defun fancy-splash-insert (&rest args) "Insert text into the current buffer, with faces. -Arguments from ARGS should be either strings, functions called -with no args that return a string, or pairs `:face FACE', -where FACE is a valid face specification, as it can be used with -`put-text-property'." +Arguments from ARGS should be either strings; functions called +with no args that return a string; pairs `:face FACE', where FACE +is a face specification usable with `put-text-property'; or pairs +`:link LINK' where LINK is a list of arguments to pass to +`insert-button', of the form (LABEL ACTION), which specifies the +button's label and `action' property. FACE and LINK can also be +functions, which are evaluated to obtain a face or button +specification." (let ((current-face nil)) (while args (cond ((eq (car args) :face) - (setq args (cdr args) current-face (car args))) + (setq args (cdr args) current-face (car args)) + (if (functionp current-face) + (setq current-face (funcall current-face)))) ((eq (car args) :link) (setq args (cdr args)) (let ((spec (car args))) + (if (functionp spec) + (setq spec (funcall spec))) (insert-button (car spec) 'face (list 'link current-face) 'action (cadr spec) @@ -1293,7 +1329,7 @@ (setq args (cdr args))))) -(defun fancy-splash-head (&optional startup) +(defun fancy-splash-head () "Insert the head part of the splash screen into the current buffer." (let* ((image-file (cond ((stringp fancy-splash-image) fancy-splash-image) @@ -1325,55 +1361,20 @@ 'help-echo "mouse-2: browse http://www.gnu.org/" 'action (lambda (button) (browse-url "http://www.gnu.org/")) 'follow-link t) - (insert "\n")))) - (insert "\n") - (fancy-splash-insert - :face '(variable-pitch :foreground "red") - (if startup "Welcome to " "This is ") - :link - '("GNU Emacs" (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))) - ", one component of the " - :link - (if (eq system-type 'gnu/linux) - '("GNU/Linux" (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))) - '("GNU" (lambda (button) (describe-project)))) - " operating system.\n") - (if startup - (fancy-splash-insert - :face 'variable-pitch - "You can do basic editing with the menu bar and scroll bar \ -using the mouse.\n" - :face 'variable-pitch - "To quit a partially entered command, type " - :face 'default - "Control-g" - :face 'variable-pitch - "." - "\n\n") - (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark) - "cyan" "darkblue"))) - (fancy-splash-insert :face `(variable-pitch :foreground ,fg) - "\n" - (emacs-version) - "\n" - :face '(variable-pitch :height 0.5) - emacs-copyright - "\n\n")))) + (insert "\n\n"))))) -(defun fancy-splash-tail (&optional startup) +(defun fancy-startup-tail () "Insert the tail part of the splash screen into the current buffer." (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark) "cyan" "darkblue"))) - (if startup - (fancy-splash-insert :face `(variable-pitch :foreground ,fg) - "\nThis is " - (emacs-version) - "\n" - :face '(variable-pitch :height 0.5) - emacs-copyright - "\n")) - (and startup - auto-save-list-file-prefix + (fancy-splash-insert :face `(variable-pitch :foreground ,fg) + "\nThis is " + (emacs-version) + "\n" + :face '(variable-pitch :height 0.5) + emacs-copyright + "\n") + (and auto-save-list-file-prefix ;; Don't signal an error if the ;; directory for auto-save-list files ;; does not yet exist. @@ -1393,74 +1394,102 @@ "Meta-x recover-session RET" :face '(variable-pitch :foreground "red") "\nto recover" - " the files you were editing.\n")))) + " the files you were editing.")) + + (fancy-splash-insert + :face 'variable-pitch "\n\n" + :link '("Dismiss" (lambda (button) + (when startup-screen-inhibit-startup-screen + (customize-set-variable 'inhibit-splash-screen t) + (customize-mark-to-save 'inhibit-splash-screen) + (custom-save-all)) + (let ((w (get-buffer-window "*GNU Emacs*"))) + (and w (not (one-window-p)) (delete-window w))) + (kill-buffer "*GNU Emacs*"))) + " ") + (when (or user-init-file custom-file) + (let ((checked (create-image "\300\300\141\143\067\076\034\030" + 'xbm t :width 8 :height 8 :background "grey75" + :foreground "black" :relief -2 :ascent 'center)) + (unchecked (create-image (make-string 8 0) + 'xbm t :width 8 :height 8 :background "grey75" + :foreground "black" :relief -2 :ascent 'center))) + (insert-button + " " :on-glyph checked :off-glyph unchecked 'checked nil + 'display unchecked 'follow-link t + 'action (lambda (button) + (if (overlay-get button 'checked) + (progn (overlay-put button 'checked nil) + (overlay-put button 'display (overlay-get button :off-glyph)) + (setq startup-screen-inhibit-startup-screen nil)) + (overlay-put button 'checked t) + (overlay-put button 'display (overlay-get button :on-glyph)) + (setq startup-screen-inhibit-startup-screen t))))) + (fancy-splash-insert :face '(variable-pitch :height 0.9) + " Don't show this message again.")))) (defun exit-splash-screen () "Stop displaying the splash screen buffer." (interactive) (quit-window t)) -(defun fancy-splash-screens (&optional startup) - "Display fancy splash screens. -If optional argument STARTUP is non-nil, display the startup screen -after Emacs starts. If STARTUP is nil, display the About screen." - (if (not startup) - ;; Display About screen - (let ((frame (fancy-splash-frame))) - (save-selected-window - (select-frame frame) - (switch-to-buffer "*About GNU Emacs*") - (setq buffer-undo-list t - mode-line-format (propertize "---- %b %-" - 'face 'mode-line-buffer-id)) - (let ((inhibit-read-only t)) - (erase-buffer) - (if pure-space-overflow - (insert "\ -Warning Warning!!! Pure space overflow !!!Warning Warning -\(See the node Pure Storage in the Lisp manual for details.)\n")) - (fancy-splash-head startup) - (dolist (text fancy-about-text) - (apply #'fancy-splash-insert text) - (insert "\n")) - (fancy-splash-tail startup) - (unless (current-message) - (message fancy-splash-help-echo)) - (set-buffer-modified-p nil) - (goto-char (point-min)) - (force-mode-line-update)) - (use-local-map splash-screen-keymap) - (setq tab-width 22) - (message "%s" (startup-echo-area-message)) - (setq buffer-read-only t) - (goto-char (point-min)))) +(defun fancy-startup-screen (concise) + "Display fancy startup screen. +If CONCISE is non-nil, display a concise version of the splash +screen." + (if (or (window-minibuffer-p) + (window-dedicated-p (selected-window))) + (pop-to-buffer (current-buffer)) + (switch-to-buffer "*GNU Emacs*")) + (let ((inhibit-read-only t)) + (erase-buffer) + (make-local-variable 'startup-screen-inhibit-startup-screen) + (if pure-space-overflow + (insert pure-space-overflow-message)) + (unless concise + (fancy-splash-head)) + (dolist (text fancy-startup-text) + (apply #'fancy-splash-insert text) + (insert "\n")) + (skip-chars-backward "\n") + (delete-region (point) (point-max)) + (insert "\n") + (fancy-startup-tail)) + (use-local-map splash-screen-keymap) + (setq tab-width 22) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (if (and view-read-only (not view-mode)) + (view-mode-enter nil 'kill-buffer)) + (goto-char (point-min))) - ;; If startup is non-nil, display startup fancy splash screen. - (if (or (window-minibuffer-p) - (window-dedicated-p (selected-window))) - (pop-to-buffer (current-buffer)) - (switch-to-buffer "*GNU Emacs*")) - (let ((inhibit-read-only t)) - (erase-buffer) - (if pure-space-overflow - (insert "\ -Warning Warning!!! Pure space overflow !!!Warning Warning -\(See the node Pure Storage in the Lisp manual for details.)\n")) - (fancy-splash-head startup) - (dolist (text fancy-startup-text) - (apply #'fancy-splash-insert text) - (insert "\n")) - (skip-chars-backward "\n") - (delete-region (point) (point-max)) - (insert "\n") - (fancy-splash-tail startup)) - (use-local-map splash-screen-keymap) - (setq tab-width 22) - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (if (and view-read-only (not view-mode)) - (view-mode-enter nil 'kill-buffer)) - (goto-char (point-min)))) +(defun fancy-about-screen () + "Display fancy About screen." + (let ((frame (fancy-splash-frame))) + (save-selected-window + (select-frame frame) + (switch-to-buffer "*About GNU Emacs*") + (setq buffer-undo-list t + mode-line-format (propertize "---- %b %-" + 'face 'mode-line-buffer-id)) + (let ((inhibit-read-only t)) + (erase-buffer) + (if pure-space-overflow + (insert pure-space-overflow-message)) + (fancy-splash-head) + (dolist (text fancy-about-text) + (apply #'fancy-splash-insert text) + (insert "\n")) + (unless (current-message) + (message fancy-splash-help-echo)) + (set-buffer-modified-p nil) + (goto-char (point-min)) + (force-mode-line-update)) + (use-local-map splash-screen-keymap) + (setq tab-width 22) + (message "%s" (startup-echo-area-message)) + (setq buffer-read-only t) + (goto-char (point-min))))) (defun fancy-splash-frame () "Return the frame to use for the fancy splash screen. @@ -1508,16 +1537,12 @@ (propertize "---- %b %-" 'face 'mode-line-buffer-id))) (if pure-space-overflow - (insert "\ -Warning Warning!!! Pure space overflow !!!Warning Warning -\(See the node Pure Storage in the Lisp manual for details.)\n")) + (insert pure-space-overflow-message)) ;; The convention for this piece of code is that ;; each piece of output starts with one or two newlines ;; and does not end with any newlines. - (if startup - (insert "Welcome to GNU Emacs") - (insert "This is GNU Emacs")) + (insert (if startup "Welcome to GNU Emacs" "This is GNU Emacs")) (insert (if (eq system-type 'gnu/linux) ", one component of the GNU/Linux operating system.\n" @@ -1843,21 +1868,29 @@ (kill-buffer buffer))))) (message "%s" (startup-echo-area-message))))) +(defun display-startup-screen (concise) + "Display startup screen according to display. +A fancy display is used on graphic displays, normal otherwise. -(defun display-splash-screen (&optional startup) - "Display splash screen according to display. -Fancy splash screens are used on graphic displays, normal otherwise. - -If optional argument STARTUP is non-nil, display the startup screen -after Emacs starts. If STARTUP is nil, display the About screen." - (interactive "P") +If CONCISE is non-nil, display a concise version of the startup +screen." ;; Prevent recursive calls from server-process-filter. (if (not (get-buffer "*About GNU Emacs*")) (if (use-fancy-splash-screens-p) - (fancy-splash-screens startup) - (normal-splash-screen startup)))) + (fancy-startup-screen concise) + (normal-splash-screen t)))) -(defalias 'about-emacs 'display-splash-screen) +(defun display-about-screen () + "Display the *About GNU Emacs* buffer. +A fancy display is used on graphic displays, normal otherwise." + (interactive) + (if (not (get-buffer "*About GNU Emacs*")) + (if (use-fancy-splash-screens-p) + (fancy-about-screen) + (normal-splash-screen nil)))) + +(defalias 'about-emacs 'display-about-screen) +(defalias 'display-splash 'display-about-screen) (defun command-line-1 (command-line-args-left) (display-startup-echo-area-message) @@ -1874,267 +1907,273 @@ "Building Emacs overflowed pure space. (See the node Pure Storage in the Lisp manual for details.)" :warning)) - (when command-line-args-left - ;; We have command args; process them. - (let ((dir command-line-default-directory) - (file-count 0) - first-file-buffer - tem - ;; This approach loses for "-batch -L DIR --eval "(require foo)", - ;; if foo is intended to be found in DIR. - ;; - ;; ;; The directories listed in --directory/-L options will *appear* - ;; ;; at the front of `load-path' in the order they appear on the - ;; ;; command-line. We cannot do this by *placing* them at the front - ;; ;; in the order they appear, so we need this variable to hold them, - ;; ;; temporarily. - ;; extra-load-path - ;; - ;; To DTRT we keep track of the splice point and modify `load-path' - ;; straight away upon any --directory/-L option. - splice - just-files ;; t if this follows the magic -- option. - ;; This includes our standard options' long versions - ;; and long versions of what's on command-switch-alist. - (longopts - (append '(("--funcall") ("--load") ("--insert") ("--kill") - ("--directory") ("--eval") ("--execute") ("--no-splash") - ("--find-file") ("--visit") ("--file") ("--no-desktop")) - (mapcar (lambda (elt) - (list (concat "-" (car elt)))) - command-switch-alist))) - (line 0) - (column 0)) + (let ((file-count 0) + first-file-buffer) + (when command-line-args-left + ;; We have command args; process them. + (let ((dir command-line-default-directory) + tem + ;; This approach loses for "-batch -L DIR --eval "(require foo)", + ;; if foo is intended to be found in DIR. + ;; + ;; ;; The directories listed in --directory/-L options will *appear* + ;; ;; at the front of `load-path' in the order they appear on the + ;; ;; command-line. We cannot do this by *placing* them at the front + ;; ;; in the order they appear, so we need this variable to hold them, + ;; ;; temporarily. + ;; extra-load-path + ;; + ;; To DTRT we keep track of the splice point and modify `load-path' + ;; straight away upon any --directory/-L option. + splice + just-files ;; t if this follows the magic -- option. + ;; This includes our standard options' long versions + ;; and long versions of what's on command-switch-alist. + (longopts + (append '(("--funcall") ("--load") ("--insert") ("--kill") + ("--directory") ("--eval") ("--execute") ("--no-splash") + ("--find-file") ("--visit") ("--file") ("--no-desktop")) + (mapcar (lambda (elt) + (list (concat "-" (car elt)))) + command-switch-alist))) + (line 0) + (column 0)) - ;; Add the long X options to longopts. - (dolist (tem command-line-x-option-alist) - (if (string-match "^--" (car tem)) - (push (list (car tem)) longopts))) + ;; Add the long X options to longopts. + (dolist (tem command-line-x-option-alist) + (if (string-match "^--" (car tem)) + (push (list (car tem)) longopts))) + + ;; Loop, processing options. + (while command-line-args-left + (let* ((argi (car command-line-args-left)) + (orig-argi argi) + argval completion) + (setq command-line-args-left (cdr command-line-args-left)) - ;; Loop, processing options. - (while command-line-args-left - (let* ((argi (car command-line-args-left)) - (orig-argi argi) - argval completion) - (setq command-line-args-left (cdr command-line-args-left)) + ;; Do preliminary decoding of the option. + (if just-files + ;; After --, don't look for options; treat all args as files. + (setq argi "") + ;; Convert long options to ordinary options + ;; and separate out an attached option argument into argval. + (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))) + (if (eq completion t) + (setq argi (substring argi 1)) + (if (stringp completion) + (let ((elt (assoc completion longopts))) + (or elt + (error "Option `%s' is ambiguous" argi)) + (setq argi (substring (car elt) 1))) + (setq argval nil + argi orig-argi)))) - ;; Do preliminary decoding of the option. - (if just-files - ;; After --, don't look for options; treat all args as files. - (setq argi "") - ;; Convert long options to ordinary options - ;; and separate out an attached option argument into argval. - (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))) - (if (eq completion t) - (setq argi (substring argi 1)) - (if (stringp completion) - (let ((elt (assoc completion longopts))) - (or elt - (error "Option `%s' is ambiguous" argi)) - (setq argi (substring (car elt) 1))) - (setq argval nil - argi orig-argi)))) + ;; Execute the option. + (cond ((setq tem (assoc argi command-switch-alist)) + (if argval + (let ((command-line-args-left + (cons argval command-line-args-left))) + (funcall (cdr tem) argi)) + (funcall (cdr tem) argi))) + + ((equal argi "-no-splash") + (setq inhibit-startup-message t)) - ;; Execute the option. - (cond ((setq tem (assoc argi command-switch-alist)) - (if argval - (let ((command-line-args-left - (cons argval command-line-args-left))) - (funcall (cdr tem) argi)) - (funcall (cdr tem) argi))) + ((member argi '("-f" ; what the manual claims + "-funcall" + "-e")) ; what the source used to say + (setq tem (intern (or argval (pop command-line-args-left)))) + (if (commandp tem) + (command-execute tem) + (funcall tem))) - ((equal argi "-no-splash") - (setq inhibit-startup-message t)) + ((member argi '("-eval" "-execute")) + (eval (read (or argval (pop command-line-args-left))))) + + ((member argi '("-L" "-directory")) + (setq tem (expand-file-name + (command-line-normalize-file-name + (or argval (pop command-line-args-left))))) + (cond (splice (setcdr splice (cons tem (cdr splice))) + (setq splice (cdr splice))) + (t (setq load-path (cons tem load-path) + splice load-path)))) - ((member argi '("-f" ; what the manual claims - "-funcall" - "-e")) ; what the source used to say - (setq tem (intern (or argval (pop command-line-args-left)))) - (if (commandp tem) - (command-execute tem) - (funcall tem))) - - ((member argi '("-eval" "-execute")) - (eval (read (or argval (pop command-line-args-left))))) - - ((member argi '("-L" "-directory")) - (setq tem (expand-file-name - (command-line-normalize-file-name - (or argval (pop command-line-args-left))))) - (cond (splice (setcdr splice (cons tem (cdr splice))) - (setq splice (cdr splice))) - (t (setq load-path (cons tem load-path) - splice load-path)))) + ((member argi '("-l" "-load")) + (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))) + (when (file-exists-p file-ex) + (setq file file-ex)) + (load file nil t))) - ((member argi '("-l" "-load")) - (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))) - (when (file-exists-p file-ex) - (setq file file-ex)) - (load file nil t))) + ;; This is used to handle -script. It's not clear + ;; we need to document it. + ((member argi '("-scriptload")) + (let* ((file (command-line-normalize-file-name + (or argval (pop command-line-args-left)))) + ;; Take file from default dir. + (file-ex (expand-file-name file))) + (load file-ex nil t t))) - ;; This is used to handle -script. It's not clear - ;; we need to document it. - ((member argi '("-scriptload")) - (let* ((file (command-line-normalize-file-name - (or argval (pop command-line-args-left)))) - ;; Take file from default dir. - (file-ex (expand-file-name file))) - (load file-ex nil t t))) + ((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))) - ((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))) + ((equal argi "-kill") + (kill-emacs t)) - ((equal argi "-kill") - (kill-emacs t)) + ;; This is for when they use --no-desktop with -q, or + ;; don't load Desktop in their .emacs. If desktop.el + ;; _is_ loaded, it will handle this switch, and we + ;; won't see it by the time we get here. + ((equal argi "-no-desktop") + (message "\"--no-desktop\" ignored because the Desktop package is not loaded")) - ;; This is for when they use --no-desktop with -q, or - ;; don't load Desktop in their .emacs. If desktop.el - ;; _is_ loaded, it will handle this switch, and we - ;; won't see it by the time we get here. - ((equal argi "-no-desktop") - (message "\"--no-desktop\" ignored because the Desktop package is not loaded")) + ((string-match "^\\+[0-9]+\\'" argi) + (setq line (string-to-number argi))) + + ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) + (setq line (string-to-number (match-string 1 argi)) + column (string-to-number (match-string 2 argi)))) + + ((setq tem (assoc argi command-line-x-option-alist)) + ;; Ignore X-windows options and their args if not using X. + (setq command-line-args-left + (nthcdr (nth 1 tem) command-line-args-left))) - ((string-match "^\\+[0-9]+\\'" argi) - (setq line (string-to-number argi))) - - ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) - (setq line (string-to-number (match-string 1 argi)) - column (string-to-number (match-string 2 argi)))) + ((member argi '("-find-file" "-file" "-visit")) + ;; An explicit option to specify visiting a file. + (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)) + (let ((file (expand-file-name + (command-line-normalize-file-name tem) dir))) + (if (= file-count 1) + (setq first-file-buffer (find-file file)) + (find-file-other-window file))) + (or (zerop line) + (goto-line line)) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)) - ((setq tem (assoc argi command-line-x-option-alist)) - ;; Ignore X-windows options and their args if not using X. - (setq command-line-args-left - (nthcdr (nth 1 tem) command-line-args-left))) - - ((member argi '("-find-file" "-file" "-visit")) - ;; An explicit option to specify visiting a file. - (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)) - (let ((file (expand-file-name - (command-line-normalize-file-name tem) dir))) - (if (= file-count 1) - (setq first-file-buffer (find-file file)) - (find-file-other-window file))) - (or (zerop line) - (goto-line line)) - (setq line 0) - (unless (< column 1) - (move-to-column (1- column))) - (setq column 0)) + ((equal argi "--") + (setq just-files t)) + (t + ;; We have almost exhausted our options. See if the + ;; user has made any other command-line options available + (let ((hooks command-line-functions) + (did-hook nil)) + (while (and hooks + (not (setq did-hook (funcall (car hooks))))) + (setq hooks (cdr hooks))) + (if (not did-hook) + ;; Presume that the argument is a file name. + (progn + (if (string-match "\\`-" argi) + (error "Unknown option `%s'" argi)) + (setq file-count (1+ file-count)) + (let ((file + (expand-file-name + (command-line-normalize-file-name orig-argi) + dir))) + (if (= file-count 1) + (setq first-file-buffer (find-file file)) + (find-file-other-window file))) + (or (zerop line) + (goto-line line)) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)))))) + ;; In unusual circumstances, the execution of Lisp code due + ;; to command-line options can cause the last visible frame + ;; to be deleted. In this case, kill emacs to avoid an + ;; abort later. + (unless (frame-live-p (selected-frame)) (kill-emacs nil)))))) - ((equal argi "--") - (setq just-files t)) - (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 - (did-hook nil)) - (while (and hooks - (not (setq did-hook (funcall (car hooks))))) - (setq hooks (cdr hooks))) - (if (not did-hook) - ;; Presume that the argument is a file name. - (progn - (if (string-match "\\`-" argi) - (error "Unknown option `%s'" argi)) - (setq file-count (1+ file-count)) - (let ((file - (expand-file-name - (command-line-normalize-file-name orig-argi) - dir))) - (if (= file-count 1) - (setq first-file-buffer (find-file file)) - (find-file-other-window file))) - (or (zerop line) - (goto-line line)) - (setq line 0) - (unless (< column 1) - (move-to-column (1- column))) - (setq column 0)))))) - ;; In unusual circumstances, the execution of Lisp code due - ;; to command-line options can cause the last visible frame - ;; to be deleted. In this case, kill emacs to avoid an - ;; abort later. - (unless (frame-live-p (selected-frame)) (kill-emacs nil)))) + (when initial-buffer-choice + (cond ((eq initial-buffer-choice t) + (switch-to-buffer (get-buffer-create "*scratch*"))) + ((stringp initial-buffer-choice) + (find-file initial-buffer-choice)))) + + (if (or inhibit-splash-screen + initial-buffer-choice + noninteractive + emacs-quick-startup) - ;; If 3 or more files visited, and not all visible, - ;; 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))))) + ;; Not displaying a startup screen. If 3 or more files + ;; visited, and not all visible, show user what they all are. + (and (> file-count 2) + (not noninteractive) + (not inhibit-startup-buffer-menu) + (or (get-buffer-window first-file-buffer) + (list-buffers))) - (when initial-buffer-choice - (cond ((eq initial-buffer-choice t) - (switch-to-buffer (get-buffer-create "*scratch*"))) - ((stringp initial-buffer-choice) - (find-file initial-buffer-choice)))) + ;; Display a startup screen, after some preparations. + + ;; If there are no switches to process, we might as well + ;; run this hook now, and there may be some need to do it + ;; before doing any output. + (run-hooks 'emacs-startup-hook) + (and term-setup-hook + (run-hooks 'term-setup-hook)) + (setq inhibit-startup-hooks t) - ;; Maybe display a startup screen. - (unless (or inhibit-startup-message - initial-buffer-choice - noninteractive - emacs-quick-startup) - ;; Display a startup screen, after some preparations. + ;; It's important to notice the user settings before we + ;; display the startup message; otherwise, the settings + ;; won't take effect until the user gives the first + ;; keystroke, and that's distracting. + (when (fboundp 'frame-notice-user-settings) + (frame-notice-user-settings)) - ;; If there are no switches to process, we might as well - ;; run this hook now, and there may be some need to do it - ;; before doing any output. - (run-hooks 'emacs-startup-hook) - (and term-setup-hook - (run-hooks 'term-setup-hook)) - (setq inhibit-startup-hooks t) - - ;; It's important to notice the user settings before we - ;; display the startup message; otherwise, the settings - ;; won't take effect until the user gives the first - ;; keystroke, and that's distracting. - (when (fboundp 'frame-notice-user-settings) - (frame-notice-user-settings)) + ;; If there are no switches to process, we might as well + ;; run this hook now, and there may be some need to do it + ;; before doing any output. + (when window-setup-hook + (run-hooks 'window-setup-hook) + ;; Don't let the hook be run twice. + (setq window-setup-hook nil)) - ;; If there are no switches to process, we might as well - ;; run this hook now, and there may be some need to do it - ;; before doing any output. - (when window-setup-hook - (run-hooks 'window-setup-hook) - ;; Don't let the hook be run twice. - (setq window-setup-hook nil)) + ;; Do this now to avoid an annoying delay if the user + ;; clicks the menu bar during the sit-for. + (when (display-popup-menus-p) + (precompute-menubar-bindings)) + (with-no-warnings + (setq menubar-bindings-done t)) - ;; Do this now to avoid an annoying delay if the user - ;; clicks the menu bar during the sit-for. - (when (display-popup-menus-p) - (precompute-menubar-bindings)) - (with-no-warnings - (setq menubar-bindings-done t)) + ;; If *scratch* exists and is empty, insert initial-scratch-message. + (and initial-scratch-message + (get-buffer "*scratch*") + (with-current-buffer "*scratch*" + (when (zerop (buffer-size)) + (insert initial-scratch-message) + (set-buffer-modified-p nil)))) - ;; If *scratch* exists and is empty, insert initial-scratch-message. - (and initial-scratch-message - (get-buffer "*scratch*") - (with-current-buffer "*scratch*" - (when (zerop (buffer-size)) - (insert initial-scratch-message) - (set-buffer-modified-p nil)))) - - ;; If user typed input during all that work, - ;; abort the startup screen. Otherwise, display it now. - (unless (input-pending-p) - (display-splash-screen t)))) - + (cond ((= file-count 0) + (display-startup-screen nil)) + ((or (= file-count 1) inhibit-startup-buffer-menu) + (let ((buf (current-buffer)) + (first-window (get-buffer-window first-file-buffer))) + (if first-window (select-window first-window)) + (display-startup-screen t) + (display-buffer buf))) + (t + (display-startup-screen t) + (display-buffer (list-buffers-noselect))))))) (defun command-line-normalize-file-name (file) "Collapse multiple slashes to one, to handle non-Emacs file names."