diff options
| -rw-r--r-- | catbird/repl.scm | 19 |
1 files changed, 10 insertions, 9 deletions
diff --git a/catbird/repl.scm b/catbird/repl.scm index c30a51f..5619c9a 100644 --- a/catbird/repl.scm +++ b/catbird/repl.scm @@ -25,6 +25,7 @@ #:use-module (catbird mode) #:use-module (catbird node) #:use-module (catbird node-2d) + #:use-module (catbird pushdown) #:use-module (catbird region) #:use-module (catbird ring-buffer) #:use-module (catbird scene) @@ -129,8 +130,10 @@ (debug #:accessor debug #:init-keyword #:debug #:init-value #f)) (define-class <repl> (<node-2d>) - (level #:accessor level #:init-form (make <repl-level>)) - (level-stack #:accessor level-stack #:init-value '())) + (level-state #:getter level-state #:init-thunk make-pushdown-state)) + +(define-method (level (repl <repl>)) + (state-current (level-state repl))) (define-method (language (repl <repl>)) (language (level repl))) @@ -146,6 +149,7 @@ (define-method (initialize (repl <repl>) initargs) (next-method) + (state-push! (level-state repl) (make <repl-level>)) (attach-to repl (make <canvas> #:name 'background) @@ -159,15 +163,12 @@ (refresh-prompt repl)) (define-method (push-repl-level (repl <repl>) (new-level <repl-level>)) - (set! (level-stack repl) (cons (level repl) (level-stack repl))) - (set! (level repl) new-level)) + (state-push! (level-state repl) new-level)) (define-method (pop-repl-level (repl <repl>)) - (match (level-stack repl) - (() (detach repl)) - ((prev . rest) - (set! (level repl) prev) - (set! (level-stack repl) rest)))) + (state-pop! (level-state repl)) + (unless (state-current (level-state repl)) + (detach repl))) (define-method (log-append (repl <repl>) node) (let ((container (make <margin-container> |