;;; 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
(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 "~/")
(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
"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.
(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)
\"\\'\"; 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'."
(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)
;; 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.
(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)
(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)
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
(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
(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)
(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.
(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,
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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/"))
`: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/"))
`("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"
,(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.")
(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.")
(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")
(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."
(save-selected-window
(select-frame frame)
(switch-to-buffer "*About GNU Emacs*")
- (setq buffer-undo-list t
- mode-line-format
- (concat "----"
- (propertize "%b" 'face 'mode-line-buffer-id)
- "%-"))
+ (setq buffer-undo-list t)
(let ((inhibit-read-only t))
(erase-buffer)
(if pure-space-overflow
(erase-buffer)
(setq default-directory command-line-default-directory)
(set (make-local-variable 'tab-width) 8)
- (if (not startup)
- (set (make-local-variable 'mode-line-format)
- (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
(if pure-space-overflow
(insert pure-space-overflow-message))
(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))
;; 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*"
(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
;; (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."
HCoop / bpt / emacs.git / blobdiff