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: Sat, 28 Jul 2007 00:16:34 +0300 Organization: JURTA Message-ID: <874pjp5xl5.fsf@jurta.org> References: <871wf5cv6y.fsf@jurta.org> <7dbe73ed0707190725l426d0731u5f9c36cd14278f78@mail.gmail.com> <87k5st7iqt.fsf@jurta.org> <87sl7ebwtk.fsf@jurta.org> <87sl7d9w9s.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 1185573566 8735 80.91.229.12 (27 Jul 2007 21:59:26 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Fri, 27 Jul 2007 21:59:26 +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 Fri Jul 27 23:59:19 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 1IEXq8-00055D-Q2 for ged-emacs-devel@m.gmane.org; Fri, 27 Jul 2007 23:59:17 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1IEXq8-0006h6-4a for ged-emacs-devel@m.gmane.org; Fri, 27 Jul 2007 17:59:16 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1IEXoy-0001gG-9q for emacs-devel@gnu.org; Fri, 27 Jul 2007 17:58:04 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1IEXou-0001QM-Re for emacs-devel@gnu.org; Fri, 27 Jul 2007 17:58:03 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1IEXou-0001Pt-OC for emacs-devel@gnu.org; Fri, 27 Jul 2007 17:58:00 -0400 Original-Received: from relay01.kiev.sovam.com ([62.64.120.200]) by monty-python.gnu.org with esmtps (TLS-1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1IEXop-0006vz-Ls; Fri, 27 Jul 2007 17:57:56 -0400 Original-Received: from [83.170.232.243] (helo=smtp.svitonline.com) by relay01.kiev.sovam.com with esmtp (Exim 4.67) (envelope-from ) id 1IEXol-000Mrv-WC; Sat, 28 Jul 2007 00:57:52 +0300 In-Reply-To: <87sl7d9w9s.fsf@jurta.org> (Juri Linkov's message of "Wed\, 25 Jul 2007 03\:12\:15 +0300") User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/22.1.50 (gnu/linux) X-Scanner-Signature: 87106b1a3aa0995ed8156c103cdd76ce 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 1293 [July 27 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:75726 Archived-At: 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/