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:
mainzelm 2005-05-24 13:57:56 +00:00
parent c5447bc2cd
commit 4e7e1301cb
2 changed files with 90 additions and 1 deletions

71
scheme/inspector.scm Normal file
View File

@ -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?))

View File

@ -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))