Re: master f2d2fe6fc8: server-execute: Initialize the *scratch* buffer

[Sean Whitton <spwhitton@spwhitton.name>]

[-- Attachment #1: Type: text/plain, Size: 671 bytes --]

Hello,

On Thu 05 May 2022 at 03:07PM -07, Sean Whitton wrote:

> Hello,
>
> On Wed 04 May 2022 at 12:26PM -04, Stefan Monnier wrote:
>
>>> It looks like Fother_window is called only from Fcall_interactively and
>>> Fkill_buffer, so there probably isn't a bootstrapping issue if I make
>>> those Ffuncall my new `get-initial-buffer-create'.  It looks like
>>> bootstrapping C code just makes an empty *scratch* and leaves it to
>>> startup.el to initialise it.
>>
>> Even better,
>
> Here's my fix.  Haven't quite finished testing each and every call site
> but seemed worth posting it for comments.

Hopefully fixed the commit message in the attached.

-- 
Sean Whitton

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Factor-out-scratch-initialization.patch --]
[-- Type: text/x-patch, Size: 6276 bytes --]

From 9731fa66ff5b6e2ed3287ef033b71c584abadd12 Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Thu, 5 May 2022 13:03:06 -0700
Subject: [PATCH] Factor out *scratch* initialization

* lisp/simple.el: Require subr-x when compiling.
(get-initial-buffer-create): New function, factored out of
scratch-buffer, and additionally clearing the modification flag and
calling substitute-command-keys (bug#55257).
(scratch-buffer):
* lisp/server.el (server-execute):
* lisp/startup.el (normal-no-mouse-startup-screen, command-line-1):
* lisp/window.el (last-buffer):
* src/buffer.c (Fother_buffer, other_buffer_safely): Use it.
* lisp/startup.el (startup--get-buffer-create-scratch): Delete
now-unused function.
---
 lisp/server.el  |  2 +-
 lisp/simple.el  | 22 +++++++++++++++-------
 lisp/startup.el | 12 +++---------
 lisp/window.el  |  5 +----
 src/buffer.c    | 21 ++-------------------
 5 files changed, 22 insertions(+), 40 deletions(-)

diff --git a/lisp/server.el b/lisp/server.el
index 763cf27f7a..042962b8e9 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1367,7 +1367,7 @@ server-execute
 			 ((functionp initial-buffer-choice)
 			  (funcall initial-buffer-choice)))))
 	      (switch-to-buffer
-	       (if (buffer-live-p buf) buf (get-buffer-create "*scratch*"))
+	       (if (buffer-live-p buf) buf (get-initial-buffer-create))
 	       'norecord)))
 
           ;; Delete the client if necessary.
diff --git a/lisp/simple.el b/lisp/simple.el
index 861d9eefde..5a37e246f7 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -28,7 +28,9 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile
+  (require 'cl-lib)
+  (require 'subr-x))
 
 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
@@ -10213,16 +10215,22 @@ capitalize-dwim
 the number of seconds east of Greenwich.")
   )
 
+(defun get-initial-buffer-create ()
+  "Return the \*scratch\* buffer, creating a new one if needed."
+  (if-let ((scratch (get-buffer "*scratch*")))
+      scratch
+    (prog1 (setq scratch (get-buffer-create "*scratch*"))
+      (with-current-buffer scratch
+        (when initial-scratch-message
+          (insert (substitute-command-keys initial-scratch-message))
+          (set-buffer-modified-p nil))
+        (funcall initial-major-mode)))))
+
 (defun scratch-buffer ()
   "Switch to the \*scratch\* buffer.
 If the buffer doesn't exist, create it first."
   (interactive)
-  (if (get-buffer "*scratch*")
-      (pop-to-buffer-same-window "*scratch*")
-    (pop-to-buffer-same-window (get-buffer-create "*scratch*"))
-    (when initial-scratch-message
-      (insert initial-scratch-message))
-    (funcall initial-major-mode)))
+  (pop-to-buffer-same-window (get-initial-buffer-create)))
 
 \f
 
diff --git a/lisp/startup.el b/lisp/startup.el
index c7cf86a01e..3fa25ddee9 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -2355,7 +2355,7 @@ normal-no-mouse-startup-screen
   (insert "\t\t")
   (insert-button "Open *scratch* buffer"
 		 'action (lambda (_button) (switch-to-buffer
-                                       (startup--get-buffer-create-scratch)))
+                                       (get-initial-buffer-create)))
 		 'follow-link t)
   (insert "\n")
   (save-restriction
@@ -2487,12 +2487,6 @@ display-about-screen
 (defalias 'about-emacs 'display-about-screen)
 (defalias 'display-splash-screen 'display-startup-screen)
 
-(defun startup--get-buffer-create-scratch ()
-  (or (get-buffer "*scratch*")
-      (with-current-buffer (get-buffer-create "*scratch*")
-        (set-buffer-major-mode (current-buffer))
-        (current-buffer))))
-
 ;; This avoids byte-compiler warning in the unexec build.
 (declare-function pdumper-stats "pdumper.c" ())
 
@@ -2784,7 +2778,7 @@ command-line-1
     (when (eq initial-buffer-choice t)
       ;; When `initial-buffer-choice' equals t make sure that *scratch*
       ;; exists.
-      (startup--get-buffer-create-scratch))
+      (get-initial-buffer-create))
 
     ;; If *scratch* exists and is empty, insert initial-scratch-message.
     ;; Do this before switching to *scratch* below to handle bug#9605.
