edwin: Name threads. Punt thread "flags" for the world report.
authorMatt Birkholz <matt@birchwood-abbey.net>
Mon, 28 Aug 2017 18:23:29 +0000 (11:23 -0700)
committerMatt Birkholz <matt@birchwood-abbey.net>
Mon, 28 Aug 2017 18:23:29 +0000 (11:23 -0700)
src/edwin/editor.scm
src/edwin/intmod.scm
src/edwin/notify.scm
src/edwin/world-monitor.scm

index 3556e9b3be7c8b58bacbd5dc3daa7d24931cf971..c189795967af4cbf0716eed3bc0753a08c7481da 100644 (file)
@@ -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)
@@ -573,7 +576,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!
@@ -586,7 +590,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))
index bff038162b64eadda9c512dbe2b7263be3503057..f7ad3947f79da405cce13719ab98dc932760db80 100644 (file)
@@ -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
index d6aea04028ab74c5c8589f1c808585d1838b2573..2ed9936e6b21ec8b307bd1c6a841989dab96b573 100644 (file)
@@ -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)
index a98bd4c6b7236499b9d9ed87349fd2ffa3d46d47..891193689d94df0e0360085a4a158cc00ab7d7c3 100644 (file)
@@ -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