Re: Scratch buffer annoyance

[Juri Linkov <juri@jurta.org>]

>     I'll present the combined patch after an agreement on a new
>     customizable option.  Is it OK to add `visit-on-startup'?
>
> Please do!

In the following patch the name of the new option is `initial-buffer'.
I think it better fits to the existing option names in the same group
`initialization'.  Depending on the non-nil value of the new option
`initial-buffer' either *scratch* buffer is displayed on startup, or
a directory/file is visited.  The parent group of `initialization' was
changed from `internal' to `environment' as was suggested.  The recent
change that sets buffer-offer-save in *scratch* and enables auto-save was
reverted.

New links on the startup splash screen are the following:

Visit New File
Visit Home Directory
Visit *scratch* Buffer
Customize Startup Screen
Exit This Screen

All the rest changes are the same as I already described earlier.

Index: lisp/startup.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/startup.el,v
retrieving revision 1.442
diff -c -r1.442 startup.el
*** lisp/startup.el	24 Jul 2007 04:48:03 -0000	1.442
--- lisp/startup.el	25 Jul 2007 00:11:57 -0000
***************
*** 38,44 ****
  
  (defgroup initialization nil
    "Emacs start-up procedure."
!   :group 'internal)
  
  (defcustom inhibit-splash-screen nil
    "Non-nil inhibits the startup screen.
--- 38,54 ----
  
  (defgroup initialization nil
    "Emacs start-up procedure."
!   :group 'environment)
! 
! (defcustom initial-buffer nil
!   "Buffer to show after starting Emacs."
!   :type '(choice
!           (directory :tag "Directory"        :value "~/")
!           (file      :tag "File"             :value "~/new.txt")
!           (const     :tag "*scratch* buffer" :value "*scratch*")
!           (const     :tag "Splash screen"    nil))
!   :version "23.1"
!   :group 'initialization)
  
  (defcustom inhibit-splash-screen nil
    "Non-nil inhibits the startup screen.
***************
*** 1055,1064 ****
    (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)))
  
    ;; Load library for our terminal type.
    ;; User init file can set term-file-prefix to nil to prevent this.
--- 1065,1071 ----
    (if (get-buffer "*scratch*")
        (with-current-buffer "*scratch*"
  	(if (eq major-mode 'fundamental-mode)
! 	    (funcall initial-major-mode))))
  
    ;; Load library for our terminal type.
    ;; User init file can set term-file-prefix to nil to prevent this.
***************
*** 1168,1174 ****
  	 :face variable-pitch
  	 ".
  
! Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/
  
  "
  	 :face (variable-pitch :weight bold)
--- 1175,1189 ----
  	 :face variable-pitch
  	 ".
  
! Emacs Guided Tour\t\tSee "
! 	 :face '(link variable-pitch)
! 	 (lambda ()
! 	   (propertize "http://www.gnu.org/software/emacs/tour/"
! 		       'keymap fancy-splash-link-keymap
! 		       'link "http://www.gnu.org/software/emacs/tour/"
! 		       'help-echo "mouse-2: browse this URL"))
! 	 :face variable-pitch
! 	 "
  
  "
  	 :face (variable-pitch :weight bold)
***************
*** 1216,1228 ****
  		 (file :tag "File")))
  
  
  ;; 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.
--- 1231,1260 ----
  		 (file :tag "File")))
  
  
+ (defvar fancy-splash-keymap
+   (let ((map (make-sparse-keymap)))
+     (define-key map " " 'fancy-splash-quit)
+     (define-key map "q" 'fancy-splash-quit)
+     map)
+   "Keymap for splash screen buffer.")
+ 
+ (defvar fancy-splash-link-keymap
+   (let ((map (make-sparse-keymap)))
+     (set-keymap-parent map fancy-splash-keymap)
+     (define-key map "\C-m" 'fancy-splash-link-at-point)
+     (define-key map [mouse-2] 'fancy-splash-link-at-click)
+     (define-key map [down-mouse-2] 'ignore)
+     (define-key map [up-mouse-2] 'ignore)
+     (define-key map [follow-link] 'mouse-face)
+     map)
+   "Keymap for links in 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)
  
  (defun fancy-splash-insert (&rest args)
    "Insert text into the current buffer, with faces.
***************
*** 1297,1309 ****
       :face 'variable-pitch
       "Type "
       :face 'default
!      "Control-l"
       :face 'variable-pitch
!      " to begin editing"
!      (if (equal (buffer-name fancy-splash-outer-buffer)
! 		"*scratch*")
! 	 ".\n"
!        " your file.\n"))))
  
  (defun fancy-splash-tail ()
    "Insert the tail part of the splash screen into the current buffer."
--- 1329,1395 ----
       :face 'variable-pitch
       "Type "
       :face 'default
!      "`q'"
       :face 'variable-pitch
!      " to quit from this screen.\n"))
!   (when (not fancy-splash-outer-buffer)
!     (fancy-splash-insert
!      ;; Insert links to the most common tasks.
! 
!      ;; Create new file
!      :face '(link variable-pitch)
!      (lambda ()
!        (propertize "Visit New File"
! 		   'keymap fancy-splash-link-keymap
! 		   'link 'find-file
! 		   'help-echo "mouse-2: visit or create a new file"))
!      :face 'default "\n"
! 
!      ;; Visit home directory.
!      :face '(link variable-pitch)
!      (lambda ()
!        (propertize "Visit Home Directory"
! 		   'keymap fancy-splash-link-keymap
! 		   'link (lambda ()
! 			   (interactive)
! 			   (find-file "~/"))
! 		   'help-echo "mouse-2: visit home directory"))
!      :face 'default "\n"
! 
!      ;; Visit scratch buffer.
!      :face '(link variable-pitch)
!      (lambda ()
!        (propertize "Visit *scratch* Buffer"
! 		   'keymap fancy-splash-link-keymap
! 		   'link (lambda ()
! 			   (interactive)
! 			   (switch-to-buffer (get-buffer-create "*scratch*")))
! 		   'help-echo "mouse-2: visit buffer for notes you don't want to save, and for Lisp evaluation"))
!      :face 'default "\n"
! 
!      ;; Customize this screen.
!      :face '(link variable-pitch)
!      (lambda ()
!        (propertize "Customize Startup Screen"
! 		   'keymap fancy-splash-link-keymap
! 		   'link (lambda ()
! 			   (interactive)
! 			   (customize-group 'initialization))
! 		   'help-echo "mouse-2: customize this screen"))
!      :face 'default "\n"
! 
!      ;; Exit this screen.
!      :face '(link variable-pitch)
!      (lambda ()
!        (propertize "Exit This Screen"
! 		   'keymap fancy-splash-link-keymap
! 		   'link (lambda ()
! 			   (interactive)
! 			   (kill-buffer splash-buffer))
! 		   'help-echo "mouse-2: exit this screen"))
!      :face 'default "\n"
! 
!      "\n")))
  
  (defun fancy-splash-tail ()
    "Insert the tail part of the splash screen into the current buffer."
***************
*** 1343,1349 ****
      (throw 'stop-splashing nil))
    (unless fancy-current-text
      (setq fancy-current-text fancy-splash-text))
!   (let ((text (car fancy-current-text)))
      (set-buffer buffer)
      (erase-buffer)
      (if pure-space-overflow
--- 1429,1436 ----
      (throw 'stop-splashing nil))
    (unless fancy-current-text
      (setq fancy-current-text fancy-splash-text))
!   (let ((text (car fancy-current-text))
! 	(inhibit-read-only t))
      (set-buffer buffer)
      (erase-buffer)
      (if pure-space-overflow
***************
*** 1360,1432 ****
      (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."
!   (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))
! 
! (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)
    "Display fancy splash screens when Emacs starts."
!   (if hide-on-input
        (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")
  	  (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)
  		  (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)
--- 1447,1491 ----
      (force-mode-line-update)
      (setq fancy-current-text (cdr fancy-current-text))))
  
! (defun fancy-splash-quit ()
!   "Stop displaying the splash screen buffer."
    (interactive)
!   (if fancy-splash-outer-buffer
!       (throw 'exit nil)
!     (kill-buffer splash-buffer)))
  
+ (defun fancy-splash-link-at-point ()
+   "Go to the link at point."
+   (interactive)
+   (let ((link (get-text-property (point) 'link)))
+     (when link
+       (cond ((stringp link) (browse-url link))
+ 	    ((commandp link) (command-execute link))
+ 	    ((functionp link) (funcall link))))))
+ 
+ (defun fancy-splash-link-at-click (click)
+   "Follow a link where you click."
+   (interactive "e")
+   (mouse-set-point click)
+   (fancy-splash-link-at-point))
  
! (defun fancy-splash-screens (&optional static)
    "Display fancy splash screens when Emacs starts."
!   (if (not static)
        (let ((old-hourglass display-hourglass)
  	    (fancy-splash-outer-buffer (current-buffer))
  	    splash-buffer
  	    (frame (fancy-splash-frame))
  	    timer)
  	(save-selected-window
  	  (select-frame frame)
! 	  (switch-to-buffer " About GNU Emacs")
  	  (make-local-variable 'cursor-type)
  	  (setq splash-buffer (current-buffer))
  	  (catch 'stop-splashing
  	    (unwind-protect
! 		(let ((cursor-type nil))
  		  (setq display-hourglass nil
  			buffer-undo-list t
  			mode-line-format (propertize "---- %b %-"
  						     'face 'mode-line-buffer-id)
***************
*** 1435,1459 ****
  			timer (run-with-timer 0 fancy-splash-delay
  					      #'fancy-splash-screens-1
  					      splash-buffer))
  		  (message "%s" (startup-echo-area-message))
  		  (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.
      (if (or (window-minibuffer-p)
  	    (window-dedicated-p (selected-window)))
  	(pop-to-buffer (current-buffer))
!       (switch-to-buffer "*About GNU Emacs*"))
      (setq buffer-read-only nil)
      (erase-buffer)
      (if pure-space-overflow
--- 1494,1511 ----
  			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)
! 	      (kill-buffer splash-buffer)))))
!     ;; If static is nil, don't hide the buffer on input.
      (if (or (window-minibuffer-p)
  	    (window-dedicated-p (selected-window)))
  	(pop-to-buffer (current-buffer))
!       (switch-to-buffer " GNU Emacs"))
      (setq buffer-read-only nil)
      (erase-buffer)
      (if pure-space-overflow
***************
*** 1469,1478 ****
--- 1521,1532 ----
        (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))
  	  (view-mode-enter nil 'kill-buffer))
+       (setq splash-buffer (current-buffer))
        (goto-char (point-min)))))
  
  (defun fancy-splash-frame ()
***************
*** 1507,1521 ****
  	  (> frame-height (+ image-height 19)))))))
  
  
! (defun normal-splash-screen (&optional hide-on-input)
    "Display splash screen when Emacs starts."
    (let ((prev-buffer (current-buffer)))
      (unwind-protect
! 	(with-current-buffer (get-buffer-create "GNU Emacs")
  	  (setq buffer-read-only nil)
  	  (erase-buffer)
  	  (set (make-local-variable 'tab-width) 8)
! 	  (if hide-on-input
  	      (set (make-local-variable 'mode-line-format)
  		   (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
  
--- 1561,1575 ----
  	  (> frame-height (+ image-height 19)))))))
  
  
! (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 " About GNU Emacs")
  	  (setq buffer-read-only nil)
  	  (erase-buffer)
  	  (set (make-local-variable 'tab-width) 8)
! 	  (if (not static)
  	      (set (make-local-variable 'mode-line-format)
  		   (propertize "---- %b %-" 'face 'mode-line-buffer-id)))
  
***************
*** 1533,1545 ****
                 ", one component of the GNU/Linux operating system.\n"
               ", a part of the GNU operating system.\n"))
  
! 	  (if hide-on-input
  	      (insert (substitute-command-keys
  		       (concat
! 			"\nType \\[recenter] to begin editing"
! 			(if (equal (buffer-name prev-buffer) "*scratch*")
! 			    ".\n"
! 			  " your file.\n")))))
  
            (if (display-mouse-p)
                ;; The user can use the mouse to activate menus
--- 1587,1596 ----
                 ", one component of the GNU/Linux operating system.\n"
               ", a part of the GNU operating system.\n"))
  
! 	  (if (not static)
  	      (insert (substitute-command-keys
  		       (concat
! 			"\nType \\[recenter] to quit from this screen.\n"))))
  
            (if (display-mouse-p)
                ;; The user can use the mouse to activate menus
***************
*** 1655,1664 ****
  	  (if (and view-read-only (not view-mode))
  	      (view-mode-enter nil 'kill-buffer))
            (goto-char (point-min))
!           (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))
--- 1706,1715 ----
  	  (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))
***************
*** 1670,1679 ****
              ;; 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)))))
  
  
  (defun startup-echo-area-message ()
--- 1721,1730 ----
              ;; In case the window is dedicated or something.
              (error (pop-to-buffer (current-buffer))))))
        ;; Unwind ... ensure splash buffer is killed
!       (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,1704 ****
      (message "%s" (startup-echo-area-message))))
  
  
! (defun display-splash-screen (&optional hide-on-input)
    "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)))
  
  
  (defun command-line-1 (command-line-args-left)
    (or noninteractive (input-pending-p) init-file-had-error
--- 1740,1756 ----
      (message "%s" (startup-echo-area-message))))
  
  
! (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)
  
  (defun command-line-1 (command-line-args-left)
    (or noninteractive (input-pending-p) init-file-had-error
***************
*** 1958,1965 ****
--- 2010,2025 ----
             (or (get-buffer-window first-file-buffer)
                 (list-buffers)))))
  
+   (when initial-buffer
+     (cond ((and (equal "*scratch*" initial-buffer)
+ 		(get-buffer "*scratch*"))
+ 	   (switch-to-buffer "*scratch*"))
+ 	  ((file-exists-p initial-buffer)
+ 	   (find-file initial-buffer))))
+ 
    ;; Maybe display a startup screen.
    (unless (or inhibit-startup-message
+ 	      initial-buffer
  	      noninteractive
  	      emacs-quick-startup)
      ;; Display a startup screen, after some preparations.

-- 
Juri Linkov
http://www.jurta.org/emacs/