diff --git a/scheme/inspector.scm b/scheme/inspector.scm index 29ed3c3..33f5516 100644 --- a/scheme/inspector.scm +++ b/scheme/inspector.scm @@ -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.") - (begin - (set! header (make-header (car stack) num-cols)) + (set-header-message! "Can't go up from here.") + (begin (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)) - (else - (error "did not handle message " message)))))) + ((get-focus-object) + get-focus-object) + ((get-selection) + get-selection) + (else + (debug-message "inspector did not handle message " message)))))) (register-plugin! (make-view-plugin make-inspector exception-continuation?)) diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index d305095..5486df9 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -224,7 +224,9 @@ srfi-6 display-conditions signals + (subset srfi-13 (string-join)) + focus-table ncurses layout select-list