# HG changeset patch # User Juri Linkov # Date 1187220163 0 # Node ID 71b7e41a741571a343614588baf77762794635c3 # Parent 9d202ec7bccf65894946c7f211e72ba8335b1637 (initialization): Change parent group from `internal' to `environment'. (initial-buffer-choice): New variable. (command-line): Revert 2007-07-02 change that sets buffer-offer-save in *scratch* and enables auto-save in it. (fancy-splash-text): Add links to existing items. Add new items with links for useful tasks. Move information about Control-g to fancy-splash-head. Move "Emacs Guided Tour" to the end. (fancy-splash-keymap): New variable. (fancy-splash-last-input-event): Remove variable. (fancy-splash-insert): Add processing of `:link' element. (fancy-splash-head): Replace "Type Control-l to begin editing" with "Type `q' to exit". (fancy-splash-screens-1): Let-bind inhibit-read-only to t. (fancy-splash-default-action, fancy-splash-special-event-action): Remove functions. (fancy-splash-quit): New function. (fancy-splash-screens): Rename input arg from `hide-on-input' to `static' and reverse the condition of its usage. Don't preserve original values of `minor-mode-map-alist', `emulation-mode-map-alists', `special-event-map'. Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs". Rename about-buffer from " GNU Emacs" to " About GNU Emacs". Remove processing of special events. Use local key map `fancy-splash-keymap'. Set buffer to read-only. (normal-splash-screen): Rename input arg from `hide-on-input' to `static' and reverse the condition of its usage. Rename startup-buffer from "*About GNU Emacs*" to " GNU Emacs". Rename about-buffer from " GNU Emacs" to " About GNU Emacs". Add links to existing items. Add new items with links for useful tasks. Use local key map `fancy-splash-keymap'. (display-splash-screen): Rename input arg from `hide-on-input' to `static'. (about-emacs): Add alias to display-splash-screen. (command-line-1): Use `initial-buffer-choice'. diff -r 9d202ec7bccf -r 71b7e41a7415 lisp/startup.el --- a/lisp/startup.el Wed Aug 15 23:01:58 2007 +0000 +++ b/lisp/startup.el Wed Aug 15 23:22:43 2007 +0000 @@ -38,7 +38,20 @@ (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. @@ -1055,10 +1068,7 @@ (if (get-buffer "*scratch*") (with-current-buffer "*scratch*" (if (eq major-mode 'fundamental-mode) - (funcall initial-major-mode)) - ;; Don't lose text that users type in *scratch*. - (setq buffer-offer-save t) - (auto-save-mode 1))) + (funcall initial-major-mode)))) ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. @@ -1131,6 +1141,8 @@ '((:face (variable-pitch :weight bold) "Important Help menu items:\n" :face variable-pitch + :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) + "\t\tLearn how to use Emacs efficiently" (lambda () (let* ((en "TUTORIAL") (tut (or (get-language-info current-language-environment @@ -1144,37 +1156,31 @@ (buffer-substring (point-min) (1- (point)))))) ;; If there is a specific tutorial for the current language ;; environment and it is not English, append its title. - (concat - "Emacs Tutorial\t\tLearn how to use Emacs efficiently" - (if (string= en tut) - "" - (concat " (" title ")")) - "\n"))) - :face variable-pitch "\ -Emacs FAQ\t\tFrequently asked questions and answers -View Emacs Manual\t\tView the Emacs manual using Info -Absence of Warranty\tGNU Emacs comes with " + (if (string= en tut) + "" + (concat " (" title ")")))) + "\n" + :face variable-pitch + :link ("Emacs FAQ" (lambda (button) (view-emacs-FAQ))) + "\t\tFrequently asked questions and answers\n" + :link ("View Emacs Manual" (lambda (button) (info-emacs-manual))) + "\t\tView the Emacs manual using Info\n" + :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) + "\tGNU Emacs comes with " :face (variable-pitch :slant oblique) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch - "\ -Copying Conditions\t\tConditions for redistributing and changing Emacs -Getting New Versions\tHow to obtain the latest version of Emacs -More Manuals / Ordering Manuals Buying printed manuals from the FSF\n") - (:face variable-pitch - "\nTo quit a partially entered command, type " - :face default - "Control-g" - :face variable-pitch - ". - -Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/ - -" - :face (variable-pitch :weight bold) + :link ("Copying Conditions" (lambda (button) (describe-copying))) + "\t\tConditions for redistributing and changing Emacs\n" + :link ("Getting New Versions" (lambda (button) (describe-distribution))) + "\tHow to obtain the latest version of Emacs\n" + :link ("More Manuals / Ordering Manuals" (lambda (button) (view-order-manuals))) + " Buying printed manuals from the FSF\n") + (:face (variable-pitch :weight bold) "Useful File menu items:\n" :face variable-pitch - "Exit Emacs\t\t(Or type " + :link ("Exit Emacs" (lambda (button) (save-buffers-kill-emacs))) + "\t\t(Or type " :face default "Control-x" :face variable-pitch @@ -1182,9 +1188,31 @@ :face default "Control-c" :face variable-pitch - ") -Recover Crashed Session\tRecover files you were editing before a crash\n" - )) + ")\n" + :link ("Recover Crashed Session" (lambda (button) (recover-session))) + "\tRecover files you were editing before a crash\n\n" + + :face (variable-pitch :weight bold) + "Useful tasks:\n" + :face variable-pitch + :link ("Visit New File" + (lambda (button) (call-interactively 'find-file))) + " Specify a new file's name, to edit the file\n" + :link ("Open Home Directory" + (lambda (button) (dired "~"))) + " Open your home directory, to operate on its files\n" + :link ("Open *scratch* buffer" + (lambda (button) (switch-to-buffer (get-buffer-create "*scratch*")))) + " Open buffer for notes you don't want to save\n" + :link ("Customize Startup" + (lambda (button) (customize-group 'initialization))) + " Change initialization settings including this screen\n" + + "\nEmacs Guided Tour\t\tSee " + :link ("http://www.gnu.org/software/emacs/tour/" + (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))) + + )) "A list of texts to show in the middle part of splash screens. Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") @@ -1216,13 +1244,22 @@ (file :tag "File"))) +(defvar fancy-splash-keymap + (let ((map (make-sparse-keymap))) + (suppress-keymap map) + (set-keymap-parent map button-buffer-map) + + (define-key map " " 'fancy-splash-quit) + (define-key map "q" 'fancy-splash-quit) + map) + "Keymap for splash screen buffer.") + ;; These are temporary storage areas for the splash screen display. (defvar fancy-current-text nil) (defvar fancy-splash-help-echo nil) (defvar fancy-splash-stop-time nil) (defvar fancy-splash-outer-buffer nil) -(defvar fancy-splash-last-input-event nil) (defun fancy-splash-insert (&rest args) "Insert text into the current buffer, with faces. @@ -1232,14 +1269,21 @@ `put-text-property'." (let ((current-face nil)) (while args - (if (eq (car args) :face) - (setq args (cdr args) current-face (car args)) - (insert (propertize (let ((it (car args))) - (if (functionp it) - (funcall it) - it)) - 'face current-face - 'help-echo fancy-splash-help-echo))) + (cond ((eq (car args) :face) + (setq args (cdr args) current-face (car args))) + ((eq (car args) :link) + (setq args (cdr args)) + (let ((spec (car args))) + (insert-button (car spec) + 'face (list 'link current-face) + 'action (cadr spec) + 'follow-link t))) + (t (insert (propertize (let ((it (car args))) + (if (functionp it) + (funcall it) + it)) + 'face current-face + 'help-echo fancy-splash-help-echo)))) (setq args (cdr args))))) @@ -1279,7 +1323,7 @@ (throw 'exit nil))) (define-key map [down-mouse-2] 'ignore) (define-key map [up-mouse-2] 'ignore) - (insert-image img (propertize "xxx" 'help-echo help-echo + (insert-image img (propertize "[image]" 'help-echo help-echo 'keymap map))) (insert "\n")))) (fancy-splash-insert @@ -1291,19 +1335,22 @@ (fancy-splash-insert :face 'variable-pitch "You can do basic editing with the menu bar and scroll bar \ -using the mouse.\n\n") +using the mouse.\n" + :face 'variable-pitch + "To quit a partially entered command, type " + :face 'default + "Control-g" + :face 'variable-pitch + "." + "\n\n") (when fancy-splash-outer-buffer (fancy-splash-insert :face 'variable-pitch "Type " :face 'default - "Control-l" + "`q'" :face 'variable-pitch - " to begin editing" - (if (equal (buffer-name fancy-splash-outer-buffer) - "*scratch*") - ".\n" - " your file.\n")))) + " to exit from this screen.\n"))) (defun fancy-splash-tail () "Insert the tail part of the splash screen into the current buffer." @@ -1343,7 +1390,8 @@ (throw 'stop-splashing nil)) (unless fancy-current-text (setq fancy-current-text fancy-splash-text)) - (let ((text (car fancy-current-text))) + (let ((text (car fancy-current-text)) + (inhibit-read-only t)) (set-buffer buffer) (erase-buffer) (if pure-space-overflow @@ -1360,73 +1408,30 @@ (force-mode-line-update) (setq fancy-current-text (cdr fancy-current-text)))) - -(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." +(defun fancy-splash-quit () + "Stop displaying the splash screen buffer." (interactive) - (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 spash screen window. - ;; Ignore it and consume the corresponding mouse-up event. - (read-event) - (push last-command-event unread-command-events)) - (throw 'exit nil)) + (if fancy-splash-outer-buffer + (throw 'exit nil) + (kill-buffer (current-buffer)))) -(defun fancy-splash-special-event-action () - "Save the last event and 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 that is bound in `special-event-map'" - (interactive) - (setq fancy-splash-last-input-event last-input-event) - (throw 'exit nil)) - - -(defun fancy-splash-screens (&optional hide-on-input) +(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 - (old-minor-mode-map-alist minor-mode-map-alist) - (old-emulation-mode-map-alists emulation-mode-map-alists) - (old-special-event-map special-event-map) (frame (fancy-splash-frame)) timer) (save-selected-window (select-frame frame) - (switch-to-buffer " GNU Emacs") + (switch-to-buffer " About GNU Emacs") (make-local-variable 'cursor-type) (setq splash-buffer (current-buffer)) (catch 'stop-splashing (unwind-protect - (let ((map (make-sparse-keymap)) - (cursor-type nil)) - (use-local-map map) - (define-key map [switch-frame] 'ignore) - (define-key map [t] 'fancy-splash-default-action) - (define-key map [mouse-movement] 'ignore) - (define-key map [mode-line t] '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) + (let ((cursor-type nil)) (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) @@ -1435,25 +1440,18 @@ timer (run-with-timer 0 fancy-splash-delay #'fancy-splash-screens-1 splash-buffer)) + (use-local-map fancy-splash-keymap) (message "%s" (startup-echo-area-message)) + (setq buffer-read-only t) (recursive-edit)) (cancel-timer timer) - (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 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. + (setq display-hourglass old-hourglass) + (kill-buffer splash-buffer))))) + ;; If static is non-nil, don't show fancy splash screen. (if (or (window-minibuffer-p) (window-dedicated-p (selected-window))) (pop-to-buffer (current-buffer)) - (switch-to-buffer "*About GNU Emacs*")) + (switch-to-buffer " GNU Emacs")) (setq buffer-read-only nil) (erase-buffer) (if pure-space-overflow @@ -1469,6 +1467,7 @@ (delete-region (point) (point-max)) (insert "\n") (fancy-splash-tail) + (use-local-map fancy-splash-keymap) (set-buffer-modified-p nil) (setq buffer-read-only t) (if (and view-read-only (not view-mode)) @@ -1507,15 +1506,15 @@ (> frame-height (+ image-height 19))))))) -(defun normal-splash-screen (&optional hide-on-input) +(defun normal-splash-screen (&optional static) "Display splash screen when Emacs starts." (let ((prev-buffer (current-buffer))) (unwind-protect - (with-current-buffer (get-buffer-create "GNU Emacs") + (with-current-buffer (get-buffer-create " About GNU Emacs") (setq buffer-read-only nil) (erase-buffer) (set (make-local-variable 'tab-width) 8) - (if hide-on-input + (if (not static) (set (make-local-variable 'mode-line-format) (propertize "---- %b %-" 'face 'mode-line-buffer-id))) @@ -1533,13 +1532,10 @@ ", one component of the GNU/Linux operating system.\n" ", a part of the GNU operating system.\n")) - (if hide-on-input + (if (not static) (insert (substitute-command-keys (concat - "\nType \\[recenter] to begin editing" - (if (equal (buffer-name prev-buffer) "*scratch*") - ".\n" - " your file.\n"))))) + "\nType \\[recenter] to quit from this screen.\n")))) (if (display-mouse-p) ;; The user can use the mouse to activate menus @@ -1547,22 +1543,68 @@ (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 +To quit a partially entered command, type Control-g.\n") -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) + (insert "\nImportant Help menu items:\n") + (insert-button "Emacs Tutorial" + 'action (lambda (button) (help-with-tutorial)) + 'follow-link t) + (insert " Learn how to use Emacs efficiently\n") + (insert-button "Emacs FAQ" + 'action (lambda (button) (view-emacs-FAQ)) + 'follow-link t) + (insert " Frequently asked questions and answers\n") + (insert-button "Read the Emacs Manual" + 'action (lambda (button) (info-emacs-manual)) + 'follow-link t) + (insert " View the Emacs manual using Info\n") + (insert-button "\(Non)Warranty" + 'action (lambda (button) (describe-no-warranty)) + 'follow-link t) + (insert " GNU Emacs comes with ABSOLUTELY NO WARRANTY\n") + (insert-button "Copying Conditions" + 'action (lambda (button) (describe-copying)) + 'follow-link t) + (insert " Conditions for redistributing and changing Emacs\n") + (insert-button "Getting New Versions" + 'action (lambda (button) (describe-distribution)) + 'follow-link t) + (insert " How 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 File menu items:\n") + (insert-button "Exit Emacs" + 'action (lambda (button) (save-buffers-kill-emacs)) + 'follow-link t) + (insert " (or type Control-x followed by Control-c)\n") + (insert-button "Recover Crashed Session" + 'action (lambda (button) (recover-session)) + 'follow-link t) + (insert " Recover files you were editing before a crash\n") + + (insert "\nUseful tasks:\n") + (insert-button "Visit New File" + 'action (lambda (button) (call-interactively 'find-file)) + 'follow-link t) + (insert " Specify a new file's name, to edit the file\n") + (insert-button "Open Home Directory" + 'action (lambda (button) (dired "~")) + 'follow-link t) + (insert " Open 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 " Open buffer for notes you don't want to save\n") + (insert-button "Customize Startup" + 'action (lambda (button) (customize-group 'initialization)) + 'follow-link t) + (insert " Change initialization settings including this screen\n") + + (insert "\n" (emacs-version) "\n" emacs-copyright)) ;; No mouse menus, so give help using kbd commands. @@ -1609,7 +1651,27 @@ \(`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 "\n\nUseful tasks (move point to the link and press RET):\n") + (insert-button "Visit New File" + 'action (lambda (button) (call-interactively 'find-file)) + 'follow-link t) + (insert " Specify a new file's name, to edit the file\n") + (insert-button "Open Home Directory" + 'action (lambda (button) (dired "~")) + 'follow-link t) + (insert " Open 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 " Open buffer for notes you don't want to save\n") + (insert-button "Customize Startup" + 'action (lambda (button) (customize-group 'initialization)) + 'follow-link t) + (insert " Change initialization settings including this screen\n") + + (insert "\n" (emacs-version) "\n" emacs-copyright) (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) @@ -1647,7 +1709,9 @@ 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 button-buffer-map) ;; Display the input that we set up in the buffer. (set-buffer-modified-p nil) @@ -1655,10 +1719,10 @@ (if (and view-read-only (not view-mode)) (view-mode-enter nil 'kill-buffer)) (goto-char (point-min)) - (if hide-on-input + (if (not static) (if (or (window-minibuffer-p) (window-dedicated-p (selected-window))) - ;; If hide-on-input is nil, creating a new frame will + ;; 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)) @@ -1670,10 +1734,10 @@ ;; In case the window is dedicated or something. (error (pop-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 () @@ -1689,16 +1753,17 @@ (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 hide-on-input) - (normal-splash-screen hide-on-input))) + (fancy-splash-screens static) + (normal-splash-screen static))) +(defalias 'about-emacs 'display-splash-screen) (defun command-line-1 (command-line-args-left) (or noninteractive (input-pending-p) init-file-had-error @@ -1958,8 +2023,15 @@ (or (get-buffer-window first-file-buffer) (list-buffers))))) + (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)))) + ;; Maybe display a startup screen. (unless (or inhibit-startup-message + initial-buffer-choice noninteractive emacs-quick-startup) ;; Display a startup screen, after some preparations.