Initial version of a view plugin for exception-continuations
up and down work but you cannot select other objects yet
This commit is contained in:
parent
c5447bc2cd
commit
4e7e1301cb
|
@ -0,0 +1,71 @@
|
|||
(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-print-object 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?))
|
|
@ -92,6 +92,22 @@
|
|||
define-record-types)
|
||||
(files fs-object))
|
||||
|
||||
;;; inspector
|
||||
|
||||
(define-interface nuit-inspector-interface
|
||||
(export inspect-value))
|
||||
|
||||
(define-structure nuit-inspector-plugin nuit-inspector-interface
|
||||
(open scheme
|
||||
inspector-internal
|
||||
continuations
|
||||
formats
|
||||
define-record-types
|
||||
|
||||
tty-debug
|
||||
plugin)
|
||||
(files inspector))
|
||||
|
||||
;;; nuit evaluates the expressions entered into command buffer in this
|
||||
;;; package
|
||||
|
||||
|
@ -191,6 +207,7 @@
|
|||
conditions
|
||||
signals
|
||||
handle
|
||||
rt-modules
|
||||
ncurses
|
||||
srfi-1
|
||||
srfi-6
|
||||
|
@ -209,7 +226,8 @@
|
|||
browse-list-plugin
|
||||
dirlist-view-plugin
|
||||
process-view-plugin
|
||||
standard-command-plugin)
|
||||
standard-command-plugin
|
||||
nuit-inspector-plugin)
|
||||
(files nuit-engine
|
||||
handle-fatal-error))
|
||||
|
||||
|
|
Loading…
Reference in New Issue