;;; 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
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
"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.
-It also inhibits display of the initial message in the `*scratch*' buffer.
This is for use in your personal init file (but NOT site-start.el), once
you are familiar with the contents of the startup screen."
(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
("--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)
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.")
(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,
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
(if command-line-processed
(message "Back to top level.")
(setq command-line-processed t)
- ;; Give *Messages* the same default-directory as *scratch*,
- ;; just to keep things predictable.
(let ((dir default-directory))
(with-current-buffer "*Messages*"
+ ;; Make it easy to do like "tail -f".
+ (set (make-local-variable 'window-point-insertion-type) t)
+ ;; Give *Messages* the same default-directory as *scratch*,
+ ;; just to keep things predictable.
(setq default-directory dir)))
;; `user-full-name' is now known; reset its standard-value here.
(put 'user-full-name 'standard-value
;; 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)
(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 ()
(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)
(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)
(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)
(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.
;; 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))
;; 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)
(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)
+ (custom-reevaluate-setting 'auto-encryption-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
(setq init-file-had-error nil))
(error
(let ((message-log-max nil))
- (save-excursion
- (set-buffer (get-buffer-create "*Messages*"))
+ (with-current-buffer (get-buffer-create "*Messages*")
(insert "\n\n"
(format "An error has occurred while loading `%s':\n\n"
user-init-file)
(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))
;; 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).
(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.
;; 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.
")
"Initial message displayed in *scratch* buffer at startup.
-If this is nil, no message will be displayed.
-If `inhibit-startup-screen' is non-nil, then no message is displayed,
-regardless of the value of this variable."
+If this is nil, no message will be displayed."
:type '(choice (text :tag "Message")
(const :tag "none" nil))
:group 'initialization)
'("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 "
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))))))
'("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 ()
(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 "
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))))))
;; 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)
'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")
(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")
(load file nil t)))
;; This is used to handle -script. It's not clear
- ;; we need to document it.
+ ;; we need to document it (it is totally internal).
((member argi '("-scriptload"))
(let* ((file (command-line-normalize-file-name
(or argval (pop command-line-args-left))))
(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
;; 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*")
+ (with-current-buffer "*scratch*"
+ (when (zerop (buffer-size))
+ (insert initial-scratch-message)
+ (set-buffer-modified-p nil))))
+
(if (or inhibit-startup-screen
+ initial-buffer-choice
noninteractive
emacs-quick-startup)
;; (with-no-warnings
;; (setq menubar-bindings-done t))
- ;; If *scratch* exists and is empty, insert initial-scratch-message.
- (and initial-scratch-message
- (get-buffer "*scratch*")
- (with-current-buffer "*scratch*"
- (when (zerop (buffer-size))
- (insert initial-scratch-message)
- (set-buffer-modified-p nil))))
-
(if (> file-count 0)
(display-startup-screen t)
(display-startup-screen nil)))))
HCoop / bpt / emacs.git / blobdiff