104 lines
3.2 KiB
Scheme
104 lines
3.2 KiB
Scheme
(define footer-length 0)
|
|
|
|
(define (make-inspector-selection-list num-cols num-lines focus-obj)
|
|
(let ((menu (prepare-menu focus-obj)))
|
|
(make-select-list
|
|
(map (lambda (e)
|
|
(make-unmarked-element
|
|
(cdr e) #t (layout-menu-entry num-cols e)))
|
|
menu)
|
|
num-lines)))
|
|
|
|
(define (make-header focus-obj num-cols)
|
|
(list (val-to-string focus-obj num-cols)
|
|
(if (exception-continuation? focus-obj)
|
|
"Press cont-down key to see more"
|
|
"")))
|
|
|
|
(define (layout-menu-entry num-cols entry)
|
|
(let ((head (format #f "[~a]" (or (car entry) ""))))
|
|
(string-append head (val-to-string (cdr entry)
|
|
(- num-cols (string-length head))))))
|
|
|
|
(define (val-to-string val max-length)
|
|
(let ((out (open-output-string)))
|
|
(limited-write val
|
|
out
|
|
3
|
|
5)
|
|
(let ((str (get-output-string out)))
|
|
(substring str 0 (min (string-length str) max-length)))))
|
|
|
|
(define (inspect-value val)
|
|
(error "not yet"))
|
|
|
|
(define key-d 100)
|
|
(define key-u 117)
|
|
|
|
(define down-key key-d)
|
|
(define up-key key-u)
|
|
|
|
(define (make-inspector focus-obj buffer)
|
|
(let* ((num-cols (result-buffer-num-cols buffer))
|
|
(num-lines (result-buffer-num-lines buffer))
|
|
(val focus-obj)
|
|
(stack '())
|
|
(header (make-header focus-obj num-cols))
|
|
(num-cols num-cols)
|
|
(num-lines num-lines)
|
|
(selection-list
|
|
(make-inspector-selection-list num-cols
|
|
(- num-lines (length header))
|
|
focus-obj)))
|
|
|
|
(define (inspect-next-continuation)
|
|
(if (continuation? val)
|
|
(set! stack (cons stack (continuation-parent val)))
|
|
(set! header
|
|
"Can't go down from a non-continuation.")))
|
|
|
|
(define (inspector-state-pop-value)
|
|
(if (null? stack)
|
|
(set! header "Can't go up from here.")
|
|
(begin
|
|
(set! header (make-header (car stack) num-cols))
|
|
(set! val (car stack))
|
|
(set! stack (cdr stack))
|
|
(set! selection-list
|
|
(make-inspector-selection-list
|
|
num-cols
|
|
(- num-lines (length header))
|
|
val)))))
|
|
|
|
(lambda (message)
|
|
(case message
|
|
((paint)
|
|
(lambda (self win result-buffer have-focus?)
|
|
(let ((hdr-len (length header)))
|
|
(for-each (lambda (text y)
|
|
(mvwaddstr win y 0 text))
|
|
header
|
|
(iota hdr-len))
|
|
(paint-selection-list-at
|
|
selection-list
|
|
0 hdr-len
|
|
win result-buffer have-focus?))))
|
|
|
|
((key-press)
|
|
(lambda (self key control-x-pressed?)
|
|
(cond
|
|
((= key down-key)
|
|
(inspect-next-continuation))
|
|
((= key up-key)
|
|
(inspector-state-pop-value))
|
|
(else
|
|
(set! selection-list
|
|
(select-list-handle-key-press
|
|
selection-list key))))
|
|
self))
|
|
(else
|
|
(error "did not handle message " message))))))
|
|
|
|
(register-plugin!
|
|
(make-view-plugin make-inspector exception-continuation?))
|