[Emacs-diffs] Changes to emacs/lisp/startup.el,v

[Juri Linkov]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Juri Linkov <jurta>     07/09/04 22:52:08

Index: startup.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/startup.el,v
retrieving revision 1.452
retrieving revision 1.453
diff -u -b -r1.452 -r1.453
--- startup.el  31 Aug 2007 06:57:24 -0000      1.452
+++ startup.el  4 Sep 2007 22:52:08 -0000       1.453
@@ -1198,26 +1198,19 @@
 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
+    ))
+  "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
@@ -1237,10 +1230,7 @@
 
 ;; 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)
 
 (defun fancy-splash-insert (&rest args)
   "Insert text into the current buffer, with faces.
@@ -1268,7 +1258,7 @@
       (setq args (cdr args)))))
 
 
-(defun fancy-splash-head ()
+(defun fancy-splash-head (&optional startup)
   "Insert the head part of the splash screen into the current buffer."
   (let* ((image-file (cond ((stringp fancy-splash-image)
                            fancy-splash-image)
@@ -1307,6 +1297,7 @@
        "GNU Emacs is one component of the GNU/Linux operating system."
      "GNU Emacs is one component of the GNU operating system."))
   (insert "\n")
+  (if startup
   (fancy-splash-insert
    :face 'variable-pitch
    "You can do basic editing with the menu bar and scroll bar \
@@ -1317,17 +1308,10 @@
    "Control-g"
    :face 'variable-pitch
    "."
-   "\n\n")
-  (when fancy-splash-outer-buffer
-    (fancy-splash-insert
-     :face 'variable-pitch
-     "Type "
-     :face 'default
-     "`q'"
-     :face 'variable-pitch
-     " to exit from this screen.\n")))
+       "\n\n"))
+  )
 
-(defun fancy-splash-tail ()
+(defun fancy-splash-tail (&optional startup)
   "Insert the tail part of the splash screen into the current buffer."
   (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark)
                "cyan" "darkblue")))
@@ -1336,8 +1320,10 @@
                         (emacs-version)
                         "\n"
                         :face '(variable-pitch :height 0.5)
-                        emacs-copyright)
-    (and auto-save-list-file-prefix
+                        emacs-copyright
+                        "\n")
+    (and startup
+        auto-save-list-file-prefix
         ;; Don't signal an error if the
         ;; directory for auto-save-list files
         ;; does not yet exist.
@@ -1351,7 +1337,7 @@
                                 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"
@@ -1359,100 +1345,72 @@
                              "\nto recover"
                              " the files you were editing.\n"))))
 
