73 lines
2.2 KiB
Scheme
73 lines
2.2 KiB
Scheme
(define-record-type inspector-state :inspector-state
|
|
(make-inspector-state val stack)
|
|
inspector-state?
|
|
(val inspector-state-val)
|
|
(stack inspector-state-stack))
|
|
|
|
|
|
(define (inspect-value val)
|
|
(make-inspector-state val '()))
|
|
|
|
(define key-d 100)
|
|
(define key-u 117)
|
|
|
|
(define down-key key-d)
|
|
(define up-key key-u)
|
|
|
|
(define (inspector-receiver message)
|
|
(debug-message "inspector-receiver " message)
|
|
(cond
|
|
((init-with-result-message? message)
|
|
(make-inspector-state (init-with-result-message-result message) '()))
|
|
((print-message? message)
|
|
(let ((val (inspector-state-val (message-result-object message))))
|
|
(let ((head-line (format #f "~a" val))
|
|
(menu (map (lambda (val) (format #f "~a" val)) (prepare-menu val))))
|
|
(make-simple-result-buffer-printer
|
|
1 1 (cons head-line menu) '() '()))))
|
|
|
|
((key-pressed-message? message)
|
|
(let ((old-state (message-result-object message))
|
|
(key (key-pressed-message-key message)))
|
|
(cond
|
|
((= key down-key)
|
|
(inspect-next-continuation old-state))
|
|
((= key up-key)
|
|
(pop-inspector-stack old-state))
|
|
(else old-state))))
|
|
(else
|
|
(debug-message "did not handle message " message))))
|
|
|
|
(define (inspect-next-continuation state)
|
|
(let ((val (inspector-state-val state)))
|
|
(if (continuation? val)
|
|
(make-inspector-state (continuation-parent val)
|
|
(cons val (inspector-state-stack state)))
|
|
(begin
|
|
(debug-message "Can't go down from a non-continuation." val)
|
|
state))))
|
|
|
|
(define (pop-inspector-stack state)
|
|
(let ((stack (inspector-state-stack state)))
|
|
(if (null? stack)
|
|
(begin
|
|
(debug-message "Can't go up from here.")
|
|
state)
|
|
(make-inspector-state (car stack)
|
|
(cdr stack)))))
|
|
|
|
(define (error-receiver message)
|
|
(debug-message "error-receiver " message)
|
|
(cond
|
|
((init-with-result-message? message)
|
|
(make-inspector-state (init-with-result-message-result message) '()))
|
|
(else
|
|
(inspector-receiver message)))) ;; inheritance!
|
|
|
|
|
|
(register-plugin!
|
|
(make-view-plugin error-receiver exception-continuation?))
|
|
|
|
(register-plugin!
|
|
(make-view-plugin inspector-receiver inspector-state?))
|