From: Arthur Gleckler <edu/mit/csail/zurich/arthur>
Date: Wed, 28 Aug 1991 22:28:42 +0000 (+0000)
Subject: Provide a run light for Edwin, which shows "eval" when Edwin is
X-Git-Tag: 20090517-FFI~10267
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b972f9ffa414978f2214799492b89170881dd5a8;p=mit-scheme.git

Provide a run light for Edwin, which shows "eval" when Edwin is
evaluating an expression provided by the user.  This is accomplished
by setting the Edwin variable RUN-LIGHT to "eval" or false.  The
default value of MODE-LINE-PROCESS will now cause ": eval" to appear
after the names of the minor modes on the mode line, e.g.:

  (Scheme Narrow)

when no evaluation is running, and

  (Scheme Narrow: eval)

when an evaluation is running.  Because this requires a DYNAMIC-WIND
at every evaluation, Edwin variable ENABLE-RUN-LIGHT? can be used to
disable this feature.
---

diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index e88023797..31c085974 100644
--- a/v7/src/edwin/evlcom.scm
+++ b/v7/src/edwin/evlcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.27 1991/08/28 21:07:07 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.28 1991/08/28 22:28:42 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -304,16 +304,44 @@ may be available.  The following commands are special to this mode:
 (define scheme-syntax-table?
   (access syntax-table? system-global-environment))
 
+(define-variable run-light
+  "Scheme run light.  Not intended to be modified by users, but needed to
+kludge the mode line."
+  false)
+
+(define-variable enable-run-light?
+  "Whether to display the Scheme run light."
+  true
+  boolean?)
+
 (define (editor-eval sexp environment)
-  (let ((to-transcript? (ref-variable enable-transcript-buffer)))
-    (with-output-to-transcript-buffer
-     (lambda ()
-       (let* ((buffer (transcript-buffer))
-	      (value (eval-with-history sexp environment)))
-	 (transcript-write value
-			   buffer
-			   to-transcript?)
-	 value)))))
+  (let* ((to-transcript? (ref-variable enable-transcript-buffer))
+	 (core 
+	  (lambda ()
+	    (with-output-to-transcript-buffer
+	     (lambda ()
+	       (let* ((buffer (transcript-buffer))
+		      (value (eval-with-history sexp environment)))
+		 (transcript-write value
+				   buffer
+				   to-transcript?)
+		 value))))))
+    (if (ref-variable enable-run-light?)
+	(dynamic-wind
+	 (lambda ()
+	   (set-variable! run-light "eval")
+	   (for-each (lambda (window)
+		       (window-modeline-event! window 'RUN-LIGHT))
+		     (window-list))
+	   (update-screens! false))
+	 core
+	 (lambda ()
+	   (set-variable! run-light false)
+	   (for-each (lambda (window)
+		       (window-modeline-event! window 'RUN-LIGHT))
+		     (window-list))
+	   (update-screens! false)))
+	(core))))
 
 (define (eval-with-history expression environment)
   (let ((syntax-table (evaluation-syntax-table environment)))
diff --git a/v7/src/edwin/modlin.scm b/v7/src/edwin/modlin.scm
index 592634de3..b2d97153c 100644
--- a/v7/src/edwin/modlin.scm
+++ b/v7/src/edwin/modlin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modlin.scm,v 1.10 1991/05/17 19:07:05 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modlin.scm,v 1.11 1991/08/28 22:28:33 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -99,8 +99,8 @@ other than ordinary files may change this (e.g. Info, Dired,...)"
 
 (define-variable-per-buffer mode-line-process
   "Mode-line control for displaying info on process status.
-Normally false in most modes, since there is no process to display."
-  false)
+Normally displays the Scheme run light, if ENABLE-RUN-LIGHT? is true."
+  '(run-light (": " run-light) ""))
 
 (define-variable-per-buffer mode-line-procedure
   "Procedure used to generate the mode-line.