Allow thread's buffer to be killed, by default

* src/thread.c (Fmake_thread): Add new argument (bug#76969).
(thread_set_error): New function, extracted from thread-signal.
(Fthread_buffer_disposition): Add getter.
(Fthread_set_buffer_disposition): And setter.
(thread_check_current_buffer): Check the values of threads'
buffer_disposition.
(thread_all_before_buffer_killed): New function.
(init_threads): Set buffer_disposition to nil for the main thread.
(syms_of_threads): Add new symbols and define the error.

* src/thread.h (thread_state): New field buffer_disposition.
(thread_all_before_buffer_killed): Declare.

* src/buffer.c (Fkill_buffer): Call thread_check_current_buffer
one more time after all hooks and after that call
thread_all_before_buffer_killed.

* src/comp.c (ABI_VERSION): Increase the value.

* test/src/thread-tests.el (thread-buffer-disposition-t)
(thread-buffer-disposition-nil)
(thread-buffer-disposition-silently)
(thread-set-buffer-disposition)
(thread-set-buffer-disposition-main-thread): New tests.

* doc/lispref/threads.texi (Basic Thread Functions): Document
buffer-disposition in make-thread and its getter and setter.

* etc/NEWS: Add entry.

1 files changed, 64 insertions, 0 deletions

diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 9a065187b5e..0b9e8f96c09 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -398,6 +398,70 @@
   (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)))
+
+(ert-deftest thread-set-buffer-disposition ()
+  "Test being able to modify a thread's buffer disposition."
+  (skip-unless (featurep 'threads))
+  (let ((thread (make-thread #'ignore)))
+    (should (eq (thread-buffer-disposition thread) nil))
+    (thread-set-buffer-disposition thread t)
+    (should (eq (thread-buffer-disposition thread) t))))
+
+(ert-deftest thread-set-buffer-disposition-main-thread ()
+  "Test not being able to modify main thread's buffer disposition."
+  (skip-unless (featurep 'threads))
+  (should (null (thread-buffer-disposition main-thread)))
+  (should-error (thread-set-buffer-disposition main-thread t)
+                :type 'wrong-type-argument))
+
 (defvar threads-test--var 'global)
 
 (ert-deftest threads-test-bug48990 ()