bug#34765: 26.1; with-temp-buffer should not run buffer-list-update-hook

[martin rudalics <rudalics@gmx.at>]

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

>>   > How 'bout adding an optional argument to `generate-new-buffer` to set
>>   > `inhibit_buffer_hooks`?
>>
>> How about moving 'generate-new-buffer' to C to set that flag without
>> exposing it to Lisp (and to avoid things like
>>
>>               ;; We can't use `generate-new-buffer' because files.el
>>               ;; is not yet loaded.
>>
>> in 'load-with-code-conversion')?
>
> Fine with me.

I attach a preliminary patch.

martin



[-- Attachment #2: inhibit-buffer-hooks.diff --]
[-- Type: text/plain, Size: 11521 bytes --]

diff --git a/lisp/files.el b/lisp/files.el
index c05d70a00e..d919793251 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1777,6 +1777,9 @@ kill-buffer-hook
 The buffer being killed is current while the hook is running.
 See `kill-buffer'.
 
+This hook is not run for buffers created by 'generate-new-buffer'
+with the second argument 'inhibit-buffer-hooks' non-nil.
+
 Note: Be careful with let-binding this hook considering it is
 frequently used for cleanup.")
 
@@ -1880,11 +1883,6 @@ create-file-buffer
 			     (concat "|" lastname)
 			   lastname))))
 
-(defun generate-new-buffer (name)
-  "Create and return a buffer with a name based on NAME.
-Choose the buffer's name using `generate-new-buffer-name'."
-  (get-buffer-create (generate-new-buffer-name name)))
-
 (defcustom automount-dir-prefix (purecopy "^/tmp_mnt/")
   "Regexp to match the automounter prefix in a directory name."
   :group 'files
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index ba30fee496..d168ee9a16 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -306,10 +306,7 @@ load-with-code-conversion
       (and (null noerror)
 	   (signal 'file-error (list "Cannot open load file" file)))
     ;; Read file with code conversion, and then eval.
-    (let* ((buffer
-            ;; We can't use `generate-new-buffer' because files.el
-            ;; is not yet loaded.
-            (get-buffer-create (generate-new-buffer-name " *load*")))
+    (let* ((buffer (generate-new-buffer " *load*"))
 	   (load-in-progress t)
 	   (source (save-match-data (string-match "\\.el\\'" fullname))))
       (unless nomessage
diff --git a/lisp/subr.el b/lisp/subr.el
index f68f9dd419..5f2c43c78b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3530,8 +3530,7 @@ with-temp-file
   (let ((temp-file (make-symbol "temp-file"))
 	(temp-buffer (make-symbol "temp-buffer")))
     `(let ((,temp-file ,file)
-	   (,temp-buffer
-	    (get-buffer-create (generate-new-buffer-name " *temp file*"))))
+	   (,temp-buffer (generate-new-buffer " *temp file*" t)))
        (unwind-protect
 	   (prog1
 	       (with-current-buffer ,temp-buffer
@@ -3569,7 +3568,7 @@ with-temp-buffer
 See also `with-temp-file' and `with-output-to-string'."
   (declare (indent 0) (debug t))
   (let ((temp-buffer (make-symbol "temp-buffer")))
-    `(let ((,temp-buffer (generate-new-buffer " *temp*")))
+    `(let ((,temp-buffer (generate-new-buffer " *temp*" t)))
        ;; FIXME: kill-buffer can change current-buffer in some odd cases.
        (with-current-buffer ,temp-buffer
          (unwind-protect
@@ -3604,8 +3603,7 @@ with-silent-modifications
 (defmacro with-output-to-string (&rest body)
   "Execute BODY, return the text it sent to `standard-output', as a string."
   (declare (indent 0) (debug t))
-  `(let ((standard-output
-	  (get-buffer-create (generate-new-buffer-name " *string-output*"))))
+  `(let ((standard-output (generate-new-buffer " *string-output*" t)))
      (unwind-protect
 	 (progn
 	   (let ((standard-output standard-output))
diff --git a/src/buffer.c b/src/buffer.c
index ab47748191..3e135148fb 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -500,19 +500,43 @@ get_truename_buffer (register Lisp_Object filename)
   return Qnil;
 }
 
-DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
-       doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
-If BUFFER-OR-NAME is a string and a live buffer with that name exists,
-return that buffer.  If no such buffer exists, create a new buffer with
-that name and return it.  If BUFFER-OR-NAME starts with a space, the new
-buffer does not keep undo information.
 
-If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
-even if it is dead.  The return value is never nil.  */)
-  (register Lisp_Object buffer_or_name)
+/**
+ * run_buffer_list_update_hook:
+ *
+ * Run any functions on 'buffer-list-update-hook'.  Do not run the
+ * functions when BUFFER is a buffer and its inhibit_buffer_hooks
+ * structure element is set.  Do not run any functions either when we
+ * are not allowed to run hooks.
+ */
+static void
+run_buffer_list_update_hook (Lisp_Object buffer)
 {
-  register Lisp_Object buffer, name;
-  register struct buffer *b;
+  if (!NILP (Vrun_hooks)
+      && (!BUFFERP (buffer) || !XBUFFER (buffer)->inhibit_buffer_hooks))
+    {
+      ptrdiff_t count = SPECPDL_INDEX ();
+
+      record_unwind_current_buffer ();
+      call1 (Vrun_hooks, Qbuffer_list_update_hook);
+      unbind_to (count, Qnil);
+    }
+}
+
+/**
+ * get_buffer_create:
+ *
+ * Return buffer specified by BUFFER-OR-NAME, creating a new one if
+ * needed.  See Fget_buffer_create below for more information.
+ *
+ * Second argument INHIBIT_BUFFER_HOOKS true means to not run
+ * 'buffer-list-update-hook'.
+ */
+static Lisp_Object
+get_buffer_create (Lisp_Object buffer_or_name, bool inhibit_buffer_hooks)
+{
+  Lisp_Object buffer, name;
+  struct buffer *b;
 
   buffer = Fget_buffer (buffer_or_name);
   if (!NILP (buffer))
@@ -600,14 +624,29 @@ even if it is dead.  The return value is never nil.  */)
   /* Put this in the alist of all live buffers.  */
   XSETBUFFER (buffer, b);
   Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer)));
-  /* And run buffer-list-update-hook.  */
-  if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks)
-    call1 (Vrun_hooks, Qbuffer_list_update_hook);
+  if (!inhibit_buffer_hooks)
+    /* Run buffer-list-update-hook.  */
+    run_buffer_list_update_hook (buffer);
 
   return buffer;
 }
 
 
+DEFUN ("get-buffer-create", Fget_buffer_create, Sget_buffer_create, 1, 1, 0,
+       doc: /* Return the buffer specified by BUFFER-OR-NAME, creating a new one if needed.
+If BUFFER-OR-NAME is a string and a live buffer with that name exists,
+return that buffer.  If no such buffer exists, create a new buffer with
+that name and return it.  If BUFFER-OR-NAME starts with a space, the new
+buffer does not keep undo information.
+
+If BUFFER-OR-NAME is a buffer instead of a string, return it as given,
+even if it is dead.  The return value is never nil.  */)
+     (Lisp_Object buffer_or_name)
+{
+  return get_buffer_create (buffer_or_name, false);
+}
+
+
 /* Return a list of overlays which is a copy of the overlay list
    LIST, but for buffer B.  */
 
@@ -871,8 +910,7 @@ CLONE nil means the indirect buffer's state is reset to default values.  */)
     }
 
   /* Run buffer-list-update-hook.  */
-  if (!NILP (Vrun_hooks))
-    call1 (Vrun_hooks, Qbuffer_list_update_hook);
+  run_buffer_list_update_hook (Qnil);
 
   return buf;
 }
@@ -1135,6 +1173,31 @@ is first appended to NAME, to speed up finding a non-existent buffer.  */)
     }
 }
 
+DEFUN ("generate-new-buffer", Fgenerate_new_buffer, Sgenerate_new_buffer,
+       1, 2, 0,
+       doc: /* Create and return a buffer with a name based on NAME.
+Choose the buffer's name using `generate-new-buffer-name'.
+
+Optional second argument INHIBIT-BUFFER-HOOKS non-nil means to not run
+any buffer hooks ('kill-buffer-hook', 'buffer-list-update-hook' or
+'kill-buffer-query-functions') for this buffer.  This argument should
+be set only for internal buffers that are never presented to users or
+passed on to other applications.  */)
+  (Lisp_Object name, Lisp_Object inhibit_buffer_hooks)
+{
+  Lisp_Object buffer_name = Fgenerate_new_buffer_name (name, Qnil);
+  Lisp_Object buffer = get_buffer_create (buffer_name,
+					  !NILP (inhibit_buffer_hooks));
+
+  if (!NILP (inhibit_buffer_hooks))
+    {
+     struct buffer *b = XBUFFER (buffer);
+
+     b->inhibit_buffer_hooks = true;
+    }
+
+  return buffer;
+}
 \f
 DEFUN ("buffer-name", Fbuffer_name, Sbuffer_name, 0, 1, 0,
        doc: /* Return the name of BUFFER, as a string.
@@ -1499,8 +1562,7 @@ This does not change the name of the visited file (if any).  */)
     call0 (intern ("rename-auto-save-file"));
 
   /* Run buffer-list-update-hook.  */
-  if (!NILP (Vrun_hooks) && !current_buffer->inhibit_buffer_hooks)
-    call1 (Vrun_hooks, Qbuffer_list_update_hook);
+  run_buffer_list_update_hook (buf);
 
   /* Refetch since that last call may have done GC.  */
   return BVAR (current_buffer, name);
@@ -1677,6 +1739,10 @@ buffer is actually killed.  The buffer being killed will be current
 while the hook is running.  Functions called by any of these hooks are
 supposed to not change the current buffer.
 
+Neither 'kill-buffer-query-functions' nor 'kill-buffer-hook' are run
+for buffers created by 'generate-new-buffer' with the second argument
+'inhibit-buffer-hooks' non-nil.
+
 Any processes that have this buffer as the `process-buffer' are killed
 with SIGHUP.  This function calls `replace-buffer-in-windows' for
 cleaning up all windows currently displaying the buffer to be killed. */)
@@ -1938,8 +2004,7 @@ cleaning up all windows currently displaying the buffer to be killed. */)
   bset_undo_list (b, Qnil);
 
   /* Run buffer-list-update-hook.  */
-  if (!NILP (Vrun_hooks) && !b->inhibit_buffer_hooks)
-    call1 (Vrun_hooks, Qbuffer_list_update_hook);
+  run_buffer_list_update_hook (buffer);
 
   return Qt;
 }
@@ -1980,8 +2045,7 @@ record_buffer (Lisp_Object buffer)
   fset_buried_buffer_list (f, Fdelq (buffer, f->buried_buffer_list));
 
   /* Run buffer-list-update-hook.  */
-  if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks)
-    call1 (Vrun_hooks, Qbuffer_list_update_hook);
+  run_buffer_list_update_hook (buffer);
 }
 
 
