Use object-oriented approach

scheme/browse-directory-list.scm

@@ -2,18 +2,6 @@
 (define key-u 117)
 (define key-return 10)
 
-(define-record-type filelist-state :filelist-state
-  (make-filelist-state files select-list working-dir)
-  filelist-state?
-  (files filelist-state-files)
-  (select-list filelist-state-select-list)
-  (working-dir filelist-state-working-dir))
-
-(define-record-discloser :filelist-state
-  (lambda (r)
-    `(filelist-state ,(filelist-state-working-dir r)
-		     ,(filelist-state-files r))))
-
 (define (add-marks-to-special-file file-name fs-object)
   (let ((info (fs-object-info fs-object)))
     (cond
@@ -60,39 +48,27 @@
 (define header-line-path
   "Paths relative to ")
 
-(define (make-header-line state width)
+(define (make-header-line wdir width)
-  (let ((dir (filelist-state-working-dir state)))
+  (string-append 
-    (string-append 
+   header-line-path
-     header-line-path
+   (if wdir
-     (if dir
+       (abbrev-path 
-	 (abbrev-path 
+	wdir (- width (string-length header-line-path)))
-	  dir (- width (string-length header-line-path)))
+       "<unknown>")))
-	 "<unknown>"))))
 
-(define (paint-browser state)
+(define (paint-browser select-list wdir win buffer have-focus?)
-  (lambda (win result-buffer have-focus?)
+  (wattron win (A-BOLD))
-    (wattron win (A-BOLD))
+  (mvwaddstr win 0 0
-    (mvwaddstr win 0 0
+	     (make-header-line 
-	       (make-header-line 
+	      wdir (result-buffer-num-cols buffer)))
-		state (result-buffer-num-cols result-buffer)))
+  (wattrset win (A-NORMAL))
-    (wattrset win (A-NORMAL))
+  (paint-selection-list-at select-list 1 2 win
-    ((paint-selection-list-at
+			   buffer have-focus?))
-      (filelist-state-select-list state) 1 2)
-     win result-buffer have-focus?)))
 
-(define (make-browser-for-dir dir num-lines)
+(define (make-browser-for-dir instance dir)
-  (with-cwd dir
+  (let ((new-instance (make-fsobjects-viewer)))
-    (let ((fs-objects (directory-files)))
+    (send new-instance 'init-browser-for-dir
-      (make-filelist-state
+	  dir (send instance 'get-buffer))))
-       fs-objects (make-file-select-list fs-objects (cwd) num-lines)
-       (cwd)))))
-
-(define (make-browser-for-fs-objects fs-objects num-lines)
-  (let ((parent-dir (find-common-parent (map fs-object-path fs-objects))))
-    (make-filelist-state
-     fs-objects 
-     (make-file-select-list fs-objects parent-dir num-lines)
-     parent-dir)))
 
 (define (find-common-parent paths)
   (if (null? paths)
@@ -117,13 +93,13 @@
                                prefix-len)
                     prefix-len))))))))
 
-(define (handle-return-key state selected-entry num-lines)
+(define (handle-return-key instance selected-entry num-lines)
   (cond
    ((eq? selected-entry 'parent-dir)
     (let* ((maybe-parent 
-	    (file-name-directory (filelist-state-working-dir state)))
+	    (file-name-directory (send instance 'get-working-dir)))
 	   (parent (if (string=? maybe-parent "") "/" maybe-parent)))
-      (make-browser-for-dir parent num-lines)))
+      (make-browser-for-dir instance parent)))
    (else
     (let ((fi (fs-object-info selected-entry)))
       (if (and fi (file-info-directory? fi))
@@ -132,50 +108,89 @@
             (else
              (display packet)
              (newline)
-             state))
+             instance))
-           (make-browser-for-dir (fs-object-complete-path selected-entry)
+           (make-browser-for-dir instance 
-                                 num-lines))
+				 (fs-object-complete-path selected-entry)))
-	  state)))))
+	  instance)))))
 
-(define (handle-key-press message)
+(define (handle-key-press instance key)
-  (let* ((state (message-result-object message))
+  (let ((select-list (send instance 'get-select-list))
-	 (select-list (filelist-state-select-list state))
+	(buffer (send instance 'get-buffer)))
-	 (key (key-pressed-message-key message)))
     (cond
      ((= key key-return)
       (handle-return-key
-       state (select-list-selected-entry select-list)
+       instance (select-list-selected-entry select-list)
-       (calculate-number-of-lines
+       (calculate-number-of-lines buffer)))
-	(key-pressed-message-result-buffer message))))
      (else
-      (make-filelist-state
+      (send instance 'set-select-list!
-       (filelist-state-files state)
+	    (select-list-handle-key-press select-list key))
-       (select-list-handle-key-press
+      instance))))
-	(filelist-state-select-list state) message)
-       (filelist-state-working-dir state))))))
   
-(define (filelist-browser message)
+(define (make-fsobjects-viewer)
-  (cond
+  (let ((fs-objects #f)
+	(buffer #f)
+	(select-list #f)
+	(working-dir #f))
+    (lambda (message)
+      (cond
 
-   ((init-with-result-message? message)
+       ((eq? message 'init)
-    (let ((fsobjects (init-with-result-message-result message))
+	(lambda (self new-fs-objects new-buffer)
-	  (num-lines (calculate-number-of-lines 
+	  (let ((num-lines (result-buffer-num-lines new-buffer))
-		      (init-with-result-message-buffer message))))
+		(parent-dir 
-      (make-browser-for-fs-objects fsobjects num-lines)))
+		 (find-common-parent
-	
+		  (map fs-object-path new-fs-objects))))
-   ((print-message? message)
+	    (set! buffer new-buffer)
-    (paint-browser (message-result-object message)))
+	    (set! fs-objects new-fs-objects)
+	    (set! working-dir parent-dir)
+	    (set! select-list
+		  (make-file-select-list fs-objects parent-dir num-lines))
+	    self)))
 
-   ((key-pressed-message? message)
+       ((eq? message 'init-browser-for-dir)
-    (handle-key-press message))
+	(lambda (self new-dir new-buffer)
-   
+	  (with-cwd new-dir
-   (else
+	    (let ((new-fs-objects (directory-files)))
-    (values))))
+	      (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 
+		 (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 'set-select-list!)
+	(lambda (self new-select-list)
+	  (set! select-list new-select-list)))
+
+       ((eq? message 'get-buffer)
+	(lambda (self)
+	  buffer))
+
+       ((eq? message 'get-working-dir)
+	(lambda (self)
+	  working-dir))
+       
+       (else
+	(error "fsobjects-viewer unknown message" message))))))
 
 (define (list-of-fs-objects? thing)
   (and (proper-list? thing)
        (every fs-object? thing)))
 
 (register-plugin! 
- (make-view-plugin filelist-browser
+ (make-view-plugin make-fsobjects-viewer
 		   list-of-fs-objects?))

scheme/nuit-packages.scm

@@ -90,11 +90,11 @@
 
 (define-structure dirlist-view-plugin (export)
   (open (modify nuit-eval (hide string-copy))
-	define-record-types
 	srfi-1
 	(subset srfi-13 (string-copy string-drop string-prefix-length))
 	signals
 
+	objects
 	layout
 	fs-object
 	select-list