From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.devel Subject: Re: Scratch buffer annoyance Date: Wed, 25 Jul 2007 03:12:15 +0300 Organization: JURTA Message-ID: <87sl7d9w9s.fsf@jurta.org> References: <871wf5cv6y.fsf@jurta.org> <7dbe73ed0707190725l426d0731u5f9c36cd14278f78@mail.gmail.com> <87k5st7iqt.fsf@jurta.org> <87sl7ebwtk.fsf@jurta.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1185322566 13178 80.91.229.12 (25 Jul 2007 00:16:06 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Wed, 25 Jul 2007 00:16:06 +0000 (UTC) Cc: emacs-devel@gnu.org To: rms@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Jul 25 02:16:04 2007 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1IDUXn-00054P-HR for ged-emacs-devel@m.gmane.org; Wed, 25 Jul 2007 02:16:00 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1IDUXm-0003JA-Ah for ged-emacs-devel@m.gmane.org; Tue, 24 Jul 2007 20:15:58 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1IDUXi-0003J5-R3 for emacs-devel@gnu.org; Tue, 24 Jul 2007 20:15:54 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1IDUXh-0003It-3h for emacs-devel@gnu.org; Tue, 24 Jul 2007 20:15:53 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1IDUXg-0003Iq-Tq for emacs-devel@gnu.org; Tue, 24 Jul 2007 20:15:52 -0400 Original-Received: from relay02.kiev.sovam.com ([62.64.120.197]) by monty-python.gnu.org with esmtps (TLS-1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1IDUXd-0000Lv-Tf; Tue, 24 Jul 2007 20:15:50 -0400 Original-Received: from [83.170.232.243] (helo=smtp.svitonline.com) by relay02.kiev.sovam.com with esmtp (Exim 4.67) (envelope-from ) id 1IDUXX-000KqL-V7; Wed, 25 Jul 2007 03:15:46 +0300 In-Reply-To: (Richard Stallman's message of "Tue\, 24 Jul 2007 12\:45\:58 -0400") User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/22.1.50 (gnu/linux) X-Scanner-Signature: 3396fa6536e0db8d6226b6585dab02e8 X-DrWeb-checked: yes X-SpamTest-Envelope-From: juri@jurta.org X-SpamTest-Group-ID: 00000000 X-SpamTest-Header: Not Detected X-SpamTest-Info: Profiles 1281 [July 24 2007] X-SpamTest-Info: helo_type=3 X-SpamTest-Method: none X-SpamTest-Rate: 0 X-SpamTest-Status: Not detected X-SpamTest-Status-Extended: not_detected X-SpamTest-Version: SMTP-Filter Version 3.0.0 [0255], KAS30/Release X-detected-kernel: FreeBSD 4.8-5.1 (or MacOS X 10.2-10.3) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:75501 Archived-At: > 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/