Re: Scratch buffer annoyance

[Juri Linkov]

Is it OK to install the patch I submitted three days ago?

>> 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/