From ddf1ca752bebc48b9df9e0eab897913a28a081cd Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Tue, 31 May 2005 14:54:48 +0000
Subject: [PATCH] Fix a few bugs in fsobjects-viewer

---
 scheme/browse-directory-list.scm | 95 ++++++++++++++------------------
 scheme/nuit-packages.scm         |  1 +
 2 files changed, 43 insertions(+), 53 deletions(-)

diff --git a/scheme/browse-directory-list.scm b/scheme/browse-directory-list.scm
index 6197851..25eb897 100644
--- a/scheme/browse-directory-list.scm
+++ b/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)
@@ -125,59 +120,53 @@
       (send instance 'set-select-list!
 	    (select-list-handle-key-press select-list key))
       instance))))
+
+(define (make-browser-for-dir dir buffer)
+  (with-cwd dir
+    (make-fsobjects-viewer (directory-files)
+                           buffer
+                           (cwd))))
   
-(define (make-fsobjects-viewer fs-objects buffer)
-  (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))))
+(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)
+          (select-list
+           (make-file-select-list fs-objects 
+                                  working-dir
+                                  (- (result-buffer-num-lines buffer) 2))))
 
-    (lambda (message)
-      (cond
+          (lambda (message)
+            (cond
+             ((eq? message 'paint)
+              (lambda (self . args)
+                (apply paint-browser
+                       (append (list select-list working-dir) args))))
 
-       ((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 'key-press)
+              (lambda (self key control-x-pressed?)
+                (handle-key-press self key)))
 
-       ((eq? message 'paint)
-	(lambda (self . args)
-	  (apply paint-browser 
-		 (append (list select-list working-dir) args))))
-
-       ((eq? message 'key-press)
-	(lambda (self key control-x-pressed?)
-	  (handle-key-press self key)))
-
-       ((eq? message 'get-select-list)
-	(lambda (self)
-	  select-list))
+             ((eq? message 'get-select-list)
+              (lambda (self)
+                select-list))
        
-       ((eq? message 'set-select-list!)
-	(lambda (self new-select-list)
-	  (set! select-list new-select-list)))
+             ((eq? message 'set-select-list!)
+              (lambda (self new-select-list)
+                (set! select-list new-select-list)))
 
-       ((eq? message 'get-buffer)
-	(lambda (self)
-	  buffer))
+             ((eq? message 'get-buffer)
+              (lambda (self)
+                buffer))
 
-       ((eq? message 'get-working-dir)
-	(lambda (self)
-	  working-dir))
+             ((eq? message 'get-working-dir)
+              (lambda (self)
+                working-dir))
        
-       (else
-	(error "fsobjects-viewer unknown message" message))))))
+             (else
+              (error "fsobjects-viewer unknown message" message))))))))
 
 (define (list-of-fs-objects? thing)
   (and (proper-list? thing)
diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm
index f80dadc..11e30a3 100644
--- a/scheme/nuit-packages.scm
+++ b/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