Factor out *scratch* initialization

* lisp/simple.el (get-scratch-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, window-normalize-buffer-to-switch-to):
* src/buffer.c (Fother_buffer, other_buffer_safely): Use it.
(syms_of_buffer): Add Qget_scratch_buffer_create.
* lisp/startup.el (startup--get-buffer-create-scratch): Delete
now-unused function.
* doc/lispref/os.texi (Summary: Sequence of Actions at Startup):
* NEWS (Incompatible changes in Emacs 29.1): Document the change.

doc/lispref/os.texi

@@ -329,10 +329,10 @@ file will not inhibit the message for someone else.
 @end defopt
 
 @defopt initial-scratch-message
-This variable, if non-@code{nil}, should be a string, which is
-treated as documentation to be
-inserted into the @file{*scratch*} buffer when Emacs starts up.  If it
-is @code{nil}, the @file{*scratch*} buffer is empty.
+This variable, if non-@code{nil}, should be a string, which is treated
+as documentation to be inserted into the @file{*scratch*} buffer when
+Emacs starts up or when that buffer is recreated.  If it is
+@code{nil}, the @file{*scratch*} buffer is empty.
 @end defopt
 
 @noindent

etc/NEWS

@@ -245,6 +245,14 @@ encouraged to test timestamp-related code with this variable set to
 nil, as it will default to nil in a future Emacs version and will be
 removed some time after that.
 
++++
+** Functions which recreate the *scratch* buffer now also initialize it.
+When functions like 'other-buffer' and 'server-execute' recreate
+*scratch*, they now also insert 'initial-scratch-message' and set
+the major mode according to 'initial-major-mode', like at Emacs
+startup.  Previously, these functions ignored
+'initial-scratch-message' and left *scratch* in 'fundamental-mode'.
+
 
 * Changes in Emacs 29.1
 

lisp/server.el

@@ -1367,7 +1367,7 @@ The following commands are accepted by the client:
 			 ((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-scratch-buffer-create))
 	       'norecord)))
 
           ;; Delete the client if necessary.

lisp/simple.el

@@ -10213,16 +10213,24 @@ This is an integer indicating the UTC offset in seconds, i.e.,
 the number of seconds east of Greenwich.")
   )
 
+(defun get-scratch-buffer-create ()
+  "Return the \*scratch\* buffer, creating a new one if needed."
+  (or (get-buffer "*scratch*")
+      (let ((scratch (get-buffer-create "*scratch*")))
+        ;; Don't touch the buffer contents or mode unless we know that
+        ;; we just created it.
+        (with-current-buffer scratch
+          (when initial-scratch-message
+            (insert (substitute-command-keys initial-scratch-message))
+            (set-buffer-modified-p nil))
+          (funcall initial-major-mode))
+        scratch)))
+
 (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-scratch-buffer-create)))
 
 
 

lisp/startup.el

@@ -2358,7 +2358,7 @@ If you have no Meta key, you may instead type ESC followed by the character.)"))
   (insert "\t\t")
   (insert-button "Open *scratch* buffer"
 		 'action (lambda (_button) (switch-to-buffer
-                                       (startup--get-buffer-create-scratch)))
+                                       (get-scratch-buffer-create)))
 		 'follow-link t)
   (insert "\n")
   (save-restriction
@@ -2490,12 +2490,6 @@ A fancy display is used on graphic displays, normal otherwise."
 (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" ())
 
@@ -2787,7 +2781,7 @@ nil default-directory" name)
     (when (eq initial-buffer-choice t)
       ;; When `initial-buffer-choice' equals t make sure that *scratch*
       ;; exists.
-      (startup--get-buffer-create-scratch))
+      (get-scratch-buffer-create))
 
     ;; If *scratch* exists and is empty, insert initial-scratch-message.
     ;; Do this before switching to *scratch* below to handle bug#9605.
@@ -2811,7 +2805,7 @@ nil default-directory" name)
 		   ((functionp initial-buffer-choice)
 		    (funcall initial-buffer-choice))
                    ((eq initial-buffer-choice t)
-                    (startup--get-buffer-create-scratch))
+                    (get-scratch-buffer-create))
                    (t
                     (error "`initial-buffer-choice' must be a string, a function, or t")))))
         (unless (buffer-live-p buf)

lisp/window.el

@@ -4886,10 +4886,7 @@ the buffer `*scratch*', creating it if necessary."
   (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-scratch-buffer-create)))
 
 (defcustom frame-auto-hide-function #'iconify-frame
   "Function called to automatically hide frames.
@@ -8621,12 +8618,13 @@ If BUFFER-OR-NAME is nil, return the buffer returned by
 `other-buffer'.  Else, if a buffer specified by BUFFER-OR-NAME
 exists, return that buffer.  If no such buffer exists, create a
 buffer with the name BUFFER-OR-NAME and return that buffer."
-  (if buffer-or-name
-      (or (get-buffer buffer-or-name)
-	  (let ((buffer (get-buffer-create buffer-or-name)))
-	    (set-buffer-major-mode buffer)
-	    buffer))
-    (other-buffer)))
+  (pcase buffer-or-name
+    ('nil (other-buffer))
+    ("*scratch*" (get-scratch-buffer-create))
+    (_ (or (get-buffer buffer-or-name)
+	   (let ((buffer (get-buffer-create buffer-or-name)))
+	     (set-buffer-major-mode buffer)
+	     buffer)))))
 
 (defcustom switch-to-buffer-preserve-window-point t
   "If non-nil, `switch-to-buffer' tries to preserve `window-point'.

src/buffer.c

@@ -1665,16 +1665,7 @@ exists, return the buffer `*scratch*' (creating it if necessary).  */)
   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 safe_call (1, Qget_scratch_buffer_create);
 }
 
 /* The following function is a safe variant of Fother_buffer: It doesn't
@@ -1690,15 +1681,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 safe_call (1, Qget_scratch_buffer_create);
 }
 
 DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, Sbuffer_enable_undo,
@@ -5583,6 +5566,7 @@ syms_of_buffer (void)
   DEFSYM (Qbefore_change_functions, "before-change-functions");
   DEFSYM (Qafter_change_functions, "after-change-functions");
   DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions");
+  DEFSYM (Qget_scratch_buffer_create, "get-scratch-buffer-create");
 
   DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar");
   Fput (Qvertical_scroll_bar, Qchoice, list4 (Qnil, Qt, Qleft, Qright));