(defvar command-line-processed nil
"Non-nil once command line has been processed.")
+(defvar window-system initial-window-system
+ "Name of window system the selected frame is displaying through.
+The value is a symbol--for instance, `x' for X windows.
+The value is nil if the selected frame is on a text-only-terminal.")
+
+(make-variable-frame-local 'window-system)
+
(defgroup initialization nil
"Emacs start-up procedure."
- :group 'internal)
+ :group 'environment)
+
+ (defcustom initial-buffer-choice nil
+ "Buffer to show after starting Emacs.
+ If the value is nil and `inhibit-splash-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."
+ :type '(choice
+ (const :tag "Splash screen" nil)
+ (directory :tag "Directory" :value "~/")
+ (file :tag "File" :value "~/file.txt")
+ (const :tag "Lisp scratch buffer" t))
+ :version "23.1"
+ :group 'initialization)
(defcustom inhibit-splash-screen nil
"Non-nil inhibits the startup screen.
(force-mode-line-update)
(setq fancy-current-text (cdr fancy-current-text))))
-(defun exit-splash-screen ()
- "Stop displaying the splash screen buffer."
+(defun fancy-splash-default-action ()
+ "Stop displaying the splash screen buffer.
+This is an internal function used to turn off the splash screen after
+the user caused an input event by hitting a key or clicking with the
+mouse."
(interactive)
- (if fancy-splash-outer-buffer
- (throw 'exit nil)
+ (if (and (memq 'down (event-modifiers last-command-event))
+ (eq (posn-window (event-start last-command-event))
+ (selected-window)))
+ ;; This is a mouse-down event in the splash screen window.
+ ;; Ignore it and consume the corresponding mouse-up event.
+ (read-event)
+ (push last-command-event unread-command-events))
+ (throw 'exit nil))
+
- (defun fancy-splash-exit ()
++(defun exit-splash-screen ()
+ "Exit the splash screen."
- (if (get-buffer "GNU Emacs")
- (throw 'stop-splashing nil)))
++ (if (get-buffer "*About GNU Emacs*")
++ (throw 'stop-splashing nil)
+ (quit-window t)))
- (run-at-time 0 nil 'fancy-splash-exit)))
+(defun fancy-splash-delete-frame (frame)
+ "Exit the splash screen after the frame is deleted."
+ ;; We can not throw from `delete-frame-events', so we set up a timer
+ ;; to exit the recursive edit as soon as Emacs is idle again.
+ (if (frame-live-p frame)
- (defun fancy-splash-screens (&optional hide-on-input)
++ (run-at-time 0 nil 'exit-splash-screen)))
+
+ (defun fancy-splash-screens (&optional static)
"Display fancy splash screens when Emacs starts."
- (if hide-on-input
+ (if (not static)
(let ((old-hourglass display-hourglass)
(fancy-splash-outer-buffer (current-buffer))
splash-buffer
(setq splash-buffer (current-buffer))
(catch 'stop-splashing
(unwind-protect
- (let ((cursor-type nil))
+ (let* ((map (make-sparse-keymap))
+ (cursor-type nil)
+ (overriding-local-map map)
+ ;; Catch if our frame is deleted; the delete-frame
+ ;; event is unreliable and is handled by
+ ;; `special-event-map' anyway.
+ (delete-frame-functions (cons 'fancy-splash-delete-frame
+ delete-frame-functions)))
+ (define-key map [t] 'fancy-splash-default-action)
+ (define-key map [mouse-movement] 'ignore)
+ (define-key map [mode-line t] 'ignore)
+ (define-key map [select-window] 'ignore)
+ ;; Temporarily bind special events to
+ ;; fancy-splash-special-event-action so as to stop
+ ;; displaying splash screens with such events.
+ ;; Otherwise, drag-n-drop into splash screens may
+ ;; leave us in recursive editing with invisible
+ ;; cursors for a while.
+ (setq special-event-map (make-sparse-keymap))
+ (map-keymap
+ (lambda (key def)
+ (define-key special-event-map (vector key)
+ (if (eq def 'ignore)
+ 'ignore
+ 'fancy-splash-special-event-action)))
+ old-special-event-map)
(setq display-hourglass nil
- minor-mode-map-alist nil
- emulation-mode-map-alists nil
buffer-undo-list t
mode-line-format (propertize "---- %b %-"
'face 'mode-line-buffer-id)
timer (run-with-timer 0 fancy-splash-delay
#'fancy-splash-screens-1
splash-buffer))
+ (use-local-map splash-screen-keymap)
+ (setq tab-width 22)
(message "%s" (startup-echo-area-message))
+ (setq buffer-read-only t)
(recursive-edit))
(cancel-timer timer)
- (setq display-hourglass old-hourglass)
- (kill-buffer splash-buffer)))))
- ;; If static is non-nil, don't show fancy splash screen.
+ (setq display-hourglass old-hourglass
+ minor-mode-map-alist old-minor-mode-map-alist
+ emulation-mode-map-alists old-emulation-mode-map-alists
+ special-event-map old-special-event-map)
+ (kill-buffer splash-buffer)
+ (when (frame-live-p frame)
+ (select-frame frame)
+ (switch-to-buffer fancy-splash-outer-buffer))
+ (when fancy-splash-last-input-event
+ (setq last-input-event fancy-splash-last-input-event
+ fancy-splash-last-input-event nil)
+ (command-execute (lookup-key special-event-map
+ (vector last-input-event))
+ nil (vector last-input-event) t))))))
+ ;; If hide-on-input is nil, don't hide the buffer on input.
(if (or (window-minibuffer-p)
(window-dedicated-p (selected-window)))
(pop-to-buffer (current-buffer))
(progn
(insert "\
You can do basic editing with the menu bar and scroll bar using the mouse.
- To quit a partially entered command, type Control-g.
-
- Useful File menu items:
- Exit Emacs (or type Control-x followed by Control-c)
- Recover Crashed Session Recover files you were editing before a crash
-
- Important Help menu items:
- Emacs Tutorial Learn how to use Emacs efficiently
- Emacs FAQ Frequently asked questions and answers
- Read the Emacs Manual View the Emacs manual using Info
- \(Non)Warranty GNU Emacs comes with ABSOLUTELY NO WARRANTY
- Copying Conditions Conditions for redistributing and changing Emacs
- Getting New Versions How to obtain the latest version of Emacs
- More Manuals / Ordering Manuals How to order printed manuals from the FSF
- ")
- (insert "\n\n" (emacs-version)
+ To quit a partially entered command, type Control-g.\n")
+
+ (insert "\nImportant Help menu items:\n")
+ (insert-button "Emacs Tutorial"
+ 'action (lambda (button) (help-with-tutorial))
+ 'follow-link t)
+ (insert "\t\tLearn how to use Emacs efficiently\n")
+ (insert-button "Emacs FAQ"
+ 'action (lambda (button) (view-emacs-FAQ))
+ 'follow-link t)
+ (insert "\t\tFrequently asked questions and answers\n")
+ (insert-button "Read the Emacs Manual"
+ 'action (lambda (button) (info-emacs-manual))
+ 'follow-link t)
+ (insert "\tView the Emacs manual using Info\n")
+ (insert-button "\(Non)Warranty"
+ 'action (lambda (button) (describe-no-warranty))
+ 'follow-link t)
+ (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n")
+ (insert-button "Copying Conditions"
+ 'action (lambda (button) (describe-copying))
+ 'follow-link t)
+ (insert "\tConditions for redistributing and changing Emacs\n")
+ (insert-button "Getting New Versions"
+ 'action (lambda (button) (describe-distribution))
+ 'follow-link t)
+ (insert "\tHow to obtain the latest version of Emacs\n")
+ (insert-button "More Manuals / Ordering Manuals"
+ 'action (lambda (button) (view-order-manuals))
+ 'follow-link t)
+ (insert " How to order printed manuals from the FSF\n")
+
+ (insert "\nUseful tasks:\n")
+ (insert-button "Visit New File"
+ 'action (lambda (button) (call-interactively 'find-file))
+ 'follow-link t)
+ (insert "\t\tSpecify a new file's name, to edit the file\n")
+ (insert-button "Open Home Directory"
+ 'action (lambda (button) (dired "~"))
+ 'follow-link t)
+ (insert "\tOpen your home directory, to operate on its files\n")
+ (insert-button "Open *scratch* buffer"
+ 'action (lambda (button) (switch-to-buffer
+ (get-buffer-create "*scratch*")))
+ 'follow-link t)
+ (insert "\tOpen buffer for notes you don't want to save\n")
+ (insert-button "Customize Startup"
+ 'action (lambda (button) (customize-group 'initialization))
+ 'follow-link t)
+ (insert "\tChange initialization settings including this screen\n")
+
+ (insert "\n" (emacs-version)
"\n" emacs-copyright))
- ;; No mouse menus, so give help using kbd commands.
-
- ;; If keys have their default meanings,
- ;; use precomputed string to save lots of time.
- (if (and (eq (key-binding "\C-h") 'help-command)
- (eq (key-binding "\C-xu") 'advertised-undo)
- (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
- (eq (key-binding "\C-ht") 'help-with-tutorial)
- (eq (key-binding "\C-hi") 'info)
- (eq (key-binding "\C-hr") 'info-emacs-manual)
- (eq (key-binding "\C-h\C-n") 'view-emacs-news))
+ ;; No mouse menus, so give help using kbd commands.
+
+ ;; If keys have their default meanings,
+ ;; use precomputed string to save lots of time.
+ (if (and (eq (key-binding "\C-h") 'help-command)
+ (eq (key-binding "\C-xu") 'advertised-undo)
+ (eq (key-binding "\C-x\C-c") 'save-buffers-kill-terminal)
+ (eq (key-binding "\C-ht") 'help-with-tutorial)
+ (eq (key-binding "\C-hi") 'info)
+ (eq (key-binding "\C-hr") 'info-emacs-manual)
+ (eq (key-binding "\C-h\C-n") 'view-emacs-news))
- (insert "
+ (progn
+ (insert "
Get help C-h (Hold down CTRL and press h)
- Emacs manual C-h r
- Emacs tutorial C-h t Undo changes C-x u
- Buy manuals C-h C-m Exit Emacs C-x C-c
- Browse manuals C-h i")
+ ")
+ (insert-button "Emacs manual"
+ 'action (lambda (button) (info-emacs-manual))
+ 'follow-link t)
+ (insert " C-h r\t")
+ (insert-button "Browse manuals"
+ 'action (lambda (button) (Info-directory))
+ 'follow-link t)
+ (insert "\t C-h i
+ ")
+ (insert-button "Emacs tutorial"
+ 'action (lambda (button) (help-with-tutorial))
+ 'follow-link t)
+ (insert " C-h t\tUndo changes\t C-x u
+ ")
+ (insert-button "Buy manuals"
+ 'action (lambda (button) (view-order-manuals))
+ 'follow-link t)
+ (insert "\t C-h C-m\tExit Emacs\t C-x C-c"))
- (insert (format "
+ (insert (substitute-command-keys
+ (format "\n
Get help %s
- Emacs manual \\[info-emacs-manual]
- Emacs tutorial \\[help-with-tutorial]\tUndo changes\t\\[advertised-undo]
- Buy manuals \\[view-order-manuals]\tExit Emacs\t\\[save-buffers-kill-terminal]
- Browse manuals \\[info]"
- (let ((where (where-is-internal
- 'help-command nil t)))
- (if where
- (key-description where)
- "M-x help"))))))
-
- ;; Say how to use the menu bar with the keyboard.
- (if (and (eq (key-binding "\M-`") 'tmm-menubar)
- (eq (key-binding [f10]) 'tmm-menubar))
- (insert "
- Activate menubar F10 or ESC ` or M-`")
- (insert (substitute-command-keys "
- Activate menubar \\[tmm-menubar]")))
+ "
+ (let ((where (where-is-internal
+ 'help-command nil t)))
+ (if where
+ (key-description where)
+ "M-x help"))))
+ (insert-button "Emacs manual"
+ 'action (lambda (button) (info-emacs-manual))
+ 'follow-link t)
+ (insert (substitute-command-keys" \\[info-emacs-manual]\t"))
+ (insert-button "Browse manuals"
+ 'action (lambda (button) (Info-directory))
+ 'follow-link t)
+ (insert (substitute-command-keys "\t \\[info]
+ "))
+ (insert-button "Emacs tutorial"
+ 'action (lambda (button) (help-with-tutorial))
+ 'follow-link t)
+ (insert (substitute-command-keys
+ " \\[help-with-tutorial]\tUndo changes\t \\[advertised-undo]
+ "))
+ (insert-button "Buy manuals"
+ 'action (lambda (button) (view-order-manuals))
+ 'follow-link t)
+ (insert (substitute-command-keys
+ "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-emacs]")))
+
+ ;; Say how to use the menu bar with the keyboard.
+ (insert "\n")
+ (insert-button "Activate menubar"
+ 'action (lambda (button) (tmm-menubar))
+ 'follow-link t)
+ (if (and (eq (key-binding "\M-`") 'tmm-menubar)
+ (eq (key-binding [f10]) 'tmm-menubar))
+ (insert " F10 or ESC ` or M-`")
+ (insert (substitute-command-keys " \\[tmm-menubar]")))
- ;; Many users seem to have problems with these.
- (insert "
+ ;; Many users seem to have problems with these.
+ (insert "
\(`C-' means use the CTRL key. `M-' means use the Meta (or Alt) key.
If you have no Meta key, you may instead type ESC followed by the character.)")
- (insert "\n\n" (emacs-version)
+ ;; Insert links to useful tasks
+ (insert "\nUseful tasks:\n")
+
+ (insert-button "Visit New File"
+ 'action (lambda (button) (call-interactively 'find-file))
+ 'follow-link t)
+ (insert "\t\t\t")
+ (insert-button "Open Home Directory"
+ 'action (lambda (button) (dired "~"))
+ 'follow-link t)
+ (insert "\n")
+
+ (insert-button "Customize Startup"
+ 'action (lambda (button) (customize-group 'initialization))
+ 'follow-link t)
+ (insert "\t\t")
+ (insert-button "Open *scratch* buffer"
+ 'action (lambda (button) (switch-to-buffer
+ (get-buffer-create "*scratch*")))
+ 'follow-link t)
+ (insert "\n")
+
+ (insert "\n" (emacs-version)
"\n" emacs-copyright)
- (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
- (eq (key-binding "\C-h\C-d") 'describe-distribution)
- (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
+ (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
+ (eq (key-binding "\C-h\C-d") 'describe-distribution)
+ (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
- (insert
- "\n
- GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
+ (progn
+ (insert
+ "\n
+ GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ")
+ (insert-button "full details"
+ 'action (lambda (button) (describe-no-warranty))
+ 'follow-link t)
+ (insert ".
Emacs is Free Software--Free as in Freedom--so you can redistribute copies
- of Emacs and modify it; type C-h C-c to see the conditions.
- Type C-h C-d for information on getting the latest version.")
- (insert (substitute-command-keys
- "\n
- GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
+ of Emacs and modify it; type C-h C-c to see ")
+ (insert-button "the conditions"
+ 'action (lambda (button) (describe-copying))
+ 'follow-link t)
+ (insert ".
+ Type C-h C-d for information on ")
+ (insert-button "getting the latest version"
+ 'action (lambda (button) (describe-distribution))
+ 'follow-link t)
+ (insert "."))
+ (insert (substitute-command-keys
+ "\n
+ GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
+ (insert-button "full details"
+ 'action (lambda (button) (describe-no-warranty))
+ 'follow-link t)
+ (insert (substitute-command-keys ".
Emacs is Free Software--Free as in Freedom--so you can redistribute copies
- of Emacs and modify it; type \\[describe-copying] to see the conditions.
- Type \\[describe-distribution] for information on getting the latest version."))))
+ of Emacs and modify it; type \\[describe-copying] to see "))
+ (insert-button "the conditions"
+ 'action (lambda (button) (describe-copying))
+ 'follow-link t)
+ (insert (substitute-command-keys".
+ Type \\[describe-distribution] for information on "))
+ (insert-button "getting the latest version"
+ 'action (lambda (button) (describe-distribution))
+ 'follow-link t)
+ (insert ".")))
- ;; The rest of the startup screen is the same on all
- ;; kinds of terminals.
-
- ;; Give information on recovering, if there was a crash.
- (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)
- (insert "\n\nIf an Emacs session crashed recently, "
- "type Meta-x recover-session RET\nto recover"
+ ;; The rest of the startup screen is the same on all
+ ;; kinds of terminals.
+
+ ;; Give information on recovering, if there was a crash.
+ (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)
+ (insert "\n\nIf an Emacs session crashed recently, "
+ "type Meta-x recover-session RET\nto recover"
- " the files you were editing."))
+ " the files you were editing.\n"))
+
+ (use-local-map splash-screen-keymap)
;; Display the input that we set up in the buffer.
(set-buffer-modified-p nil)
(if (and view-read-only (not view-mode))
(view-mode-enter nil 'kill-buffer))
(goto-char (point-min))
- (if (not static)
- (if (or (window-minibuffer-p)
- (window-dedicated-p (selected-window)))
- ;; If static is nil, creating a new frame will
- ;; generate enough events that the subsequent `sit-for'
- ;; will immediately return anyway.
- nil ;; (pop-to-buffer (current-buffer))
+ (if hide-on-input
+ (if (or (window-minibuffer-p)
+ (window-dedicated-p (selected-window)))
+ ;; If hide-on-input is nil, creating a new frame will
+ ;; generate enough events that the subsequent `sit-for'
+ ;; will immediately return anyway.
+ nil ;; (pop-to-buffer (current-buffer))
(save-window-excursion
- (switch-to-buffer (current-buffer))
- (sit-for 120)))
- (condition-case nil
- (switch-to-buffer (current-buffer))
- ;; In case the window is dedicated or something.
- (error (pop-to-buffer (current-buffer))))))
+ (switch-to-buffer (current-buffer))
+ (sit-for 120))
+ (condition-case nil
+ (switch-to-buffer (current-buffer))))))
;; Unwind ... ensure splash buffer is killed
- (if hide-on-input
- (kill-buffer "GNU Emacs")
- (switch-to-buffer "GNU Emacs")
- (rename-buffer "*About GNU Emacs*" t)))))
+ (if (not static)
+ (kill-buffer "*About GNU Emacs*")
+ (switch-to-buffer "*About GNU Emacs*")
+ (rename-buffer "*GNU Emacs*" t)))))
(defun startup-echo-area-message ()
(defun display-startup-echo-area-message ()
(let ((resize-mini-windows t))
- (message "%s" (startup-echo-area-message))))
+ (or noninteractive ;(input-pending-p) init-file-had-error
+ ;; t if the init file says to inhibit the echo area startup message.
+ (and inhibit-startup-echo-area-message
+ user-init-file
+ (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
+ (equal inhibit-startup-echo-area-message
+ (if (equal init-file-user "")
+ (user-login-name)
+ init-file-user)))
+ ;; Wasn't set with custom; see if .emacs has a setq.
+ (let ((buffer (get-buffer-create " *temp*")))
+ (prog1
+ (condition-case nil
+ (save-excursion
+ (set-buffer buffer)
+ (insert-file-contents user-init-file)
+ (re-search-forward
+ (concat
+ "([ \t\n]*setq[ \t\n]+"
+ "inhibit-startup-echo-area-message[ \t\n]+"
+ (regexp-quote
+ (prin1-to-string
+ (if (equal init-file-user "")
+ (user-login-name)
+ init-file-user)))
+ "[ \t\n]*)")
+ nil t))
+ (error nil))
+ (kill-buffer buffer)))))
+ ;; display-splash-screen at the end of command-line-1 calls
+ ;; use-fancy-splash-screens-p. This can cause image.el to be
+ ;; loaded, putting "Loading image... done" in the echo area.
+ ;; This hides startup-echo-area-message. So
+ ;; use-fancy-splash-screens-p is called here simply to get the
+ ;; loading of image.el (if needed) out of the way before
+ ;; display-startup-echo-area-message runs.
+ (progn
+ (use-fancy-splash-screens-p)
+ (message "%s" (startup-echo-area-message))))))
- (defun display-splash-screen (&optional hide-on-input)
+ (defun display-splash-screen (&optional static)
"Display splash screen according to display.
Fancy splash screens are used on graphic displays,
normal otherwise.
With a prefix argument, any user input hides the splash screen."
(interactive "P")
- (if (use-fancy-splash-screens-p)
- (fancy-splash-screens static)
- (normal-splash-screen static)))
-
-(defalias 'about-emacs 'display-splash-screen)
+ ;; Prevent recursive calls from server-process-filter.
- (if (not (get-buffer "GNU Emacs"))
++ (if (not (get-buffer "*About GNU Emacs*"))
+ (if (use-fancy-splash-screens-p)
+ (fancy-splash-screens hide-on-input)
+ (normal-splash-screen hide-on-input))))
(defun command-line-1 (command-line-args-left)
- (or noninteractive (input-pending-p) init-file-had-error
- ;; t if the init file says to inhibit the echo area startup message.
- (and inhibit-startup-echo-area-message
- user-init-file
- (or (and (get 'inhibit-startup-echo-area-message 'saved-value)
- (equal inhibit-startup-echo-area-message
- (if (equal init-file-user "")
- (user-login-name)
- init-file-user)))
- ;; Wasn't set with custom; see if .emacs has a setq.
- (let ((buffer (get-buffer-create " *temp*")))
- (prog1
- (condition-case nil
- (save-excursion
- (set-buffer buffer)
- (insert-file-contents user-init-file)
- (re-search-forward
- (concat
- "([ \t\n]*setq[ \t\n]+"
- "inhibit-startup-echo-area-message[ \t\n]+"
- (regexp-quote
- (prin1-to-string
- (if (equal init-file-user "")
- (user-login-name)
- init-file-user)))
- "[ \t\n]*)")
- nil t))
- (error nil))
- (kill-buffer buffer)))))
- ;; display-splash-screen at the end of command-line-1 calls
- ;; use-fancy-splash-screens-p. This can cause image.el to be
- ;; loaded, putting "Loading image... done" in the echo area.
- ;; This hides startup-echo-area-message. So
- ;; use-fancy-splash-screens-p is called here simply to get the
- ;; loading of image.el (if needed) out of the way before
- ;; display-startup-echo-area-message runs.
- (progn
- (use-fancy-splash-screens-p)
- (display-startup-echo-area-message)))
+ (display-startup-echo-area-message)
;; Delay 2 seconds after an init file error message
;; was displayed, so user can read it.
projects / emacs.git / commitdiff