Subject: bug#76969: kill-buffer fails silently when a thread exists where it's current

From: Dmitry Gutov <[email-masked]>
Date: Thu, 24 Jul 2025 04:32:05 +0300

On 23/07/2025 14:36, Eli Zaretskii wrote:
>> Date: Wed, 23 Jul 2025 04:39:33 +0300
>> Cc: [email-masked], [email-masked]
>> From: Dmitry Gutov <[email-masked]>
>>
>> On 22/07/2025 15:54, Eli Zaretskii wrote:
>>>> So if we make it an optional argument of 'make-thread', and the default
>>>> is for thread's buffer to be killable, that might call for a name change
>>>> (flipping the meaning).
>>>>
>>>> Should it be
>>>>
>>>>      (make-thread FUNCTION &optional NAME BUFFER-PROTECTED)
>>>>
>>>> ?
>>> I'd prefer to call that argument BUFFER-DISPOSITION.
>>
>> I had to google it just now. A term from POSIX signals?
> 
> Or from email messages.

In the context of emails the meaning seems different (more like how the 
content is displayed).

Although it just occurred to me that the word is derived from the root 
"dispose".

>> Makes certain sense.
>>
>> Seems like the default value would have to be nil, though, if it's
>> passed as an optional argument to a function.
> 
> Yes.  But given that this isn't a simple boolean, what it means when
> disposition = nil is open to interpretation, and the doc string should
> say clearly what that means.

Sure.

>> Are we okay with nil meaning "thread's buffer is killed and sent a
>> signal", t meaning "thread's buffer is never killed" and 'silently'
>> meaning "thread's buffer is killed without a signal"?
> 
> Maybe.  I'm not sure there's a definite agreement about the default.

Here's a patch that implements the new default.

I think there are no places in the manual where exceptions to killing a 
buffer are exhaustively described, so I just updated the description for 
'make-thread'. LMK if something was missed.

diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi
index 3d9ebf08073..31713bcab10 100644
--- a/doc/lispref/threads.texi
+++ b/doc/lispref/threads.texi
@@ -55,7 +55,7 @@ Basic Thread Functions
 directly, but the current thread can be exited implicitly, and other
 threads can be signaled.
 
-@defun make-thread function &optional name
+@defun make-thread function &optional name buffer-disposition
 Create a new thread of execution which invokes @var{function}.  When
 @var{function} returns, the thread exits.
 
@@ -66,6 +66,13 @@ Basic Thread Functions
 used for debugging and informational purposes only; it has no meaning
 to Emacs.  If @var{name} is provided, it must be a string.
 
+@var{buffer-disposition} indicates what happens if the thread's current
+buffer is about to be killed.  If the value is @code{t}, it's not
+allowed.  Any other value, including nil (which is the default), means
+that the buffer is killed and the thread is assigned another current
+buffer, and it's signaled the error @code{thread-buffer-killed}.  But if
+the value is the symbol @code{silently}, the error is not signaled.
+
 This function returns the new thread.
 @end defun
 
diff --git a/src/buffer.c b/src/buffer.c
index a465153279d..e44b6daf587 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -2050,6 +2050,13 @@ DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
 	return Qnil;
     }
 
+  /* Check all threads again, in case a hook changed something.  */
+  if (thread_check_current_buffer (b))
+    return Qnil;
+
+  /* Clean up references to the buffer in threads.  */
+  thread_all_before_buffer_killed (buffer);
+
   /* If the buffer now current is shown in the minibuffer and our buffer
      is the sole other buffer give up.  */
   XSETBUFFER (tem, current_buffer);
diff --git a/src/thread.c b/src/thread.c
index 8fd713d0c81..ce1ecf22ca9 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -882,11 +882,18 @@ finalize_one_thread (struct thread_state *state)
   free_bc_thread (&state->bc);
 }
 
-DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 2, 0,
+DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 3, 0,
        doc: /* Start a new thread and run FUNCTION in it.
 When the function exits, the thread dies.
-If NAME is given, it must be a string; it names the new thread.  */)
-  (Lisp_Object function, Lisp_Object name)
+If NAME is given, it must be a string; it names the new thread.
+
+BUFFER-DISPOSITION determines how attached the thread is to its current
+buffer.  If the value is t, that buffer can't be killed.  Any other
+value, including nil (the default), means that if its buffer is killed,
+the thread is switched to another buffer and receives an error signal
+`thread-buffer-killed'.  But if the value is symbol `silently', no error
+will be signaled.  */)
+  (Lisp_Object function, Lisp_Object name, Lisp_Object buffer_disposition)
 {
   /* Can't start a thread in temacs.  */
   if (!initialized)
@@ -934,6 +941,8 @@ DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 2, 0,
 #endif
     }
 
+  new_thread->buffer_disposition = buffer_disposition;
+
   /* FIXME: race here where new thread might not be filled in?  */
   Lisp_Object result;
   XSETTHREAD (result, new_thread);
@@ -972,6 +981,15 @@ thread_signal_callback (void *arg)
   post_acquire_global_lock (self);
 }
 
+static void
+thread_set_error (struct thread_state *tstate, Lisp_Object error_symbol, Lisp_Object data)
+{
+  /* What to do if thread is already signaled?  */
+  /* What if error_symbol is Qnil?  */
+  tstate->error_symbol = error_symbol;
+  tstate->error_data = data;
+}
+
 DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0,
        doc: /* Signal an error in a thread.
 This acts like `signal', but arranges for the signal to be raised
@@ -1006,10 +1024,7 @@ DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0,
   else
 #endif
     {
-      /* What to do if thread is already signaled?  */
-      /* What if error_symbol is Qnil?  */
-      tstate->error_symbol = error_symbol;
-      tstate->error_data = data;
+      thread_set_error (tstate, error_symbol, data);
 
       if (tstate->wait_condvar)
 	flush_stack_call_func (thread_signal_callback, tstate);
@@ -1030,6 +1045,34 @@ DEFUN ("thread-live-p", Fthread_live_p, Sthread_live_p, 1, 1, 0,
   return thread_live_p (tstate) ? Qt : Qnil;
 }
 
+DEFUN ("thread-buffer-disposition", Fthread_buffer_disposition, Sthread_buffer_disposition,
+       1, 1, 0,
+       doc: /* Return the value of THREAD's buffer disposition.  */)
+  (Lisp_Object thread)
+{
+  struct thread_state *tstate;
+
+  CHECK_THREAD (thread);
+  tstate = XTHREAD (thread);
+
+  return tstate->buffer_disposition;
+}
+
+DEFUN ("thread-set-buffer-disposition", Fthread_set_buffer_disposition, Sthread_set_buffer_disposition,
+       2, 2, 0,
+       doc: /* Set THREAD's buffer disposition.  */)
+  (Lisp_Object thread, Lisp_Object value)
+{
+  struct thread_state *tstate;
+
+  CHECK_THREAD (thread);
+  tstate = XTHREAD (thread);
+
+  tstate->buffer_disposition = value;
+
+  return value;
+}
+
 DEFUN ("thread--blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0,
        doc: /* Return the object that THREAD is blocking on.
 If THREAD is blocked in `thread-join' on a second thread, return that
@@ -1139,13 +1182,43 @@ thread_check_current_buffer (struct buffer *buffer)
       if (iter == current_thread)
 	continue;
 
-      if (iter->m_current_buffer == buffer)
+      if (iter->m_current_buffer == buffer && EQ (iter->buffer_disposition, Qt))
 	return true;
     }
 
   return false;
 }
 
+void
+thread_all_before_buffer_killed (Lisp_Object current)
+{
+  struct thread_state *iter;
+  struct buffer * other = NULL;
+  struct buffer * b = XBUFFER (current);
+  struct thread_state *caller_thread = current_thread;
+
+  for (iter = all_threads; iter; iter = iter->next_thread)
+    {
+      if (iter == caller_thread)
+	continue;
+
+      if (iter->m_current_buffer == b)
+	{
+	  Lisp_Object thread;
+
+	  XSETTHREAD (thread, iter);
+
+	  if (other == NULL)
+	    other = XBUFFER (Fother_buffer (current, Qnil, Qnil));
+
+	  if (!EQ (iter->buffer_disposition, Qsilently))
+	    thread_set_error (iter, Qthread_buffer_killed, Qnil);
+
+	  iter->m_current_buffer = other;
+	}
+    }
+}
+
 
 
 bool
@@ -1174,6 +1247,7 @@ init_threads (void)
 #endif /* defined HAVE_ANDROID && !defined ANDROID_STUBIFY */
 
   main_thread.s.thread_id = sys_thread_self ();
+  main_thread.s.buffer_disposition = Qnil;
   init_bc_thread (&main_thread.s.bc);
 }
 
