X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4a5da22b3948df8f56f54c0cf4500410cf6ff472..refs/heads/wip:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index cc40f9ec8e..aa448848ce 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,8 +1,8 @@ ;;; 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-2014 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal ;; Package: emacs @@ -42,20 +42,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 +282,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 +304,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." @@ -441,8 +451,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 (if (fboundp 'untranslated-canonical-name) - (untranslated-canonical-name this-dir)))) + (canonicalized (if (fboundp 'w32-untranslated-canonical-name) + (w32-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. (setq attrs (or canonicalized @@ -489,40 +499,101 @@ It is the default value of the variable `top-level'." (if command-line-processed (message "Back to top level.") (setq command-line-processed t) - (let ((dir default-directory)) - (with-current-buffer "*Messages*" - (messages-buffer-mode) - ;; 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 - (list (default-value 'user-full-name))) - ;; Look in each dir in load-path for a subdirs.el file. - ;; If we find one, load it, which will add the appropriate subdirs - ;; of that dir into load-path, + + ;; Look in each dir in load-path for a subdirs.el file. If we + ;; find one, load it, which will add the appropriate subdirs of + ;; that dir into load-path. This needs to be done before setting + ;; the locale environment, because the latter might need to load + ;; some support files. ;; Look for a leim-list.el file too. Loading it will register ;; available input methods. (let ((tail load-path) (lispdir (expand-file-name "../lisp" data-directory)) - ;; For out-of-tree builds, leim-list is generated in the build dir. -;;; (leimdir (expand-file-name "../leim" doc-directory)) dir) (while tail (setq dir (car tail)) (let ((default-directory dir)) (load (expand-file-name "subdirs.el") t t t)) - ;; Do not scan standard directories that won't contain a leim-list.el. - ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html - (or (string-match (concat "\\`" lispdir) dir) - (let ((default-directory dir)) - (load (expand-file-name "leim-list.el") t t t))) + ;; Do not scan standard directories that won't contain a leim-list.el. + ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html + ;; (Except the preloaded one in lisp/leim.) + (or (string-prefix-p lispdir dir) + (let ((default-directory dir)) + (load (expand-file-name "leim-list.el") t t t))) ;; We don't use a dolist loop and we put this "setq-cdr" command at ;; the end, because the subdirs.el files may add elements to the end ;; of load-path and we want to take it into account. (setq tail (cdr tail)))) + + ;; Set the default strings to display in mode line for end-of-line + ;; formats that aren't native to this platform. This should be + ;; done before calling set-locale-environment, as the latter might + ;; use these mnemonics. + (cond + ((memq system-type '(ms-dos windows-nt)) + (setq eol-mnemonic-unix "(Unix)" + eol-mnemonic-mac "(Mac)")) + (t ; this is for Unix/GNU/Linux systems + (setq eol-mnemonic-dos "(DOS)" + eol-mnemonic-mac "(Mac)"))) + + (set-locale-environment nil) + ;; Decode all default-directory's (probably, only *scratch* exists + ;; at this point). default-directory of *scratch* is the basis + ;; for many other file-name variables and directory lists, so it + ;; is important to decode it ASAP. + (when locale-coding-system + (let ((coding (if (eq system-type 'windows-nt) + ;; MS-Windows build converts all file names to + ;; UTF-8 during startup. + 'utf-8 + locale-coding-system))) + (save-excursion + (dolist (elt (buffer-list)) + (set-buffer elt) + (if default-directory + (setq default-directory + (decode-coding-string default-directory coding t))))) + + ;; Decode all the important variables and directory lists, now + ;; that we know the locale's encoding. This is because the + ;; values of these variables are until here unibyte undecoded + ;; strings created by build_unibyte_string. data-directory in + ;; particular is used to construct many other standard + ;; directory names, so it must be decoded ASAP. Note that + ;; charset-map-path cannot be decoded here, since we could + ;; then be trapped in infinite recursion below, when we load + ;; subdirs.el, because encoding a directory name might need to + ;; load a charset map, which will want to encode + ;; charset-map-path, which will want to load the same charset + ;; map... So decoding of charset-map-path is delayed until + ;; further down below. + (dolist (pathsym '(load-path exec-path)) + (let ((path (symbol-value pathsym))) + (if (listp path) + (set pathsym (mapcar (lambda (dir) + (decode-coding-string dir coding t)) + path))))) + (dolist (filesym '(data-directory doc-directory exec-directory + installation-directory + invocation-directory invocation-name + source-directory + shared-game-score-directory)) + (let ((file (symbol-value filesym))) + (if (stringp file) + (set filesym (decode-coding-string file coding t))))))) + + (let ((dir default-directory)) + (with-current-buffer "*Messages*" + (messages-buffer-mode) + ;; 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 + (list (default-value 'user-full-name))) ;; If the PWD environment variable isn't accurate, delete it. (let ((pwd (getenv "PWD"))) (and (stringp pwd) @@ -536,6 +607,17 @@ It is the default value of the variable `top-level'." (setq process-environment (delete (concat "PWD=" pwd) process-environment))))) + ;; Now, that other directories were searched, and any charsets we + ;; need for encoding them are already loaded, we are ready to + ;; decode charset-map-path. + (if (listp charset-map-path) + (let ((coding (if (eq system-type 'windows-nt) + 'utf-8 + locale-coding-system))) + (setq charset-map-path + (mapcar (lambda (dir) + (decode-coding-string dir coding t)) + charset-map-path)))) (setq default-directory (abbreviate-file-name default-directory)) (let ((old-face-font-rescale-alist face-font-rescale-alist)) (unwind-protect @@ -567,9 +649,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. @@ -605,8 +685,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 @@ -659,7 +739,6 @@ 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)) @@ -756,18 +835,6 @@ Amongst another things, it parses the command-line arguments." ;;! ;; Choose a good default value for split-window-keep-point. ;;! (setq split-window-keep-point (> baud-rate 2400)) - ;; Set the default strings to display in mode line for - ;; end-of-line formats that aren't native to this platform. - (cond - ((memq system-type '(ms-dos windows-nt)) - (setq eol-mnemonic-unix "(Unix)" - eol-mnemonic-mac "(Mac)")) - (t ; this is for Unix/GNU/Linux systems - (setq eol-mnemonic-dos "(DOS)" - eol-mnemonic-mac "(Mac)"))) - - (set-locale-environment nil) - ;; Convert preloaded file names in load-history to absolute. (let ((simple-file-name ;; Look for simple.el or simple.elc and use their directory @@ -801,7 +868,7 @@ please check its value") load-history)))) ;; Convert the arguments to Emacs internal representation. - (let ((args (cdr command-line-args))) + (let ((args command-line-args)) (while args (setcar args (decode-coding-string (car args) locale-coding-system t)) @@ -1211,19 +1278,6 @@ the `--debug-init' option to view a complete error backtrace." (setq after-init-time (current-time)) (run-hooks 'after-init-hook) - ;; Decode all default-directory. - (if (and (default-value 'enable-multibyte-characters) locale-coding-system) - (save-excursion - (dolist (elt (buffer-list)) - (set-buffer elt) - (if default-directory - (setq default-directory - (decode-coding-string default-directory - locale-coding-system t)))) - (setq command-line-default-directory - (decode-coding-string command-line-default-directory - locale-coding-system t)))) - ;; If *scratch* exists and init file didn't change its mode, initialize it. (if (get-buffer "*scratch*") (with-current-buffer "*scratch*" @@ -1233,8 +1287,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. @@ -1245,6 +1300,29 @@ the `--debug-init' option to view a complete error backtrace." ;; Process the remaining args. (command-line-1 (cdr command-line-args)) + ;; This is a problem because, e.g. if emacs.d/gnus.el exists, + ;; trying to load gnus could load the wrong file. + ;; OK, it would not matter if .emacs.d were at the end of load-path. + ;; but for the sake of simplicity, we discourage it full-stop. + ;; Ref eg http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00056.html + ;; + ;; A bad element could come from user-emacs-file, the command line, + ;; or EMACSLOADPATH, so we basically always have to check. + (let (warned) + (dolist (dir load-path) + (and (not warned) + (string-match-p "/[._]emacs\\.d/?\\'" dir) + (string-equal (file-name-as-directory (expand-file-name dir)) + (expand-file-name user-emacs-directory)) + (setq warned t) + (display-warning 'initialization + (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)))) + ;; If -batch, terminate after processing the command options. (if noninteractive (kill-emacs t)) @@ -1325,8 +1403,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))) @@ -1519,24 +1598,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))) @@ -1672,6 +1753,7 @@ splash screen in another window." (insert "\n") (fancy-startup-tail concise)) (use-local-map splash-screen-keymap) + (setq-local browse-url-browser-function 'eww-browse-url) (setq tab-width 22 buffer-read-only t) (set-buffer-modified-p nil) @@ -1709,6 +1791,7 @@ splash screen in another window." (goto-char (point-min)) (force-mode-line-update)) (use-local-map splash-screen-keymap) + (setq-local browse-url-browser-function 'eww-browse-url) (setq tab-width 22) (setq buffer-read-only t) (goto-char (point-min)) @@ -1720,6 +1803,10 @@ Returning non-nil does not mean we should necessarily use the fancy splash screen, but if we do use it, we put it on this frame." (let (chosen-frame) + ;; MS-Windows needs this to have a chance to make the initial + ;; frame visible. + (if (eq system-type 'windows-nt) + (sit-for 0 t)) (dolist (frame (append (frame-list) (list (selected-frame)))) (if (and (frame-visible-p frame) (not (window-minibuffer-p (frame-selected-window frame)))) @@ -1730,14 +1817,11 @@ we put it on this frame." "Return t if fancy splash screens should be used." (when (and (display-graphic-p) (or (and (display-color-p) - (image-type-available-p 'xpm)) + (image-type-available-p 'xpm)) (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 @@ -2087,12 +2171,11 @@ A fancy display is used on graphic displays, normal otherwise." ;; This approach loses for "-batch -L DIR --eval "(require foo)", ;; if foo is intended to be found in DIR. ;; - ;; ;; The directories listed in --directory/-L options will *appear* - ;; ;; at the front of `load-path' in the order they appear on the - ;; ;; command-line. We cannot do this by *placing* them at the front - ;; ;; in the order they appear, so we need this variable to hold them, - ;; ;; temporarily. - ;; extra-load-path + ;; 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. ;; ;; To DTRT we keep track of the splice point and modify `load-path' ;; straight away upon any --directory/-L option. @@ -2172,13 +2255,22 @@ A fancy display is used on graphic displays, normal otherwise." (eval (read (or argval (pop command-line-args-left))))) ((member argi '("-L" "-directory")) - (setq tem (expand-file-name - (command-line-normalize-file-name - (or argval (pop command-line-args-left))))) - (cond (splice (setcdr splice (cons tem (cdr splice))) - (setq splice (cdr splice))) - (t (setq load-path (cons tem load-path) - splice load-path)))) + ;; -L :/foo adds /foo to the _end_ of load-path. + (let (append) + (if (string-match-p + (format "\\`%s" path-separator) + (setq tem (or argval (pop command-line-args-left)))) + (setq tem (substring tem 1) + append t)) + (setq tem (expand-file-name + (command-line-normalize-file-name tem))) + (cond (append (setq load-path + (append load-path (list tem))) + (if splice (setq splice load-path))) + (splice (setcdr splice (cons tem (cdr splice))) + (setq splice (cdr splice))) + (t (setq load-path (cons tem load-path) + splice load-path))))) ((member argi '("-l" "-load")) (let* ((file (command-line-normalize-file-name @@ -2342,10 +2434,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 @@ -2357,10 +2446,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.