X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f5b6cffdd7fc800a6aa288896a9242031d75fff1..fcaf7de969a4e3556e184640911efb8e4a8dc874:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index e0fb840c16..c1b25b1867 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,6 +1,6 @@ ;;; startup.el --- process Emacs shell arguments -;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002 +;; Copyright (C) 1985, 86, 92, 94, 95, 96, 97, 98, 99, 2000, 01, 02, 2004 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -25,101 +25,9 @@ ;;; 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.) -;; ------------------------- -;; -no-splash Don't display a splash screen on startup. -;; --no-splash -;; ------------------------- -;; -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: @@ -168,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.") @@ -241,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 @@ -270,6 +178,10 @@ 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 @@ -308,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'. @@ -355,12 +267,17 @@ from being initialized." string) :group 'auto-save) +(defvar emacs-quick-startup nil) + (defvar init-file-debug nil) (defvar init-file-had-error nil) (defvar normal-top-level-add-subdirs-inode-list nil) +(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 @@ -376,8 +293,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. @@ -426,12 +343,14 @@ 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))) + ;; Subprocesses of Emacs do not have direct access to the terminal, + ;; so unless told otherwise they should only assume a dumb terminal. + (setenv "TERM" "dumb") ;; For root, preserve owner and group when editing files. (if (equal (user-uid) 0) (setq backup-by-copying-when-mismatch t)) @@ -440,32 +359,25 @@ 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) - (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))))))) + (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))) + (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 @@ -496,9 +408,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. @@ -575,81 +488,71 @@ 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) @@ -667,7 +570,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (if (eq system-type 'ms-dos) (getenv "TMPDIR"))) (setq auto-save-file-name-transforms - (list (list "\\`/[^/]*:\\(.+/\\)*\\(.*\\)" + (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))) @@ -675,14 +578,11 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; 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 @@ -695,15 +595,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 @@ -721,21 +621,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) @@ -745,7 +644,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))) @@ -754,22 +653,23 @@ 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") ("--user") + ("--debug-init") ("--iconic") ("--icon-type"))) + (argi (pop args)) + (orig-argi argi) + argval) ;; Handle --OPTION=VALUE format. - (when (and (string-match "\\`--" argi) - (string-match "=" argi)) + (when (string-match "^\\(--[^=]*\\)=" argi) (setq argval (substring argi (match-end 0)) - argi (substring argi 0 (match-beginning 0)))) + argi (match-string 1 argi))) (unless (equal argi "--") (let ((completion (try-completion argi longopts))) (if (eq completion t) @@ -779,54 +679,62 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (or elt (error "Option `%s' is ambiguous" argi)) (setq argi (substring (car elt) 1))) - (setq argval nil))))) + (setq argval nil + argi orig-argi))))) (cond + ((equal argi "-Q") + (setq init-file-user nil + site-run-file nil + emacs-quick-startup 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)) ;; 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. (when (fboundp 'frame-initialize) (frame-initialize)) ;; 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-quick-startup + (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-quick-startup + (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))) + (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)) @@ -845,19 +753,20 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (setq-default normal-erase-is-backspace t) (normal-erase-is-backspace-mode 1))) - (when (and (not noninteractive) - (display-graphic-p) - (fboundp 'x-show-tip)) + (unless (or noninteractive + emacs-quick-startup + (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 ;; 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 @@ -867,9 +776,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) @@ -952,19 +861,19 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (sit-for 1)) (setq user-init-file source)))) - (when (and (stringp custom-file) - (not (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)) - - (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))))))))) + (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. + ;; (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) @@ -1050,15 +959,18 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; 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))))) ;; Update the out-of-memory error message based on user's key bindings ;; for save-some-buffers. @@ -1074,7 +986,8 @@ 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)) + (if (and (boundp 'x-session-previous-id) + (stringp x-session-previous-id)) (emacs-session-restore x-session-previous-id))) (defcustom initial-scratch-message (purecopy "\ @@ -1195,8 +1108,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. @@ -1266,6 +1179,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) @@ -1278,7 +1193,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)) @@ -1337,9 +1255,10 @@ we put it on this 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)) + (image-type-available-p 'pbm))) (let ((frame (fancy-splash-frame))) (when frame (let* ((img (create-image (or fancy-splash-image @@ -1360,6 +1279,9 @@ we put it on this frame." (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. @@ -1510,8 +1432,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))) @@ -1523,7 +1444,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. @@ -1539,226 +1460,220 @@ 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))))) + ;; Stop any "Loading image..." message hiding echo-area-message. + (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") ("--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 (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))) - - ((string-equal argi "-no-splash") - (setq inhibit-startup-message t)) - - ((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 + ;; 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 + 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))))) + ;; Set the default directory as specified in -L. + + ((member argi '("-L" "-directory")) + (setq tem (or argval (pop command-line-args-left))) + ;; We will reverse `extra-load-path' and prepend it to + ;; `load-path' after all the arguments have been processed. + (push + (expand-file-name (command-line-normalize-file-name tem)) + extra-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))) + + ((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-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. + (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)))))))) + + ;; See --directory/-L option above. + (when extra-load-path + (setq load-path (append (nreverse extra-load-path) load-path))) + + ;; 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) + (unless (or inhibit-startup-message + noninteractive + emacs-quick-startup ;; Don't display startup screen if init file ;; has started some sort of server. - (not (and (fboundp 'process-list) - (process-list)))) + (and (fboundp 'process-list) + (process-list))) ;; 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 @@ -1779,12 +1694,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)) @@ -1807,4 +1723,5 @@ normal otherwise." (setq file (replace-match "/" t t file))) file)) +;;; arch-tag: 7e294698-244d-4758-984b-4047f887a5db ;;; startup.el ends here