From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Mon, 28 Aug 2017 18:23:29 +0000 (-0700)
Subject: edwin: Name threads.  Punt thread "flags" for the world report.
X-Git-Tag: mit-scheme-pucked-9.2.12~86
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6c860bb340ffe08e7f7466449bba150621eb3eb4;p=mit-scheme.git

edwin: Name threads.  Punt thread "flags" for the world report.
---

diff --git a/src/edwin/editor.scm b/src/edwin/editor.scm
index 3556e9b3b..c18979596 100644
--- 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)
@@ -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))
diff --git a/src/edwin/intmod.scm b/src/edwin/intmod.scm
index bff038162..f7ad3947f 100644
--- 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 d6aea0402..2ed9936e6 100644
--- 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 a98bd4c6b..891193689 100644
--- 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