Name most threads.

diff --git a/src/edwin/editor.scm b/src/edwin/editor.scm
index 7c4beaea76bbb62fa325e2f51349b17e16101d7f..691f8280341b1b80de06cea83b789be80dbd996f 100644 (file)
--- a/src/edwin/editor.scm
+++ b/src/edwin/editor.scm
@@ -54,6 +54,7 @@ USA.
                 (inferior-threads '())
                 (recursive-edit-continuation #f)
                 (recursive-edit-level 0))
+       (thread-put! editor-thread 'name edwin-editor)
        (editor-grab-display edwin-editor
         (lambda (with-editor-ungrabbed operations)
           (let ((message (cmdl-message/null)))
@@ -78,7 +79,9 @@ USA.
                                           thunks)
                                         (cdr thunks)))
                                ((null? thunks))
-                             (create-thread root-continuation (car thunks)))
+                             (create-thread root-continuation
+                               (car thunks)
+                               (car thunks)))
                            (top-level-command-reader
                             edwin-initialization)))))))
                 message)
@@ -580,7 +583,8 @@ TRANSCRIPT    messages appear in transcript buffer, if it is enabled;
                 (weak-set-cdr! (car threads) #f))
               (loop (cdr threads) threads)))))))
 
-(define (start-standard-polling-thread interval output-processor)
+(define (start-standard-polling-thread interval output-processor
+                                      #!optional name)
   (let ((holder (list #f)))
     (set-car! holder
              (register-inferior-thread!
@@ -593,7 +597,8 @@ TRANSCRIPT    messages appear in transcript buffer, if it is enabled;
                                     (exit-current-thread unspecific))
                                    (registration
                                     (inferior-thread-output! registration))))
-                           (sleep-current-thread interval))))))
+                           (sleep-current-thread interval)))
+                       name)))
                 (detach-thread thread)
                 thread)
               output-processor))

diff --git a/src/edwin/intmod.scm b/src/edwin/intmod.scm
index 711380dfb66bbe5ebcdff8ce79aec8915a0be3f8..dc85f554aada62bde3ad7ed3f3fa0255a0077528 100644 (file)
--- a/src/edwin/intmod.scm
+++ b/src/edwin/intmod.scm
@@ -138,7 +138,8 @@ evaluated in the specified inferior REPL buffer."
             (lambda ()
               (signal-thread-event editor-thread
                 (lambda ()
-                  (unwind-inferior-repl-buffer buffer)))))))))))
+                  (unwind-inferior-repl-buffer buffer)))))))))
+    buffer))
 
 (define (make-init-message message)
   (if message

diff --git a/src/edwin/notify.scm b/src/edwin/notify.scm
index 00fb94dd1d6e2ebb97a591e1505954d71b5150ef..8a0661a0db1af2ad7fa797f46d8bacfb1b3671dc 100644 (file)
--- a/src/edwin/notify.scm
+++ b/src/edwin/notify.scm
@@ -181,7 +181,8 @@ which can show various things including time, load average, and mail status."
     (set! notifier-thread-registration
          (start-standard-polling-thread (* (ref-variable notify-interval #f)
                                            1000)
-                                        notifier))
+                                        notifier
+                                        (cons 'notifier current-editor)))
     unspecific))
 
 (define (notifier)

diff --git a/src/edwin/world-monitor.scm b/src/edwin/world-monitor.scm
index d98061a1b6df99a20295a39161f3527a5032d1bc..b65b831fd895cbd4ff25c1925b880b83780b9c67 100644 (file)
--- a/src/edwin/world-monitor.scm
+++ b/src/edwin/world-monitor.scm
@@ -51,13 +51,12 @@ it, and spawn a thread to update it after every
   (set-buffer-major-mode! buffer (ref-mode-object read-only))
   (local-set-variable! truncate-lines #t buffer)
   (let ((registration #f)
-       (report #f)
-       (thread-flags (list (cons (current-thread) "edwin"))))
+       (report #f))
 
     (define (new-report)
       (call-with-output-string
        (lambda (port)
-         (world-report port thread-flags))))
+         (world-report port))))
 
     (define (sleep)
       (sleep-current-thread
@@ -80,10 +79,9 @@ it, and spawn a thread to update it after every
                       (if registration
                           (deregister-inferior-thread! registration))
                       (set! registration #f)
-                      (exit-current-thread #t))))))))
-
+                      (exit-current-thread #t)))))
+            buffer)))
       (buffer-put! buffer 'WORLD-MONITOR monitor)
-      (set! thread-flags (cons (cons monitor "monitor") thread-flags))
       (update-world-monitor! buffer (new-report))
       (set-buffer-point! buffer (buffer-start buffer))
       (set! registration

diff --git a/src/imail/imail-imap.scm b/src/imail/imail-imap.scm
index 076860a3fea1b3e67a13633a25d07ad6d4b64ecf..d323f469ddcbe200cc3fdf3699f4ad5402c96cae 100644 (file)
--- a/src/imail/imail-imap.scm
+++ b/src/imail/imail-imap.scm
@@ -741,7 +741,8 @@ USA.
           (set! connection-closure-thread-registration
                 (start-standard-polling-thread
                  connection-closure-thread-interval
-                 connection-closure-output-processor))
+                 connection-closure-output-processor
+                 'connection-closure-thread))
           unspecific)))))
 
 (define (connection-closure-output-processor)

diff --git a/src/imail/imail-top.scm b/src/imail/imail-top.scm
index 9ab5d25c596536765c8d53b4ed2cd495a5b2d007..7aaaa8cbd10dc1e540058f64d16ed36672999f11 100644 (file)
--- a/src/imail/imail-top.scm
+++ b/src/imail/imail-top.scm
@@ -2229,7 +2229,8 @@ WARNING: With a prefix argument, this command may take a very long
                                  (start-standard-polling-thread
                                   (* 1000 interval)
                                   (probe-folder-output-processor
-                                   (weak-cons folder unspecific)))))))))))
+                                   (weak-cons folder unspecific))
+                                  folder)))))))))
 
 (define ((probe-folder-output-processor folder))
   (let ((folder (weak-car folder)))