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

[Richard M. Stallman]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Richard M. Stallman <rms>       07/09/05 19:58:50

Index: startup.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/startup.el,v
retrieving revision 1.453
retrieving revision 1.454
diff -u -b -r1.453 -r1.454
--- startup.el  4 Sep 2007 22:52:08 -0000       1.453
+++ startup.el  5 Sep 2007 19:58:50 -0000       1.454
@@ -1134,12 +1134,10 @@
 ;;; Fancy splash screen
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defvar fancy-splash-text
-  '((:face (variable-pitch :weight bold)
-          "Important Help menu items:\n"
-          :face variable-pitch
+(defvar fancy-startup-text
+  '((:face variable-pitch
           :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
-          "\tLearn how to use Emacs efficiently"
+     "\tLearn basic Emacs keystroke commands"
            (lambda ()
              (let* ((en "TUTORIAL")
                     (tut (or (get-language-info current-language-environment
@@ -1158,10 +1156,11 @@
                  (concat " (" title ")"))))
           "\n"
           :face variable-pitch
-          :link ("Emacs FAQ" (lambda (button) (view-emacs-FAQ)))
-          "\tFrequently asked questions and answers\n"
           :link ("View Emacs Manual" (lambda (button) (info-emacs-manual)))
           "\tView the Emacs manual using Info\n"
+     :link ("Emacs Guided Tour"
+         (lambda (button) (browse-url 
"http://www.gnu.org/software/emacs/tour/";)))
+     "\tOverview of Emacs features\n"
           :link ("Absence of Warranty" (lambda (button) 
(describe-no-warranty)))
           "\tGNU Emacs comes with "
           :face (variable-pitch :slant oblique)
@@ -1169,37 +1168,58 @@
           :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 ("More Manuals / Ordering Manuals" (lambda (button) 
(view-order-manuals)))
-          "  Buying printed manuals from the FSF\n")
-  (:face (variable-pitch :weight bold)
-        "Useful tasks:\n"
-        :face variable-pitch
-        :link ("Visit New File"
+     :link ("More Manuals / Ordering" (lambda (button) (view-order-manuals)))
+     "\tThe FSF sells printed copies of several manuals for Emacs\n"
+     "\n"
+     "To start...       "
+     :link ("Open a File"
                (lambda (button) (call-interactively 'find-file)))
-        "\tSpecify a new file's name, to edit the file\n"
+     "\t"
         :link ("Open Home Directory"
                (lambda (button) (dired "~")))
-        "\tOpen your home directory, to operate on its files\n"
-        :link ("Open *scratch* buffer"
-               (lambda (button) (switch-to-buffer (get-buffer-create 
"*scratch*"))))
-        "\tOpen buffer for notes you don't want to save\n"
-        :link ("Customize Startup"
-               (lambda (button) (customize-group 'initialization)))
-        "\tChange initialization settings including this screen\n"
-
-        "\nEmacs Guided Tour\tSee "
-        :link ("http://www.gnu.org/software/emacs/tour/";
-               (lambda (button) (browse-url 
"http://www.gnu.org/software/emacs/tour/";)))
-
-        ))
+     "\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
+     :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 ("More Manuals / Ordering Manuals" (lambda (button) 
(view-order-manuals)))
+     "  Buying 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 tutorial-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/";)))
+     "\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
@@ -1291,11 +1311,15 @@
                     'action (lambda (button) (browse-url 
"http://www.gnu.org/";))
                     'follow-link t)
        (insert "\n"))))
+  (insert "\n")
   (fancy-splash-insert
    :face '(variable-pitch :foreground "red")
+   "GNU Emacs is one component of the "
+   :link
    (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."))
+       '("GNU/Linux" (lambda (button) (browse-url 
"http://www.gnu.org/gnu/linux-and-gnu.html";)))
+     '("GNU" (lambda (button) (describe-project))))
+   " operating system.")
   (insert "\n")
   (if startup
       (fancy-splash-insert
@@ -1397,7 +1421,7 @@
 Warning Warning!!!  Pure space overflow    !!!Warning Warning
 \(See the node Pure Storage in the Lisp manual for details.)\n"))
       (fancy-splash-head startup)
-      (dolist (text fancy-splash-text)
+      (dolist (text fancy-startup-text)
        (apply #'fancy-splash-insert text)
        (insert "\n"))
       (skip-chars-backward "\n")
@@ -1473,11 +1497,55 @@
           ", one component of the GNU/Linux operating system.\n"
         ", a part of the GNU operating system.\n"))
 
+      (insert "\n")
+
       (if startup
          (if (display-mouse-p)
              ;; The user can use the mouse to activate menus
              ;; so give help in terms of menu items.
-             (progn
+             (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 "\
 You can do basic editing with the menu bar and scroll bar using the mouse.
 To quit a partially entered command, type Control-g.\n")
@@ -1486,11 +1554,7 @@
                (insert-button "Emacs Tutorial"
                               'action (lambda (button) (help-with-tutorial))
                               'follow-link t)
-               (insert "\t\tLearn how to use Emacs efficiently\n")
-               (insert-button "Emacs FAQ"
-                              'action (lambda (button) (view-emacs-FAQ))
-                              'follow-link t)
-               (insert "\t\tFrequently asked questions and answers\n")
+  (insert "\t\tLearn basic Emacs keystroke commands\n")
                (insert-button "Read the Emacs Manual"
                               'action (lambda (button) (info-emacs-manual))
                               'follow-link t)
@@ -1503,10 +1567,6 @@
                               '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 obtain the latest version of Emacs\n")
                (insert-button "More Manuals / Ordering Manuals"
                               'action (lambda (button) (view-order-manuals))
                               'follow-link t)
@@ -1521,11 +1581,6 @@
                               'action (lambda (button) (dired "~"))
                               'follow-link t)
                (insert "\tOpen your home directory, to operate on its files\n")
-               (insert-button "Open *scratch* buffer"
-                              'action (lambda (button) (switch-to-buffer
-                                                        (get-buffer-create 
"*scratch*")))
-                              'follow-link t)
-               (insert "\tOpen buffer for notes you don't want to save\n")
                (insert-button "Customize Startup"
                               'action (lambda (button) (customize-group 
'initialization))
                               'follow-link t)
@@ -1534,7 +1589,8 @@
                (insert "\n" (emacs-version)
                        "\n" emacs-copyright))
 
-           ;; No mouse menus, so give help using kbd commands.
+;; 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.
@@ -1633,9 +1689,7 @@
                                                     (get-buffer-create 
"*scratch*")))
                           'follow-link t)
            (insert "\n")
-
-           (insert "\n" (emacs-version)
-                   "\n" emacs-copyright)
+  (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)
@@ -1678,43 +1732,35 @@
                             'follow-link t)
              (insert ".")))
 
-       ;; About screen
-       (insert "\n" (emacs-version) "\n" emacs-copyright "\n")
-       )
+(defun normal-about-screen ()
+  (insert "\n" (emacs-version) "\n" emacs-copyright "\n\n")
 
-      ;; The rest of the startup screen is the same on all
-      ;; kinds of terminals.
+  (insert "To follow a link, click Mouse-1 on it, or move to it and type 
RET.\n\n")
 
-      ;; 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"))
+  (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")
 
-      (use-local-map splash-screen-keymap)
+  (insert-button "Absence of Warranty"
+                'action (lambda (button) (describe-no-warranty))
+                'follow-link t)
+  (insert "\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
 
-      ;; 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)))))
+  (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)