@code{condition-wait}, or @code{thread-join}; @code{thread-signal}
will unblock it.
-Since signal handlers in Emacs are located in the main thread, a
-signal must be propagated there in order to become visible. The
-second @code{signal} call let the thread die:
-
-@example
-(thread-signal main-thread 'error data)
-(signal 'error data)
-@end example
+If @var{thread} is the main thread, the signal is not propagated
+there. Instead, it is shown as message in the main thread.
@end defun
@defun thread-yield
+++
*** 'thread-join' returns the result of the finished thread now.
++++
+*** 'thread-signal' does not propagate errors to the main thread.
+Instead, error messages are just printed in the main thread.
+
---
** thingatpt.el supports a new "thing" called 'uuid'.
A symbol 'uuid' can be passed to thing-at-point and it returns the
--- /dev/null
+;;; thread.el --- List active threads in a buffer -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: lisp, tools, maint
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+;;;###autoload
+(defun thread-handle-event (event)
+ "Handle thread events, propagated by `thread-signal'.
+An EVENT has the format
+ (thread-event THREAD ERROR-SYMBOL DATA)"
+ (interactive "e")
+ (if (and (consp event)
+ (eq (car event) 'thread-event)
+ (= (length event) 4))
+ (let ((thread (cadr event))
+ (err (cddr event)))
+ (message "Error %s: %S" thread err))))
+
+(provide 'thread)
+;;; thread.el ends here
#endif
#ifdef USE_FILE_NOTIFY
|| EQ (XCAR (c), Qfile_notify)
+#endif
+#ifdef THREADS_ENABLED
+ || EQ (XCAR (c), Qthread_event)
#endif
|| EQ (XCAR (c), Qconfig_changed_event))
&& !end_time)
}
#endif /* subprocesses */
-#if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY
+#if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED
if (noninteractive
/* In case we are running as a daemon, only do this before
detaching from the terminal. */
*kbp = current_kboard;
return obj;
}
-#endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY */
+#endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED */
/* Wait until there is input available. */
for (;;)
#ifdef HAVE_DBUS
case DBUS_EVENT:
#endif
+#ifdef THREADS_ENABLED
+ case THREAD_EVENT:
+#endif
#ifdef HAVE_XWIDGETS
case XWIDGET_EVENT:
#endif
}
#endif /* HAVE_DBUS */
+#ifdef THREADS_ENABLED
+ case THREAD_EVENT:
+ {
+ return Fcons (Qthread_event, event->arg);
+ }
+#endif /* THREADS_ENABLED */
+
#ifdef HAVE_XWIDGETS
case XWIDGET_EVENT:
{
DEFSYM (Qdbus_event, "dbus-event");
#endif
+#ifdef THREADS_ENABLED
+ DEFSYM (Qthread_event, "thread-event");
+#endif
+
#ifdef HAVE_XWIDGETS
DEFSYM (Qxwidget_event, "xwidget-event");
#endif
"dbus-handle-event");
#endif
+#ifdef THREADS_ENABLED
+ /* Define a special event which is raised for thread signals. */
+ initial_define_lispy_key (Vspecial_event_map, "thread-event",
+ "thread-handle-event");
+#endif
+
#ifdef USE_FILE_NOTIFY
/* Define a special event which is raised for notification callback
functions. */
, DBUS_EVENT
#endif
+#ifdef THREADS_ENABLED
+ , THREAD_EVENT
+#endif
+
, CONFIG_CHANGED_EVENT
#ifdef HAVE_NTGUI
#include "process.h"
#include "coding.h"
#include "syssignal.h"
+#include "keyboard.h"
static struct thread_state main_thread;
static sys_mutex_t global_lock;
-extern int poll_suppress_count;
extern volatile int interrupt_input_blocked;
\f
This acts like `signal', but arranges for the signal to be raised
in THREAD. If THREAD is the current thread, acts just like `signal'.
This will interrupt a blocked call to `mutex-lock', `condition-wait',
-or `thread-join' in the target thread. */)
+or `thread-join' in the target thread.
+If THREAD is the main thread, just the error message is shown. */)
(Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data)
{
struct thread_state *tstate;
if (tstate == current_thread)
Fsignal (error_symbol, data);
- /* What to do if thread is already signaled? */
- /* What if error_symbol is Qnil? */
- tstate->error_symbol = error_symbol;
- tstate->error_data = data;
+ if (main_thread_p (tstate))
+ {
+ /* Construct an event. */
+ struct input_event event;
+ EVENT_INIT (event);
+ event.kind = THREAD_EVENT;
+ event.frame_or_window = Qnil;
+ event.arg = list3 (Fcurrent_thread (), error_symbol, data);
+
+ /* Store it into the input event queue. */
+ kbd_buffer_store_event (&event);
+ }
+
+ else
+ {
+ /* What to do if thread is already signaled? */
+ /* What if error_symbol is Qnil? */
+ tstate->error_symbol = error_symbol;
+ tstate->error_data = data;
- if (tstate->wait_condvar)
- flush_stack_call_func (thread_signal_callback, tstate);
+ if (tstate->wait_condvar)
+ flush_stack_call_func (thread_signal_callback, tstate);
+ }
return Qnil;
}
;;; Code:
+(require 'thread)
+
;; Declare the functions in case Emacs has been configured --without-threads.
(declare-function all-threads "thread.c" ())
(declare-function condition-mutex "thread.c" (cond))
(should-not (thread-alive-p thread))
(should (equal (thread-last-error) '(error)))))
+(ert-deftest threads-signal-main-thread ()
+ "Test signaling the main thread."
+ (skip-unless (featurep 'threads))
+ ;; We cannot use `ert-with-message-capture', because threads do not
+ ;; know let-bound variables.
+ (with-current-buffer "*Messages*"
+ (let (buffer-read-only)
+ (erase-buffer))
+ (let ((thread
+ (make-thread #'(lambda () (thread-signal main-thread 'error nil)))))
+ (while (thread-alive-p thread)
+ (thread-yield))
+ (read-event nil nil 0.1)
+ ;; No error has been raised, which is part of the test.
+ (should
+ (string-match
+ (format-message "Error %s: (error nil)" thread)
+ (buffer-string ))))))
+
(defvar threads-condvar nil)
(defun threads-test-condvar-wait ()