X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/412f24b9ddf1e07022f8c5fe05f0717f130c4c02..a66744021faeb2ce105b1001a380c4a46384c5f4:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index 26c5a46933..e71fe32306 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,6 +1,6 @@ ;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*- -;; Copyright (C) 1985-1986, 1992, 1994-2011 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1992, 1994-2012 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -41,8 +41,9 @@ (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." +startup screen. If the value is a 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 "~/") @@ -64,6 +65,8 @@ once you are familiar with the contents of the startup screen." (defvar startup-screen-inhibit-startup-screen nil) +;; FIXME? Why does this get such weirdly extreme treatment, when the +;; more important inhibit-startup-screen does not. (defcustom inhibit-startup-echo-area-message nil "Non-nil inhibits the initial startup echo area message. Setting this variable takes effect @@ -98,11 +101,15 @@ the remaining command-line args are in the variable `command-line-args-left'.") "List of command-line args not yet processed.") (defvaralias 'argv 'command-line-args-left - ;; FIXME: Bad name for a dynamically bound variable. "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.") +(internal-make-var-non-special 'argv) + +(defvar argi nil + "Current command-line argument.") +(internal-make-var-non-special 'argi) (defvar command-line-functions nil ;; lrs 7/31/89 "List of functions to process unrecognized command-line arguments. @@ -331,7 +338,9 @@ this variable usefully is to set it while building and dumping Emacs." (error "Customizing `site-run-file' does not work"))) (defcustom mail-host-address nil - "Name of this machine, for purposes of naming users." + "Name of this machine, for purposes of naming users. +If non-nil, Emacs uses this instead of `system-name' when constructing +email addresses." :type '(choice (const nil) string) :group 'mail) @@ -403,7 +412,7 @@ The regexp should not contain a starting \"\\`\" or a trailing \"\\'\"; those are added automatically by callers.") (defun normal-top-level-add-subdirs-to-load-path () - "Add all subdirectories of current directory to `load-path'. + "Add all subdirectories of `default-directory' to `load-path'. More precisely, this uses only the subdirectories whose names start with letters or digits; it excludes any subdirectory named `RCS' or `CVS', and any subdirectory that contains a file named `.nosearch'." @@ -458,6 +467,10 @@ DIRS are relative." (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail)))))) (defun normal-top-level () + "Emacs calls this function when it first starts up. +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.") (setq command-line-processed t) @@ -476,13 +489,20 @@ DIRS are relative." ;; 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) dir) + (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)) - (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 + (or (string-match (concat "\\`" 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. @@ -695,6 +715,8 @@ opening the first frame (e.g. open a connection to an X server).") (defvar server-process) (defun command-line () + "A subroutine of `normal-top-level'. +Amongst another things, it parses the command-line arguments." (setq before-init-time (current-time) after-init-time nil command-line-default-directory default-directory) @@ -882,33 +904,12 @@ opening the first frame (e.g. open a connection to an X server).") (run-hooks 'before-init-hook) - ;; Under X, this creates the X frame and deletes the terminal frame. + ;; Under X, create the X frame and delete the terminal frame. (unless (daemonp) - - ;; If X resources are available, use them to initialize the values - ;; of `tool-bar-mode' and `menu-bar-mode', as well as the value of - ;; `no-blinking-cursor' and the `cursor' face. - (cond - ((or noninteractive emacs-basic-display) - (setq menu-bar-mode nil - tool-bar-mode nil - no-blinking-cursor t)) - ((memq initial-window-system '(x w32 ns)) - (let ((no-vals '("no" "off" "false" "0"))) - (if (member (x-get-resource "menuBar" "MenuBar") no-vals) - (setq menu-bar-mode nil)) - (if (member (x-get-resource "toolBar" "ToolBar") no-vals) - (setq tool-bar-mode nil)) - (if (member (x-get-resource "cursorBlink" "CursorBlink") - no-vals) - (setq no-blinking-cursor t))) - ;; If the cursorColor X resource exists, alter the `cursor' face - ;; spec, but mark it as changed outside of Customize. - (let ((color (x-get-resource "cursorColor" "CursorColor"))) - (when color - (put 'cursor 'theme-face - `((changed ((t :background ,color))))) - (put 'cursor 'face-modified t))))) + (if (or noninteractive emacs-basic-display) + (setq menu-bar-mode nil + tool-bar-mode nil + no-blinking-cursor t)) (frame-initialize)) (when (fboundp 'x-create-frame) @@ -923,7 +924,7 @@ opening the first frame (e.g. open a connection to an X server).") emacs-basic-display (and (memq window-system '(x w32 ns)) (not (member (x-get-resource "cursorBlink" "CursorBlink") - '("off" "false"))))) + '("no" "off" "false" "0"))))) (setq no-blinking-cursor t)) ;; Re-evaluate predefined variables whose initial value depends on @@ -937,7 +938,7 @@ opening the first frame (e.g. open a connection to an X server).") (normal-erase-is-backspace-setup-frame) ;; Register default TTY colors for the case the terminal hasn't a - ;; terminal init file. We do this regardles of whether the terminal + ;; terminal init file. We do this regardless 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 @@ -1126,7 +1127,7 @@ the `--debug-init' option to view a complete error backtrace." (eq orig-enable-multibyte (default-value 'enable-multibyte-characters))) ;; Init file changed to unibyte. Reset existing multibyte - ;; buffers (probably *scratch*, *Messages*, *Minibuff-0*). + ;; buffers (probably *scratch*, *Messages*, *Minibuf-0*). ;; Arguably this should only be done if they're free of ;; multibyte characters. (mapc (lambda (buffer) @@ -1146,38 +1147,6 @@ the `--debug-init' option to view a complete error backtrace." (or mail-host-address (system-name)))))) - ;; Originally face attributes were specified via - ;; `font-lock-face-attributes'. Users then changed the default - ;; face attributes by setting that variable. However, we try and - ;; be back-compatible and respect its value if set except for - ;; faces where M-x customize has been used to save changes for the - ;; face. - (when (boundp 'font-lock-face-attributes) - (let ((face-attributes font-lock-face-attributes)) - (while face-attributes - (let* ((face-attribute (pop face-attributes)) - (face (car face-attribute))) - ;; Rustle up a `defface' SPEC from a - ;; `font-lock-face-attributes' entry. - (unless (get face 'saved-face) - (let ((foreground (nth 1 face-attribute)) - (background (nth 2 face-attribute)) - (bold-p (nth 3 face-attribute)) - (italic-p (nth 4 face-attribute)) - (underline-p (nth 5 face-attribute)) - face-spec) - (when foreground - (setq face-spec (cons ':foreground (cons foreground face-spec)))) - (when background - (setq face-spec (cons ':background (cons background face-spec)))) - (when bold-p - (setq face-spec (append '(:weight bold) face-spec))) - (when italic-p - (setq face-spec (append '(:slant italic) face-spec))) - (when underline-p - (setq face-spec (append '(:underline t) face-spec))) - (face-spec-set face (list (list t face-spec)) nil))))))) - ;; If parameter have been changed in the init file which influence ;; face realization, clear the face cache so that new faces will ;; be realized. @@ -1275,6 +1244,29 @@ the `--debug-init' option to view a complete error backtrace." (with-no-warnings (emacs-session-restore x-session-previous-id)))) +(defun x-apply-session-resources () + "Apply X resources which specify initial values for Emacs variables. +This is called from a window-system initialization function, such +as `x-initialize-window-system' for X, either at startup (prior +to reading the init file), or afterwards when the user first +opens a graphical frame. + +This can set the values of `menu-bar-mode', `tool-bar-mode', and +`no-blinking-cursor', as well as the `cursor' face. Changed +settings will be marked as \"CHANGED outside of Customize\"." + (let ((no-vals '("no" "off" "false" "0")) + (settings '(("menuBar" "MenuBar" menu-bar-mode nil) + ("toolBar" "ToolBar" tool-bar-mode nil) + ("cursorBlink" "CursorBlink" no-blinking-cursor t)))) + (dolist (x settings) + (if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals) + (set (nth 2 x) (nth 3 x))))) + (let ((color (x-get-resource "cursorColor" "Foreground"))) + (when color + (put 'cursor 'theme-face + `((changed ((t :background ,color))))) + (put 'cursor 'face-modified t)))) + (defcustom initial-scratch-message (purecopy "\ ;; This buffer is for notes you don't want to save, and for Lisp evaluation. ;; If you want to create a file, visit that file with C-x C-f, @@ -1293,7 +1285,7 @@ If this is nil, no message will be displayed." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst fancy-startup-text - `((:face (variable-pitch (:foreground "red")) + `((:face (variable-pitch font-lock-comment-face) "Welcome to " :link ("GNU Emacs" ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) @@ -1350,7 +1342,7 @@ Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") (defconst fancy-about-text - `((:face (variable-pitch (:foreground "red")) + `((:face (variable-pitch font-lock-comment-face) "This is " :link ("GNU Emacs" ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) @@ -1366,11 +1358,7 @@ Each element in the list should be a list of strings or pairs `("GNU" ,(lambda (_button) (describe-gnu-project)) "Display info on the GNU project."))) " operating system.\n" - :face ,(lambda () - (list 'variable-pitch - (list :foreground - (if (eq (frame-parameter nil 'background-mode) 'dark) - "cyan" "darkblue")))) + :face (variable-pitch font-lock-builtin-face) "\n" ,(lambda () (emacs-version)) "\n" @@ -1426,8 +1414,7 @@ Each element in the list should be a list of strings or pairs ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/tour/")) "Browse http://www.gnu.org/software/emacs/tour/") - "\tSee an overview of Emacs features at gnu.org" - )) + "\tSee an overview of Emacs features at gnu.org")) "A list of texts to show in the middle part of the About screen. Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") @@ -1449,8 +1436,8 @@ Each element in the list should be a list of strings or pairs (let ((map (make-sparse-keymap))) (suppress-keymap map) (set-keymap-parent map button-buffer-map) - (define-key map "\C-?" 'scroll-down) - (define-key map " " 'scroll-up) + (define-key map "\C-?" 'scroll-down-command) + (define-key map " " 'scroll-up-command) (define-key map "q" 'exit-splash-screen) map) "Keymap for splash screen buffer.") @@ -1504,7 +1491,8 @@ a face or button specification." (if (image-type-available-p 'xpm) "splash.xpm" "splash.pbm")) - ((image-type-available-p 'svg) + ((or (image-type-available-p 'svg) + (image-type-available-p 'imagemagick)) "splash.svg") ((image-type-available-p 'png) "splash.png") @@ -1537,93 +1525,91 @@ a face or button specification." (defun fancy-startup-tail (&optional concise) "Insert the tail part of the splash screen into the current buffer." - (let ((fg (if (eq (frame-parameter nil 'background-mode) 'dark) - "cyan" "darkblue"))) - (unless concise - (fancy-splash-insert - :face 'variable-pitch - "\nTo start... " - :link `("Open a File" - ,(lambda (_button) (call-interactively 'find-file)) - "Specify a new file's name, to edit the file") - " " - :link `("Open Home Directory" - ,(lambda (_button) (dired "~")) - "Open your home directory, to operate on its files") - " " - :link `("Customize Startup" - ,(lambda (_button) (customize-group 'initialization)) - "Change initialization settings including this screen") - "\n")) + (unless concise (fancy-splash-insert - :face 'variable-pitch "To quit a partially entered command, type " - :face 'default "Control-g" - :face 'variable-pitch ".\n") - (fancy-splash-insert :face `(variable-pitch (:foreground ,fg)) - "\nThis is " - (emacs-version) - "\n" - :face '(variable-pitch (:height 0.8)) - emacs-copyright - "\n") - (and auto-save-list-file-prefix - ;; Don't signal an error if the - ;; directory for auto-save-list files - ;; does not yet exist. - (file-directory-p (file-name-directory - auto-save-list-file-prefix)) - (directory-files - (file-name-directory auto-save-list-file-prefix) - nil - (concat "\\`" - (regexp-quote (file-name-nondirectory - auto-save-list-file-prefix))) - t) - (fancy-splash-insert :face '(variable-pitch (:foreground "red")) - "\nIf an Emacs session crashed recently, " - "type " - :face '(fixed-pitch :foreground "red") - "Meta-x recover-session RET" - :face '(variable-pitch (:foreground "red")) - "\nto recover" - " the files you were editing.")) - - (when concise - (fancy-splash-insert - :face 'variable-pitch "\n" - :link `("Dismiss this startup screen" - ,(lambda (_button) - (when startup-screen-inhibit-startup-screen - (customize-set-variable 'inhibit-startup-screen t) - (customize-mark-to-save 'inhibit-startup-screen) - (custom-save-all)) - (let ((w (get-buffer-window "*GNU Emacs*"))) - (and w (not (one-window-p)) (delete-window w))) - (kill-buffer "*GNU Emacs*"))) - " ") - (when (or user-init-file custom-file) - (let ((checked (create-image "checked.xpm" - nil nil :ascent 'center)) - (unchecked (create-image "unchecked.xpm" - nil nil :ascent 'center))) - (insert-button - " " - :on-glyph checked - :off-glyph unchecked - 'checked nil 'display unchecked 'follow-link t - 'action (lambda (button) - (if (overlay-get button 'checked) - (progn (overlay-put button 'checked nil) - (overlay-put button 'display - (overlay-get button :off-glyph)) - (setq startup-screen-inhibit-startup-screen - nil)) - (overlay-put button 'checked t) - (overlay-put button 'display - (overlay-get button :on-glyph)) - (setq startup-screen-inhibit-startup-screen t))))) - (fancy-splash-insert :face '(variable-pitch (:height 0.9)) - " Never show it again."))))) + :face 'variable-pitch + "\nTo start... " + :link `("Open a File" + ,(lambda (_button) (call-interactively 'find-file)) + "Specify a new file's name, to edit the file") + " " + :link `("Open Home Directory" + ,(lambda (_button) (dired "~")) + "Open your home directory, to operate on its files") + " " + :link `("Customize Startup" + ,(lambda (_button) (customize-group 'initialization)) + "Change initialization settings including this screen") + "\n")) + (fancy-splash-insert + :face 'variable-pitch "To quit a partially entered command, type " + :face 'default "Control-g" + :face 'variable-pitch ".\n") + (fancy-splash-insert :face `(variable-pitch font-lock-builtin-face) + "\nThis is " + (emacs-version) + "\n" + :face '(variable-pitch (:height 0.8)) + emacs-copyright + "\n") + (and auto-save-list-file-prefix + ;; Don't signal an error if the + ;; directory for auto-save-list files + ;; does not yet exist. + (file-directory-p (file-name-directory + auto-save-list-file-prefix)) + (directory-files + (file-name-directory auto-save-list-file-prefix) + nil + (concat "\\`" + (regexp-quote (file-name-nondirectory + auto-save-list-file-prefix))) + t) + (fancy-splash-insert :face '(variable-pitch font-lock-comment-face) + "\nIf an Emacs session crashed recently, " + "type " + :face '(fixed-pitch font-lock-comment-face) + "Meta-x recover-session RET" + :face '(variable-pitch font-lock-comment-face) + "\nto recover" + " the files you were editing.")) + + (when concise + (fancy-splash-insert + :face 'variable-pitch "\n" + :link `("Dismiss this startup screen" + ,(lambda (_button) + (when startup-screen-inhibit-startup-screen + (customize-set-variable 'inhibit-startup-screen t) + (customize-mark-to-save 'inhibit-startup-screen) + (custom-save-all)) + (let ((w (get-buffer-window "*GNU Emacs*"))) + (and w (not (one-window-p)) (delete-window w))) + (kill-buffer "*GNU Emacs*"))) + " ") + (when (or user-init-file custom-file) + (let ((checked (create-image "checked.xpm" + nil nil :ascent 'center)) + (unchecked (create-image "unchecked.xpm" + nil nil :ascent 'center))) + (insert-button + " " + :on-glyph checked + :off-glyph unchecked + 'checked nil 'display unchecked 'follow-link t + 'action (lambda (button) + (if (overlay-get button 'checked) + (progn (overlay-put button 'checked nil) + (overlay-put button 'display + (overlay-get button :off-glyph)) + (setq startup-screen-inhibit-startup-screen + nil)) + (overlay-put button 'checked t) + (overlay-put button 'display + (overlay-get button :on-glyph)) + (setq startup-screen-inhibit-startup-screen t))))) + (fancy-splash-insert :face '(variable-pitch (:height 0.9)) + " Never show it again.")))) (defun exit-splash-screen () "Stop displaying the splash screen buffer." @@ -2077,6 +2063,7 @@ A fancy display is used on graphic displays, normal otherwise." (defalias 'display-splash-screen 'display-startup-screen) (defun command-line-1 (args-left) + "A subroutine of `command-line'." (display-startup-echo-area-message) (when (and pure-space-overflow (not noninteractive)) @@ -2308,13 +2295,13 @@ 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)))) + (when (eq initial-buffer-choice t) + ;; When initial-buffer-choice equals t make sure that *scratch* + ;; exists. + (get-buffer-create "*scratch*")) ;; If *scratch* exists and is empty, insert initial-scratch-message. + ;; Do this before switching to *scratch* below to handle bug#9605. (and initial-scratch-message (get-buffer "*scratch*") (with-current-buffer "*scratch*" @@ -2322,9 +2309,16 @@ A fancy display is used on graphic displays, normal otherwise." (insert initial-scratch-message) (set-buffer-modified-p 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 (or inhibit-startup-screen initial-buffer-choice noninteractive + (daemonp) inhibit-x-resources) ;; Not displaying a startup screen. If 3 or more files @@ -2367,9 +2361,7 @@ A fancy display is used on graphic displays, normal otherwise." ;; (with-no-warnings ;; (setq menubar-bindings-done t)) - (if (> file-count 0) - (display-startup-screen t) - (display-startup-screen nil))))) + (display-startup-screen (> file-count 0))))) (defun command-line-normalize-file-name (file) "Collapse multiple slashes to one, to handle non-Emacs file names."