Fix a few bugs in fsobjects-viewer

scheme/browse-directory-list.scm

@@ -65,11 +65,6 @@
   (paint-selection-list-at select-list 1 2 win
 			   buffer have-focus?))
 
-(define (make-browser-for-dir instance dir)
-  (let ((new-instance (make-fsobjects-viewer)))
-    (send new-instance 'init-browser-for-dir
-	  dir (send instance 'get-buffer))))
-
 (define (find-common-parent paths)
   (if (null? paths)
       ""
@@ -99,7 +94,7 @@
     (let* ((maybe-parent 
 	    (file-name-directory (send instance 'get-working-dir)))
 	   (parent (if (string=? maybe-parent "") "/" maybe-parent)))
-      (make-browser-for-dir instance parent)))
+      (make-browser-for-dir parent (send instance 'get-buffer))))
    (else
     (let ((fi (fs-object-info selected-entry)))
       (if (and fi (file-info-directory? fi))
@@ -109,8 +104,8 @@
              (display packet)
              (newline)
              instance))
-           (make-browser-for-dir instance 
-				 (fs-object-complete-path selected-entry)))
+           (make-browser-for-dir (fs-object-complete-path selected-entry)
+                                 (send instance 'get-buffer)))
 	  instance)))))
 
 (define (handle-key-press instance key)
@@ -126,31 +121,25 @@
 	    (select-list-handle-key-press select-list key))
       instance))))
 
-(define (make-fsobjects-viewer fs-objects buffer)
-  (let* ((fs-objects fs-objects)
+(define (make-browser-for-dir dir buffer)
+  (with-cwd dir
+    (make-fsobjects-viewer (directory-files)
+                           buffer
+                           (cwd))))
+  
+(define (make-fsobjects-viewer fs-objects buffer . maybe-parent)
+  (let-optionals maybe-parent
+      ((working-dir (find-common-parent
+                     (map fs-object-path fs-objects))))
+    (let ((fs-objects fs-objects)
           (buffer buffer)
-         (working-dir (find-common-parent
-                       (map fs-object-path fs-objects)))
           (select-list
            (make-file-select-list fs-objects 
                                   working-dir
-                                 (result-buffer-num-lines buffer))))
+                                  (- (result-buffer-num-lines buffer) 2))))
 
           (lambda (message)
             (cond
-
-       ((eq? message 'init-browser-for-dir)
-	(lambda (self new-dir new-buffer)
-	  (with-cwd new-dir
-	    (let ((new-fs-objects (directory-files)))
-	      (set! buffer new-buffer)
-	      (set! fs-objects new-fs-objects)
-	      (set! working-dir new-dir)
-	      (set! select-list
-		    (make-file-select-list 
-		     fs-objects (cwd) (result-buffer-num-lines new-buffer)))
-	      self))))
-
              ((eq? message 'paint)
               (lambda (self . args)
                 (apply paint-browser
@@ -177,7 +166,7 @@
                 working-dir))
        
              (else
-	(error "fsobjects-viewer unknown message" message))))))
+              (error "fsobjects-viewer unknown message" message))))))))
 
 (define (list-of-fs-objects? thing)
   (and (proper-list? thing)

scheme/nuit-packages.scm

@@ -107,6 +107,7 @@
 	srfi-1
 	(subset srfi-13 (string-copy string-drop string-prefix-length))
 	signals
+        let-opt
 
 	objects
 	layout