Use select-list in the inspector

scheme/inspector.scm

@@ -1,12 +1,110 @@
 (define-record-type inspector-state :inspector-state
-  (make-inspector-state val stack)
+  (make-inspector-state val stack header num-cols num-lines selection-list)
   inspector-state?
   (val inspector-state-val)
-  (stack inspector-state-stack))
+  (stack inspector-state-stack)
+  (header inspector-state-header)
+  (num-cols inspector-state-num-cols)
+  (num-lines inspector-state-num-lines)
+  (selection-list inspector-state-selection-list))
+
+(define footer-length 0)
+
+(define (make-initial-inspector-state focus-obj num-cols num-lines)
+  (let ((header (make-header focus-obj num-cols)))
+    (make-inspector-state focus-obj
+                          '()
+                          header
+                          num-cols
+                          num-lines
+                          (make-inspector-selection-list num-cols
+                                                         (- num-lines (length header))
+                                                         focus-obj))))
+
+(define (make-inspector-selection-list num-cols num-lines focus-obj)
+  (let ((menu (prepare-menu focus-obj)))
+    (make-select-list
+     (zip
+      (map cdr menu) ;; drop name
+      (map (lambda (e) #t) menu) ;; all are selectable
+      (map (lambda (e) (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 (inspector-state-exchange-selection-list old-state sl)
+  (make-inspector-state (inspector-state-val old-state)
+                        (inspector-state-stack old-state)
+                        (inspector-state-header old-state)
+                        (inspector-state-num-cols old-state)
+                        (inspector-state-num-lines old-state)
+                        sl))
+
+(define (inspector-state-exchange-header-msg old-state msg)
+  (make-inspector-state  (inspector-state-val old-state)
+                         (inspector-state-stack old-state)
+                         (cons (car (inspector-state-header old-state))
+                               (list msg))
+                         (inspector-state-num-cols old-state)
+                         (inspector-state-num-lines old-state)
+                         (inspector-state-selection-list old-state)))
+
+
+(define (inspector-state-push-value state val)
+  (let* ((num-cols (inspector-state-num-cols state))
+         (num-lines (inspector-state-num-lines state))
+         (hdr (make-header val num-cols)))
+    (make-inspector-state val
+                          (cons (inspector-state-val state)
+                                (inspector-state-stack state))
+                          hdr
+                          num-cols
+                          num-lines
+                          (make-inspector-selection-list
+                           num-cols
+                           (- num-lines (length hdr))
+                           val))))
+
+(define (inspector-state-pop-value state)
+  (let ((stack (inspector-state-stack state))
+        (num-cols (inspector-state-num-cols state))
+        (num-lines (inspector-state-num-lines state)))
+    (if (null? stack)
+        (inspector-state-exchange-header-msg state
+                                             "Can't go up from here.")
+        (let ((hdr (make-header (car stack) num-cols)))
+          (make-inspector-state (car stack)
+                                (cdr stack)
+                                hdr
+                                num-cols
+                                num-lines
+                                (make-inspector-selection-list
+                                 num-cols
+                                 (- num-lines (length hdr))
+                                 (car stack)))))))
 
                         
 (define (inspect-value val)
-  (make-inspector-state val '()))
+  (error "not yet"))
 
 (define key-d 100)
 (define key-u 117)
@@ -18,13 +116,26 @@
   (debug-message "inspector-receiver " message)
   (cond 
    ((init-with-result-message? message)
-    (make-inspector-state (init-with-result-message-result message) '()))
+    (let* ((focus-obj (init-with-result-message-result message))
+           (buffer (init-with-result-message-buffer message))
+           (num-cols (result-buffer-num-cols buffer))
+           (num-lines (result-buffer-num-lines buffer)))
+      (make-initial-inspector-state focus-obj
+                                    num-cols
+                                    num-lines)))
    ((print-message? message)
-    (let ((val (inspector-state-val (message-result-object message))))
+    (lambda (win result-buffer have-focus?)
-      (let ((head-line (format #f "~a" val))
+      (let* ((state (message-result-object message))
-            (menu (map (lambda (val) (format #f "~a" val)) (prepare-menu val))))
+             (hdr (inspector-state-header state))
-	(make-simple-result-buffer-printer
+             (hdr-len (length hdr)))
-	 1 1 (cons head-line menu) '() '()))))
+        (for-each (lambda (text y)
+                    (mvwaddstr win y 0 text))
+                  hdr
+                  (iota hdr-len))
+        ((paint-selection-list-at
+          (inspector-state-selection-list state)
+          0 hdr-len)
+         win result-buffer have-focus?))))
 
    ((key-pressed-message? message)
     (let ((old-state (message-result-object message))
@@ -33,36 +144,27 @@
        ((= key down-key)
         (inspect-next-continuation old-state))
        ((= key up-key)
-        (pop-inspector-stack old-state))
+        (inspector-state-pop-value old-state))
-       (else old-state))))
+       (else
+        (let ((old-state (message-result-object message)))
+          (inspector-state-exchange-selection-list
+           old-state
+           (select-list-handle-key-press
+            (inspector-state-selection-list old-state)
+            message)))))))
    (else
     (debug-message "did not handle message " message))))
 
 (define (inspect-next-continuation state)
   (let ((val (inspector-state-val state)))
     (if (continuation? val)
-        (make-inspector-state (continuation-parent val)
+        (inspector-state-push-value state (continuation-parent val))
-                              (cons val (inspector-state-stack state)))
+        (inspector-state-exchange-header-msg
-        (begin
+         state
-          (debug-message "Can't go down from a non-continuation." val)
+         "Can't go down from a non-continuation."))))
-          state))))
-        
-(define (pop-inspector-stack state)
-  (let ((stack (inspector-state-stack state)))
-    (if (null? stack)
-        (begin
-          (debug-message "Can't go up from here.")
-          state)
-        (make-inspector-state (car stack)
-                              (cdr stack)))))
         
 (define (error-receiver message)
-  (debug-message "error-receiver " message)
+  (inspector-receiver message))
-  (cond
-   ((init-with-result-message? message)
-    (make-inspector-state (init-with-result-message-result message) '()))
-   (else
-    (inspector-receiver message)))) ;; inheritance!
 
 
 (register-plugin! 

scheme/nuit-packages.scm

@@ -148,8 +148,13 @@
         continuations
         formats
         define-record-types
+        srfi-1
+        srfi-6
+        display-conditions
         
+	ncurses
         layout
+        select-list
         tty-debug
         plugin)
   (files inspector))