@@ -2808,7 +2802,7 @@ command-line-1
 		   ((functionp initial-buffer-choice)
 		    (funcall initial-buffer-choice))
                    ((eq initial-buffer-choice t)
-                    (startup--get-buffer-create-scratch))
+                    (get-initial-buffer-create))
                    (t
                     (error "`initial-buffer-choice' must be a string, a function, or t")))))
         (unless (buffer-live-p buf)
diff --git a/lisp/window.el b/lisp/window.el
index 9f78784612..4ec329e0cf 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -4886,10 +4886,7 @@ last-buffer
   (setq frame (or frame (selected-frame)))
   (or (get-next-valid-buffer (nreverse (buffer-list frame))
  			     buffer visible-ok frame)
-      (get-buffer "*scratch*")
-      (let ((scratch (get-buffer-create "*scratch*")))
-	(set-buffer-major-mode scratch)
-	scratch)))
+      (get-initial-buffer-create)))
 
 (defcustom frame-auto-hide-function #'iconify-frame
   "Function called to automatically hide frames.
diff --git a/src/buffer.c b/src/buffer.c
index f8a7a4f510..702b21f9fc 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1634,16 +1634,7 @@ DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0,
   if (!NILP (notsogood))
     return notsogood;
   else
-    {
-      AUTO_STRING (scratch, "*scratch*");
-      buf = Fget_buffer (scratch);
-      if (NILP (buf))
-	{
-	  buf = Fget_buffer_create (scratch, Qnil);
-	  Fset_buffer_major_mode (buf);
-	}
-      return buf;
-    }
+    return call0 (intern ("get-initial-buffer-create"));
 }
 
 /* The following function is a safe variant of Fother_buffer: It doesn't
@@ -1659,15 +1650,7 @@ other_buffer_safely (Lisp_Object buffer)
     if (candidate_buffer (buf, buffer))
       return buf;
 
-  AUTO_STRING (scratch, "*scratch*");
-  buf = Fget_buffer (scratch);
-  if (NILP (buf))
-    {
-      buf = Fget_buffer_create (scratch, Qnil);
-      Fset_buffer_major_mode (buf);
-    }
-
-  return buf;
+  return call0 (intern ("get-initial-buffer-create"));
 }
 \f
 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
-- 
2.30.2