diff options
Diffstat (limited to 'lisp/startup.el')
| -rw-r--r-- | lisp/startup.el | 258 |
1 files changed, 162 insertions, 96 deletions
diff --git a/lisp/startup.el b/lisp/startup.el index a5e315cbc0f..8ab56eee180 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,7 +1,8 @@ ;;; startup.el --- process Emacs shell arguments ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -40,6 +41,19 @@ "Emacs start-up procedure." :group 'environment) +(defcustom initial-buffer-choice nil + "Buffer to show after starting Emacs. +If the value is nil and `inhibit-startup-screen' is nil, show the +startup screen. If the value is string, visit the specified file or +directory using `find-file'. If t, open the `*scratch*' buffer." + :type '(choice + (const :tag "Startup screen" nil) + (directory :tag "Directory" :value "~/") + (file :tag "File" :value "~/file.txt") + (const :tag "Lisp scratch buffer" t)) + :version "23.1" + :group 'initialization) + (defcustom inhibit-startup-screen nil "Non-nil inhibits the startup screen. @@ -86,6 +100,12 @@ 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.") +(defvaralias 'argv 'command-line-args-left + "List of command-line args not yet processed. +This is a convenience alias, so that one can write \(pop argv\) +inside of --eval command line arguments in order to access +following arguments.") + (defvar command-line-functions nil ;; lrs 7/31/89 "List of functions to process unrecognized command-line arguments. Each function should access the dynamically bound variables @@ -153,7 +173,8 @@ This is normally copied from `default-directory' when Emacs starts.") ("--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-color) - ("--smid" 1 x-handle-smid)) + ("--smid" 1 x-handle-smid) + ("--parent-id" 1 x-handle-parent-id)) "Alist of X Windows options. Each element has the form (NAME NUMARGS HANDLER FRAME-PARAM VALUE) @@ -172,6 +193,12 @@ There is no `condition-case' around the running of these functions; therefore, if you set `debug-on-error' non-nil in `.emacs', an error in one of these functions will invoke the debugger.") +(defvar before-init-time nil + "Value of `current-time' before Emacs begins initialization.") + +(defvar after-init-time nil + "Value of `current-time' after loading the init files.") + (defvar emacs-startup-hook nil "Normal hook run after loading init files and handling the command line.") @@ -265,9 +292,9 @@ init file is read, in case it sets `mail-host-address'." (defcustom auto-save-list-file-prefix (cond ((eq system-type 'ms-dos) ;; MS-DOS cannot have initial dot, and allows only 8.3 names - "~/_emacs.d/auto-save.list/_s") + (concat user-emacs-directory "auto-save.list/_s")) (t - "~/.emacs.d/auto-save-list/.saves-")) + (concat user-emacs-directory "auto-save-list/.saves-"))) "Prefix for generating `auto-save-list-file-name'. This is used after reading your `.emacs' file to initialize `auto-save-list-file-name', by appending Emacs's pid and the system name, @@ -301,6 +328,14 @@ from being initialized." Warning Warning!!! Pure space overflow !!!Warning Warning \(See the node Pure Storage in the Lisp manual for details.)\n") +(defvar tutorial-directory nil + "Directory containing the Emacs TUTORIAL files.") + +;; Get correct value in a dumped, installed Emacs. +(eval-at-startup + (setq tutorial-directory (file-name-as-directory + (expand-file-name "tutorials" data-directory)))) + (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 @@ -443,36 +478,19 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; for instance due to a dense colormap. (when (or frame-initial-frame ;; If frame-initial-frame has no meaning, do this anyway. - (not (and window-system + (not (and initial-window-system (not noninteractive) - (not (eq window-system 'pc))))) + (not (eq initial-window-system 'pc))))) ;; Modify the initial frame based on what .emacs puts into ;; ...-frame-alist. (if (fboundp 'frame-notice-user-settings) (frame-notice-user-settings)) + ;; Set the faces for the initial background mode even if + ;; 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. (if (fboundp 'frame-set-background-mode) - ;; Set the faces for the initial background mode even if - ;; 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 (selected-frame)) - term) - (when (and (null window-system) - ;; 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" - "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 default-frame-background-mode 'light))) - (frame-set-background-mode (selected-frame))))) + (frame-set-background-mode (selected-frame)))) ;; Now we know the user's default font, so add it to the menu. (if (fboundp 'font-menu-add-default) @@ -481,7 +499,25 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (run-hooks 'window-setup-hook)) (or menubar-bindings-done (if (display-popup-menus-p) - (precompute-menubar-bindings))))))) + (precompute-menubar-bindings))))) + ;; Subprocesses of Emacs do not have direct access to the terminal, so + ;; unless told otherwise they should only assume a dumb terminal. + ;; We are careful to do it late (after term-setup-hook), although the + ;; new multi-tty code does not use $TERM any more there anyway. + (setenv "TERM" "dumb") + ;; Remove DISPLAY from the process-environment as well. This allows + ;; `callproc.c' to give it a useful adaptive default which is either + ;; the value of the `display' frame-parameter or the DISPLAY value + ;; from initial-environment. + (let ((display (frame-parameter nil 'display))) + ;; Be careful which DISPLAY to remove from process-environment: follow + ;; the logic of `callproc.c'. + (if (stringp display) (setq display (concat "DISPLAY=" display)) + (dolist (varval initial-environment) + (if (string-match "\\`DISPLAY=" varval) + (setq display varval)))) + (when display + (delete display process-environment))))) ;; Precompute the keyboard equivalents in the menu bar items. (defun precompute-menubar-bindings () @@ -513,6 +549,20 @@ 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.") +(defvar handle-args-function-alist '((nil . tty-handle-args)) + "Functions for processing window-system dependent command-line arguments. +Window system startup files should add their own function to this +alist, which should parse the command line arguments. Those +pertaining to the window system should be processed and removed +from the returned command line.") + +(defvar window-system-initialization-alist '((nil . ignore)) + "Alist of window-system initialization functions. +Window-system startup files should add their own initialization +function to this list. The function should take no arguments, +and initialize the window system environment to prepare for +opening the first frame (e.g. open a connection to an X server).") + ;; Handle the X-like command-line arguments "-fg", "-bg", "-name", etc. (defun tty-handle-args (args) (let (rest) @@ -580,7 +630,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (nreverse rest))) (defun command-line () - (setq command-line-default-directory default-directory) + (setq before-init-time (current-time) + command-line-default-directory default-directory) ;; Choose a reasonable location for temporary files. (custom-reevaluate-setting 'temporary-file-directory) @@ -617,16 +668,22 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (setq eol-mnemonic-dos "(DOS)" eol-mnemonic-mac "(Mac)"))) - ;; Read window system's init file if using a window system. + ;; Make sure window system's init file was loaded in loadup.el if using a window system. (condition-case error - (if (and window-system (not noninteractive)) - (load (concat term-file-prefix - (symbol-name window-system) - "-win") - ;; Every window system should have a startup file; - ;; barf if we can't find it. - nil t)) - ;; If we can't read it, print the error message and exit. + (unless noninteractive + (if (and initial-window-system + (not (featurep + (intern (concat (symbol-name initial-window-system) "-win"))))) + (error "Unsupported window system `%s'" initial-window-system)) + ;; Process window-system specific command line parameters. + (setq command-line-args + (funcall (or (cdr (assq initial-window-system handle-args-function-alist)) + (error "Unsupported window system `%s'" initial-window-system)) + command-line-args)) + ;; Initialize the window system. (Open connection, etc.) + (funcall (or (cdr (assq initial-window-system window-system-initialization-alist)) + (error "Unsupported window system `%s'" initial-window-system)))) + ;; If there was an error, print the error message and exit. (error (princ (if (eq (car error) 'error) @@ -642,13 +699,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (cdr error) ", ")))) 'external-debugging-output) (terpri 'external-debugging-output) - (setq window-system nil) + (setq initial-window-system nil) (kill-emacs))) - ;; Windowed displays do this inside their *-win.el. - (unless (or (display-graphic-p) noninteractive) - (setq command-line-args (tty-handle-args command-line-args))) - (set-locale-environment nil) ;; Convert preloaded file names in load-history to absolute. @@ -771,7 +824,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; If frame was created with a menu bar, set menu-bar-mode on. (unless (or noninteractive emacs-basic-display - (and (memq window-system '(x w32)) + (and (memq initial-window-system '(x w32)) (<= (frame-parameter nil 'menu-bar-lines) 0))) (menu-bar-mode 1)) @@ -785,7 +838,6 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; 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) (custom-reevaluate-setting 'global-font-lock-mode) (custom-reevaluate-setting 'mouse-wheel-down-event) @@ -793,14 +845,18 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (custom-reevaluate-setting 'file-name-shadow-mode) (custom-reevaluate-setting 'send-mail-function) (custom-reevaluate-setting 'focus-follows-mouse) + (custom-reevaluate-setting 'global-auto-composition-mode) + (custom-reevaluate-setting 'transient-mark-mode) + + (normal-erase-is-backspace-setup-frame) ;; Register default TTY colors for the case the terminal hasn't a - ;; terminal init file. - (unless (memq window-system '(x w32 mac)) - ;; 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)) + ;; terminal init file. We do this regardles of whether the terminal + ;; supports colors or not and regardless the current display type, + ;; since users can connect to color-capable terminals and also + ;; switch color 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 @@ -964,11 +1020,9 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (with-current-buffer (window-buffer) (deactivate-mark))) - ;; If the user has a file of abbrevs, read it. - ;; FIXME: after the 22.0 release this should be changed so - ;; that it does not read the abbrev file when -batch is used - ;; on the command line. - (when (and (file-exists-p abbrev-file-name) + ;; If the user has a file of abbrevs, read it (unless -batch). + (when (and (not noninteractive) + (file-exists-p abbrev-file-name) (file-readable-p abbrev-file-name)) (quietly-read-abbrev-file abbrev-file-name)) @@ -989,11 +1043,11 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*). ;; Arguably this should only be done if they're free of ;; multibyte characters. - (mapcar (lambda (buffer) - (with-current-buffer buffer - (if enable-multibyte-characters - (set-buffer-multibyte nil)))) - (buffer-list)) + (mapc (lambda (buffer) + (with-current-buffer buffer + (if enable-multibyte-characters + (set-buffer-multibyte nil)))) + (buffer-list)) ;; Also re-set the language environment in case it was ;; originally done before unibyte was set and is sensitive to ;; unibyte (display table, terminal coding system &c). @@ -1046,6 +1100,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (eq face-ignored-fonts old-face-ignored-fonts)) (clear-face-cache))) + (setq after-init-time (current-time)) (run-hooks 'after-init-hook) ;; Decode all default-directory. @@ -1070,31 +1125,8 @@ 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. (unless (or noninteractive - window-system - (null term-file-prefix)) - (let* ((TERM (getenv "TERM")) - (term 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))) - (setq term TERM) - ;; The terminal file has been loaded, now call the terminal specific - ;; initialization function. - (while term - (let ((term-init-func (intern-soft (concat "terminal-init-" term)))) - (if (not (fboundp term-init-func)) - ;; Strip off last hyphen and what follows, then try again - (setq term - (if (setq hyphend (string-match "[-_][^-_]+\\'" term)) - (substring term 0 hyphend) - nil)) - (setq term nil) - (funcall term-init-func)))))) + initial-window-system) + (tty-run-terminal-initialization (selected-frame))) ;; Update the out-of-memory error message based on user's key bindings ;; for save-some-buffers. @@ -1145,7 +1177,7 @@ If this is nil, no message will be displayed." '("GNU/Linux" (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) "Browse http://www.gnu.org/gnu/linux-and-gnu.html") - '("GNU" (lambda (button) (describe-project)) + '("GNU" (lambda (button) (describe-gnu-project)) "Display info on the GNU project"))) " operating system.\n" :face variable-pitch "To quit a partially entered command, type " @@ -1160,7 +1192,7 @@ If this is nil, no message will be displayed." en)) (title (with-temp-buffer (insert-file-contents - (expand-file-name tut data-directory) + (expand-file-name tut tutorial-directory) nil 0 256) (search-forward ".") (buffer-substring (point-min) (1- (point)))))) @@ -1204,7 +1236,7 @@ Each element in the list should be a list of strings or pairs '("GNU/Linux" (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) "Browse http://www.gnu.org/gnu/linux-and-gnu.html") - '("GNU" (lambda (button) (describe-project)) + '("GNU" (lambda (button) (describe-gnu-project)) "Display info on the GNU project."))) " operating system.\n" :face (lambda () @@ -1219,7 +1251,18 @@ Each element in the list should be a list of strings or pairs (lambda () emacs-copyright) "\n\n" :face variable-pitch - :link ("GNU and Freedom" (lambda (button) (describe-project))) + :link ("Authors" + (lambda (button) + (view-file (expand-file-name "AUTHORS" data-directory)) + (goto-char (point-min)))) + "\tMany people have contributed code included in GNU Emacs\n" + :link ("Contributing" + (lambda (button) + (view-file (expand-file-name "CONTRIBUTE" data-directory)) + (goto-char (point-min)))) + "\tHow to contribute improvements to Emacs\n" + "\n" + :link ("GNU and Freedom" (lambda (button) (describe-gnu-project))) "\tWhy we developed GNU Emacs, and the GNU operating system\n" :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) "\tGNU Emacs comes with " @@ -1242,7 +1285,7 @@ Each element in the list should be a list of strings or pairs en)) (title (with-temp-buffer (insert-file-contents - (expand-file-name tut data-directory) + (expand-file-name tut tutorial-directory) nil 0 256) (search-forward ".") (buffer-substring (point-min) (1- (point)))))) @@ -1671,7 +1714,7 @@ To quit a partially entered command, type Control-g.\n") ;; 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-x\C-c") 'save-buffers-kill-terminal) (eq (key-binding "\C-ht") 'help-with-tutorial) (eq (key-binding "\C-hi") 'info) (eq (key-binding "\C-hr") 'info-emacs-manual) @@ -1726,7 +1769,7 @@ Get help\t %s 'action (lambda (button) (view-order-manuals)) 'follow-link t) (insert (substitute-command-keys - "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-emacs]"))) + "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-terminal]"))) ;; Say how to use the menu bar with the keyboard. (insert "\n") @@ -1812,8 +1855,24 @@ Type \\[describe-distribution] for information on ")) (insert "To follow a link, click Mouse-1 on it, or move to it and type RET.\n\n") + (insert-button "Authors" + 'action + (lambda (button) + (view-file (expand-file-name "AUTHORS" data-directory)) + (goto-char (point-min))) + 'follow-link t) + (insert "\t\tMany people have contributed code included in GNU Emacs\n") + + (insert-button "Contributing" + 'action + (lambda (button) + (view-file (expand-file-name "CONTRIBUTE" data-directory)) + (goto-char (point-min))) + 'follow-link t) + (insert "\tHow to contribute improvements to Emacs\n\n") + (insert-button "GNU and Freedom" - 'action (lambda (button) (describe-project)) + 'action (lambda (button) (describe-gnu-project)) 'follow-link t) (insert "\t\tWhy we developed GNU Emacs and the GNU system\n") @@ -2097,7 +2156,7 @@ A fancy display is used on graphic displays, normal otherwise." (progn (if (string-match "\\`-" argi) (error "Unknown option `%s'" argi)) - (unless window-system + (unless initial-window-system (setq inhibit-startup-screen t)) (setq file-count (1+ file-count)) (let ((file @@ -2121,6 +2180,12 @@ A fancy display is used on graphic displays, normal otherwise." ;; abort later. (unless (frame-live-p (selected-frame)) (kill-emacs nil)))))) + (when initial-buffer-choice + (cond ((eq initial-buffer-choice t) + (switch-to-buffer (get-buffer-create "*scratch*"))) + ((stringp initial-buffer-choice) + (find-file initial-buffer-choice)))) + ;; If *scratch* exists and is empty, insert initial-scratch-message. (and initial-scratch-message (get-buffer "*scratch*") @@ -2130,6 +2195,7 @@ A fancy display is used on graphic displays, normal otherwise." (set-buffer-modified-p nil)))) (if (or inhibit-startup-screen + initial-buffer-choice noninteractive emacs-quick-startup) |