-(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))
-       (inhibit-read-only t))
-    (set-buffer buffer)
+(defun exit-splash-screen ()
+  "Stop displaying the splash screen buffer."
+  (interactive)
+  (quit-window t))
+
+(defun fancy-splash-screens (&optional startup)
+  "Display fancy splash screens.
+If optional argument STARTUP is non-nil, display the startup screen
+after Emacs starts.  If STARTUP is nil, display the About screen."
+  (if (not startup)
+      ;; Display About screen
+      (let ((frame (fancy-splash-frame)))
+       (save-selected-window
+         (select-frame frame)
+         (switch-to-buffer "*About GNU Emacs*")
+         (setq buffer-undo-list t
+               mode-line-format (propertize "---- %b %-"
+                                            'face 'mode-line-buffer-id))
+         (let ((inhibit-read-only t))
     (erase-buffer)
     (if pure-space-overflow
        (insert "\
 Warning Warning!!!  Pure space overflow    !!!Warning Warning
 \(See the node Pure Storage in the Lisp manual for details.)\n"))
-    (fancy-splash-head)
+           (fancy-splash-head startup)
+           (dolist (text fancy-about-text)
     (apply #'fancy-splash-insert text)
-    (fancy-splash-tail)
+             (insert "\n"))
+           (fancy-splash-tail startup)
     (unless (current-message)
       (message fancy-splash-help-echo))
     (set-buffer-modified-p nil)
     (goto-char (point-min))
-    (force-mode-line-update)
-    (setq fancy-current-text (cdr fancy-current-text))))
-
-(defun exit-splash-screen ()
-  "Stop displaying the splash screen buffer."
-  (interactive)
-  (if fancy-splash-outer-buffer
-      (throw 'stop-splashing nil)
-    (quit-window t)))
-
-(defun fancy-splash-screens (&optional static)
-  "Display fancy splash screens when Emacs starts."
-  (if (not static)
-      (let ((old-hourglass display-hourglass)
-           (fancy-splash-outer-buffer (current-buffer))
-           splash-buffer
-           (frame (fancy-splash-frame))
-           timer)
-       (save-selected-window
-         (select-frame frame)
-         (switch-to-buffer "*About GNU Emacs*")
-         (make-local-variable 'cursor-type)
-         (setq splash-buffer (current-buffer))
-         (catch 'stop-splashing
-           (unwind-protect
-               (let ((cursor-type nil))
-                 (setq display-hourglass 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))
+           (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)
-                 (recursive-edit))
-             (cancel-timer timer)
-             (setq display-hourglass old-hourglass)
-             (kill-buffer splash-buffer)
-             (when (frame-live-p frame)
-               (select-frame frame)
-               (switch-to-buffer fancy-splash-outer-buffer))))))
-    ;; If static is non-nil, don't show fancy splash screen.
+         (goto-char (point-min))))
+
+    ;; If startup is non-nil, display startup fancy splash screen.
     (if (or (window-minibuffer-p)
            (window-dedicated-p (selected-window)))
        (pop-to-buffer (current-buffer))
       (switch-to-buffer "*GNU Emacs*"))
-    (setq buffer-read-only nil)
+    (let ((inhibit-read-only t))
     (erase-buffer)
     (if pure-space-overflow
        (insert "\
 Warning Warning!!!  Pure space overflow    !!!Warning Warning
 \(See the node Pure Storage in the Lisp manual for details.)\n"))
-    (let (fancy-splash-outer-buffer)
-      (fancy-splash-head)
+      (fancy-splash-head startup)
       (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)
+      (fancy-splash-tail startup))
       (use-local-map splash-screen-keymap)
       (setq tab-width 22)
       (set-buffer-modified-p nil)
       (setq buffer-read-only t)
       (if (and view-read-only (not view-mode))
          (view-mode-enter nil 'kill-buffer))
-      (goto-char (point-min)))))
+    (goto-char (point-min))))
 
 (defun fancy-splash-frame ()
   "Return the frame to use for the fancy splash screen.
@@ -1486,15 +1444,16 @@
          (> frame-height (+ image-height 19)))))))
 
 
-(defun normal-splash-screen (&optional static)
-  "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 "*About GNU Emacs*")
          (setq buffer-read-only nil)
          (erase-buffer)
          (set (make-local-variable 'tab-width) 8)
-         (if (not static)
+      (if (not startup)
              (set (make-local-variable 'mode-line-format)
                   (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
 
@@ -1506,17 +1465,15 @@
           ;; The convention for this piece of code is that
           ;; each piece of output starts with one or two newlines
           ;; and does not end with any newlines.
+      (if startup
           (insert "Welcome to GNU Emacs")
+       (insert "This is GNU Emacs"))
           (insert
            (if (eq system-type 'gnu/linux)
                ", one component of the GNU/Linux operating system.\n"
              ", a part of the GNU operating system.\n"))
 
-         (if (not static)
-             (insert (substitute-command-keys
-                      (concat
-                       "\nType \\[recenter] to quit from this screen.\n"))))
-
+      (if startup
           (if (display-mouse-p)
               ;; The user can use the mouse to activate menus
               ;; so give help in terms of menu items.
@@ -1590,7 +1547,7 @@
                     (eq (key-binding "\C-h\C-n") 'view-emacs-news))
                 (progn
                  (insert "
-Get help          C-h  (Hold down CTRL and press h)
+Get help\t   C-h  (Hold down CTRL and press h)
 ")
                  (insert-button "Emacs manual"
                                 'action (lambda (button) (info-emacs-manual))
@@ -1612,7 +1569,7 @@
                  (insert "\t   C-h C-m\tExit Emacs\t   C-x C-c"))
 
              (insert (format "
-Get help          %s
+Get help\t   %s
 "
                              (let ((where (where-is-internal
                                            'help-command nil t)))
@@ -1622,7 +1579,7 @@
              (insert-button "Emacs manual"
                             'action (lambda (button) (info-emacs-manual))
                             'follow-link t)
-             (insert (substitute-command-keys"    \\[info-emacs-manual]\t"))
+             (insert (substitute-command-keys"\t   \\[info-emacs-manual]\t"))
              (insert-button "Browse manuals"
                             'action (lambda (button) (Info-directory))
                             'follow-link t)
@@ -1632,7 +1589,7 @@
                             'action (lambda (button) (help-with-tutorial))
                             'follow-link t)
              (insert (substitute-command-keys
-                      "           \\[help-with-tutorial]\tUndo changes\t   
\\[advertised-undo]
+                      "\t   \\[help-with-tutorial]\tUndo changes\t   
\\[advertised-undo]
 "))
              (insert-button "Buy manuals"
                             'action (lambda (button) (view-order-manuals))
@@ -1721,11 +1678,16 @@
                             'follow-link t)
              (insert ".")))
 
+       ;; About screen
+       (insert "\n" (emacs-version) "\n" emacs-copyright "\n")
+       )
+
          ;; 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
+      (and startup
+          auto-save-list-file-prefix
               ;; Don't signal an error if the
               ;; directory for auto-save-list files
               ;; does not yet exist.
@@ -1749,24 +1711,9 @@
          (setq buffer-read-only t)
          (if (and view-read-only (not view-mode))
              (view-mode-enter nil 'kill-buffer))
-          (goto-char (point-min))
-         (if (not static)
-             (if (or (window-minibuffer-p)
-                     (window-dedicated-p (selected-window)))
-                 ;; If static 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))))))
-      ;; Unwind ... ensure splash buffer is killed
-      (if (not static)
-         (kill-buffer "*About GNU Emacs*")
        (switch-to-buffer "*About GNU Emacs*")
-       (rename-buffer "*GNU Emacs*" t)))))
+      (if startup (rename-buffer "*GNU Emacs*" t))
+      (goto-char (point-min)))))
 
 
 (defun startup-echo-area-message ()
@@ -1808,29 +1755,21 @@
                              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)
-         (message "%s" (startup-echo-area-message))))))
+       (message "%s" (startup-echo-area-message)))))
 
 
-(defun display-splash-screen (&optional static)
+(defun display-splash-screen (&optional startup)
   "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."
+Fancy splash screens are used on graphic displays, normal otherwise.
+
+If optional argument STARTUP is non-nil, display the startup screen
+after Emacs starts.  If STARTUP is nil, display the About screen."
   (interactive "P")
   ;; Prevent recursive calls from server-process-filter.
   (if (not (get-buffer "*About GNU Emacs*"))
       (if (use-fancy-splash-screens-p)
-         (fancy-splash-screens static)
-       (normal-splash-screen static))))
+         (fancy-splash-screens startup)
+       (normal-splash-screen startup))))
 
 (defalias 'about-emacs 'display-splash-screen)