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)
|
define-record-types)
|
||||||
(files fs-object))
|
(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
|
;;; nuit evaluates the expressions entered into command buffer in this
|
||||||
;;; package
|
;;; package
|
||||||
|
|
||||||
|
@ -191,6 +207,7 @@
|
||||||
conditions
|
conditions
|
||||||
signals
|
signals
|
||||||
handle
|
handle
|
||||||
|
rt-modules
|
||||||
ncurses
|
ncurses
|
||||||
srfi-1
|
srfi-1
|
||||||
srfi-6
|
srfi-6
|
||||||
|
@ -209,7 +226,8 @@
|
||||||
browse-list-plugin
|
browse-list-plugin
|
||||||
dirlist-view-plugin
|
dirlist-view-plugin
|
||||||
process-view-plugin
|
process-view-plugin
|
||||||
standard-command-plugin)
|
standard-command-plugin
|
||||||
|
nuit-inspector-plugin)
|
||||||
(files nuit-engine
|
(files nuit-engine
|
||||||
handle-fatal-error))
|
handle-fatal-error))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue