X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/51f47f643cb19decdd63e268b51f9b7fde40faa2..b883cdb2fefa8ea9c3b0d82eba7a9ee792f871bb:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index 5e135433a2..33138ef387 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,7 +1,7 @@ ;;; startup.el --- process Emacs shell arguments ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, -;; 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -40,14 +40,16 @@ "Emacs start-up procedure." :group 'internal) -(defcustom inhibit-startup-message nil - "*Non-nil inhibits the initial startup message. +(defcustom inhibit-splash-screen nil + "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 message." +with the contents of the startup screen." :type 'boolean :group 'initialization) -(defvaralias 'inhibit-splash-screen 'inhibit-startup-message) +(defvaralias 'inhibit-startup-message 'inhibit-splash-screen) (defcustom inhibit-startup-echo-area-message nil "*Non-nil inhibits the initial startup echo area message. @@ -197,23 +199,22 @@ the user's init file.") :type 'function :group 'initialization) -(defcustom init-file-user nil +(defvar init-file-user nil "Identity of user whose `.emacs' file is or was read. The value is nil if `-q' or `--no-init-file' was specified, meaning do not load any init file. -Otherwise, the value may be the null string, meaning use the init file -for the user that originally logged in, or it may be a -string containing a user's name meaning use that person's init file. +Otherwise, the value may be an empty string, meaning +use the init file for the user who originally logged in, +or it may be a string containing a user's name meaning +use that person's init file. In either of the latter cases, `(concat \"~\" init-file-user \"/\")' evaluates to the name of the directory where the `.emacs' file was looked for. Setting `init-file-user' does not prevent Emacs from loading -`site-start.el'. The only way to do that is to use `--no-site-file'." - :type '(choice (const :tag "none" nil) string) - :group 'initialization) +`site-start.el'. The only way to do that is to use `--no-site-file'.") (defcustom site-run-file "site-start" "File containing site-wide run-time initializations. @@ -642,15 +643,21 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (set-locale-environment nil) ;; Convert preloaded file names to absolute. - (setq load-history - (mapcar (lambda (elt) - (if (and (stringp (car elt)) - (not (file-name-absolute-p (car elt)))) - (cons (locate-file (car elt) load-path - load-suffixes) - (cdr elt)) - elt)) - load-history)) + (let ((lisp-dir + (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)) + (cdr elt)) + elt)) + load-history))) ;; Convert the arguments to Emacs internal representation. (let ((args (cdr command-line-args))) @@ -765,8 +772,12 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (custom-reevaluate-setting 'blink-cursor-mode) (custom-reevaluate-setting 'normal-erase-is-backspace) (custom-reevaluate-setting 'tooltip-mode) + (custom-reevaluate-setting 'global-font-lock-mode) (custom-reevaluate-setting 'mouse-wheel-down-event) (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. @@ -809,7 +820,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" @@ -921,6 +941,10 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (pop-to-buffer "*Messages*")) (setq init-file-had-error t))))) + (if (and deactivate-mark transient-mark-mode) + (with-current-buffer (window-buffer) + (deactivate-mark))) + ;; If the user has a file of abbrevs, read it. (if (file-exists-p abbrev-file-name) (quietly-read-abbrev-file abbrev-file-name)) @@ -958,6 +982,38 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (or mail-host-address (system-name))))) + ;; Originally face attributes were specified via + ;; `font-lock-face-attributes'. Users then changed the default + ;; face attributes by setting that variable. However, we try and + ;; be back-compatible and respect its value if set except for + ;; faces where M-x customize has been used to save changes for the + ;; face. + (when (boundp 'font-lock-face-attributes) + (let ((face-attributes font-lock-face-attributes)) + (while face-attributes + (let* ((face-attribute (pop face-attributes)) + (face (car face-attribute))) + ;; Rustle up a `defface' SPEC from a + ;; `font-lock-face-attributes' entry. + (unless (get face 'saved-face) + (let ((foreground (nth 1 face-attribute)) + (background (nth 2 face-attribute)) + (bold-p (nth 3 face-attribute)) + (italic-p (nth 4 face-attribute)) + (underline-p (nth 5 face-attribute)) + face-spec) + (when foreground + (setq face-spec (cons ':foreground (cons foreground face-spec)))) + (when background + (setq face-spec (cons ':background (cons background face-spec)))) + (when bold-p + (setq face-spec (append '(:weight bold) face-spec))) + (when italic-p + (setq face-spec (append '(:slant italic) face-spec))) + (when underline-p + (setq face-spec (append '(:underline t) face-spec))) + (face-spec-set face (list (list t face-spec)) nil))))))) + ;; If parameter have been changed in the init file which influence ;; face realization, clear the face cache so that new faces will ;; be realized. @@ -1042,7 +1098,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) @@ -1199,6 +1257,9 @@ where FACE is a valid face specification, as it can be used with (insert-image img (propertize "xxx" 'help-echo help-echo 'keymap map))) (insert "\n")))) + (fancy-splash-insert + :face '(variable-pitch :background "red") + "\n!! This version is ALPHA status. It may lose your data!!\n\n") (fancy-splash-insert :face '(variable-pitch :foreground "red") (if (eq system-type 'gnu/linux) @@ -1220,7 +1281,7 @@ where FACE is a valid face specification, as it can be used with (emacs-version) "\n" :face '(variable-pitch :height 0.5) - "Copyright (C) 2005 Free Software Foundation, Inc.") + "Copyright (C) 2006 Free Software Foundation, Inc.") (and auto-save-list-file-prefix ;; Don't signal an error if the ;; directory for auto-save-list files @@ -1249,7 +1310,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) @@ -1267,7 +1330,7 @@ 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 (consp last-command-event) + (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. @@ -1284,6 +1347,7 @@ mouse." (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 @@ -1302,9 +1366,10 @@ mouse." (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 '(:weight bold)) + 'face 'mode-line-buffer-id) fancy-splash-stop-time (+ (float-time) fancy-splash-max-time) timer (run-with-timer 0 fancy-splash-delay @@ -1313,7 +1378,8 @@ mouse." (recursive-edit)) (cancel-timer timer) (setq display-hourglass old-hourglass - minor-mode-map-alist old-minor-mode-map-alist) + minor-mode-map-alist old-minor-mode-map-alist + emulation-mode-map-alists old-emulation-mode-map-alists) (kill-buffer splash-buffer)))))) (defun fancy-splash-frame () @@ -1350,31 +1416,33 @@ we put it on this frame." (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*") - (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 "\ + (set (make-local-variable 'tab-width) 8) + (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")) + + (unless (equal (buffer-name prev-buffer) "*scratch*") + (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 "\ You can do basic editing with the menu bar and scroll bar using the mouse. Useful File menu items: @@ -1390,101 +1458,107 @@ 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) - " -Copyright (C) 2005 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 " + (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 " 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) - " -Copyright (C) 2005 Free Software Foundation, Inc.") + (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) + (goto-char (point-min)) + (if (or (window-minibuffer-p) + (window-dedicated-p (selected-window))) + ;; There's no point is using pop-to-buffer since 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)))) ;; Unwind ... ensure splash buffer is killed (kill-buffer "GNU Emacs")))) @@ -1558,6 +1632,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) @@ -1583,7 +1664,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))) @@ -1683,6 +1764,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)))