Merge from emacs--devo--0
[bpt/emacs.git] / lisp / startup.el
index df20bc1..fb44e53 100644 (file)
@@ -41,7 +41,9 @@
   :group 'internal)
 
 (defcustom inhibit-splash-screen nil
-  "*Non-nil inhibits the startup screen.
+  "Non-nil inhibits the startup screen.
+It also inhibits display of the initial message in the *scratch* buffer.
+
 This is for use in your personal init file, once you are familiar
 with the contents of the startup screen."
   :type 'boolean
@@ -245,14 +247,16 @@ this variable usefully is to set it while building and dumping Emacs."
   :group 'mail)
 
 (defcustom user-mail-address (if command-line-processed
-                                (concat (user-login-name) "@"
-                                        (or mail-host-address
-                                            (system-name)))
+                                (or (getenv "EMAIL")
+                                    (concat (user-login-name) "@"
+                                            (or mail-host-address
+                                                (system-name))))
                               ;; Empty string means "not set yet".
                               "")
   "*Full mailing address of this user.
-This is initialized based on `mail-host-address',
-after your init file is read, in case it sets `mail-host-address'."
+This is initialized with environment variable `EMAIL' or, as a
+fallback, using `mail-host-address'. This is done after your
+init file is read, in case it sets `mail-host-address'."
   :type 'string
   :group 'mail)
 
@@ -642,18 +646,17 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
 
   ;; Convert preloaded file names to absolute.
   (let ((lisp-dir
-        (file-name-directory
-         (locate-file "simple" load-path
-                      load-suffixes))))
+        (file-truename
+         (file-name-directory
+          (locate-file "simple" load-path
+                       (get-load-suffixes))))))
 
     (setq load-history
          (mapcar (lambda (elt)
                    (if (and (stringp (car elt))
                             (not (file-name-absolute-p (car elt))))
                        (cons (concat lisp-dir
-                                     (car elt)
-                                     (if (string-match "[.]el$" (car elt))
-                                         "" ".elc"))
+                                     (car elt))
                              (cdr elt))
                      elt))
                  load-history)))
@@ -776,6 +779,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
   (custom-reevaluate-setting 'mouse-wheel-up-event)
   (custom-reevaluate-setting 'file-name-shadow-mode)
   (custom-reevaluate-setting 'send-mail-function)
+  (custom-reevaluate-setting 'global-auto-composition-mode)
 
   ;; Register default TTY colors for the case the terminal hasn't a
   ;; terminal init file.
@@ -818,7 +822,16 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
                           (format "Invalid user name %s"
                                   init-file-user)
                           :error)
-       (if (file-directory-p (expand-file-name (concat "~" init-file-user)))
+       (if (file-directory-p (expand-file-name
+                              ;; We don't support ~USER on MS-Windows except
+                              ;; for the current user, and always load .emacs
+                              ;; from the current user's home directory (see
+                              ;; below).  So always check "~", even if invoked
+                              ;; with "-u USER", or if $USER or $LOGNAME are
+                              ;; set to something different.
+                              (if (eq system-type 'windows-nt)
+                                  "~"
+                                (concat "~" init-file-user))))
            nil
          (display-warning 'initialization
                           (format "User %s has no home directory"
@@ -967,9 +980,10 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
 
     ;; Do this here in case the init file sets mail-host-address.
     (if (equal user-mail-address "")
-       (setq user-mail-address (concat (user-login-name) "@"
-                                       (or mail-host-address
-                                           (system-name)))))
+       (setq user-mail-address (or (getenv "EMAIL")
+                                   (concat (user-login-name) "@"
+                                           (or mail-host-address
+                                               (system-name))))))
 
     ;; Originally face attributes were specified via
     ;; `font-lock-face-attributes'.  Users then changed the default
@@ -1087,7 +1101,9 @@ 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 this is nil, no message will be displayed.
+If `inhibit-splash-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))
   :group 'initialization)
@@ -1253,11 +1269,16 @@ where FACE is a valid face specification, as it can be used with
        "GNU Emacs is one component of the GNU/Linux operating system."
      "GNU Emacs is one component of the GNU operating system."))
   (insert "\n")
-  (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*")
-    (fancy-splash-insert :face 'variable-pitch
-                        (substitute-command-keys
-                         "Type \\[recenter] to begin editing your file.\n"))))
-
+  (if fancy-splash-outer-buffer
+      (fancy-splash-insert
+       :face 'variable-pitch
+       (substitute-command-keys
+       (concat
+        "Type \\[recenter] to begin editing"
+        (if (equal (buffer-name fancy-splash-outer-buffer)
+                   "*scratch*")
+            ".\n"
+          " your file.\n"))))))
 
 (defun fancy-splash-tail ()
   "Insert the tail part of the splash screen into the current buffer."
@@ -1297,7 +1318,9 @@ where FACE is a valid face specification, as it can be used with
     (set-buffer buffer)
     (erase-buffer)
     (if pure-space-overflow
-       (insert "Warning Warning  Pure space overflow   Warning Warning\n"))
+       (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)
@@ -1325,44 +1348,69 @@ mouse."
   (throw 'exit nil))
 
 
-(defun fancy-splash-screens ()
+(defun fancy-splash-screens (&optional hide-on-input)
   "Display fancy splash screens when Emacs starts."
   (setq fancy-splash-help-echo (startup-echo-area-message))
-  (let ((old-hourglass display-hourglass)
-       (fancy-splash-outer-buffer (current-buffer))
-       splash-buffer
-       (old-minor-mode-map-alist minor-mode-map-alist)
-       (frame (fancy-splash-frame))
-       timer)
-    (save-selected-window
-      (select-frame frame)
-      (switch-to-buffer "GNU Emacs")
-      (setq tab-width 20)
-      (setq splash-buffer (current-buffer))
-      (catch 'stop-splashing
-       (unwind-protect
-           (let ((map (make-sparse-keymap)))
-             (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)
-             (setq cursor-type nil
-                   display-hourglass nil
-                   minor-mode-map-alist nil
-                   buffer-undo-list t
-                   mode-line-format (propertize "---- %b %-"
-                                                'face '(:weight bold))
-                   fancy-splash-stop-time (+ (float-time)
-                                             fancy-splash-max-time)
-                   timer (run-with-timer 0 fancy-splash-delay
-                                         #'fancy-splash-screens-1
-                                         splash-buffer))
-             (recursive-edit))
-         (cancel-timer timer)
-         (setq display-hourglass old-hourglass
-               minor-mode-map-alist old-minor-mode-map-alist)
-         (kill-buffer splash-buffer))))))
+  (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)
+           (frame (fancy-splash-frame))
+           timer)
+       (save-selected-window
+         (select-frame frame)
+         (switch-to-buffer "GNU Emacs")
+         (setq tab-width 20)
+         (setq splash-buffer (current-buffer))
+         (catch 'stop-splashing
+           (unwind-protect
+               (let ((map (make-sparse-keymap)))
+                 (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)
+                 (setq cursor-type nil
+                       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))
+                 (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)
+             (kill-buffer splash-buffer)))))
+    ;; If hide-on-input is non-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 "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))
+      (fancy-splash-tail)
+      (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)))))
 
 (defun fancy-splash-frame ()
   "Return the frame to use for the fancy splash screen.
@@ -1393,36 +1441,45 @@ we put it on this frame."
          (> window-height (+ image-height 19)))))))
 
 
-(defun normal-splash-screen ()
+(defun normal-splash-screen (&optional hide-on-input)
   "Display splash screen when Emacs starts."
   (let ((prev-buffer (current-buffer)))
     (unwind-protect
        (with-current-buffer (get-buffer-create "GNU Emacs")
-         (let ((tab-width 8)
-               (mode-line-format (propertize "---- %b %-"
-                                             'face '(:weight bold))))
-
-           (if pure-space-overflow
-               (insert "Warning Warning  Pure space overflow   Warning Warning\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"))
-
-           (unless (equal (buffer-name prev-buffer) "*scratch*")
+         (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
-                      "\nType \\[recenter] to begin editing 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 "\
+                      (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.
 
 Useful File menu items:
@@ -1438,103 +1495,115 @@ 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
 ")
-                 (insert "\n\n" (emacs-version)
-                         "
+                (insert "\n\n" (emacs-version)
+                        "
 Copyright (C) 2006 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 "
+            ;; 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
+              (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 "
+                               (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 "
+              (insert (substitute-command-keys "
 Activate menubar     \\[tmm-menubar]")))
 
-             ;; Many users seem to have problems with these.
-             (insert "
+            ;; 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)
-                     "
+            (insert "\n\n" (emacs-version)
+                    "
 Copyright (C) 2006 Free Software Foundation, Inc.")
 
-             (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
+            (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.
 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
+              (insert (substitute-command-keys
+                       "\n
 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
 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 M-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)
-           (goto-char (point-min))
-           (save-window-excursion
-             (switch-to-buffer (current-buffer))
-             (sit-for 120))))
+          ;; 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 M-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 (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.
+             (pop-to-buffer (current-buffer))
+           (if hide-on-input
+               (save-window-excursion
+                 (switch-to-buffer (current-buffer))
+                 (sit-for 120))
+             (switch-to-buffer (current-buffer)))))
       ;; Unwind ... ensure splash buffer is killed
-      (kill-buffer "GNU Emacs"))))
+      (if hide-on-input
+         (kill-buffer "GNU Emacs")))))
 
 
 (defun startup-echo-area-message ()
@@ -1550,14 +1619,14 @@ Type \\[describe-distribution] for information on getting the latest version."))
     (message "%s" (startup-echo-area-message))))
 
 
-(defun display-splash-screen ()
+(defun display-splash-screen (&optional hide-on-input)
   "Display splash screen according to display.
 Fancy splash screens are used on graphic displays,
 normal otherwise."
   (interactive)
   (if (use-fancy-splash-screens-p)
-      (fancy-splash-screens)
-    (normal-splash-screen)))
+      (fancy-splash-screens hide-on-input)
+    (normal-splash-screen hide-on-input)))
 
 
 (defun command-line-1 (command-line-args-left)
@@ -1606,6 +1675,13 @@ normal otherwise."
   (when init-file-had-error
     (sit-for 2))
 
+  (when (and pure-space-overflow
+            (not noninteractive))
+    (display-warning
+     'initialization
+     "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)
@@ -1631,7 +1707,7 @@ normal otherwise."
           (longopts
            (append '(("--funcall") ("--load") ("--insert") ("--kill")
                      ("--directory") ("--eval") ("--execute") ("--no-splash")
-                     ("--find-file") ("--visit") ("--file"))
+                     ("--find-file") ("--visit") ("--file") ("--no-desktop"))
                    (mapcar (lambda (elt)
                              (list (concat "-" (car elt))))
                            command-switch-alist)))
@@ -1731,6 +1807,13 @@ normal otherwise."
                 ((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)))
 
@@ -1846,7 +1929,7 @@ normal otherwise."
     ;; If user typed input during all that work,
     ;; abort the startup screen.  Otherwise, display it now.
     (unless (input-pending-p)
-      (display-splash-screen))))
+      (display-splash-screen t))))
 
 
 (defun command-line-normalize-file-name (file)