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

From: Dmitry Gutov <[email-masked]>
Date: Sun, 13 Jul 2025 17:02:07 +0300

Hi Eli,

On 18/03/2025 02:21, Dmitry Gutov wrote:
> On 17/03/2025 21:41, Eli Zaretskii wrote:
>> Don't forget that
>> the target thread could be the main thread.
> 
> Good question what we should do with the main thread in this case - but 
> even if it receives the signal, it should be more a lot more visible to 
> the user than in background threads, helping fix whatever misbehavior 
> that caused it.
> 
> But we'll probably use the same method that's being discussed to declare 
> a thread an exception, prohibiting its buffer from being killed externally.

Here's a patch with implementation:

* It's a property of the thread, on by default.
* Set to nil for the main thread (currently can be changed from Lisp).
* Not a buffer-local variable - and looking more at it, that seems not a 
good idea, because several threads could have the same buffer current, 
and some might be okay with this behavior, while others not.
* A couple of questions about the finer details of the implementation, 
see comments in 'thread_all_before_buffer_killed'.
* Two tests included.

Seems to work well in my testing, and in the diff-hl scenario described 
in the report: step 5 kills the buffer and sends the signal which I can 
catch inside condition-case in diff-hl--update-safe.

WDYT?

diff --git a/src/buffer.c b/src/buffer.c
index a465153279d..dd3b1ef018d 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -2050,6 +2050,8 @@ DEFUN ("kill-buffer", Fkill_buffer, Skill_buffer, 0, 1, "bKill buffer: ",
 	return Qnil;
     }
 
+  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..88c6e9346ac 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -934,6 +934,8 @@ DEFUN ("make-thread", Fmake_thread, Smake_thread, 1, 2, 0,
 #endif
     }
 
+  new_thread->buffer_killable_p = true;
+
   /* FIXME: race here where new thread might not be filled in?  */
   Lisp_Object result;
   XSETTHREAD (result, new_thread);
@@ -1030,6 +1032,38 @@ DEFUN ("thread-live-p", Fthread_live_p, Sthread_live_p, 1, 1, 0,
   return thread_live_p (tstate) ? Qt : Qnil;
 }
 
+DEFUN ("thread-buffer-killable-p", Fthread_buffer_killable_p, Sthread_buffer_killable_p,
+       1, 1, 0,
+       doc: /* Return t if THREAD's buffer is allowed to be killed from
+another thread.  This is a property of the thread, not of a buffer.  */)
+  (Lisp_Object thread)
+{
+  struct thread_state *tstate;
+
+  CHECK_THREAD (thread);
+  tstate = XTHREAD (thread);
+
+  return tstate->buffer_killable_p ? Qt : Qnil;
+}
+
+DEFUN ("thread-set-buffer-killable", Fthread_set_buffer_killable, Sthread_set_buffer_killable,
+       2, 2, 0,
+       doc: /* Set whether THREAD's buffer is allowed to be killed.  */)
+  (Lisp_Object thread, Lisp_Object value)
+{
+  struct thread_state *tstate;
+
+  CHECK_THREAD (thread);
+  tstate = XTHREAD (thread);
+
+  if (EQ (value, Qnil))
+    tstate->buffer_killable_p = false;
+  else
+    tstate->buffer_killable_p = true;
+
+  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 +1173,52 @@ thread_check_current_buffer (struct buffer *buffer)
       if (iter == current_thread)
 	continue;
 
-      if (iter->m_current_buffer == buffer)
+      if (iter->m_current_buffer == buffer && !iter->buffer_killable_p)
 	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;
+
+      /* Could iter->buffer_killable_p be false now?
+	 E.g. changed by hooks.  */
+      if (iter->m_current_buffer == b)
+	{
+	  Lisp_Object thread;
+
+	  XSETTHREAD (thread, iter);
+
+	  if (other == NULL)
+	    other = XBUFFER (Fother_buffer (current, Qnil, Qnil));
+
+	  // Or we could inline the last part of its definition.
+	  Fthread_signal (thread, Qthread_buffer_killed, Qnil);
+
+	  // Are we okay just setting the value here, and relying on
+	  // set_buffer_internal_2 call in post_acquire_global_lock?
+	  iter->m_current_buffer = other;
+
+	  /* current_thread = iter; */
+	  /* set_buffer_internal_1 (other); */
+	}
+    }
+
+  /* current_thread = caller_thread; */
+}
+
 
 
 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_killable_p = false;
   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_killable_p);
+      defsubr (&Sthread_set_buffer_killable);
 
       staticpro (&last_thread_error);
       last_thread_error = Qnil;
@@ -1214,6 +1290,12 @@ 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 (Qscan_error, Qerror_message,
+	build_string ("Thread's current buffer killed"));
+
   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..fd06dcdb8c7 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)
 
+  /* When true the thread's current buffer can be killed.  */
+  bool buffer_killable_p;
+
   /* 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 322547c2e6a..e498aebd949 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -393,6 +393,39 @@ threads-test-bug33073
   (let ((th (make-thread 'ignore)))
     (should-not (equal th main-thread))))
 
+(ert-deftest thread-buffer-killable-nil ()
+  "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)))))
+    (thread-set-buffer-killable thread nil)
+    (kill-buffer buf)
+    (should (buffer-live-p buf))
+    ;; No error:
+    (thread-join thread)))
+
+(ert-deftest thread-buffer-killable-t ()
+  "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)))))
+    (thread-set-buffer-killable thread t)
+    (kill-buffer buf)
+    (should-not (buffer-live-p buf))
+    (should-error
+     (thread-join thread)
+     :type 'thread-buffer-killed)))
+
 (defvar threads-test--var 'global)
 
 (ert-deftest threads-test-bug48990 ()