@@ -2019,8 +2083,7 @@ DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal,
     (f, Fcons (buffer, Fdelq (buffer, f->buried_buffer_list)));
 
   /* Run buffer-list-update-hook.  */
-  if (!NILP (Vrun_hooks) && !XBUFFER (buffer)->inhibit_buffer_hooks)
-    call1 (Vrun_hooks, Qbuffer_list_update_hook);
+  run_buffer_list_update_hook (buffer);
 
   return Qnil;
 }
@@ -6255,7 +6318,10 @@ Use Custom to set this variable and update the display.  */);
 The buffer being killed will be current while the functions are running.
 
 If any of them returns nil, the buffer is not killed.  Functions run by
-this hook are supposed to not change the current buffer.  */);
+this hook are supposed to not change the current buffer.
+
+This hook is not run for buffers created by 'generate-new-buffer' with
+the second argument 'inhibit-buffer-hooks' non-nil.  */);
   Vkill_buffer_query_functions = Qnil;
 
   DEFVAR_LISP ("change-major-mode-hook", Vchange_major_mode_hook,
@@ -6268,9 +6334,9 @@ The function `kill-all-local-variables' runs this before doing anything else.  *
 	       doc: /* Hook run when the buffer list changes.
 Functions (implicitly) running this hook are `get-buffer-create',
 `make-indirect-buffer', `rename-buffer', `kill-buffer', `bury-buffer'
-and `select-window'.  Functions run by this hook should avoid calling
-`select-window' with a nil NORECORD argument or `with-temp-buffer'
-since either may lead to infinite recursion.  */);
+and `select-window'.  This hook is not run for buffers created by
+'generate-new-buffer' with the second argument 'inhibit-buffer-hooks'
+non-nil.  */);
   Vbuffer_list_update_hook = Qnil;
   DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook");
 
@@ -6281,6 +6347,7 @@ since either may lead to infinite recursion.  */);
   defsubr (&Sget_buffer_create);
   defsubr (&Smake_indirect_buffer);
   defsubr (&Sgenerate_new_buffer_name);
+  defsubr (&Sgenerate_new_buffer);
   defsubr (&Sbuffer_name);
   defsubr (&Sbuffer_file_name);
   defsubr (&Sbuffer_base_buffer);