Add param:hide-notifications?.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index e6504898defe715bf30a3f73c1680862b3f515df..2d6e16c9a52a385d94802d8a9a69fb4a69a377cd 100644 (file)
--- 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 d403217743f1994614a507d1cf204a4ead229a13..b5b4234995d79b6ecb94fde4e4d663760c6f105a 100644 (file)
--- 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))
 \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