Fixed various bugs in the inspector

Make focus/selection messages work

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)))
+          (push-val! (continuation-parent val))
-          (set! header
+          (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
+          (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))
-         (else
+        ((get-focus-object)
-          (error "did not handle message " message))))))
+         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?))

scheme/nuit-packages.scm

@@ -224,7 +224,9 @@
         srfi-6
         display-conditions
 	signals
+        (subset srfi-13 (string-join))
         
+        focus-table
 	ncurses
         layout
         select-list