Backport startup screen related changes from the trunk.

1 files changed, 909 insertions, 743 deletions

diff --git a/lisp/startup.el b/lisp/startup.el
index f90ffeba0ef..4d0af4fe27e 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -38,9 +38,9 @@
 
 (defgroup initialization nil
   "Emacs start-up procedure."
-  :group 'internal)
+  :group 'environment)
 
-(defcustom inhibit-splash-screen nil
+(defcustom inhibit-startup-screen nil
   "Non-nil inhibits the startup screen.
 It also inhibits display of the initial message in the `*scratch*' buffer.
 
@@ -49,7 +49,10 @@ you are familiar with the contents of the startup screen."
   :type 'boolean
   :group 'initialization)
 
-(defvaralias 'inhibit-startup-message 'inhibit-splash-screen)
+(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.
@@ -295,6 +298,10 @@ from being initialized."
 (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")
+
 (defun normal-top-level-add-subdirs-to-load-path ()
   "Add all subdirectories of current directory to `load-path'.
 More precisely, this uses only the subdirectories whose names
@@ -823,8 +830,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
         (load site-run-file t t))
 
     ;; Sites should not disable this.  Only individuals should disable
-    ;; the startup message.
-    (setq inhibit-startup-message nil)
+    ;; the startup screen.
+    (setq inhibit-startup-screen nil)
 
     ;; Warn for invalid user name.
     (when init-file-user
@@ -918,7 +925,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
                             (setq user-init-file source))))
 
                       (unless inhibit-default-init
-                        (let ((inhibit-startup-message nil))
+                        (let ((inhibit-startup-screen 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
@@ -1117,7 +1124,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
 ")
   "Initial message displayed in *scratch* buffer at startup.
 If this is nil, no message will be displayed.
-If `inhibit-splash-screen' is non-nil, then no message is displayed,
+If `inhibit-startup-screen' is non-nil, then no message is displayed,
 regardless of the value of this variable."
   :type '(choice (text :tag "Message")
                  (const :tag "none" nil))
@@ -1128,88 +1135,140 @@ regardless of the value of this variable."
 ;;; Fancy splash screen
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defvar fancy-splash-text
-  '((:face (variable-pitch :weight bold)
-           "Important Help menu items:\n"
-           :face variable-pitch
-           (lambda ()
-             (let* ((en "TUTORIAL")
-                    (tut (or (get-language-info current-language-environment
-                                                'tutorial)
-                             en))
-                    (title (with-temp-buffer
-                             (insert-file-contents
-                              (expand-file-name tut data-directory)
-                              nil 0 256)
-                             (search-forward ".")
-                             (buffer-substring (point-min) (1- (point))))))
-               ;; If there is a specific tutorial for the current language
-               ;; environment and it is not English, append its title.
-               (concat
-                "Emacs Tutorial\t\tLearn how to use Emacs efficiently"
-                (if (string= en tut)
-                    ""
-                  (concat " (" title ")"))
-                "\n")))
-           :face variable-pitch "\
-Emacs FAQ\t\tFrequently asked questions and answers
-View Emacs Manual\t\tView the Emacs manual using Info
-Absence of Warranty\tGNU Emacs comes with "
-           :face (variable-pitch :slant oblique)
-           "ABSOLUTELY NO WARRANTY\n"
-           :face variable-pitch
-           "\
-Copying Conditions\t\tConditions for redistributing and changing Emacs
-Getting New Versions\tHow to obtain the latest version of Emacs
-More Manuals / Ordering Manuals       Buying printed manuals from the FSF\n")
-  (:face variable-pitch
-         "\nTo quit a partially entered command, type "
-         :face default
-         "Control-g"
-         :face variable-pitch
-         ".
-
-Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/
-
-"
-         :face (variable-pitch :weight bold)
-         "Useful File menu items:\n"
-         :face variable-pitch
-         "Exit Emacs\t\t(Or type "
-         :face default
-         "Control-x"
-         :face variable-pitch
-         " followed by "
-         :face default
-         "Control-c"
-         :face variable-pitch
-         ")
-Recover Crashed Session\tRecover files you were editing before a crash\n"
-           ))
+(defvar fancy-startup-text
+  '((:face (variable-pitch :foreground "red")
+     "Welcome to "
+     :link ("GNU Emacs"
+            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
+            "Browse 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"))
+             "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
+         '("GNU" (lambda (button) (describe-project))
+           "Display info on the GNU 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 keystroke commands"
+     (lambda ()
+       (let* ((en "TUTORIAL")
+              (tut (or (get-language-info current-language-environment
+                                          'tutorial)
+                       en))
+              (title (with-temp-buffer
+                       (insert-file-contents
+                        (expand-file-name tut data-directory)
+                        nil 0 256)
+                       (search-forward ".")
+                       (buffer-substring (point-min) (1- (point))))))
+         ;; If there is a specific tutorial for the current language
+         ;; environment and it is not English, append its title.
+         (if (string= en tut)
+             ""
+           (concat " (" title ")"))))
+     "\n"
+     :face variable-pitch
+     :link ("Emacs Guided Tour"
+            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
+            "Browse http://www.gnu.org/software/emacs/tour/")
+     "\tOverview of Emacs features\n"
+     :link ("View Emacs Manual" (lambda (button) (info-emacs-manual)))
+     "\tView the Emacs manual using Info\n"
+     :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
+     "\tGNU Emacs comes with "
+     :face (variable-pitch :slant oblique)
+     "ABSOLUTELY NO WARRANTY\n"
+     :face variable-pitch
+     :link ("Copying Conditions" (lambda (button) (describe-copying)))
+     "\tConditions for redistributing and changing Emacs\n"
+     :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 :foreground "red")
+     "This is "
+     :link ("GNU Emacs"
+            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
+            "Browse 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"))
+             "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
+         '("GNU" (lambda (button) (describe-project))
+           "Display info on the GNU 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 ("GNU and Freedom" (lambda (button) (describe-project)))
+     "\tWhy we developed GNU Emacs, and the GNU operating system\n"
+     :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
+     "\tGNU Emacs comes with "
+     :face (variable-pitch :slant oblique)
+     "ABSOLUTELY NO WARRANTY\n"
+     :face variable-pitch
+     :link ("Copying Conditions" (lambda (button) (describe-copying)))
+     "\tConditions for redistributing and changing Emacs\n"
+     :link ("Getting New Versions" (lambda (button) (describe-distribution)))
+     "\tHow to obtain the latest version of Emacs\n"
+     :link ("Ordering Manuals" (lambda (button) (view-order-manuals)))
+     "\tBuying printed manuals from the FSF\n"
+     "\n"
+     :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
+     "\tLearn basic Emacs keystroke commands"
+     (lambda ()
+       (let* ((en "TUTORIAL")
+              (tut (or (get-language-info current-language-environment
+                                          'tutorial)
+                       en))
+              (title (with-temp-buffer
+                       (insert-file-contents
+                        (expand-file-name tut data-directory)
+                        nil 0 256)
+                       (search-forward ".")
+                       (buffer-substring (point-min) (1- (point))))))
+         ;; If there is a specific tutorial for the current language
+         ;; environment and it is not English, append its title.
+         (if (string= en tut)
+             ""
+           (concat " (" title ")"))))
+     "\n"
+     :link ("Emacs Guided Tour"
+            (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
+            "Browse http://www.gnu.org/software/emacs/tour/")
+     "\tSee an overview of the many facilities of GNU Emacs"
+     ))
+  "A list of texts to show in the middle part of the About screen.
+Each element in the list should be a list of strings or pairs
+`:face FACE', like `fancy-splash-insert' accepts them.")
+
 
 (defgroup fancy-splash-screen ()
   "Fancy splash screen when Emacs starts."
   :version "21.1"
   :group 'initialization)
 
-
-(defcustom fancy-splash-delay 7
-  "*Delay in seconds between splash screens."
-  :group 'fancy-splash-screen
-  :type 'integer)
-
-
-(defcustom fancy-splash-max-time 30
-  "*Show splash screens for at most this number of seconds.
-Values less than twice `fancy-splash-delay' are ignored."
-  :group 'fancy-splash-screen
-  :type 'integer)
-
-
 (defcustom fancy-splash-image nil
   "*The image to show in the splash screens, or nil for defaults."
   :group 'fancy-splash-screen
@@ -1217,30 +1276,54 @@ Values less than twice `fancy-splash-delay' are ignored."
                  (file :tag "File")))
 
 
+(defvar splash-screen-keymap
+  (let ((map (make-sparse-keymap)))
+    (suppress-keymap map)
+    (set-keymap-parent map button-buffer-map)
+    (define-key map "\C-?" 'scroll-down)
+    (define-key map " " 'scroll-up)
+    (define-key map "q" 'exit-splash-screen)
+    map)
+  "Keymap for splash screen buffer.")
+
 ;; These are temporary storage areas for the splash screen display.
 
-(defvar fancy-current-text nil)
 (defvar fancy-splash-help-echo nil)
-(defvar fancy-splash-stop-time nil)
-(defvar fancy-splash-outer-buffer nil)
-(defvar fancy-splash-last-input-event nil)
 
 (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 [HELP-ECHO]), which
+specifies the button's label, `action' property and help-echo string.
+FACE and LINK can also be functions, which are evaluated to obtain
+a face or button specification."
   (let ((current-face nil))
     (while args
-      (if (eq (car args) :face)
-          (setq args (cdr args) current-face (car args))
-        (insert (propertize (let ((it (car args)))
-                              (if (functionp it)
-                                  (funcall it)
-                                it))
-                            'face current-face
-                            'help-echo fancy-splash-help-echo)))
+      (cond ((eq (car args) :face)
+             (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)
+                              'help-echo (concat "mouse-2, RET: "
+                                                 (or (nth 2 spec)
+                                                     "Follow this link"))
+                              'follow-link t)))
+            (t (insert (propertize (let ((it (car args)))
+                                     (if (functionp it)
+                                         (funcall it)
+                                       it))
+                                   'face current-face
+                                   'help-echo fancy-splash-help-echo))))
       (setq args (cdr args)))))
 
 
@@ -1250,11 +1333,11 @@ where FACE is a valid face specification, as it can be used with
                             fancy-splash-image)
                            ((and (display-color-p)
                                  (image-type-available-p 'xpm))
-                            (if (and (fboundp 'x-display-planes)
-                                     (= (funcall 'x-display-planes) 8))
-                                "splash8.xpm"
-                              "splash.xpm"))
-                           (t "splash.pbm")))
+                            (if (and (fboundp 'x-display-planes)
+                                     (= (funcall 'x-display-planes) 8))
+                                "splash8.xpm"
+                              "splash.xpm"))
+                            (t "splash.pbm")))
          (img (create-image image-file))
          (image-width (and img (car (image-size img))))
          (window-width (window-width (selected-window))))
@@ -1270,52 +1353,41 @@ where FACE is a valid face specification, as it can be used with
                    (eq (frame-parameter nil 'background-mode) 'dark))
           (setq img (append img '(:color-symbols (("#000000" . "gray30"))))))
 
-        ;; Insert the image with a help-echo and a keymap.
-        (let ((map (make-sparse-keymap))
-              (help-echo "mouse-2: browse http://www.gnu.org/"))
-          (define-key map [mouse-2]
-            (lambda ()
-              (interactive)
-              (browse-url "http://www.gnu.org/")
-              (throw 'exit nil)))
-          (define-key map [down-mouse-2] 'ignore)
-          (define-key map [up-mouse-2] 'ignore)
-          (insert-image img (propertize "xxx" 'help-echo help-echo
-                                        'keymap map)))
-        (insert "\n"))))
-  (fancy-splash-insert
-   :face '(variable-pitch :foreground "red")
-   (if (eq system-type 'gnu/linux)
-       "GNU Emacs is one component of the GNU/Linux operating system."
-     "GNU Emacs is one component of the GNU operating system."))
-  (insert "\n")
-  (fancy-splash-insert
-   :face 'variable-pitch
-   "You can do basic editing with the menu bar and scroll bar \
-using the mouse.\n\n")
-  (when fancy-splash-outer-buffer
-    (fancy-splash-insert
-     :face 'variable-pitch
-     "Type "
-     :face 'default
-     "Control-l"
-     :face 'variable-pitch
-     " to begin editing"
-     (if (equal (buffer-name fancy-splash-outer-buffer)
-                "*scratch*")
-         ".\n"
-       " your file.\n"))))
-
-(defun fancy-splash-tail ()
+        ;; Insert the image with a help-echo and a link.
+        (make-button (prog1 (point) (insert-image img)) (point)
+                     'face 'default
+                     'help-echo "mouse-2, RET: Browse http://www.gnu.org/"
+                     'action (lambda (button) (browse-url "http://www.gnu.org/"))
+                     'follow-link t)
+        (insert "\n\n")))))
+
+(defun fancy-startup-tail (&optional concise)
   "Insert the tail part of the splash screen into the current buffer."
   (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
                 "cyan" "darkblue")))
+    (unless concise
+      (fancy-splash-insert
+       :face 'variable-pitch
+       "\nTo start...     "
+       :link '("Open a File"
+               (lambda (button) (call-interactively 'find-file))
+               "Specify a new file's name, to edit the file")
+       "     "
+       :link '("Open Home Directory"
+               (lambda (button) (dired "~"))
+               "Open your home directory, to operate on its files")
+       "     "
+       :link '("Customize Startup"
+               (lambda (button) (customize-group 'initialization))
+               "Change initialization settings including this screen")
+       "\n"))
     (fancy-splash-insert :face `(variable-pitch :foreground ,fg)
                          "\nThis is "
                          (emacs-version)
                          "\n"
                          :face '(variable-pitch :height 0.5)
-                         "Copyright (C) 2007 Free Software Foundation, Inc.")
+                         emacs-copyright
+                         "\n")
     (and auto-save-list-file-prefix
          ;; Don't signal an error if the
          ;; directory for auto-save-list files
@@ -1330,151 +1402,120 @@ using the mouse.\n\n")
                                  auto-save-list-file-prefix)))
           t)
          (fancy-splash-insert :face '(variable-pitch :foreground "red")
-                              "\n\nIf an Emacs session crashed recently, "
+                              "\nIf an Emacs session crashed recently, "
                               "type "
                               :face '(fixed-pitch :foreground "red")
                               "Meta-x recover-session RET"
                               :face '(variable-pitch :foreground "red")
                               "\nto recover"
-                              " the files you were editing."))))
-
-(defun fancy-splash-screens-1 (buffer)
-  "Timer function displaying a splash screen."
-  (when (> (float-time) fancy-splash-stop-time)
-    (throw 'stop-splashing nil))
-  (unless fancy-current-text
-    (setq fancy-current-text fancy-splash-text))
-  (let ((text (car fancy-current-text)))
-    (set-buffer buffer)
-    (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)
-    (apply #'fancy-splash-insert text)
-    (fancy-splash-tail)
-    (unless (current-message)
-      (message fancy-splash-help-echo))
-    (set-buffer-modified-p nil)
-    (goto-char (point-min))
-    (force-mode-line-update)
-    (setq fancy-current-text (cdr fancy-current-text))))
-
-
-(defun fancy-splash-default-action ()
-  "Stop displaying the splash screen buffer.
-This is an internal function used to turn off the splash screen after
-the user caused an input event by hitting a key or clicking with the
-mouse."
-  (interactive)
-  (if (and (memq 'down (event-modifiers last-command-event))
-           (eq (posn-window (event-start last-command-event))
-               (selected-window)))
-      ;; This is a mouse-down event in the spash screen window.
-      ;; Ignore it and consume the corresponding mouse-up event.
-      (read-event)
-    (push last-command-event unread-command-events))
-  (throw 'exit nil))
-
-(defun fancy-splash-special-event-action ()
-  "Save the last event and stop displaying the splash screen buffer.
-This is an internal function used to turn off the splash screen after
-the user caused an input event that is bound in `special-event-map'"
+                              " the files you were editing."))
+
+    (when concise
+      (fancy-splash-insert
+       :face 'variable-pitch "\n"
+       :link '("Dismiss this startup screen"
+               (lambda (button)
+                 (when startup-screen-inhibit-startup-screen
+                   (customize-set-variable 'inhibit-startup-screen t)
+                   (customize-mark-to-save 'inhibit-startup-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)
+                             " Never show it again.")))))
+
+(defun exit-splash-screen ()
+  "Stop displaying the splash screen buffer."
   (interactive)
-  (setq fancy-splash-last-input-event last-input-event)
-  (throw 'exit nil))
-
-
-(defun fancy-splash-screens (&optional hide-on-input)
-  "Display fancy splash screens when Emacs starts."
-  (if hide-on-input
-      (let ((old-hourglass display-hourglass)
-            (fancy-splash-outer-buffer (current-buffer))
-            splash-buffer
-            (old-minor-mode-map-alist minor-mode-map-alist)
-            (old-emulation-mode-map-alists emulation-mode-map-alists)
-            (old-special-event-map special-event-map)
-            (frame (fancy-splash-frame))
-            timer)
-        (save-selected-window
-          (select-frame frame)
-          (switch-to-buffer " GNU Emacs")
-          (make-local-variable 'cursor-type)
-          (setq splash-buffer (current-buffer))
-          (catch 'stop-splashing
-            (unwind-protect
-                (let ((map (make-sparse-keymap))
-                      (cursor-type nil))
-                  (use-local-map map)
-                  (define-key map [switch-frame] 'ignore)
-                  (define-key map [t] 'fancy-splash-default-action)
-                  (define-key map [mouse-movement] 'ignore)
-                  (define-key map [mode-line t] 'ignore)
-                  ;; Temporarily bind special events to
-                  ;; fancy-splash-special-event-action so as to stop
-                  ;; displaying splash screens with such events.
-                  ;; Otherwise, drag-n-drop into splash screens may
-                  ;; leave us in recursive editing with invisible
-                  ;; cursors for a while.
-                  (setq special-event-map (make-sparse-keymap))
-                  (map-keymap
-                   (lambda (key def)
-                     (define-key special-event-map (vector key)
-                       (if (eq def 'ignore)
-                           'ignore
-                         'fancy-splash-special-event-action)))
-                   old-special-event-map)
-                  (setq display-hourglass nil
-                        minor-mode-map-alist nil
-                        emulation-mode-map-alists nil
-                        buffer-undo-list t
-                        mode-line-format (propertize "---- %b %-"
-                                                     'face 'mode-line-buffer-id)
-                        fancy-splash-stop-time (+ (float-time)
-                                                  fancy-splash-max-time)
-                        timer (run-with-timer 0 fancy-splash-delay
-                                              #'fancy-splash-screens-1
-                                              splash-buffer))
-                  (message "%s" (startup-echo-area-message))
-                  (recursive-edit))
-              (cancel-timer timer)
-              (setq display-hourglass old-hourglass
-                    minor-mode-map-alist old-minor-mode-map-alist
-                    emulation-mode-map-alists old-emulation-mode-map-alists
-                    special-event-map old-special-event-map)
-              (kill-buffer splash-buffer)
-              (when fancy-splash-last-input-event
-                (setq last-input-event fancy-splash-last-input-event
-                      fancy-splash-last-input-event nil)
-                (command-execute (lookup-key special-event-map
-                                             (vector last-input-event))
-                                 nil (vector last-input-event) t))))))
-    ;; If hide-on-input is nil, don't hide the buffer on input.
-    (if (or (window-minibuffer-p)
-            (window-dedicated-p (selected-window)))
-        (pop-to-buffer (current-buffer))
-      (switch-to-buffer "*About GNU Emacs*"))
-    (setq buffer-read-only nil)
-    (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"))
-    (let (fancy-splash-outer-buffer)
-      (fancy-splash-head)
-      (dolist (text fancy-splash-text)
-        (apply #'fancy-splash-insert text)
-        (insert "\n"))
-      (skip-chars-backward "\n")
-      (delete-region (point) (point-max))
-      (insert "\n")
-      (fancy-splash-tail)
+  (quit-window t))
+
+(defun fancy-startup-screen (&optional concise)
+  "Display fancy startup screen.
+If CONCISE is non-nil, display a concise version of the
+splash screen in another window."
+  (let ((splash-buffer (get-buffer-create "*GNU Emacs*")))
+    (with-current-buffer splash-buffer
+      (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 concise))
+      (use-local-map splash-screen-keymap)
+      (setq tab-width 22
+            buffer-read-only t)
       (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)))))
+      (goto-char (point-min))
+      (forward-line (if concise 2 4)))
+    (if concise
+        (progn
+          (display-buffer splash-buffer)
+          ;; If the splash screen is in a split window, fit it.
+          (let ((window (get-buffer-window splash-buffer t)))
+            (or (null window)
+                (eq window (selected-window))
+                (eq window (next-window window))
+                (fit-window-to-buffer window))))
+      (switch-to-buffer splash-buffer))))
+
+(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))
+      (forward-line 3))))
 
 (defun fancy-splash-frame ()
   "Return the frame to use for the fancy splash screen.
@@ -1508,241 +1549,360 @@ we put it on this frame."
           (> frame-height (+ image-height 19)))))))
 
 
-(defun normal-splash-screen (&optional hide-on-input)
-  "Display splash screen when Emacs starts."
+(defun normal-splash-screen (&optional startup)
+  "Display non-graphic splash screen.
+If optional argument STARTUP is non-nil, display the startup screen
+after Emacs starts.  If STARTUP is nil, display the About screen."
   (let ((prev-buffer (current-buffer)))
-    (unwind-protect
-        (with-current-buffer (get-buffer-create "GNU Emacs")
-          (setq buffer-read-only nil)
-          (erase-buffer)
-          (set (make-local-variable 'tab-width) 8)
-          (if hide-on-input
-              (set (make-local-variable 'mode-line-format)
-                   (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"))
-
-          ;; 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.
-          (insert "Welcome to GNU Emacs")
-          (insert
-           (if (eq system-type 'gnu/linux)
-               ", one component of the GNU/Linux operating system.\n"
-             ", a part of the GNU operating system.\n"))
-
-          (if hide-on-input
-              (insert (substitute-command-keys
-                       (concat
-                        "\nType \\[recenter] to begin editing"
-                        (if (equal (buffer-name prev-buffer) "*scratch*")
-                            ".\n"
-                          " your file.\n")))))
-
-          (if (display-mouse-p)
-              ;; The user can use the mouse to activate menus
-              ;; so give help in terms of menu items.
-              (progn
-                (insert "\
-You can do basic editing with the menu bar and scroll bar using the mouse.
-To quit a partially entered command, type Control-g.
-
-Useful File menu items:
-Exit Emacs              (or type Control-x followed by Control-c)
-Recover Crashed Session Recover files you were editing before a crash
-
-Important Help menu items:
-Emacs Tutorial          Learn how to use Emacs efficiently
-Emacs FAQ               Frequently asked questions and answers
-Read the Emacs Manual   View the Emacs manual using Info
-\(Non)Warranty          GNU Emacs comes with ABSOLUTELY NO WARRANTY
-Copying Conditions      Conditions for redistributing and changing Emacs
-Getting New Versions    How to obtain the latest version of Emacs
-More Manuals / Ordering Manuals    How to order printed manuals from the FSF
+    (with-current-buffer (get-buffer-create "*About GNU Emacs*")
+      (setq buffer-read-only nil)
+      (erase-buffer)
+      (set (make-local-variable 'tab-width) 8)
+      (if (not startup)
+          (set (make-local-variable 'mode-line-format)
+               (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
+
+      (if pure-space-overflow
+          (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.
+      (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"
+         ", a part of the GNU operating system.\n"))
+
+      (if startup
+          (if (display-mouse-p)
+              ;; The user can use the mouse to activate menus
+              ;; so give help in terms of menu items.
+              (normal-mouse-startup-screen)
+
+            ;; No mouse menus, so give help using kbd commands.
+            (normal-no-mouse-startup-screen))
+
+        (normal-about-screen))
+
+      ;; The rest of the startup screen is the same on all
+      ;; kinds of terminals.
+
+      ;; Give information on recovering, if there was a crash.
+      (and startup
+           auto-save-list-file-prefix
+           ;; Don't signal an error if the
+           ;; directory for auto-save-list files
+           ;; does not yet exist.
+           (file-directory-p (file-name-directory
+                              auto-save-list-file-prefix))
+           (directory-files
+            (file-name-directory auto-save-list-file-prefix)
+            nil
+            (concat "\\`"
+                    (regexp-quote (file-name-nondirectory
+                                   auto-save-list-file-prefix)))
+            t)
+           (insert "\n\nIf an Emacs session crashed recently, "
+                   "type Meta-x recover-session RET\nto recover"
+                   " the files you were editing.\n"))
+
+      (use-local-map splash-screen-keymap)
+
+      ;; Display the input that we set up in the buffer.
+      (set-buffer-modified-p nil)
+      (setq buffer-read-only t)
+      (if (and view-read-only (not view-mode))
+          (view-mode-enter nil 'kill-buffer))
+      (switch-to-buffer "*About GNU Emacs*")
+      (if startup (rename-buffer "*GNU Emacs*" t))
+      (goto-char (point-min)))))
+
+(defun normal-mouse-startup-screen ()
+  ;; The user can use the mouse to activate menus
+  ;; so give help in terms of menu items.
+  (insert "\
+To follow a link, click Mouse-1 on it, or move to it and type RET.
+To quit a partially entered command, type Control-g.\n")
+
+  (insert "\nImportant Help menu items:\n")
+  (insert-button "Emacs Tutorial"
+                 'action (lambda (button) (help-with-tutorial))
+                 'follow-link t)
+  (insert "\t\tLearn basic Emacs keystroke commands\n")
+  (insert-button "Read the Emacs Manual"
+                 'action (lambda (button) (info-emacs-manual))
+                 'follow-link t)
+  (insert "\tView the Emacs manual using Info\n")
+  (insert-button "\(Non)Warranty"
+                 'action (lambda (button) (describe-no-warranty))
+                 'follow-link t)
+  (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
+  (insert-button "Copying Conditions"
+                 'action (lambda (button) (describe-copying))
+                 'follow-link t)
+  (insert "\tConditions for redistributing and changing Emacs\n")
+  (insert-button "More Manuals / Ordering Manuals"
+                 'action (lambda (button) (view-order-manuals))
+                 'follow-link t)
+  (insert "  How to order printed manuals from the FSF\n")
+
+  (insert "\nUseful tasks:\n")
+  (insert-button "Visit New File"
+                 'action (lambda (button) (call-interactively 'find-file))
+                 'follow-link t)
+  (insert "\t\tSpecify a new file's name, to edit the file\n")
+  (insert-button "Open Home Directory"
+                 'action (lambda (button) (dired "~"))
+                 'follow-link t)
+  (insert "\tOpen your home directory, to operate on its files\n")
+  (insert-button "Customize Startup"
+                 'action (lambda (button) (customize-group 'initialization))
+                 'follow-link t)
+  (insert "\tChange initialization settings including this screen\n")
+
+  (insert "\n" (emacs-version)
+          "\n" emacs-copyright))
+
+;; No mouse menus, so give help using kbd commands.
+(defun normal-no-mouse-startup-screen ()
+
+  ;; If keys have their default meanings,
+  ;; use precomputed string to save lots of time.
+  (if (and (eq (key-binding "\C-h") 'help-command)
+           (eq (key-binding "\C-xu") 'advertised-undo)
+           (eq (key-binding "\C-x\C-c") 'save-buffers-kill-terminal)
+           (eq (key-binding "\C-ht") 'help-with-tutorial)
+           (eq (key-binding "\C-hi") 'info)
+           (eq (key-binding "\C-hr") 'info-emacs-manual)
+           (eq (key-binding "\C-h\C-n") 'view-emacs-news))
+      (progn
+        (insert "
+Get help\t   C-h  (Hold down CTRL and press h)
+")
+        (insert-button "Emacs manual"
+                       'action (lambda (button) (info-emacs-manual))
+                       'follow-link t)
+        (insert "          C-h r\t")
+        (insert-button "Browse manuals"
+                       'action (lambda (button) (Info-directory))
+                       'follow-link t)
+        (insert "\t   C-h i
 ")
-                (insert "\n\n" (emacs-version)
-                        "
-Copyright (C) 2007 Free Software Foundation, Inc."))
-
-            ;; No mouse menus, so give help using kbd commands.
-
-            ;; If keys have their default meanings,
-            ;; use precomputed string to save lots of time.
-            (if (and (eq (key-binding "\C-h") 'help-command)
-                     (eq (key-binding "\C-xu") 'advertised-undo)
-                     (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
-                     (eq (key-binding "\C-ht") 'help-with-tutorial)
-                     (eq (key-binding "\C-hi") 'info)
-                     (eq (key-binding "\C-hr") 'info-emacs-manual)
-                     (eq (key-binding "\C-h\C-n") 'view-emacs-news))
-                (insert "
-Get help           C-h  (Hold down CTRL and press h)
-Emacs manual       C-h r
-Emacs tutorial     C-h t           Undo changes     C-x u
-Buy manuals        C-h C-m         Exit Emacs       C-x C-c
-Browse manuals     C-h i")
-
-              (insert (substitute-command-keys
-                       (format "\n
-Get help           %s
-Emacs manual       \\[info-emacs-manual]
-Emacs tutorial     \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
-Buy manuals        \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-emacs]
-Browse manuals     \\[info]"
-                               (let ((where (where-is-internal
-                                             'help-command nil t)))
-                                 (if where
-                                     (key-description where)
-                                   "M-x help"))))))
-
-            ;; Say how to use the menu bar with the keyboard.
-            (if (and (eq (key-binding "\M-`") 'tmm-menubar)
-                     (eq (key-binding [f10]) 'tmm-menubar))
-                (insert "
-Activate menubar   F10  or  ESC `  or   M-`")
-              (insert (substitute-command-keys "
-Activate menubar     \\[tmm-menubar]")))
-
-            ;; Many users seem to have problems with these.
-            (insert "
+        (insert-button "Emacs tutorial"
+                       'action (lambda (button) (help-with-tutorial))
+                       'follow-link t)
+        (insert "          C-h t\tUndo changes\t   C-x u
+")
+        (insert-button "Buy manuals"
+                       'action (lambda (button) (view-order-manuals))
+                       'follow-link t)
+        (insert "\t   C-h C-m\tExit Emacs\t   C-x C-c"))
+
+    (insert (format "
+Get help\t   %s
+"
+                    (let ((where (where-is-internal
+                                  'help-command nil t)))
+                      (if where
+                          (key-description where)
+                        "M-x help"))))
+    (insert-button "Emacs manual"
+                   'action (lambda (button) (info-emacs-manual))
+                   'follow-link t)
+    (insert (substitute-command-keys"\t   \\[info-emacs-manual]\t"))
+    (insert-button "Browse manuals"
+                   'action (lambda (button) (Info-directory))
+                   'follow-link t)
+    (insert (substitute-command-keys "\t   \\[info]
+"))
+    (insert-button "Emacs tutorial"
+                   'action (lambda (button) (help-with-tutorial))
+                   'follow-link t)
+    (insert (substitute-command-keys
+             "\t   \\[help-with-tutorial]\tUndo changes\t   \\[advertised-undo]
+"))
+    (insert-button "Buy manuals"
+                   'action (lambda (button) (view-order-manuals))
+                   'follow-link t)
+    (insert (substitute-command-keys
+             "\t   \\[view-order-manuals]\tExit Emacs\t   \\[save-buffers-kill-terminal]")))
+
+  ;; Say how to use the menu bar with the keyboard.
+  (insert "\n")
+  (insert-button "Activate menubar"
+                 'action (lambda (button) (tmm-menubar))
+                 'follow-link t)
+  (if (and (eq (key-binding "\M-`") 'tmm-menubar)
+           (eq (key-binding [f10]) 'tmm-menubar))
+      (insert "   F10  or  ESC `  or   M-`")
+    (insert (substitute-command-keys "   \\[tmm-menubar]")))
+
+  ;; Many users seem to have problems with these.
+  (insert "
 \(`C-' means use the CTRL key.  `M-' means use the Meta (or Alt) key.
 If you have no Meta key, you may instead type ESC followed by the character.)")
 
-            (insert "\n\n" (emacs-version)
-                    "
-Copyright (C) 2007 Free Software Foundation, Inc.")
+  ;; Insert links to useful tasks
+  (insert "\nUseful tasks:\n")
+
+  (insert-button "Visit New File"
+                 'action (lambda (button) (call-interactively 'find-file))
+                 'follow-link t)
+  (insert "\t\t\t")
+  (insert-button "Open Home Directory"
+                 'action (lambda (button) (dired "~"))
+                 'follow-link t)
+  (insert "\n")
 
-            (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
-                     (eq (key-binding "\C-h\C-d") 'describe-distribution)
-                     (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
-                (insert
-                 "\n
-GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
+  (insert-button "Customize Startup"
+                 'action (lambda (button) (customize-group 'initialization))
+                 'follow-link t)
+  (insert "\t\t")
+  (insert-button "Open *scratch* buffer"
+                 'action (lambda (button) (switch-to-buffer
+                                           (get-buffer-create "*scratch*")))
+                 'follow-link t)
+  (insert "\n")
+  (insert "\n" (emacs-version) "\n" emacs-copyright "\n")
+
+  (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
+           (eq (key-binding "\C-h\C-d") 'describe-distribution)
+           (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
+      (progn
+        (insert
+         "
+GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ")
+        (insert-button "full details"
+                       'action (lambda (button) (describe-no-warranty))
+                       'follow-link t)
+        (insert ".
 Emacs is Free Software--Free as in Freedom--so you can redistribute copies
-of Emacs and modify it; type C-h C-c to see the conditions.
-Type C-h C-d for information on getting the latest version.")
-              (insert (substitute-command-keys
-                       "\n
-GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
+of Emacs and modify it; type C-h C-c to see ")
+        (insert-button "the conditions"
+                       'action (lambda (button) (describe-copying))
+                       'follow-link t)
+        (insert ".
+Type C-h C-d for information on ")
+        (insert-button "getting the latest version"
+                       'action (lambda (button) (describe-distribution))
+                       'follow-link t)
+        (insert "."))
+    (insert (substitute-command-keys
+             "
+GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
+    (insert-button "full details"
+                   'action (lambda (button) (describe-no-warranty))
+                   'follow-link t)
+    (insert (substitute-command-keys ".
 Emacs is Free Software--Free as in Freedom--so you can redistribute copies
-of Emacs and modify it; type \\[describe-copying] to see the conditions.
-Type \\[describe-distribution] for information on getting the latest version."))))
-
-          ;; The rest of the startup screen is the same on all
-          ;; kinds of terminals.
-
-          ;; Give information on recovering, if there was a crash.
-          (and auto-save-list-file-prefix
-               ;; Don't signal an error if the
-               ;; directory for auto-save-list files
-               ;; does not yet exist.
-               (file-directory-p (file-name-directory
-                                  auto-save-list-file-prefix))
-               (directory-files
-                (file-name-directory auto-save-list-file-prefix)
-                nil
-                (concat "\\`"
-                        (regexp-quote (file-name-nondirectory
-                                       auto-save-list-file-prefix)))
-                t)
-               (insert "\n\nIf an Emacs session crashed recently, "
-                       "type Meta-x recover-session RET\nto recover"
-                       " the files you were editing."))
-
-          ;; Display the input that we set up in the buffer.
-          (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 hide-on-input
-              (if (or (window-minibuffer-p)
-                      (window-dedicated-p (selected-window)))
-                  ;; If hide-on-input is nil, creating a new frame will
-                  ;; generate enough events that the subsequent `sit-for'
-                  ;; will immediately return anyway.
-                  nil ;; (pop-to-buffer (current-buffer))
-                (save-window-excursion
-                  (switch-to-buffer (current-buffer))
-                  (sit-for 120)))
-          (condition-case nil
-              (switch-to-buffer (current-buffer))
-            ;; In case the window is dedicated or something.
-            (error (pop-to-buffer (current-buffer))))))
-      ;; Unwind ... ensure splash buffer is killed
-      (if hide-on-input
-          (kill-buffer "GNU Emacs")
-        (switch-to-buffer "GNU Emacs")
-        (rename-buffer "*About GNU Emacs*" t)))))
-
+of Emacs and modify it; type \\[describe-copying] to see "))
+    (insert-button "the conditions"
+                   'action (lambda (button) (describe-copying))
+                   'follow-link t)
+    (insert (substitute-command-keys".
+Type \\[describe-distribution] for information on "))
+    (insert-button "getting the latest version"
+                   'action (lambda (button) (describe-distribution))
+                   'follow-link t)
+    (insert ".")))
+
+(defun normal-about-screen ()
+  (insert "\n" (emacs-version) "\n" emacs-copyright "\n\n")
+
+  (insert "To follow a link, click Mouse-1 on it, or move to it and type RET.\n\n")
+
+  (insert-button "GNU and Freedom"
+                 'action (lambda (button) (describe-project))
+                 'follow-link t)
+  (insert "\t\tWhy we developed GNU Emacs and the GNU system\n")
+
+  (insert-button "Absence of Warranty"
+                 'action (lambda (button) (describe-no-warranty))
+                 'follow-link t)
+  (insert "\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
+
+  (insert-button "Copying Conditions"
+                 'action (lambda (button) (describe-copying))
+                 'follow-link t)
+  (insert "\tConditions for redistributing and changing Emacs\n")
+
+  (insert-button "Getting New Versions"
+                 'action (lambda (button) (describe-distribution))
+                 'follow-link t)
+  (insert "\tHow to get the latest version of GNU Emacs\n")
+
+  (insert-button "More Manuals / Ordering Manuals"
+                 'action (lambda (button) (view-order-manuals))
+                 'follow-link t)
+  (insert "\tBuying printed manuals from the FSF\n"))
 
 (defun startup-echo-area-message ()
   (if (eq (key-binding "\C-h\C-p") 'describe-project)
-      "For information about the GNU system and GNU/Linux, type C-h C-p."
+      "For information about GNU Emacs and the GNU system, type C-h C-a."
     (substitute-command-keys
-     "For information about the GNU system and GNU/Linux, type \
-\\[describe-project].")))
+     "For information about GNU Emacs and the GNU system, type \
+\\[about-emacs].")))
 
 
 (defun display-startup-echo-area-message ()
   (let ((resize-mini-windows t))
-    (message "%s" (startup-echo-area-message))))
-
-
-(defun display-splash-screen (&optional hide-on-input)
-  "Display splash screen according to display.
-Fancy splash screens are used on graphic displays,
-normal otherwise.
-With a prefix argument, any user input hides the splash screen."
-  (interactive "P")
+    (or noninteractive ;(input-pending-p) init-file-had-error
+        ;; t if the init file says to inhibit the echo area startup message.
+        (and inhibit-startup-echo-area-message
+             user-init-file
+             (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
+                      (equal inhibit-startup-echo-area-message
+                             (if (equal init-file-user "")
+                                 (user-login-name)
+                               init-file-user)))
+                 ;; Wasn't set with custom; see if .emacs has a setq.
+                 (let ((buffer (get-buffer-create " *temp*")))
+                   (prog1
+                       (condition-case nil
+                           (save-excursion
+                             (set-buffer buffer)
+                             (insert-file-contents user-init-file)
+                             (re-search-forward
+                              (concat
+                               "([ \t\n]*setq[ \t\n]+"
+                               "inhibit-startup-echo-area-message[ \t\n]+"
+                               (regexp-quote
+                                (prin1-to-string
+                                 (if (equal init-file-user "")
+                                     (user-login-name)
+                                   init-file-user)))
+                               "[ \t\n]*)")
+                              nil t))
+                         (error nil))
+                     (kill-buffer buffer)))))
+        (message "%s" (startup-echo-area-message)))))
+
+(defun display-startup-screen (&optional concise)
+  "Display startup screen according to display.
+A fancy display is used on graphic displays, normal otherwise.
+
+If CONCISE is non-nil, display a concise version of the startup
+screen."
+  ;; Prevent recursive calls from server-process-filter.
+  (if (not (get-buffer "*GNU Emacs*"))
+      (if (use-fancy-splash-screens-p)
+          (fancy-startup-screen concise)
+        (normal-splash-screen t))))
+
+(defun display-about-screen ()
+  "Display the *About GNU Emacs* buffer.
+A fancy display is used on graphic displays, normal otherwise."
+  (interactive)
   (if (use-fancy-splash-screens-p)
-      (fancy-splash-screens hide-on-input)
-    (normal-splash-screen hide-on-input)))
+      (fancy-about-screen)
+    (normal-splash-screen nil)))
 
+(defalias 'about-emacs 'display-about-screen)
+(defalias 'display-splash-screen 'display-startup-screen)
 
 (defun command-line-1 (command-line-args-left)
-  (or noninteractive (input-pending-p) init-file-had-error
-      ;; t if the init file says to inhibit the echo area startup message.
-      (and inhibit-startup-echo-area-message
-           user-init-file
-           (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
-                    (equal inhibit-startup-echo-area-message
-                           (if (equal init-file-user "")
-                               (user-login-name)
-                             init-file-user)))
-               ;; Wasn't set with custom; see if .emacs has a setq.
-               (let ((buffer (get-buffer-create " *temp*")))
-                 (prog1
-                     (condition-case nil
-                         (save-excursion
-                           (set-buffer buffer)
-                           (insert-file-contents user-init-file)
-                           (re-search-forward
-                            (concat
-                             "([ \t\n]*setq[ \t\n]+"
-                             "inhibit-startup-echo-area-message[ \t\n]+"
-                             (regexp-quote
-                              (prin1-to-string
-                               (if (equal init-file-user "")
-                                   (user-login-name)
-                                 init-file-user)))
-                             "[ \t\n]*)")
-                            nil t))
-                       (error nil))
-                   (kill-buffer buffer)))))
-      ;; display-splash-screen at the end of command-line-1 calls
-      ;; use-fancy-splash-screens-p. This can cause image.el to be
-      ;; loaded, putting "Loading image... done" in the echo area.
-      ;; This hides startup-echo-area-message. So
-      ;; use-fancy-splash-screens-p is called here simply to get the
-      ;; loading of image.el (if needed) out of the way before
-      ;; display-startup-echo-area-message runs.
-      (progn
-        (use-fancy-splash-screens-p)
-        (display-startup-echo-area-message)))
+  (display-startup-echo-area-message)
 
   ;; Delay 2 seconds after an init file error message
   ;; was displayed, so user can read it.
@@ -1756,260 +1916,266 @@ With a prefix argument, any user input hides the splash screen."
      "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))
-
-      ;; 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))
-
-          ;; 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))
-
-                ((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)))
-
-                ;; 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 "-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"))
-
-                ((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)))
-
-                ((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) ;; 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))))
-
-      ;; 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)))))
-
-  ;; Maybe display a startup screen.
-  (unless (or inhibit-startup-message
-              noninteractive
-              emacs-quick-startup)
-    ;; 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)
-
-    ;; 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))
-
-    ;; 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 user typed input during all that work,
-    ;; abort the startup screen.  Otherwise, display it now.
-    (unless (input-pending-p)
-      (display-splash-screen t))))
-
+  (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)))
+
+        ;; 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))))
+
+            ;; 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-screen t))
+
+                  ((member argi '("-f"  ; what the manual claims
+                                  "-funcall"
+                                  "-e"))  ; what the source used to say
+                   (setq inhibit-startup-screen t)
+                   (setq tem (intern (or argval (pop command-line-args-left))))
+                   (if (commandp tem)
+                       (command-execute tem)
+                     (funcall tem)))
+
+                  ((member argi '("-eval" "-execute"))
+                   (setq inhibit-startup-screen t)
+                   (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)))
+
+                  ;; 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 inhibit-startup-screen t)
+                   (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))
+
+                  ;; 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)))
+
+                  ((member argi '("-find-file" "-file" "-visit"))
+                   (setq inhibit-startup-screen t)
+                   ;; 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))
+                           (unless window-system
+                             (setq inhibit-startup-screen t))
+                           (setq file-count (1+ file-count))
+                           (let ((file
+                                  (expand-file-name
+                                   (command-line-normalize-file-name orig-argi)
+                                   dir)))
+                             (cond ((= file-count 1)
+                                    (setq first-file-buffer (find-file file)))
+                                   (inhibit-startup-screen
+                                    (find-file-other-window file))
+                                   (t (find-file 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))))))
+
+    (if (or inhibit-startup-screen
+            noninteractive
+            emacs-quick-startup)
+
+        ;; 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)))
+
+      ;; 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)
+
+      ;; 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))
+
+      ;; ;; 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 (> file-count 0)
+          (display-startup-screen t)
+        (display-startup-screen nil)))))
 
 (defun command-line-normalize-file-name (file)
   "Collapse multiple slashes to one, to handle non-Emacs file names."