commander-s/scheme/inspector.scm

(define footer-length 0)

(define (make-inspector-selection-list num-cols num-lines focus-obj)
  (let ((menu (prepare-menu focus-obj)))
    (make-select-list
     (map (lambda (e)
	    (make-unmarked-element 
	     (cdr e) #t (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 (inspect-value val)
  (error "not yet"))

(define key-d 100)
(define key-u 117)

(define down-key key-d)
(define up-key key-u)

(define (make-inspector focus-obj buffer)
  (let* ((num-cols (result-buffer-num-cols buffer))
         (num-lines (result-buffer-num-lines buffer))
         (val focus-obj)
         (stack '())
         (header (make-header focus-obj num-cols))
         (num-cols num-cols)
         (num-lines num-lines)
         (selection-list
          (make-inspector-selection-list num-cols
                                         (- num-lines (length header))
                                         focus-obj)))

    (define (inspect-next-continuation)
      (if (continuation? val)
          (set! stack (cons stack (continuation-parent val)))
          (set! header
           "Can't go down from a non-continuation.")))

    (define (inspector-state-pop-value)
      (if (null? stack)
          (set! header "Can't go up from here.")
          (begin
            (set! header (make-header (car stack) num-cols))
            (set! val (car stack))
            (set! stack (cdr stack))
            (set! selection-list
                  (make-inspector-selection-list
                   num-cols
                   (- num-lines (length header))
                   val)))))

    (lambda (message)
      (case message
        ((paint)
         (lambda (self win result-buffer have-focus?)
           (let ((hdr-len (length header)))
             (for-each (lambda (text y)
                         (mvwaddstr win y 0 text))
                       header
                       (iota hdr-len))
             (paint-selection-list-at
              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))
            (else
             (set! selection-list
                   (select-list-handle-key-press
                    selection-list key))))
           self))
         (else
          (error "did not handle message " message))))))

(register-plugin! 
 (make-view-plugin make-inspector exception-continuation?))