X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/c3760c17bd1d2b81a05c50c1b1f7236fc34adb33..a66744021faeb2ce105b1001a380c4a46384c5f4:/lisp/startup.el diff --git a/lisp/startup.el b/lisp/startup.el index 6c3bb397e9..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,7 +41,7 @@ (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 +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 @@ -65,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 @@ -99,16 +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) -(with-no-warnings - ;; FIXME: Bad name for a dynamically bound variable - (defvar argi nil - "Current command-line argument.")) +(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. @@ -337,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) @@ -464,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) @@ -482,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. @@ -701,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) @@ -888,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) @@ -929,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 @@ -943,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 @@ -1132,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) @@ -1152,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. @@ -1281,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, @@ -1450,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.") @@ -1505,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") @@ -2076,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)) @@ -2307,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*" @@ -2321,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 @@ -2366,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."