Fixed various bugs in the inspector
Make focus/selection messages work
This commit is contained in:
parent
d34769b0e1
commit
bfd61dfe44
|
@ -29,14 +29,19 @@
|
|||
(let ((str (get-output-string out)))
|
||||
(substring str 0 (min (string-length str) max-length)))))
|
||||
|
||||
(define (prepare-selection-for-scheme-mode file-names)
|
||||
(string-append "'" (exp->string file-names)))
|
||||
|
||||
(define (inspect-value val)
|
||||
(error "not yet"))
|
||||
|
||||
(define key-d 100)
|
||||
(define key-u 117)
|
||||
(define key-return 10)
|
||||
|
||||
(define down-key key-d)
|
||||
(define up-key key-u)
|
||||
(define inspect-key key-return)
|
||||
|
||||
(define (make-inspector focus-obj buffer)
|
||||
(let* ((num-cols (result-buffer-num-cols buffer))
|
||||
|
@ -51,18 +56,32 @@
|
|||
(- num-lines (length header))
|
||||
focus-obj)))
|
||||
|
||||
(define (push-val! new)
|
||||
(set! header (make-header val num-cols))
|
||||
(set! stack (cons new stack))
|
||||
(set! val new)
|
||||
(set! selection-list
|
||||
(make-inspector-selection-list
|
||||
num-cols
|
||||
(- num-lines (length header))
|
||||
new)))
|
||||
|
||||
(define (inspect-next-continuation)
|
||||
(if (continuation? val)
|
||||
(set! stack (cons stack (continuation-parent val)))
|
||||
(set! header
|
||||
(push-val! (continuation-parent val))
|
||||
(set-header-message!
|
||||
"Can't go down from a non-continuation.")))
|
||||
|
||||
(define (inspector-state-pop-value)
|
||||
(define (set-header-message! msg)
|
||||
(set! header (cons (car header)
|
||||
(list msg))))
|
||||
|
||||
(define (pop-val!)
|
||||
(if (null? stack)
|
||||
(set! header "Can't go up from here.")
|
||||
(set-header-message! "Can't go up from here.")
|
||||
(begin
|
||||
(set! header (make-header (car stack) num-cols))
|
||||
(set! val (car stack))
|
||||
(set! header (make-header val num-cols))
|
||||
(set! stack (cdr stack))
|
||||
(set! selection-list
|
||||
(make-inspector-selection-list
|
||||
|
@ -70,6 +89,25 @@
|
|||
(- num-lines (length header))
|
||||
val)))))
|
||||
|
||||
(define (get-focus-object self focus-object-table)
|
||||
(let ((marked (select-list-get-selection selection-list))
|
||||
(make-reference (lambda (obj)
|
||||
(make-focus-object-reference
|
||||
focus-object-table obj))))
|
||||
(if (null? marked)
|
||||
(exp->string
|
||||
(make-reference (select-list-selected-entry selection-list)))
|
||||
(string-append
|
||||
"(list "
|
||||
(string-join (map exp->string (map make-reference marked)))
|
||||
")"))))
|
||||
|
||||
(define (get-selection self for-scheme-mode?)
|
||||
(if for-scheme-mode?
|
||||
(let ((marked (select-list-get-selection selection-list)))
|
||||
(prepare-selection-for-scheme-mode marked))
|
||||
""))
|
||||
|
||||
(lambda (message)
|
||||
(case message
|
||||
((paint)
|
||||
|
@ -83,21 +121,26 @@
|
|||
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))
|
||||
(pop-val!))
|
||||
((= key inspect-key)
|
||||
(push-val! (select-list-selected-entry selection-list)))
|
||||
(else
|
||||
(set! selection-list
|
||||
(select-list-handle-key-press
|
||||
selection-list key))))
|
||||
self))
|
||||
((get-focus-object)
|
||||
get-focus-object)
|
||||
((get-selection)
|
||||
get-selection)
|
||||
(else
|
||||
(error "did not handle message " message))))))
|
||||
(debug-message "inspector did not handle message " message))))))
|
||||
|
||||
(register-plugin!
|
||||
(make-view-plugin make-inspector exception-continuation?))
|
||||
|
|
|
@ -224,7 +224,9 @@
|
|||
srfi-6
|
||||
display-conditions
|
||||
signals
|
||||
(subset srfi-13 (string-join))
|
||||
|
||||
focus-table
|
||||
ncurses
|
||||
layout
|
||||
select-list
|
||||
|
|
Loading…
Reference in New Issue