X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7a409b30053cf0c48ff5de7c5d9b408493df1054..d8e9122115b5ffcec342c841b81cb2d2b8217e4b:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index efa198482c..999e53e56d 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,8 +1,9 @@ ;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*- -;; Copyright (C) 1985-1986, 1992, 1994-2013 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1992, 1994-2015 Free Software Foundation, +;; Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -42,20 +43,21 @@ "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 a string, switch to a buffer -visiting the file or directory specified by that string. If the -value is a function, switch to the buffer returned by that -function. If t, open the `*scratch*' buffer. +visiting the file or directory that the string specifies. If the +value is a function, call it with no arguments and switch to the buffer +that it returns. If t, open the `*scratch*' buffer. -A string value also causes emacsclient to open the specified file -or directory when no target file is specified." +If you use `emacsclient' with no target file, then it obeys any +string or function value that this variable has." :type '(choice (const :tag "Startup screen" nil) (directory :tag "Directory" :value "~/") (file :tag "File" :value "~/.emacs") - (const :tag "Notes buffer" remember-notes) + ;; Note sure about hard-coding this as an option... + (const :tag "Remember Mode notes buffer" remember-notes) (function :tag "Function") (const :tag "Lisp scratch buffer" t)) - :version "24.4" + :version "23.1" :group 'initialization) (defcustom inhibit-startup-screen nil @@ -281,14 +283,20 @@ these functions will invoke the debugger.") "Normal hook run after loading init files and handling the command line.") (defvar term-setup-hook nil - "Normal hook run after loading terminal-specific Lisp code. -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.") + "Normal hook run immediately after `emacs-startup-hook'. +In new code, there is no reason to use this instead of `emacs-startup-hook'. +If you want to execute terminal-specific Lisp code, for example +to override the definitions made by the terminal-specific file, +see `tty-setup-hook'.") + +(make-obsolete-variable 'term-setup-hook + "use either `emacs-startup-hook' or \ +`tty-setup-hook' instead." "24.4") (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.") + "Non-nil means don't run some startup hooks, because we already did. +Currently this applies to: `emacs-startup-hook', `term-setup-hook', +and `window-setup-hook'.") (defvar keyboard-type nil "The brand of keyboard you are using. @@ -297,9 +305,12 @@ 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. -Emacs runs this hook after processing the command line arguments and loading -the user's init file.") + "Normal hook run after loading init files and handling the command line. +This is very similar to `emacs-startup-hook'. The only difference +is that this hook runs after frame parameters have been set up in +response to any settings from your init file. Unless this matters +to you, use `emacs-startup-hook' instead. (The name of this hook +is due to historical reasons, and does not reflect its purpose very well.)") (defcustom initial-major-mode 'lisp-interaction-mode "Major mode command symbol to use for the initial `*scratch*' buffer." @@ -348,6 +359,8 @@ this variable usefully is to set it while building and dumping Emacs." :set (lambda (_variable _value) (error "Customizing `site-run-file' does not work"))) +(make-obsolete-variable 'system-name "use (system-name) instead" "25.1") + (defcustom mail-host-address nil "Name of this machine, for purposes of naming users. If non-nil, Emacs uses this instead of `system-name' when constructing @@ -411,21 +424,6 @@ Warning Warning!!! Pure space overflow !!!Warning Warning :type 'directory :initialize 'custom-initialize-delay) -(defvar package--builtin-versions - ;; Mostly populated by loaddefs.el via autoload-builtin-package-versions. - (purecopy `((emacs . ,(version-to-list emacs-version)))) - "Alist giving the version of each versioned builtin package. -I.e. each element of the list is of the form (NAME . VERSION) where -NAME is the package name as a symbol, and VERSION is its version -as a list.") - -(defun package--description-file (dir) - (concat (let ((subdir (file-name-nondirectory - (directory-file-name dir)))) - (if (string-match "\\([^.].*?\\)-\\([0-9]+\\(?:[.][0-9]+\\|\\(?:pre\\|beta\\|alpha\\)[0-9]+\\)*\\)" subdir) - (match-string 1 subdir) subdir)) - "-pkg.el")) - (defun normal-top-level-add-subdirs-to-load-path () "Add all subdirectories of `default-directory' to `load-path'. More precisely, this uses only the subdirectories whose names @@ -487,7 +485,7 @@ It sets `command-line-processed', processes the command-line, reads the initialization files, etc. It is the default value of the variable `top-level'." (if command-line-processed - (message "Back to top level.") + (message internal--top-level-message) (setq command-line-processed t) ;; Look in each dir in load-path for a subdirs.el file. If we @@ -639,9 +637,7 @@ It is the default value of the variable `top-level'." (emacs-pid) (system-name)))))))) (unless inhibit-startup-hooks - (run-hooks 'emacs-startup-hook) - (and term-setup-hook - (run-hooks 'term-setup-hook))) + (run-hooks 'emacs-startup-hook 'term-setup-hook)) ;; Don't do this if we failed to create the initial frame, ;; for instance due to a dense colormap. @@ -677,8 +673,8 @@ It is the default value of the variable `top-level'." ;; Now we know the user's default font, so add it to the menu. (if (fboundp 'font-menu-add-default) (font-menu-add-default)) - (and window-setup-hook - (run-hooks 'window-setup-hook)))) + (unless inhibit-startup-hooks + (run-hooks 'window-setup-hook)))) ;; 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 @@ -711,27 +707,23 @@ It is the default value of the variable `top-level'." (defconst tool-bar-images-pixel-height 24 "Height in pixels of images in the tool-bar.") -(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. +(gui-method-declare handle-args-function #'tty-handle-args + "Method 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 +method, 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, +(gui-method-declare window-system-initialization #'ignore + "Method for window-system initialization. +Window-system startup files should add their own implementation +to this method. 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).") (defun tty-handle-args (args) "Handle the X-like command-line arguments \"-fg\", \"-bg\", \"-name\", etc." (let (rest) - (message "%S" args) (while (and args (not (equal (car args) "--"))) (let* ((argi (pop args)) @@ -961,13 +953,11 @@ please check its value") ;; 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)) + (gui-method handle-args-function 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))) + (gui-method window-system-initialization initial-window-system)) (put initial-window-system 'window-system-initialized t)) ;; If there was an error, print the error message and exit. (error @@ -1035,18 +1025,6 @@ please check its value") (or (eq initial-window-system 'pc) (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 - ;; to determine if the tool-bar has been disabled by the init files, - ;; and the frame needs to be resized. - (when (fboundp 'frame-notice-user-settings) - (let ((tool-bar-lines (or (assq 'tool-bar-lines initial-frame-alist) - (assq 'tool-bar-lines default-frame-alist)))) - (setq tool-bar-originally-present - (and tool-bar-lines - (cdr tool-bar-lines) - (not (eq 0 (cdr tool-bar-lines))))))) - (let ((old-scalable-fonts-allowed scalable-fonts-allowed) (old-face-ignored-fonts face-ignored-fonts)) @@ -1175,18 +1153,25 @@ please check its value") (funcall inner) (setq init-file-had-error nil)) (error - (display-warning - 'initialization - (format "An error occurred while loading `%s':\n\n%s%s%s\n\n\ + ;; Postpone displaying the warning until all hooks + ;; in `after-init-hook' like `desktop-read' will finalize + ;; possible changes in the window configuration. + (add-hook + 'after-init-hook + (lambda () + (display-warning + 'initialization + (format "An error occurred while loading `%s':\n\n%s%s%s\n\n\ To ensure normal operation, you should investigate and remove the cause of the error in your initialization file. Start Emacs with the `--debug-init' option to view a complete error backtrace." - user-init-file - (get (car error) 'error-message) - (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) - (cdr error) ", ")) - :warning) + user-init-file + (get (car error) 'error-message) + (if (cdr error) ": " "") + (mapconcat (lambda (s) (prin1-to-string s t)) + (cdr error) ", ")) + :warning)) + t) (setq init-file-had-error t)))) (if (and deactivate-mark transient-mark-mode) @@ -1280,8 +1265,9 @@ the `--debug-init' option to view a complete error backtrace." ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. (unless (or noninteractive - initial-window-system) - (tty-run-terminal-initialization (selected-frame))) + initial-window-system + (daemonp)) + (tty-run-terminal-initialization (selected-frame) nil t)) ;; Update the out-of-memory error message based on user's key bindings ;; for save-some-buffers. @@ -1303,7 +1289,7 @@ the `--debug-init' option to view a complete error backtrace." (let (warned) (dolist (dir load-path) (and (not warned) - (string-match-p "/[._]emacs\\.d/?\\'" dir) + (stringp dir) (string-equal (file-name-as-directory (expand-file-name dir)) (expand-file-name user-emacs-directory)) (setq warned t) @@ -1311,9 +1297,10 @@ the `--debug-init' option to view a complete error backtrace." (format "Your `load-path' seems to contain your `.emacs.d' directory: %s\n\ This is likely to cause problems...\n\ -Consider using a subdirectory instead, e.g.: %s" dir -(expand-file-name "lisp" user-emacs-directory)) - :warning)))) +Consider using a subdirectory instead, e.g.: %s" + dir (expand-file-name + "lisp" user-emacs-directory)) + :warning)))) ;; If -batch, terminate after processing the command options. (if noninteractive (kill-emacs t)) @@ -1395,8 +1382,9 @@ 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-gnu-project)) - "Display info on the GNU project"))) + `("GNU" ,(lambda (_button) + (browse-url "http://www.gnu.org/gnu/thegnuproject.html")) + "Browse http://www.gnu.org/gnu/thegnuproject.html"))) " operating system.\n\n" :face variable-pitch :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial))) @@ -1478,9 +1466,7 @@ Each element in the list should be a list of strings or pairs (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)))) + ,(lambda (_button) (info "(emacs)Contributing"))) "\tHow to contribute improvements to Emacs\n" "\n" :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project))) @@ -1507,7 +1493,10 @@ Each element in the list should be a list of strings or pairs (title (with-temp-buffer (insert-file-contents (expand-file-name tut tutorial-directory) - nil 0 256) + ;; Read the entire file, to make sure any + ;; coding cookies and other local variables + ;; get acted upon. + nil) (search-forward ".") (buffer-substring (point-min) (1- (point)))))) ;; If there is a specific tutorial for the current language @@ -1589,24 +1578,26 @@ a face or button specification." (declare-function image-size "image.c" (spec &optional pixels frame)) +(defun fancy-splash-image-file () + (cond ((stringp fancy-splash-image) fancy-splash-image) + ((display-color-p) + (cond ((<= (display-planes) 8) + (if (image-type-available-p 'xpm) + "splash.xpm" + "splash.pbm")) + ((or (image-type-available-p 'svg) + (image-type-available-p 'imagemagick)) + "splash.svg") + ((image-type-available-p 'png) + "splash.png") + ((image-type-available-p 'xpm) + "splash.xpm") + (t "splash.pbm"))) + (t "splash.pbm"))) + (defun fancy-splash-head () "Insert the head part of the splash screen into the current buffer." - (let* ((image-file (cond ((stringp fancy-splash-image) - fancy-splash-image) - ((display-color-p) - (cond ((<= (display-planes) 8) - (if (image-type-available-p 'xpm) - "splash.xpm" - "splash.pbm")) - ((or (image-type-available-p 'svg) - (image-type-available-p 'imagemagick)) - "splash.svg") - ((image-type-available-p 'png) - "splash.png") - ((image-type-available-p 'xpm) - "splash.xpm") - (t "splash.pbm"))) - (t "splash.pbm"))) + (let* ((image-file (fancy-splash-image-file)) (img (create-image image-file)) (image-width (and img (car (image-size img)))) (window-width (window-width))) @@ -1794,7 +1785,7 @@ we put it on this frame." (let (chosen-frame) ;; MS-Windows needs this to have a chance to make the initial ;; frame visible. - (if (eq system-type 'windows-nt) + (if (eq (window-system) 'w32) (sit-for 0 t)) (dolist (frame (append (frame-list) (list (selected-frame)))) (if (and (frame-visible-p frame) @@ -1810,10 +1801,7 @@ we put it on this frame." (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")))) + (let* ((img (create-image (fancy-splash-image-file))) (image-height (and img (cdr (image-size img nil frame)))) ;; We test frame-height so that, if the frame is split ;; by displaying a warning, that doesn't cause the normal @@ -2052,9 +2040,7 @@ Type \\[describe-distribution] for information on ")) (insert-button "Contributing" 'action - (lambda (_button) - (view-file (expand-file-name "CONTRIBUTE" data-directory)) - (goto-char (point-min))) + (lambda (_button) (info "(emacs)Contributing")) 'follow-link t) (insert "\tHow to contribute improvements to Emacs\n\n") @@ -2426,10 +2412,7 @@ A fancy display is used on graphic displays, normal otherwise." ;; 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)) - (setq inhibit-startup-hooks t) + (run-hooks 'emacs-startup-hook 'term-setup-hook) ;; It's important to notice the user settings before we ;; display the startup message; otherwise, the settings @@ -2441,10 +2424,9 @@ A fancy display is used on graphic displays, normal otherwise." ;; 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. - (when window-setup-hook - (run-hooks 'window-setup-hook) - ;; Don't let the hook be run twice. - (setq window-setup-hook nil)) + (run-hooks 'window-setup-hook) + + (setq inhibit-startup-hooks t) ;; ;; Do this now to avoid an annoying delay if the user ;; ;; clicks the menu bar during the sit-for.