From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 27 Oct 2019 05:50:11 +0000 (-0700)
Subject: Add param:hide-notifications?.
X-Git-Tag: mit-scheme-pucked-10.1.20~11^2~22
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=571effeca55aa10649e03c4df8fadcc4f1275323;p=mit-scheme.git

Add param:hide-notifications?.
---

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index e6504898d..2d6e16c9a 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -5096,6 +5096,7 @@ USA.
   (parent (runtime))
   (export ()
 	  (write-notification-line with-notification)
+	  param:hide-notifications?
 	  prompt-for-command-char
 	  prompt-for-command-expression
 	  prompt-for-confirmation
diff --git a/src/runtime/usrint.scm b/src/runtime/usrint.scm
index d40321774..b5b423499 100644
--- a/src/runtime/usrint.scm
+++ b/src/runtime/usrint.scm
@@ -369,41 +369,47 @@ USA.
 ;;;; Activity notification
 
 (define (with-notification message #!optional thunk)
-  (if (or (default-object? thunk) (not thunk))
-      (let ((port (notification-output-port)))
-	(fresh-line port)
-	(write-notification-prefix port)
-	(message (wrap-notification-port port)))
-      (let ((done? #f)
-	    (n))
-	(dynamic-wind
-	 (lambda ()
-	   (let ((port (notification-output-port)))
-	     (fresh-line port)
-	     (write-notification-prefix port)
-	     (message (wrap-notification-port port))
-	     (write-string "..." port)
-	     (set! n (output-port/bytes-written port))
-	     unspecific))
-	 (lambda ()
-	   (let ((v
-		  (parameterize ((*notification-depth*
-				  (1+ (*notification-depth*))))
-		    (thunk))))
-	     (set! done? #t)
-	     v))
-	 (lambda ()
-	   (let ((port (notification-output-port)))
-	     (if (if n
-		     (> (output-port/bytes-written port) n)
-		     (output-port/line-start? port))
-		 (begin
-		   (fresh-line port)
-		   (write-notification-prefix port)
-		   (write-string "..." port)))
-	     (set! n)
-	     (write-string (if done? " done" " aborted") port)
-	     (newline port)))))))
+  (if (param:hide-notifications?)
+      (if (and thunk (not (default-object? thunk)))
+	  (thunk))
+      (if (or (default-object? thunk) (not thunk))
+	  (let ((port (notification-output-port)))
+	    (fresh-line port)
+	    (write-notification-prefix port)
+	    (message (wrap-notification-port port)))
+	  (let ((done? #f)
+		(n))
+	    (dynamic-wind
+	     (lambda ()
+	       (let ((port (notification-output-port)))
+		 (fresh-line port)
+		 (write-notification-prefix port)
+		 (message (wrap-notification-port port))
+		 (write-string "..." port)
+		 (set! n (output-port/bytes-written port))
+		 unspecific))
+	     (lambda ()
+	       (let ((v
+		      (parameterize ((*notification-depth*
+				      (1+ (*notification-depth*))))
+			(thunk))))
+		 (set! done? #t)
+		 v))
+	     (lambda ()
+	       (let ((port (notification-output-port)))
+		 (if (if n
+			 (> (output-port/bytes-written port) n)
+			 (output-port/line-start? port))
+		     (begin
+		       (fresh-line port)
+		       (write-notification-prefix port)
+		       (write-string "..." port)))
+		 (set! n)
+		 (write-string (if done? " done" " aborted") port)
+		 (newline port))))))))
+
+(define-deferred param:hide-notifications?
+  (make-unsettable-parameter #f))
 
 (define (wrap-notification-port port)
   (make-textual-port wrapped-notification-port-type port))
@@ -460,12 +466,11 @@ USA.
      (* (string-length indentation-atom)
 	(*notification-depth*))))
 
-(define *notification-depth*)
-(define indentation-atom)
-(define wrapped-notification-port-type)
+(define indentation-atom
+  "  ")
+
+(define-deferred *notification-depth*
+  (make-unsettable-parameter 0))
 
-(define (initialize-package!)
-  (set! *notification-depth* (make-unsettable-parameter 0))
-  (set! indentation-atom "  ")
-  (set! wrapped-notification-port-type (make-wrapped-notification-port-type))
-  unspecific)
\ No newline at end of file
+(define-deferred wrapped-notification-port-type
+  (make-wrapped-notification-port-type))
\ No newline at end of file