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."