[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Scratch buffer annoyance
From: |
Juri Linkov |
Subject: |
Re: Scratch buffer annoyance |
Date: |
Wed, 25 Jul 2007 03:12:15 +0300 |
User-agent: |
Gnus/5.11 (Gnus v5.11) Emacs/22.1.50 (gnu/linux) |
> 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/
- Re: Scratch buffer annoyance, (continued)
- Re: Scratch buffer annoyance, Richard Stallman, 2007/07/21
- RE: Scratch buffer annoyance, Drew Adams, 2007/07/22
- Re: Scratch buffer annoyance, Richard Stallman, 2007/07/23
- Re: Scratch buffer annoyance, Juri Linkov, 2007/07/21
- Re: Scratch buffer annoyance, Richard Stallman, 2007/07/23
- Re: Scratch buffer annoyance, Juri Linkov, 2007/07/23
- Re: Scratch buffer annoyance, Richard Stallman, 2007/07/24
- Re: Scratch buffer annoyance,
Juri Linkov <=
- Re: Scratch buffer annoyance, David Kastrup, 2007/07/25
- Re: Scratch buffer annoyance, Juri Linkov, 2007/07/27
- Re: Scratch buffer annoyance, Juri Linkov, 2007/07/27
- Re: Scratch buffer annoyance, Richard Stallman, 2007/07/28
- Re: Scratch buffer annoyance, Juri Linkov, 2007/07/29
- Re: Scratch buffer annoyance, David Kastrup, 2007/07/29
- RE: Scratch buffer annoyance, Drew Adams, 2007/07/29
- Re: Scratch buffer annoyance, Richard Stallman, 2007/07/30
- Re: Scratch buffer annoyance, Miles Bader, 2007/07/31
- Re: Scratch buffer annoyance, Stefan Monnier, 2007/07/31