Re: Scratch buffer annoyance

[Juri Linkov]

>       >> [Visit home directory]
>       >> [Open new file]
>       >> [Open buffer for notes you don't want to save]
>       >> [Emacs Tutorial]
>       >> [Emacs FAQ]
>       >> [Read the Emacs Manual]
>
>       > I like that!
>
>     I would like this as well...
>
> Would someone please try implementing this?  They we can see
> what it is like.

Below is an implementation that add links for the most common tasks to the
splash screen.  This requires some related modifications: the startup
screen should be static because when the user want to clink on a link, it
shouldn't disappear just before clicking on it when it happens to be at
the same time as to show the next splash screen.  This would be annoying.
Such flashing screens are more appropriate for the About screen called
from the Help menu (later more visual effects could be added to the About
screen such as a scrolling list of Emacs authors, etc.)

Another necessary change is to allow point movements commands in the
startup splash screen to be able to move point to the link and type RET to
activate it.  Currently, any key causes the splash screen to exit, and this
key is applied to the underlying buffer.  This is very dangerous because
settings in .emacs, site-start.el or the command line could create such
a configuration that typing a key on a buffer under the splash buffer
(so the user can't see this buffer at the moment of typing because the splash
screen covers it), after typing a key on the splash screen this key gets
delegated to the underlying buffer and may cause harm in it.

OTOH, the About screen goes to another extreme, and doesn't provide a key
to exit the About screen at all.

The following patch adds a keymap common to the startup splash screen and
the About screen with keys `q' and SPC to quit from them.  It also
reverses the logic of the argument `hide-on-input' and renames it to
`static'.  As a result, the startup screen is static and contains links
to the most common tasks, and the About screen switches repeatedly between
two splash screens.  `q' and SPC quit both screens.

This patch doesn't contain more necessary changes because including them
in one patch would create a mess.  A separate patch later will add more
links to the startup screen and to normal-splash-screen, revert changes to
save *scratch* buffer, and add a new option `visit-on-startup'.

Index: lisp/startup.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/startup.el,v
retrieving revision 1.440
diff -c -r1.440 startup.el
*** lisp/startup.el     3 Jul 2007 02:54:42 -0000       1.440
--- lisp/startup.el     21 Jul 2007 18:02:14 -0000
***************
*** 1168,1174 ****
         :face variable-pitch
         ".
  
! Emacs Guided Tour\t\tSee http://www.gnu.org/software/emacs/tour/
  
  "
         :face (variable-pitch :weight bold)
--- 1168,1182 ----
         :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.
--- 1224,1253 ----
                 (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."
--- 1322,1383 ----
       :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 "Create New File"
!                  'keymap fancy-splash-link-keymap
!                  'link 'find-file
!                  'help-echo "mouse-2: create new file"))
!      :face 'default "\t\t"
       :face 'variable-pitch
!      "Visit new file.\n"
! 
!      ;; Visit home directory.
!      :face '(link variable-pitch)
!      (lambda ()
!        (propertize "Visit Home Directory"
!                  'keymap fancy-splash-link-keymap
!                  'link (lambda ()
!                          (interactive)
!                          (dired "~"))
!                  'help-echo "mouse-2: visit home directory"))
!      :face 'default "\t"
!      :face 'variable-pitch
!      "Visit home directory.\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 scratch buffer"))
!      :face 'default "\t"
!      :face 'variable-pitch
!      "Visit buffer for notes you don't want to save, and for Lisp 
evaluation.\n"
! 
!      ;; Customize this screen.
!      :face '(link variable-pitch)
!      (lambda ()
!        (propertize "Customize Startup Screen"
!                  'keymap fancy-splash-link-keymap
!                  'link (lambda ()
!                          (interactive)
!                          (customize-variable 'inhibit-splash-screen))
!                  'help-echo "mouse-2: customize this screen"))
!      :face 'default "\t"
!      :face 'variable-pitch
!      "Use customization to disable this splash screen.\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
--- 1417,1424 ----
      (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)
--- 1435,1479 ----
      (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
--- 1482,1499 ----
                        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 ****
--- 1509,1520 ----
        (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)))
  
--- 1549,1563 ----
          (> 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
--- 1575,1584 ----
                 ", 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
***************
*** 1657,1666 ****
          (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))
--- 1696,1705 ----
          (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))
***************
*** 1672,1681 ****
              ;; 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 ()
--- 1711,1720 ----
              ;; 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 ()
***************
*** 1691,1706 ****
      (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
--- 1730,1746 ----
      (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

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