From 571effeca55aa10649e03c4df8fadcc4f1275323 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 26 Oct 2019 22:50:11 -0700 Subject: [PATCH] Add param:hide-notifications?. --- src/runtime/runtime.pkg | 1 + src/runtime/usrint.scm | 91 ++++++++++++++++++++++------------------- 2 files changed, 49 insertions(+), 43 deletions(-) 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 -- 2.25.1