From bfd61dfe44944e35428c06e9ab6306659d00e14a Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Wed, 1 Jun 2005 12:55:29 +0000
Subject: [PATCH] Fixed various bugs in the inspector Make focus/selection
 messages work

---
 scheme/inspector.scm     | 63 +++++++++++++++++++++++++++++++++-------
 scheme/nuit-packages.scm |  2 ++
 2 files changed, 55 insertions(+), 10 deletions(-)

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