X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/70646cf0fc77aeeb6dbba72a84e51d7bc0fe8ec3..26238072db2d78af84b46cd84a4b0a8260e4a9dd:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index 09aaba6e2b..32021225e7 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, 2001 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, +;; 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -20,103 +20,14 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: -;; This file parses the command line and gets Emacs running. Options on -;; the command line are handled in precedence order. The order is the -;; one in the list below; first described means first handled. Options -;; within each category (delimited by a bar) are handled in the order -;; encountered on the command line. - -;; ------------------------- -;; -version Print Emacs version to stderr, then exit -;; --version successfully right away. -;; This option is handled by emacs.c -;; ------------------------- -;; -help Print a short usage description and exit -;; --help successfully right away. -;; This option is handled by emacs.c -;; ------------------------- -;; -nl Do not use shared memory (for systems that -;; -no-shared-memory support this) for the dumped Emacs data. -;; This option is handled by emacs.c -;; -;; -map For VMS. -;; --map-data This option is handled by emacs.c -;; ------------------------- -;; -t FILE Use FILE as the name of the terminal. -;; --terminal FILE Using this implies "-nw" also. -;; This option is handled by emacs.c -;; ------------------------- -;; -d DISPNAME Use DISPNAME as the name of the X -;; -display DISPNAME display for the initial frame. -;; --display DISPNAME This option is handled by emacs.c -;; ------------------------- -;; -nw Do not use a windows system (but use the -;; --no-window-system terminal instead.) -;; This option is handled by emacs.c -;; ------------------------- -;; -batch Execute noninteractively (messages go to stdout, -;; --batch variable noninteractive set to t) -;; This option is handled by emacs.c -;; ------------------------- -;; -q Do not load user's init file and do not load -;; -no-init-file "default.el". Regardless of this switch, -;; --no-init-file "site-start" is still loaded. -;; ------------------------- -;; -no-site-file Do not load "site-start.el". (This is the ONLY -;; --no-site-file way to prevent loading that file.) -;; ------------------------- -;; -u USER Load USER's init file instead of the init -;; -user USER file belonging to the user starting Emacs. -;; --user USER -;; ------------------------- -;; -debug-init Don't catch errors in init files; let the -;; --debug-init debugger run. -;; ------------------------- -;; -i ICONTYPE Set type of icon using when Emacs is -;; -itype ICONTYPE iconified under X. -;; --icon-type ICONTYPE This option is passed on to term/x-win.el -;; -;; -iconic Start Emacs iconified. -;; --iconic This option is passed on to term/x-win.el -;; ------------------------- -;; Various X options for colors/fonts/geometry/title etc. -;; These options are passed on to term/x-win.el which see. -;; ------------------------- -;; FILE Visit FILE. -;; -visit FILE -;; --visit FILE -;; -file FILE -;; --file FILE -;; -;; -L DIRNAME Add DIRNAME to load-path -;; -directory DIRNAME -;; --directory DIRNAME -;; -;; -l FILE Load and execute the Emacs lisp code -;; -load FILE in FILE. -;; --load FILE -;; -;; -f FUNC Execute Emacs lisp function FUNC with -;; -funcall FUNC no arguments. The "-e" form is outdated -;; --funcall FUNC and should not be used. (It's a typo -;; -e FUNC promoted to a feature.) -;; -;; -eval FORM Execute Emacs lisp form FORM. -;; --eval FORM -;; -execute EXPR -;; --execute EXPR -;; -;; -insert FILE Insert the contents of FILE into buffer. -;; --insert FILE -;; ------------------------- -;; -kill Kill (exit) Emacs right away. -;; --kill -;; ------------------------- +;; This file parses the command line and gets Emacs running. Options +;; on the command line are handled in precedence order. For priorities +;; see the structure standard_args in the emacs.c file. ;;; Code: @@ -126,7 +37,7 @@ "Non-nil once command line has been processed.") (defgroup initialization nil - "Emacs start-up procedure" + "Emacs start-up procedure." :group 'internal) (defcustom inhibit-startup-message nil @@ -136,6 +47,8 @@ with the contents of the startup message." :type 'boolean :group 'initialization) +(defvaralias 'inhibit-splash-screen 'inhibit-startup-message) + (defcustom inhibit-startup-echo-area-message nil "*Non-nil inhibits the initial startup echo area message. Setting this variable takes effect @@ -163,8 +76,8 @@ the startup message unless he personally acts to inhibit it." (defvar command-switch-alist nil "Alist of command-line switches. Elements look like (SWITCH-STRING . HANDLER-FUNCTION). -HANDLER-FUNCTION receives switch name as sole arg; -remaining command-line args are in the variable `command-line-args-left'.") +HANDLER-FUNCTION receives the switch string as its sole argument; +the remaining command-line args are in the variable `command-line-args-left'.") (defvar command-line-args-left nil "List of command-line args not yet processed.") @@ -236,7 +149,7 @@ This is normally copied from `default-directory' when Emacs starts.") ("--cursor-color" 1 x-handle-switch cursor-color) ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t) ("--line-spacing" 1 x-handle-numeric-switch line-spacing) - ("--border-color" 1 x-handle-switch border-width) + ("--border-color" 1 x-handle-switch border-color) ("--smid" 1 x-handle-smid)) "Alist of X Windows options. Each element has the form @@ -265,11 +178,15 @@ It also follows `emacs-startup-hook'. This hook exists for users to set, so as to override the definitions made by the terminal-specific file. Emacs never sets this variable itself.") +(defvar inhibit-startup-hooks nil + "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'. +This is because we already did so.") + (defvar keyboard-type nil "The brand of keyboard you are using. -This variable is used to define -the proper function and keypad keys for use under X. It is used in a -fashion analogous to the environment variable TERM.") +This variable is used to define the proper function and keypad +keys for use under X. It is used in a fashion analogous to the +environment variable TERM.") (defvar window-setup-hook nil "Normal hook run to initialize window system display. @@ -303,7 +220,7 @@ Setting `init-file-user' does not prevent Emacs from loading "File containing site-wide run-time initializations. This file is loaded at run-time before `~/.emacs'. It contains inits that need to be in place for the entire site, but which, due to their -higher incidence of change, don't make sense to load into emacs' +higher incidence of change, don't make sense to load into Emacs's dumped image. Thus, the run-time load order is: 1. file described in this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'. @@ -312,16 +229,29 @@ 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 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." :type '(choice (const nil) string) :group 'mail) -(defcustom user-mail-address nil +(defcustom user-mail-address (if command-line-processed + (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'." @@ -345,18 +275,29 @@ from being initialized." string) :group 'auto-save) +(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 default-frame-background-mode) + +(defvar pure-space-overflow nil + "Non-nil if building Emacs overflowed pure space.") + (defun normal-top-level-add-subdirs-to-load-path () "Add all subdirectories of current directory to `load-path'. More precisely, this uses only the subdirectories whose names start with letters or digits; it excludes any subdirectory named `RCS' or `CVS', and any subdirectory that contains a file named `.nosearch'." - (let (dirs + (let (dirs attrs (pending (list default-directory))) ;; This loop does a breadth-first tree walk on DIR's subtree, @@ -366,8 +307,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (let* ((this-dir (car dirs)) (contents (directory-files this-dir)) (default-directory this-dir) - (canonicalized (and (eq system-type 'windows-nt) - (untranslated-canonical-name this-dir)))) + (canonicalized (if (fboundp 'untranslated-canonical-name) + (untranslated-canonical-name this-dir)))) ;; The Windows version doesn't report meaningful inode ;; numbers, so use the canonicalized absolute file name of the ;; directory instead. @@ -416,9 +357,11 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Give *Messages* the same default-directory as *scratch*, ;; just to keep things predictable. (let ((dir default-directory)) - (save-excursion - (set-buffer (get-buffer "*Messages*")) + (with-current-buffer "*Messages*" (setq default-directory dir))) + ;; `user-full-name' is now known; reset its standard-value here. + (put 'user-full-name 'standard-value + (list (default-value 'user-full-name))) ;; For root, preserve owner and group when editing files. (if (equal (user-uid) 0) (setq backup-by-copying-when-mismatch t)) @@ -427,32 +370,31 @@ 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. - (let ((tail load-path) - new) + (let ((tail load-path) dir) (while tail - (push (car tail) new) - (condition-case nil - (let ((default-directory (car tail))) - (load (expand-file-name "subdirs.el" (car tail)) t t t))) - (condition-case nil - (let ((default-directory (car tail))) - (load (expand-file-name "leim-list.el" (car tail)) t t t))) - (setq tail (cdr tail)))) - (if (not (eq system-type 'vax-vms)) - (progn - ;; If the PWD environment variable isn't accurate, delete it. - (let ((pwd (getenv "PWD"))) - (and (stringp pwd) - ;; Use FOO/., so that if FOO is a symlink, file-attributes - ;; describes the directory linked to, not FOO itself. - (or (equal (file-attributes - (concat (file-name-as-directory pwd) ".")) - (file-attributes - (concat (file-name-as-directory default-directory) - "."))) - (setq process-environment - (delete (concat "PWD=" pwd) - process-environment))))))) + (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"))) + (and (stringp pwd) + ;; Use FOO/., so that if FOO is a symlink, file-attributes + ;; describes the directory linked to, not FOO itself. + (or (equal (file-attributes + (concat (file-name-as-directory pwd) ".")) + (file-attributes + (concat (file-name-as-directory default-directory) + "."))) + (setq process-environment + (delete (concat "PWD=" pwd) + process-environment)))))) (setq default-directory (abbreviate-file-name default-directory)) (let ((menubar-bindings-done nil)) (unwind-protect @@ -472,7 +414,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (make-directory (file-name-directory auto-save-list-file-prefix) t) - (concat + (concat (make-temp-name (expand-file-name auto-save-list-file-prefix)) @@ -483,9 +425,10 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." auto-save-list-file-prefix (emacs-pid) (system-name)))))))) - (run-hooks 'emacs-startup-hook) - (and term-setup-hook - (run-hooks 'term-setup-hook)) + (unless inhibit-startup-hooks + (run-hooks 'emacs-startup-hook) + (and term-setup-hook + (run-hooks 'term-setup-hook))) ;; Don't do this if we failed to create the initial frame, ;; for instance due to a dense colormap. @@ -503,24 +446,23 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; frame-notice-user-settings didn't (such as on a tty). ;; frame-set-background-mode is idempotent, so it won't ;; cause any harm if it's already been done. - (let ((frame-background-mode frame-background-mode) - (frame (selected-frame)) + (let ((frame (selected-frame)) term) (when (and (null window-system) - ;; Don't override a possibly customized value. - (null frame-background-mode) - ;; Don't override user specifications. - (null (frame-parameter frame 'reverse)) + ;; Don't override default set by files in lisp/term. + (null default-frame-background-mode) (let ((bg (frame-parameter frame 'background-color))) (or (null bg) - (member bg '(unspecified "unspecified-bg"))))) + (member bg '(unspecified "unspecified-bg" + "unspecified-fg"))))) + (setq term (getenv "TERM")) ;; Some files in lisp/term do a better job with the ;; background mode, but we leave this here anyway, in ;; case they remove those files. (if (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" term) - (setq frame-background-mode 'light))) + (setq default-frame-background-mode 'light))) (frame-set-background-mode (selected-frame))))) ;; Now we know the user's default font, so add it to the menu. @@ -562,109 +504,88 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (defvar tool-bar-originally-present nil "Non-nil if tool-bars are present before user and site init files are read.") -;; Handle the X-like command line parameters "-fg", "-bg", "-name", etc. +;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc. (defun tty-handle-args (args) - (let ((rest nil)) + (let (rest) (message "%s" args) (while (and args (not (equal (car args) "--"))) - (let* ((this (car args)) - (orig-this this) - completion argval) - (setq args (cdr args)) + (let* ((argi (pop args)) + (orig-argi argi) + argval completion) ;; Check for long options with attached arguments ;; and separate out the attached option argument into argval. - (if (string-match "^--[^=]*=" this) - (setq argval (substring this (match-end 0)) - this (substring this 0 (1- (match-end 0))))) - (when (string-match "^--" this) - (setq completion (try-completion this tty-long-option-alist)) + (when (string-match "^\\(--[^=]*\\)=" argi) + (setq argval (substring argi (match-end 0)) + argi (match-string 1 argi))) + (when (string-match "^--" argi) + (setq completion (try-completion argi tty-long-option-alist)) (if (eq completion t) ;; Exact match for long option. - (setq this (cdr (assoc this tty-long-option-alist))) + (setq argi (cdr (assoc argi tty-long-option-alist))) (if (stringp completion) (let ((elt (assoc completion tty-long-option-alist))) ;; Check for abbreviated long option. (or elt - (error "Option `%s' is ambiguous" this)) - (setq this (cdr elt))) + (error "Option `%s' is ambiguous" argi)) + (setq argi (cdr elt))) ;; Check for a short option. - (setq argval nil this orig-this)))) - (cond ((or (string= this "-fg") (string= this "-foreground")) - (or argval (setq argval (car args) args (cdr args))) - (setq default-frame-alist - (cons (cons 'foreground-color argval) - default-frame-alist))) - ((or (string= this "-bg") (string= this "-background")) - (or argval (setq argval (car args) args (cdr args))) - (setq default-frame-alist - (cons (cons 'background-color argval) - default-frame-alist))) - ((or (string= this "-T") (string= this "-name")) - (or argval (setq argval (car args) args (cdr args))) - (setq default-frame-alist - (cons - (cons 'title - (if (stringp argval) - argval - (let ((case-fold-search t) - i) - (setq argval (invocation-name)) - - ;; Change any . or * characters in name to - ;; hyphens, so as to emulate behavior on X. - (while - (setq i (string-match "[.*]" argval)) - (aset argval i ?-)) - argval))) - default-frame-alist))) - ((or (string= this "-r") - (string= this "-rv") - (string= this "-reverse")) - (setq default-frame-alist - (cons '(reverse . t) - default-frame-alist))) - ((string= this "-color") - (if (null argval) - (setq argval 8)) ; default --color means 8 ANSI colors - (setq default-frame-alist - (cons (cons 'tty-color-mode - (cond - ((numberp argval) argval) - ((string-match "-?[0-9]+" argval) - (string-to-number argval)) - (t (intern argval)))) - default-frame-alist))) - (t (setq rest (cons this rest)))))) - (nreverse rest))) + (setq argval nil + argi orig-argi)))) + (cond ((member argi '("-fg" "-foreground")) + (push (cons 'foreground-color (or argval (pop args))) + default-frame-alist)) + ((member argi '("-bg" "-background")) + (push (cons 'background-color (or argval (pop args))) + default-frame-alist)) + ((member argi '("-T" "-name")) + (unless argval (setq argval (pop args))) + (push (cons 'title + (if (stringp argval) + argval + (let ((case-fold-search t) + i) + (setq argval (invocation-name)) + + ;; Change any . or * characters in name to + ;; hyphens, so as to emulate behavior on X. + (while + (setq i (string-match "[.*]" argval)) + (aset argval i ?-)) + argval))) + default-frame-alist)) + ((member argi '("-r" "-rv" "-reverse")) + (push '(reverse . t) + default-frame-alist)) + ((equal argi "-color") + (unless argval (setq argval 8)) ; default --color means 8 ANSI colors + (push (cons 'tty-color-mode + (cond + ((numberp argval) argval) + ((string-match "-?[0-9]+" argval) + (string-to-number argval)) + (t (intern argval)))) + default-frame-alist)) + (t + (push argi rest))))) + (nreverse rest))) (defun command-line () (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"))) + (custom-reevaluate-setting 'temporary-file-directory) + (custom-reevaluate-setting 'small-temporary-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"))) (cond ((eq vc nil)) ;don't do anything if not set - ((or (string= vc "t") - (string= vc "numbered")) + ((member vc '("t" "numbered")) (setq version-control t)) - ((or (string= vc "nil") - (string= vc "existing")) + ((member vc '("nil" "existing")) (setq version-control nil)) - ((or (string= vc "never") - (string= vc "simple")) + ((member vc '("never" "simple")) (setq version-control 'never)))) ;;! This has been commented out; I currently find the behavior when @@ -677,15 +598,15 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; end-of-line formats that aren't native to this platform. (cond ((memq system-type '(ms-dos windows-nt emx)) - (setq eol-mnemonic-unix "(Unix)") - (setq eol-mnemonic-mac "(Mac)")) + (setq eol-mnemonic-unix "(Unix)" + eol-mnemonic-mac "(Mac)")) ;; Both Mac and Unix EOLs are now "native" on Mac OS so keep the ;; abbreviated strings `/' and `:' set in coding.c for them. ((eq system-type 'macos) (setq eol-mnemonic-dos "(DOS)")) - (t ; this is for Unix/GNU/Linux systems - (setq eol-mnemonic-dos "(DOS)") - (setq eol-mnemonic-mac "(Mac)"))) + (t ; this is for Unix/GNU/Linux systems + (setq eol-mnemonic-dos "(DOS)" + eol-mnemonic-mac "(Mac)"))) ;; Read window system's init file if using a window system. (condition-case error @@ -703,21 +624,20 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (apply 'concat (cdr error)) (if (memq 'file-error (get (car error) 'error-conditions)) (format "%s: %s" - (nth 1 error) - (mapconcat (lambda (obj) (prin1-to-string obj t)) - (cdr (cdr error)) ", ")) + (nth 1 error) + (mapconcat (lambda (obj) (prin1-to-string obj t)) + (cdr (cdr error)) ", ")) (format "%s: %s" - (get (car error) 'error-message) - (mapconcat (lambda (obj) (prin1-to-string obj t)) - (cdr error) ", ")))) + (get (car error) 'error-message) + (mapconcat (lambda (obj) (prin1-to-string obj t)) + (cdr error) ", ")))) 'external-debugging-output) (terpri 'external-debugging-output) (setq window-system nil) (kill-emacs))) ;; Windowed displays do this inside their *-win.el. - (when (and (not (display-graphic-p)) - (not noninteractive)) + (unless (or (display-graphic-p) noninteractive) (setq command-line-args (tty-handle-args command-line-args))) (set-locale-environment nil) @@ -727,7 +647,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (while args (setcar args (decode-coding-string (car args) locale-coding-system t)) - (setq args (cdr args)))) + (pop args))) (let ((done nil) (args (cdr command-line-args))) @@ -736,110 +656,111 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; either from the environment or from the options. (setq init-file-user (if noninteractive nil (user-login-name))) ;; If user has not done su, use current $HOME to find .emacs. - (and init-file-user (string= init-file-user (user-real-login-name)) + (and init-file-user + (equal init-file-user (user-real-login-name)) (setq init-file-user "")) ;; Process the command-line args, and delete the arguments ;; processed. This is consistent with the way main in emacs.c ;; does things. (while (and (not done) args) - (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user") - ("--debug-init") ("--iconic") ("--icon-type"))) - (argi (pop args)) - (argval nil)) + (let* ((longopts '(("--no-init-file") ("--no-site-file") ("--debug-init") + ("--user") ("--iconic") ("--icon-type") ("--quick") + ("--no-blinking-cursor") ("--basic-display"))) + (argi (pop args)) + (orig-argi argi) + argval) ;; Handle --OPTION=VALUE format. - (if (and (string-match "\\`--" argi) - (string-match "=" argi)) - (setq argval (substring argi (match-end 0)) - argi (substring argi 0 (match-beginning 0)))) - (or (equal argi "--") - (let ((completion (try-completion argi longopts))) - (if (eq completion t) - (setq argi (substring argi 1)) - (if (stringp completion) - (let ((elt (assoc completion longopts))) - (or elt - (error "Option `%s' is ambiguous" argi)) - (setq argi (substring (car elt) 1))) - (setq argval nil))))) + (when (string-match "^\\(--[^=]*\\)=" argi) + (setq argval (substring argi (match-end 0)) + argi (match-string 1 argi))) + (unless (equal argi "--") + (let ((completion (try-completion argi longopts))) + (if (eq completion t) + (setq argi (substring argi 1)) + (if (stringp completion) + (let ((elt (assoc completion longopts))) + (or elt + (error "Option `%s' is ambiguous" argi)) + (setq argi (substring (car elt) 1))) + (setq argval nil + argi orig-argi))))) (cond + ((member argi '("-Q" "-quick")) + (setq init-file-user nil + site-run-file nil + 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)) ((member argi '("-u" "-user")) - (or argval - (setq argval (pop args))) - (setq init-file-user argval + (setq init-file-user (or argval (pop args)) argval nil)) - ((string-equal argi "-no-site-file") + ((equal argi "-no-site-file") (setq site-run-file nil)) - ((string-equal argi "-debug-init") + ((equal argi "-debug-init") (setq init-file-debug t)) - ((string-equal argi "-iconic") + ((equal argi "-iconic") (push '(visibility . icon) initial-frame-alist)) - ((or (string-equal argi "-icon-type") - (string-equal argi "-i") - (string-equal argi "-itype")) + ((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) (setq done t))) + (t + (push argi args) + (setq done t))) ;; Was argval set but not used? (and argval (error "Option `%s' doesn't allow an argument" argi)))) ;; Re-attach the program name to the front of the arg list. - (and command-line-args (setcdr command-line-args args))) + (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. - (if (and (not noninteractive) - (or (not (memq window-system '(x w32))) - (> (frame-parameter nil 'menu-bar-lines) 0))) - (menu-bar-mode t)) + (unless (or noninteractive + 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. - (when (and (not noninteractive) - (display-graphic-p) - (> (frame-parameter nil 'tool-bar-lines) 0)) + (unless (or noninteractive + 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. - (when (and (not noninteractive) - (not (eq system-type 'ms-dos)) - (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))) - - (when (and (not noninteractive) - (display-graphic-p) - (fboundp 'x-show-tip)) - (setq-default tooltip-mode t) - (tooltip-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) + (custom-reevaluate-setting 'tooltip-mode) ;; Register default TTY colors for the case the terminal hasn't a ;; terminal init file. - (or (memq window-system '(x w32)) - ;; We do this regardles of whether the terminal supports colors - ;; or not, since they can switch that support on or off in - ;; mid-session by setting the tty-color-mode frame parameter. - (tty-register-default-colors)) + (unless (memq window-system '(x w32)) + ;; We do this regardles of whether the terminal supports colors + ;; or not, since they can switch that support on or off in + ;; mid-session by setting the tty-color-mode frame parameter. + (tty-register-default-colors)) ;; Record whether the tool-bar is present before the user and site ;; init files are processed. frame-notice-user-settings uses this @@ -849,9 +770,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) (assq 'tool-bar-lines default-frame-alist)))) (setq tool-bar-originally-present - (not (or (null tool-bar-lines) - (null (cdr tool-bar-lines)) - (eq 0 (cdr tool-bar-lines))))))) + (and tool-bar-lines + (cdr tool-bar-lines) + (not (eq 0 (cdr tool-bar-lines))))))) (let ((old-scalable-fonts-allowed scalable-fonts-allowed) (old-font-list-limit font-list-limit) @@ -862,13 +783,21 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Run the site-start library if it exists. The point of this file is ;; that it is run before .emacs. There is no point in doing this after ;; .emacs; that is useless. - (if site-run-file + (if site-run-file (load site-run-file t t)) ;; Sites should not disable this. Only individuals should disable ;; 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 @@ -886,10 +815,15 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ((eq system-type 'ms-dos) (concat "~" init-file-user "/_emacs")) ((eq system-type 'windows-nt) + ;; Prefer .emacs on Windows. (if (directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$") "~/.emacs" - "~/_emacs")) - ((eq system-type 'vax-vms) + ;; Also support _emacs for compatibility. + (if (directory-files "~" nil "^_emacs\\(\\.elc?\\)?$") + "~/_emacs" + ;; But default to .emacs if _emacs does not exist. + "~/.emacs"))) + ((eq system-type 'vax-vms) "sys$login:.emacs") (t (concat "~" init-file-user "/.emacs"))))) @@ -897,13 +831,25 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; into user-init-file. (setq user-init-file t) (load user-init-file-1 t t) - - ;; If we did not find the user's init file, - ;; set user-init-file conclusively to nil; - ;; don't let it be set from default.el. - (if (eq user-init-file t) - (setq user-init-file user-init-file-1)) - + + (when (eq user-init-file t) + ;; If we did not find ~/.emacs, try + ;; ~/.emacs.d/.emacs. + (let ((otherfile + (expand-file-name + (file-name-nondirectory user-init-file-1) + (file-name-as-directory + (expand-file-name + ".emacs.d" + (file-name-directory user-init-file-1)))))) + (load otherfile t t) + + ;; If we did not find the user's init file, + ;; set user-init-file conclusively. + ;; Don't let it be set from default.el. + (when (eq user-init-file t) + (setq user-init-file user-init-file-1)))) + ;; If we loaded a compiled file, set ;; `user-init-file' to the source version if that ;; exists. @@ -921,14 +867,14 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." source user-init-file) (sit-for 1)) (setq user-init-file source)))) - - (or inhibit-default-init - (let ((inhibit-startup-message nil)) - ;; Users are supposed to be told their rights. - ;; (Plus how to get help and how to undo.) - ;; Don't you dare turn this off for anyone - ;; except yourself. - (load "default" t t))))))))) + + (unless inhibit-default-init + (let ((inhibit-startup-message nil)) + ;; Users are supposed to be told their rights. + ;; (Plus how to get help and how to undo.) + ;; Don't you dare turn this off for anyone + ;; except yourself. + (load "default" t t))))))))) (if init-file-debug ;; Do this without a condition-case if the user wants to debug. (funcall inner) @@ -946,17 +892,17 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (format "%s%s%s" (get (car error) 'error-message) (if (cdr error) ": " "") - (mapconcat 'prin1-to-string (cdr error) ", ")) + (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", ")) "\n\n" - "To ensure normal operation, you should investigate the cause\n" - "of the error in your initialization file and remove it. Start\n" - "Emacs with the `--debug-init' option to view a complete error\n" - "backtrace\n")) + "To ensure normal operation, you should investigate and remove the\n" + "cause of the error in your initialization file. Start Emacs with\n" + "the `--debug-init' option to view a complete error backtrace.\n\n")) (message "Error in init file: %s%s%s" (get (car error) 'error-message) (if (cdr error) ": " "") (mapconcat 'prin1-to-string (cdr error) ", ")) - (pop-to-buffer "*Messages*") + (let ((pop-up-windows nil)) + (pop-to-buffer "*Messages*")) (setq init-file-had-error t))))) ;; If the user has a file of abbrevs, read it. @@ -989,9 +935,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; originally done before unibyte was set and is sensitive to ;; unibyte (display table, terminal coding system &c). (set-language-environment current-language-environment))) - + ;; Do this here in case the init file sets mail-host-address. - (or user-mail-address + (if (equal user-mail-address "") (setq user-mail-address (concat (user-login-name) "@" (or mail-host-address (system-name))))) @@ -1003,27 +949,54 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (eq font-list-limit old-font-list-limit) (eq face-ignored-fonts old-face-ignored-fonts)) (clear-face-cache))) - + (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*") - (save-excursion - (set-buffer "*scratch*") + (with-current-buffer "*scratch*" (if (eq major-mode 'fundamental-mode) (funcall initial-major-mode)))) - + ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. - (and term-file-prefix (not noninteractive) (not window-system) - (let ((term (getenv "TERM")) - hyphend) - (while (and term - (not (load (concat term-file-prefix term) t t))) - ;; Strip off last hyphen and what follows, then try again - (if (setq hyphend (string-match "[-_][^-_]+$" term)) - (setq term (substring term 0 hyphend)) - (setq term nil))))) + (unless (or noninteractive + window-system + (null term-file-prefix)) + (let ((term (getenv "TERM")) + hyphend) + (while (and term + (not (load (concat term-file-prefix term) t t))) + ;; Strip off last hyphen and what follows, then try again + (setq term + (if (setq hyphend (string-match "[-_][^-_]+$" term)) + (substring term 0 hyphend) + nil))) + (when term + ;; The terminal file has been loaded, now call the terminal + ;; specific initialization function. + (let ((term-init-func (intern (concat "terminal-init-" term)))) + (when (fboundp term-init-func) + (funcall term-init-func)))))) + + ;; Update the out-of-memory error message based on user's key bindings + ;; for save-some-buffers. + (setq memory-signal-data + (list 'error + (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs"))) ;; Process the remaining args. (command-line-1 (cdr command-line-args)) @@ -1033,8 +1006,10 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Run emacs-session-restore (session management) if started by ;; 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))) + (if (and (boundp 'x-session-previous-id) + (stringp 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. @@ -1059,16 +1034,37 @@ 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 " :face (variable-pitch :slant oblique) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch "\ Copying Conditions\tConditions for redistributing and changing Emacs -Ordering Manuals\tHow to order Emacs manuals from the Free Software Foundation\n") +Getting New Versions\tHow to obtain the latest version of Emacs +More Manuals / Ordering Manuals Buying printed manuals from the FSF\n") (:face variable-pitch "You can do basic editing with the menu bar and scroll bar \ using the mouse.\n\n" @@ -1076,7 +1072,8 @@ 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 + @@ -1093,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) @@ -1122,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))))) @@ -1152,8 +1153,8 @@ where FACE is a valid face specification, as it can be used with (when img (when (> window-width image-width) ;; Center the image in the window. - (let ((pos (/ (- window-width image-width) 2))) - (insert (propertize " " 'display `(space :align-to ,pos)))) + (insert (propertize " " 'display + `(space :align-to (+ center (-0.5 . ,img))))) ;; Change the color of the XPM version of the splash image ;; so that it is visible with a dark frame background. @@ -1174,12 +1175,10 @@ 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")))) - (if (eq system-type 'gnu/linux) - (fancy-splash-insert - :face '(variable-pitch :foreground "red") - "GNU Emacs is one component of a Linux-based GNU system.") - (fancy-splash-insert - :face '(variable-pitch :foreground "red") + (fancy-splash-insert + :face '(variable-pitch :foreground "red") + (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.")) (insert "\n") (unless (equal (buffer-name fancy-splash-outer-buffer) "*scratch*") @@ -1197,7 +1196,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) 2001 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 @@ -1225,6 +1224,8 @@ where FACE is a valid face specification, as it can be used with (let ((text (car fancy-current-text))) (set-buffer buffer) (erase-buffer) + (if pure-space-overflow + (insert "Warning Warning Pure space overflow Warning Warning\n")) (fancy-splash-head) (apply #'fancy-splash-insert text) (fancy-splash-tail) @@ -1237,7 +1238,10 @@ where FACE is a valid face specification, as it can be used with (defun fancy-splash-default-action () - "Default action for events in the splash screen buffer." + "Stop displaying the splash screen buffer. +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) (push last-command-event unread-command-events) (throw 'exit nil)) @@ -1250,181 +1254,210 @@ where FACE is a valid face specification, as it can be used with (fancy-splash-outer-buffer (current-buffer)) splash-buffer (old-minor-mode-map-alist minor-mode-map-alist) + (frame (fancy-splash-frame)) timer) - (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 [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) - (max 60 fancy-splash-max-time)) - timer (run-with-timer 0 fancy-splash-delay - #'fancy-splash-screens-1 - splash-buffer)) - (recursive-edit)) + (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))))) - + (kill-buffer splash-buffer)))))) + +(defun fancy-splash-frame () + "Return the frame to use for the fancy splash screen. +Returning non-nil does not mean we should necessarily +use the fancy splash screen, but if we do use it, +we put it on this frame." + (let (chosen-frame) + (dolist (frame (append (frame-list) (list (selected-frame)))) + (if (and (frame-visible-p frame) + (not (window-minibuffer-p (frame-selected-window frame)))) + (setq chosen-frame frame))) + chosen-frame)) (defun use-fancy-splash-screens-p () "Return t if fancy splash screens should be used." - (when (or (and (display-color-p) + (when (and (display-graphic-p) + (or (and (display-color-p) (image-type-available-p 'xpm)) - (image-type-available-p 'pbm)) - (let* ((img (create-image (or fancy-splash-image - (if (and (display-color-p) - (image-type-available-p 'xpm)) - "splash.xpm" "splash.pbm")))) - (image-height (and img (cdr (image-size img)))) - (window-height (1- (window-height (selected-window))))) - (> window-height (+ image-height 19))))) + (image-type-available-p 'pbm))) + (let ((frame (fancy-splash-frame))) + (when frame + (let* ((img (create-image (or fancy-splash-image + (if (and (display-color-p) + (image-type-available-p 'xpm)) + "splash.xpm" "splash.pbm")))) + (image-height (and img (cdr (image-size img)))) + (window-height (1- (window-height (frame-selected-window frame))))) + (> window-height (+ image-height 19))))))) (defun normal-splash-screen () "Display splash screen when Emacs starts." - (with-current-buffer (get-buffer-create "GNU Emacs") - (let ((tab-width 8) - (mode-line-format (propertize "---- %b %-" - 'face '(:weight bold)))) - - ;; 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") - (if (eq system-type 'gnu/linux) - (insert ", one component of a Linux-based GNU system.")) - (insert "\n") - - (unless (equal (buffer-name (current-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 "\ + (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 "\ You can do basic editing with the menu bar and scroll bar using the mouse. Useful File menu items: Exit Emacs (or type Control-x followed by Control-c) -Recover Session recover files you were editing before a crash +Recover Crashed Session Recover files you were editing before a crash Important Help menu items: -Emacs Tutorial Learn-by-doing tutorial for using Emacs efficiently. +Emacs Tutorial Learn how to use Emacs efficiently Emacs FAQ Frequently asked questions and answers +Read the Emacs Manual View the Emacs manual using Info \(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY -Copying Conditions Conditions for redistributing and changing Emacs. -Getting New Versions How to obtain the latest version of Emacs. -Ordering Manuals How to order manuals from the FSF. +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) 2001 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-h\C-n") 'view-emacs-news)) - (insert " + (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 " Get help C-h (Hold down CTRL and press h) -Undo changes C-x u Exit Emacs C-x C-c -Get a tutorial C-h t Use Info to read docs C-h i -Ordering manuals C-h RET") - (insert (substitute-command-keys - (format "\n +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 Get help %s -Undo changes \\[advertised-undo] -Exit Emacs \\[save-buffers-kill-emacs] -Get a tutorial \\[help-with-tutorial] -Use Info to read docs \\[info] -Ordering manuals \\[view-order-manuals]" - (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 " +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 " 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) 2001 Free Software Foundation, Inc.") + (insert "\n\n" (emacs-version) + " +Copyright (C) 2005 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)))) - (kill-buffer "GNU Emacs")) + ;; 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)))) + ;; Unwind ... ensure splash buffer is killed + (kill-buffer "GNU Emacs")))) + (defun startup-echo-area-message () (if (eq (key-binding "\C-h\C-p") 'describe-project) @@ -1444,8 +1477,7 @@ Type \\[describe-distribution] for information on getting the latest version.")) Fancy splash screens are used on graphic displays, normal otherwise." (interactive) - (if (and (display-graphic-p) - (use-fancy-splash-screens-p)) + (if (use-fancy-splash-screens-p) (fancy-splash-screens) (normal-splash-screen))) @@ -1457,7 +1489,7 @@ normal otherwise." user-init-file (or (and (get 'inhibit-startup-echo-area-message 'saved-value) (equal inhibit-startup-echo-area-message - (if (string= init-file-user "") + (if (equal init-file-user "") (user-login-name) init-file-user))) ;; Wasn't set with custom; see if .emacs has a setq. @@ -1473,223 +1505,235 @@ normal otherwise." "inhibit-startup-echo-area-message[ \t\n]+" (regexp-quote (prin1-to-string - (if (string= init-file-user "") + (if (equal init-file-user "") (user-login-name) init-file-user))) "[ \t\n]*)") nil t)) (error nil)) (kill-buffer buffer))))) - (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. - (if init-file-had-error - (sit-for 2)) - - (if command-line-args-left - ;; We have command args; process them. - (let ((dir command-line-default-directory) - (file-count 0) - first-file-buffer - tem - just-files ;; t if this follows the magic -- option. - ;; This includes our standard options' long versions - ;; and long versions of what's on command-switch-alist. - (longopts - (append '(("--funcall") ("--load") ("--insert") ("--kill") - ("--directory") ("--eval") ("--execute") - ("--find-file") ("--visit") ("--file")) - (mapcar (lambda (elt) - (list (concat "-" (car elt)))) - command-switch-alist))) - (line 0) - (column 0)) - - ;; Add the long X options to longopts. - (dolist (tem command-line-x-option-alist) - (if (string-match "^--" (car tem)) - (push (list (car tem)) longopts))) - - ;; Loop, processing options. - (while (and command-line-args-left) - (let* ((argi (car command-line-args-left)) - (orig-argi argi) - argval completion - ;; List of directories specified in -L/--directory, - ;; in reverse of the order specified. - extra-load-path - (initial-load-path load-path)) - (setq command-line-args-left (cdr command-line-args-left)) - - ;; Do preliminary decoding of the option. - (if just-files - ;; After --, don't look for options; treat all args as files. - (setq argi "") - ;; Convert long options to ordinary options - ;; and separate out an attached option argument into argval. - (if (string-match "^--[^=]*=" argi) - (setq argval (substring argi (match-end 0)) - argi (substring argi 0 (1- (match-end 0))))) - (if (equal argi "--") - (setq completion nil) - (setq completion (try-completion argi longopts))) - (if (eq completion t) - (setq argi (substring argi 1)) - (if (stringp completion) - (let ((elt (assoc completion longopts))) - (or elt - (error "Option `%s' is ambiguous" argi)) - (setq argi (substring (car elt) 1))) - (setq argval nil argi orig-argi)))) - - ;; Execute the option. - (cond ((setq tem (assoc argi command-switch-alist)) - (if argval - (let ((command-line-args-left - (cons argval command-line-args-left))) - (funcall (cdr tem) argi)) - (funcall (cdr tem) argi))) - - ((member argi '("-f" ;what the manual claims - "-funcall" - "-e")) ; what the source used to say - (if argval - (setq tem (intern argval)) - (setq tem (intern (car command-line-args-left))) - (setq command-line-args-left (cdr command-line-args-left))) - (if (arrayp (symbol-function tem)) - (command-execute tem) - (funcall tem))) - - ((member argi '("-eval" "-execute")) - (if argval - (setq tem argval) - (setq tem (car command-line-args-left)) - (setq command-line-args-left (cdr command-line-args-left))) - (eval (read tem))) - ;; Set the default directory as specified in -L. - - ((member argi '("-L" "-directory")) - (if argval - (setq tem argval) - (setq tem (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) - (setq tem (command-line-normalize-file-name tem)) - (setq extra-load-path - (cons (expand-file-name tem) extra-load-path)) - (setq load-path (append (nreverse extra-load-path) - initial-load-path))) - - ((member argi '("-l" "-load")) - (if argval - (setq tem argval) - (setq tem (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) - (let ((file (command-line-normalize-file-name tem))) - ;; Take file from default dir if it exists there; - ;; otherwise let `load' search for it. - (if (file-exists-p (expand-file-name file)) - (setq file (expand-file-name file))) - (load file nil t))) - - ((string-equal argi "-insert") - (if argval - (setq tem argval) - (setq tem (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) - (or (stringp tem) - (error "File name omitted from `-insert' option")) - (insert-file-contents (command-line-normalize-file-name tem))) - - ((string-equal argi "-kill") - (kill-emacs t)) - - ((string-match "^\\+[0-9]+\\'" argi) - (setq line (string-to-int 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 tem (assoc argi command-line-x-option-alist)) - ;; Ignore X-windows options and their args if not using X. - (setq command-line-args-left - (nthcdr (nth 1 tem) command-line-args-left))) - - ((member argi '("-find-file" "-file" "-visit")) - ;; An explicit option to specify visiting a file. - (if argval - (setq tem argval) - (setq tem (car command-line-args-left) - command-line-args-left (cdr command-line-args-left))) - (unless (stringp tem) - (error "File name omitted from `%s' option" argi)) - (setq file-count (1+ file-count)) - (let ((file (expand-file-name - (command-line-normalize-file-name tem) dir))) - (if (= file-count 1) - (setq first-file-buffer (find-file file)) - (find-file-other-window file))) - (or (zerop line) - (goto-line line)) - (setq line 0) - (unless (< column 1) - (move-to-column (1- column))) - (setq column 0)) - - ((equal argi "--") - (setq just-files t)) - (t - ;; We have almost exhausted our options. See if the - ;; user has made any other command-line options available - (let ((hooks command-line-functions) ;; lrs 7/31/89 - (did-hook nil)) - (while (and hooks - (not (setq did-hook (funcall (car hooks))))) - (setq hooks (cdr hooks))) - (if (not did-hook) - ;; Ok, presume that the argument is a file name - (progn - (if (string-match "\\`-" argi) - (error "Unknown option `%s'" argi)) - (setq file-count (1+ file-count)) - (let ((file - (expand-file-name - (command-line-normalize-file-name orig-argi) - dir))) - (if (= file-count 1) - (setq first-file-buffer (find-file file)) - (find-file-other-window file))) - (or (zerop line) - (goto-line line)) - (setq line 0) - (unless (< column 1) - (move-to-column (1- column))) - (setq column 0)))))))) - ;; If 3 or more files visited, and not all visible, - ;; show user what they all are. But leave the last one current. - (and (> file-count 2) - (not noninteractive) - (not inhibit-startup-buffer-menu) - (or (get-buffer-window first-file-buffer) - (list-buffers))))) + (when init-file-had-error + (sit-for 2)) + + (when command-line-args-left + ;; We have command args; process them. + (let ((dir command-line-default-directory) + (file-count 0) + first-file-buffer + tem + ;; This approach loses for "-batch -L DIR --eval "(require foo)", + ;; if foo is intended to be found in DIR. + ;; + ;; ;; The directories listed in --directory/-L options will *appear* + ;; ;; at the front of `load-path' in the order they appear on the + ;; ;; command-line. We cannot do this by *placing* them at the front + ;; ;; in the order they appear, so we need this variable to hold them, + ;; ;; temporarily. + ;; extra-load-path + ;; + ;; To DTRT we keep track of the splice point and modify `load-path' + ;; straight away upon any --directory/-L option. + splice + just-files ;; t if this follows the magic -- option. + ;; This includes our standard options' long versions + ;; and long versions of what's on command-switch-alist. + (longopts + (append '(("--funcall") ("--load") ("--insert") ("--kill") + ("--directory") ("--eval") ("--execute") ("--no-splash") + ("--find-file") ("--visit") ("--file")) + (mapcar (lambda (elt) + (list (concat "-" (car elt)))) + command-switch-alist))) + (line 0) + (column 0)) + + ;; Add the long X options to longopts. + (dolist (tem command-line-x-option-alist) + (if (string-match "^--" (car tem)) + (push (list (car tem)) longopts))) + + ;; Loop, processing options. + (while command-line-args-left + (let* ((argi (car command-line-args-left)) + (orig-argi argi) + argval completion) + (setq command-line-args-left (cdr command-line-args-left)) + + ;; Do preliminary decoding of the option. + (if just-files + ;; After --, don't look for options; treat all args as files. + (setq argi "") + ;; Convert long options to ordinary options + ;; and separate out an attached option argument into argval. + (when (string-match "^\\(--[^=]*\\)=" argi) + (setq argval (substring argi (match-end 0)) + argi (match-string 1 argi))) + (if (equal argi "--") + (setq completion nil) + (setq completion (try-completion argi longopts))) + (if (eq completion t) + (setq argi (substring argi 1)) + (if (stringp completion) + (let ((elt (assoc completion longopts))) + (or elt + (error "Option `%s' is ambiguous" argi)) + (setq argi (substring (car elt) 1))) + (setq argval nil + argi orig-argi)))) + + ;; Execute the option. + (cond ((setq tem (assoc argi command-switch-alist)) + (if argval + (let ((command-line-args-left + (cons argval command-line-args-left))) + (funcall (cdr tem) argi)) + (funcall (cdr tem) argi))) + + ((equal argi "-no-splash") + (setq inhibit-startup-message t)) + + ((member argi '("-f" ; what the manual claims + "-funcall" + "-e")) ; what the source used to say + (setq tem (intern (or argval (pop command-line-args-left)))) + (if (commandp tem) + (command-execute tem) + (funcall tem))) + + ((member argi '("-eval" "-execute")) + (eval (read (or argval (pop command-line-args-left))))) + + ((member argi '("-L" "-directory")) + (setq tem (expand-file-name + (command-line-normalize-file-name + (or argval (pop command-line-args-left))))) + (cond (splice (setcdr splice (cons tem (cdr splice))) + (setq splice (cdr splice))) + (t (setq load-path (cons tem load-path) + splice load-path)))) + + ((member argi '("-l" "-load")) + (let* ((file (command-line-normalize-file-name + (or argval (pop command-line-args-left)))) + ;; Take file from default dir if it exists there; + ;; otherwise let `load' search for it. + (file-ex (expand-file-name file))) + (when (file-exists-p file-ex) + (setq file file-ex)) + (load file nil t))) + + ;; This is used to handle -script. It's not clear + ;; we need to document it. + ((member argi '("-scriptload")) + (let* ((file (command-line-normalize-file-name + (or argval (pop command-line-args-left)))) + ;; Take file from default dir. + (file-ex (expand-file-name file))) + (load file-ex nil t t))) + + ((equal argi "-insert") + (setq tem (or argval (pop command-line-args-left))) + (or (stringp tem) + (error "File name omitted from `-insert' option")) + (insert-file-contents (command-line-normalize-file-name tem))) + + ((equal argi "-kill") + (kill-emacs t)) + + ((string-match "^\\+[0-9]+\\'" argi) + (setq line (string-to-number argi))) + + ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" 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. + (setq command-line-args-left + (nthcdr (nth 1 tem) command-line-args-left))) + + ((member argi '("-find-file" "-file" "-visit")) + ;; An explicit option to specify visiting a file. + (setq tem (or argval (pop command-line-args-left))) + (unless (stringp tem) + (error "File name omitted from `%s' option" argi)) + (setq file-count (1+ file-count)) + (let ((file (expand-file-name + (command-line-normalize-file-name tem) dir))) + (if (= file-count 1) + (setq first-file-buffer (find-file file)) + (find-file-other-window file))) + (or (zerop line) + (goto-line line)) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)) + + ((equal argi "--") + (setq just-files t)) + (t + ;; We have almost exhausted our options. See if the + ;; user has made any other command-line options available + (let ((hooks command-line-functions) ;; lrs 7/31/89 + (did-hook nil)) + (while (and hooks + (not (setq did-hook (funcall (car hooks))))) + (setq hooks (cdr hooks))) + (if (not did-hook) + ;; Presume that the argument is a file name. + (progn + (if (string-match "\\`-" argi) + (error "Unknown option `%s'" argi)) + (setq file-count (1+ file-count)) + (let ((file + (expand-file-name + (command-line-normalize-file-name orig-argi) + dir))) + (if (= file-count 1) + (setq first-file-buffer (find-file file)) + (find-file-other-window file))) + (or (zerop line) + (goto-line line)) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)))))))) + + ;; If 3 or more files visited, and not all visible, + ;; show user what they all are. But leave the last one current. + (and (> file-count 2) + (not noninteractive) + (not inhibit-startup-buffer-menu) + (or (get-buffer-window first-file-buffer) + (list-buffers))))) ;; Maybe display a startup screen. - (when (and (not inhibit-startup-message) (not noninteractive) - ;; Don't display startup screen if init file - ;; has started some sort of server. - (not (and (fboundp 'process-list) - (process-list)))) + (unless (or inhibit-startup-message + noninteractive + emacs-quick-startup) ;; Display a startup screen, after some preparations. ;; If there are no switches to process, we might as well ;; run this hook now, and there may be some need to do it ;; before doing any output. + (run-hooks 'emacs-startup-hook) (and term-setup-hook (run-hooks 'term-setup-hook)) - ;; Don't let the hook be run twice. - (setq term-setup-hook nil) + (setq inhibit-startup-hooks t) ;; It's important to notice the user settings before we ;; display the startup message; otherwise, the settings @@ -1710,12 +1754,13 @@ normal otherwise." ;; clicks the menu bar during the sit-for. (when (display-popup-menus-p) (precompute-menubar-bindings)) - (setq menubar-bindings-done t) + (with-no-warnings + (setq menubar-bindings-done t)) ;; If *scratch* is selected and it is empty, insert an ;; initial message saying not to create a file there. (when (and initial-scratch-message - (string= (buffer-name) "*scratch*") + (equal (buffer-name) "*scratch*") (= 0 (buffer-size))) (insert initial-scratch-message) (set-buffer-modified-p nil)) @@ -1738,4 +1783,5 @@ normal otherwise." (setq file (replace-match "/" t t file))) file)) +;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db ;;; startup.el ends here