Remove some code duplication in startup.el
[bpt/emacs.git] / lisp / startup.el
index 5406c0f..b7b4c15 100644 (file)
@@ -770,11 +770,20 @@ Amongst another things, it parses the command-line arguments."
         (locate-file "simple" load-path (get-load-suffixes)))
        lisp-dir)
     ;; Don't abort if simple.el cannot be found, but print a warning.
+    ;; Although in most usage we are going to cryptically abort a moment
+    ;; later anyway, due to missing required bidi data files (eg bug#13430).
     (if (null simple-file-name)
-       (progn
-         (princ "Warning: Could not find simple.el nor simple.elc"
-                'external-debugging-output)
-         (terpri 'external-debugging-output))
+       (let ((standard-output 'external-debugging-output)
+             (lispdir (expand-file-name "../lisp" data-directory)))
+         (princ "Warning: Could not find simple.el or simple.elc")
+         (terpri)
+         (when (getenv "EMACSLOADPATH")
+           (princ "The EMACSLOADPATH environment variable is set, \
+please check its value")
+           (terpri))
+         (unless (file-readable-p lispdir)
+           (princ (format "Lisp directory %s not readable?" lispdir))
+           (terpri)))
       (setq lisp-dir (file-truename (file-name-directory simple-file-name)))
       (setq load-history
            (mapcar (lambda (elt)
@@ -1457,6 +1466,7 @@ Each element in the list should be a list of strings or pairs
     (suppress-keymap map)
     (set-keymap-parent map button-buffer-map)
     (define-key map "\C-?" 'scroll-down-command)
+    (define-key map [?\S-\ ] 'scroll-down-command)
     (define-key map " " 'scroll-up-command)
     (define-key map "q" 'exit-splash-screen)
     map)
@@ -1846,11 +1856,8 @@ To quit a partially entered command, type Control-g.\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.
+  "Show a splash screen suitable for displays without mouse support."
   (let* ((c-h-accessible
           ;; If normal-erase-is-backspace is used on a tty, there's
           ;; no way to invoke C-h and you have to use F1 instead.
@@ -1928,47 +1935,24 @@ If you have no Meta key, you may instead type ESC followed by the character.)")
                 '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 ")
-       (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
-            "
+  (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 ".
+  (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 "))
-    (insert-button "the conditions"
-                  'action (lambda (_button) (describe-copying))
-                  'follow-link t)
-    (insert (substitute-command-keys".
+  (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 ".")))
+  (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")
@@ -2017,14 +2001,11 @@ Type \\[describe-distribution] for information on "))
   (insert "\tBuying printed manuals from the FSF\n"))
 
 (defun startup-echo-area-message ()
-  (cond ((daemonp)
-        "Starting Emacs daemon.")
-       ((eq (key-binding "\C-h\C-a") 'about-emacs)
-        "For information about GNU Emacs and the GNU system, type C-h C-a.")
-       (t
-        (substitute-command-keys
-         "For information about GNU Emacs and the GNU system, type \
-\\[about-emacs]."))))
+  (if (daemonp)
+      "Starting Emacs daemon."
+    (substitute-command-keys
+     "For information about GNU Emacs and the GNU system, type \
+\\[about-emacs].")))
 
 (defun display-startup-echo-area-message ()
   (let ((resize-mini-windows t))
@@ -2389,13 +2370,17 @@ A fancy display is used on graphic displays, normal otherwise."
     ;; Use arg 1 so that we don't collapse // at the start of the file name.
     ;; That is significant on some systems.
     ;; However, /// at the beginning is supposed to mean just /, not //.
-    (if (string-match "^///+" file)
+    (if (string-match
+        (if (memq system-type '(ms-dos windows-nt))
+            "^\\([\\/][\\/][\\/]\\)+"
+          "^///+")
+        file)
        (setq file (replace-match "/" t t file)))
-    (and (memq system-type '(ms-dos windows-nt))
-        (string-match "^[A-Za-z]:\\(\\\\[\\\\/]\\)" file) ; C:\/ or C:\\
-        (setq file (replace-match "/" t t file 1)))
-    (while (string-match "//+" file 1)
-      (setq file (replace-match "/" t t file)))
+    (if (memq system-type '(ms-dos windows-nt))
+       (while (string-match "\\([\\/][\\/]\\)+" file 1)
+         (setq file (replace-match "/" t t file)))
+      (while (string-match "//+" file 1)
+       (setq file (replace-match "/" t t file))))
     file))
 
 ;;; startup.el ends here