diff options
| -rw-r--r-- | chickadee/scripting/script.scm | 27 |
1 files changed, 20 insertions, 7 deletions
diff --git a/chickadee/scripting/script.scm b/chickadee/scripting/script.scm index 97ba811..a67884f 100644 --- a/chickadee/scripting/script.scm +++ b/chickadee/scripting/script.scm @@ -30,9 +30,12 @@ #:replace (yield)) (define-record-type <script> - (make-script status) + (make-script status children) script? - (status script-status set-script-status!)) + (status script-status set-script-status!) + (children script-children set-script-children!)) + +(define current-script (make-parameter #f)) (define (display-script script port) (format port "<script status: ~a>" (script-status script))) @@ -54,17 +57,18 @@ (define (cancel-script script) "Prevent further execution of SCRIPT." (set-script-status! script 'cancelled) + (for-each cancel-script (script-children script)) *unspecified*) (define script-prompt (make-prompt-tag 'script)) (define (spawn-script thunk) "Apply THUNK as a script." - (let ((script (make-script 'running))) + (let ((script (make-script 'running '()))) (define (handler cont callback . args) (define (resume . args) - ;; Call continuation that resumes the procedure, unless, of - ;; course, the script has been cancelled in the meantime. + ;; Call the continuation that resumes the script, unless the + ;; script has been cancelled in the meanwhile. (unless (script-cancelled? script) (call-with-prompt script-prompt (lambda () (apply cont args)) @@ -74,8 +78,17 @@ (define task (let ((dynamic-state (current-dynamic-state))) (lambda () - (with-dynamic-state dynamic-state thunk) - (set-script-status! script 'complete)))) + (with-dynamic-state + dynamic-state + (lambda () + (current-script script) + (thunk) + (set-script-status! script 'complete)))))) + ;; Register child script with parent. Cancelling the parent will + ;; cause all children to be cancelled as well. + (when (script? (current-script)) + (set-script-children! (current-script) + (cons script (script-children (current-script))))) ;; Start the script. (call-with-prompt script-prompt task handler) script)) |