@@ -1203,6 +1277,8 @@ syms_of_threads (void)
       defsubr (&Scondition_mutex);
       defsubr (&Scondition_name);
       defsubr (&Sthread_last_error);
+      defsubr (&Sthread_buffer_disposition);
+      defsubr (&Sthread_set_buffer_disposition);
 
       staticpro (&last_thread_error);
       last_thread_error = Qnil;
@@ -1214,6 +1290,13 @@ syms_of_threads (void)
   DEFSYM (Qmutexp, "mutexp");
   DEFSYM (Qcondition_variable_p, "condition-variable-p");
 
+  DEFSYM (Qthread_buffer_killed, "thread-buffer-killed");
+  Fput (Qthread_buffer_killed, Qerror_conditions,
+	list (Qthread_buffer_killed, Qerror));
+  Fput (Qthread_buffer_killed, Qerror_message,
+	build_string ("Thread's current buffer killed"));
+  DEFSYM (Qsilently, "silently");
+
   DEFVAR_LISP ("main-thread", Vmain_thread,
     doc: /* The main thread of Emacs.  */);
 #ifdef THREADS_ENABLED
diff --git a/src/thread.h b/src/thread.h
index c496453b090..320a3e31df4 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -143,6 +143,9 @@ #define lisp_eval_depth (current_thread->m_lisp_eval_depth)
   struct buffer *m_current_buffer;
 #define current_buffer (current_thread->m_current_buffer)
 
+  /* Decides whether the thread's current buffer can be killed.  */
+  Lisp_Object buffer_disposition;
+
   /* Every call to re_search, etc., must pass &search_regs as the regs
      argument unless you can show it is unnecessary (i.e., if re_search
      is certainly going to be called again before region-around-match
@@ -338,6 +341,8 @@ XCONDVAR (Lisp_Object a)
 
 bool thread_check_current_buffer (struct buffer *);
 
+void thread_all_before_buffer_killed (Lisp_Object buffer);
+
 INLINE_HEADER_END
 
 #endif /* THREAD_H */
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 9a065187b5e..0f7999af71a 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -398,6 +398,55 @@ threads-test-bug33073
   (let ((th (make-thread 'ignore)))
     (should-not (equal th main-thread))))
 
+(ert-deftest thread-buffer-disposition-t ()
+  "Test not being able to kill a bg thread's buffer."
+  (skip-unless (featurep 'threads))
+  (let ((buf (get-buffer-create " *thread-buffer-killable-nil*"))
+        thread)
+    (with-current-buffer buf
+      (setq thread
+            (make-thread
+             (lambda ()
+               (sleep-for 0.1))
+             nil
+             t)))
+    (kill-buffer buf)
+    (should (buffer-live-p buf))
+    ;; No error:
+    (thread-join thread)))
+
+(ert-deftest thread-buffer-disposition-nil ()
+  "Test killing a bg thread's buffer."
+  (skip-unless (featurep 'threads))
+  (let ((buf (get-buffer-create " *thread-buffer-killable-t*"))
+        thread)
+    (with-current-buffer buf
+      (setq thread
+            (make-thread
+             (lambda ()
+               (sleep-for 0.1)))))
+    (kill-buffer buf)
+    (should-not (buffer-live-p buf))
+    (should-error
+     (thread-join thread)
+     :type 'thread-buffer-killed)))
+
+(ert-deftest thread-buffer-disposition-silently ()
+  "Test killing a bg thread's buffer silently."
+  (skip-unless (featurep 'threads))
+  (let ((buf (get-buffer-create " *thread-buffer-killable-t*"))
+        thread)
+    (with-current-buffer buf
+      (setq thread
+            (make-thread
+             (lambda ()
+               (sleep-for 0.1))
+             nil
+             'silently)))
+    (kill-buffer buf)
+    (should-not (buffer-live-p buf))
+    (thread-join thread)))
+
 (defvar threads-test--var 'global)
 
 (ert-deftest threads-test-bug48990 ()