X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b55c0dea6dee8944fe6697e34e82df0376f11742..16e1457021e3f6e3b83fc9b5262fde38b7140c96:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index 36065f0224..fa18b607b2 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,7 +1,7 @@ ;;; startup.el --- process Emacs shell arguments -;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, +;; 2001, 2002, 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -229,9 +229,17 @@ Put them in `default.el' instead, so that users can more easily override them. Users can prevent loading `default.el' with the `-q' option or by setting `inhibit-default-init' in their own init files, but inhibiting `site-start.el' requires `--no-site-file', which -is less convenient." +is less convenient. + +This variable is defined for customization so as to make +it visible in the relevant context. However, actually customizing it +is not allowed, since it would not work anyway. The only way to set +this variable usefully is to set it during while building and dumping Emacs." :type '(choice (const :tag "none" nil) string) - :group 'initialization) + :group 'initialization + :initialize 'custom-initialize-default + :set '(lambda (variable value) + (error "Customizing `site-run-file' does not work"))) (defcustom mail-host-address nil "*Name of this machine, for purposes of naming users." @@ -269,12 +277,16 @@ from being initialized." (defvar emacs-quick-startup nil) +(defvar emacs-basic-display nil) + (defvar init-file-debug nil) (defvar init-file-had-error nil) (defvar normal-top-level-add-subdirs-inode-list nil) +(defvar no-blinking-cursor nil) + (defvar pure-space-overflow nil "Non-nil if building Emacs overflowed pure space.") @@ -356,11 +368,17 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; of that dir into load-path, ;; Look for a leim-list.el file too. Loading it will register ;; available input methods. - (dolist (dir load-path) - (let ((default-directory dir)) - (load (expand-file-name "subdirs.el") t t t)) - (let ((default-directory dir)) - (load (expand-file-name "leim-list.el") t t t))) + (let ((tail load-path) dir) + (while tail + (setq dir (car tail)) + (let ((default-directory dir)) + (load (expand-file-name "subdirs.el") t t t)) + (let ((default-directory dir)) + (load (expand-file-name "leim-list.el") t t t)) + ;; We don't use a dolist loop and we put this "setq-cdr" command at + ;; the end, because the subdirs.el files may add elements to the end + ;; of load-path and we want to take it into account. + (setq tail (cdr tail)))) (unless (eq system-type 'vax-vms) ;; If the PWD environment variable isn't accurate, delete it. (let ((pwd (getenv "PWD"))) @@ -555,22 +573,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (setq command-line-default-directory default-directory) ;; Choose a reasonable location for temporary files. - (setq temporary-file-directory - (file-name-as-directory - (cond ((memq system-type '(ms-dos windows-nt)) - (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp")) - ((memq system-type '(vax-vms axp-vms)) - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:")) - (t - (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))) - (setq small-temporary-file-directory - (if (eq system-type 'ms-dos) - (getenv "TMPDIR"))) - (setq auto-save-file-name-transforms - (list (list (car (car auto-save-file-name-transforms)) - ;; Don't put "\\2" inside expand-file-name, since - ;; it will be transformed to "/2" on DOS/Windows. - (concat temporary-file-directory "\\2") t))) + (custom-reevaluate-setting 'temporary-file-directory) + (custom-reevaluate-setting 'small-emporary-file-directory) + (custom-reevaluate-setting 'auto-save-file-name-transforms) ;; See if we should import version-control from the environment variable. (let ((vc (getenv "VERSION_CONTROL"))) @@ -659,7 +664,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; does things. (while (and (not done) args) (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--user") - ("--debug-init") ("--iconic") ("--icon-type"))) + ("--debug-init") ("--iconic") ("--icon-type") + ("--no-blinking-cursor") ("--bare-bones"))) (argi (pop args)) (orig-argi argi) argval) @@ -679,10 +685,13 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (setq argval nil argi orig-argi))))) (cond - ((equal argi "-Q") + ((member argi '("-Q" "-quick")) (setq init-file-user nil site-run-file nil - emacs-quick-startup t) + emacs-quick-startup t)) + ((member argi '("-D" "-basic-display")) + (setq no-blinking-cursor t + emacs-basic-display t) (push '(vertical-scroll-bars . nil) initial-frame-alist)) ((member argi '("-q" "-no-init-file")) (setq init-file-user nil)) @@ -697,6 +706,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (push '(visibility . icon) initial-frame-alist)) ((member argi '("-icon-type" "-i" "-itype")) (push '(icon-type . t) default-frame-alist)) + ((member argi '("-nbc" "-no-blinking-cursor")) + (setq no-blinking-cursor t)) ;; Push the popped arg back on the list of arguments. (t (push argi args) @@ -709,52 +720,45 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (and command-line-args (setcdr command-line-args args))) - ;; Under X Windows, this creates the X frame and deletes the terminal frame. + ;; Under X Window, this creates the X frame and deletes the terminal frame. (when (fboundp 'frame-initialize) (frame-initialize)) + ;; Turn off blinking cursor if so specified in X resources. This is here + ;; only because all other settings of no-blinking-cursor are here. + (unless (or noninteractive + emacs-basic-display + (and (memq window-system '(x w32 mac)) + (not (member (x-get-resource "cursorBlink" "CursorBlink") + '("off" "false"))))) + (setq no-blinking-cursor t)) + ;; If frame was created with a menu bar, set menu-bar-mode on. (unless (or noninteractive - emacs-quick-startup + emacs-basic-display (and (memq window-system '(x w32)) (<= (frame-parameter nil 'menu-bar-lines) 0))) (menu-bar-mode 1)) ;; If frame was created with a tool bar, switch tool-bar-mode on. (unless (or noninteractive - emacs-quick-startup + emacs-basic-display (not (display-graphic-p)) (<= (frame-parameter nil 'tool-bar-lines) 0)) (tool-bar-mode 1)) - ;; Can't do this init in defcustom because window-system isn't set. - (unless (or noninteractive - emacs-quick-startup - (eq system-type 'ms-dos) - (not (memq window-system '(x w32)))) - (setq-default blink-cursor t) - (blink-cursor-mode 1)) - - (unless noninteractive - ;; DOS/Windows systems have a PC-type keyboard which has both - ;; and keys. - (when (or (memq system-type '(ms-dos windows-nt)) - (and (memq window-system '(x)) - (fboundp 'x-backspace-delete-keys-p) - (x-backspace-delete-keys-p)) - ;; If the terminal Emacs is running on has erase char - ;; set to ^H, use the Backspace key for deleting - ;; backward and, and the Delete key for deleting forward. - (and (null window-system) - (eq tty-erase-char 8))) - (setq-default normal-erase-is-backspace t) - (normal-erase-is-backspace-mode 1))) + ;; Can't do this init in defcustom because the relevant variables + ;; are not set. + (custom-reevaluate-setting 'blink-cursor-mode) + (custom-reevaluate-setting 'normal-erase-is-backspace) + ;; If you change the code below, you need to also change the + ;; corresponding code in the tooltip-mode defcustom. The two need + ;; to be equivalent under all conditions, or Custom will get confused. (unless (or noninteractive - emacs-quick-startup + emacs-basic-display (not (display-graphic-p)) (not (fboundp 'x-show-tip))) - (setq-default tooltip-mode t) (tooltip-mode 1)) ;; Register default TTY colors for the case the terminal hasn't a @@ -793,6 +797,14 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; the startup message. (setq inhibit-startup-message nil) + ;; Warn for invalid user name. + (and init-file-user + (not (file-directory-p (expand-file-name (concat "~" init-file-user)))) + (display-warning 'initialization + (format "User %s has no home directory" + init-file-user) + :error)) + ;; Load that user's init file, or the default one, or none. (let (debug-on-error-from-init-file debug-on-error-should-be-set @@ -863,12 +875,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (sit-for 1)) (setq user-init-file source)))) - (when (stringp custom-file) - (unless (assoc custom-file load-history) - ;; If the .emacs file has set `custom-file' but hasn't - ;; loaded the file yet, let's load it. - (load custom-file t t))) - (unless inhibit-default-init (let ((inhibit-startup-message nil)) ;; Users are supposed to be told their rights. @@ -953,6 +959,19 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (run-hooks 'after-init-hook) + ;; Decode all default-directory. + (if (and default-enable-multibyte-characters locale-coding-system) + (save-excursion + (dolist (elt (buffer-list)) + (set-buffer elt) + (if default-directory + (setq default-directory + (decode-coding-string default-directory + locale-coding-system t)))) + (setq command-line-default-directory + (decode-coding-string command-line-default-directory + locale-coding-system t)))) + ;; If *scratch* exists and init file didn't change its mode, initialize it. (if (get-buffer "*scratch*") (with-current-buffer "*scratch*" @@ -990,7 +1009,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; the session manager and we have a session manager connection. (if (and (boundp 'x-session-previous-id) (stringp x-session-previous-id)) - (emacs-session-restore x-session-previous-id))) + (with-no-warnings + (emacs-session-restore x-session-previous-id)))) (defcustom initial-scratch-message (purecopy "\ ;; This buffer is for notes you don't want to save, and for Lisp evaluation. @@ -1015,8 +1035,27 @@ If this is nil, no message will be displayed." using the mouse.\n\n" :face (variable-pitch :weight bold) "Important Help menu items:\n" - :face variable-pitch "\ -Emacs Tutorial\tLearn-by-doing tutorial for using Emacs efficiently + :face variable-pitch + (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 data-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. + (concat + "Emacs Tutorial\tLearn how to use Emacs efficiently" + (if (string= en tut) + "" + (concat " (" title ")")) + "\n"))) + :face variable-pitch "\ Emacs FAQ\tFrequently asked questions and answers Read the Emacs Manual\tView the Emacs manual using Info \(Non)Warranty\tGNU Emacs comes with " @@ -1033,7 +1072,7 @@ using the mouse.\n\n" "Useful File menu items:\n" :face variable-pitch "\ Exit Emacs\t(Or type Control-x followed by Control-c) -Recover Session\tRecover files you were editing before a crash +Recover Crashed Session\tRecover files you were editing before a crash @@ -1051,15 +1090,15 @@ Each element in the list should be a list of strings or pairs :group 'initialization) -(defcustom fancy-splash-delay 10 +(defcustom fancy-splash-delay 7 "*Delay in seconds between splash screens." :group 'fancy-splash-screen :type 'integer) -(defcustom fancy-splash-max-time 60 +(defcustom fancy-splash-max-time 30 "*Show splash screens for at most this number of seconds. -Values less than 60 seconds are ignored." +Values less than twice `fancy-splash-delay' are ignored." :group 'fancy-splash-screen :type 'integer) @@ -1080,14 +1119,18 @@ Values less than 60 seconds are ignored." (defun fancy-splash-insert (&rest args) "Insert text into the current buffer, with faces. -Arguments from ARGS should be either strings or pairs `:face FACE', +Arguments from ARGS should be either strings, functions called +with no args that return a string, or pairs `:face FACE', where FACE is a valid face specification, as it can be used with -`put-text-properties'." +`put-text-property'." (let ((current-face nil)) (while args (if (eq (car args) :face) (setq args (cdr args) current-face (car args)) - (insert (propertize (car args) + (insert (propertize (let ((it (car args))) + (if (functionp it) + (funcall it) + it)) 'face current-face 'help-echo fancy-splash-help-echo))) (setq args (cdr args))))) @@ -1132,6 +1175,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) @@ -1153,7 +1199,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) 2004 Free Software Foundation, Inc.") + "Copyright (C) 2005 Free Software Foundation, Inc.") (and auto-save-list-file-prefix ;; Don't signal an error if the ;; directory for auto-save-list files @@ -1233,7 +1279,7 @@ mouse." mode-line-format (propertize "---- %b %-" 'face '(:weight bold)) fancy-splash-stop-time (+ (float-time) - (max 60 fancy-splash-max-time)) + fancy-splash-max-time) timer (run-with-timer 0 fancy-splash-delay #'fancy-splash-screens-1 splash-buffer)) @@ -1469,9 +1515,16 @@ normal otherwise." nil t)) (error nil)) (kill-buffer buffer))))) - ;; Stop any "Loading image..." message hiding echo-area-message. - (use-fancy-splash-screens-p) - (display-startup-echo-area-message)) + ;; 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) + (display-startup-echo-area-message))) ;; Delay 2 seconds after an init file error message ;; was displayed, so user can read it. @@ -1595,11 +1648,11 @@ normal otherwise." (kill-emacs t)) ((string-match "^\\+[0-9]+\\'" argi) - (setq line (string-to-int argi))) + (setq line (string-to-number argi))) ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) - (setq line (string-to-int (match-string 1 argi)) - column (string-to-int (match-string 2 argi)))) + (setq line (string-to-number (match-string 1 argi)) + column (string-to-number (match-string 2 argi)))) ((setq tem (assoc argi command-line-x-option-alist)) ;; Ignore X-windows options and their args if not using X. @@ -1728,5 +1781,5 @@ normal otherwise." (setq file (replace-match "/" t t file))) file)) -;;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db +;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db ;;; startup.el ends here