new features for selection-lists: list length is now adjustable, may

be placed at arbitrary position in the result buffer

scheme/browse-directory-list.scm

@@ -148,7 +148,8 @@
       (let ((fs-objects (init-with-result-message-result message)))
 	(init-with-list-of-files
 	 (map fs-object-name fs-objects) (cwd)
-	 (init-with-result-message-width message))))
+	 (result-buffer-num-cols
+	  (init-with-result-message-buffer message)))))
 
      ((next-command-message? message)
       (init-with-list-of-files (directory-files) (cwd)))

scheme/nuit-engine.scm

@@ -518,13 +518,13 @@
 	 (values 
 	  (post-message plugin
 			(make-init-with-result-message
-			 result (buffer-num-cols command-buffer)))
+			 result result-buffer))
 	  plugin)))
    (else 
     (values 
      (post-message standard-view-plugin
 		   (make-init-with-result-message
-		    result (buffer-num-cols command-buffer)))
+		    result result-buffer))
      standard-view-plugin))))
 
 ;;Extracts the name of the function and its parameters
@@ -742,7 +742,8 @@
      1 1 
      (layout-result-standard 
       (exp->string (init-with-result-message-result message))
-      (init-with-result-message-width message))
+      (result-buffer-num-cols 
+       (init-with-result-message-buffer message)))
      (init-with-result-message-result message)))
    ((next-command-message? message)
     (let* ((result (eval-expression (message-command-string message)))

scheme/nuit-packages.scm

@@ -70,6 +70,7 @@
 
 	pps
 	plugin
+	layout
 	select-list
 	tty-debug)
   (files process))
@@ -114,19 +115,19 @@
 (define-interface select-list-interface
   (export make-select-list
 	  select-list?
-	  select-list-cursor-index
-	  select-list-cursor-y
 	  select-list-handle-key-press
 	  unmark-current-line
 	  mark-current-line
 	  move-cursor-up
 	  move-cursor-down
-	  paint-selection-list))
+	  paint-selection-list
+	  paint-selection-list-at))
 
 (define-structure select-list select-list-interface
   (open scheme
 	srfi-1
 	define-record-types
+	let-opt
 	
 	tty-debug
 	plugin
@@ -188,7 +189,7 @@
 
 	  init-with-result-message?
 	  init-with-result-message-result
-	  init-with-result-message-width
+	  init-with-result-message-buffer
 
 	  key-pressed-message?
 	  key-pressed-message-result-buffer

scheme/plugins.scm

@@ -41,10 +41,10 @@
   (width next-command-message-width))
 
 (define-record-type init-with-result-message :init-with-result-message
-  (make-init-with-result-message result width)
+  (make-init-with-result-message result buffer)
   init-with-result-message?
   (result init-with-result-message-result)
-  (width init-with-result-message-width))
+  (buffer init-with-result-message-buffer))
 
 ;;key pressed
 ;;The object and the key are send to the user-code, who returns the

scheme/process.scm

@@ -32,20 +32,24 @@
 		      process-info-command-line))))
    width))
   
-(define (make-process-selection-list width processes)
+(define (make-process-selection-list num-cols num-lines processes)
-  (let ((layout (lambda (p) (layout-process width p))))
+  (let ((layout (lambda (p) (layout-process num-cols p))))
     (make-select-list
-     (zip processes (map layout processes)))))
+     (zip processes (map layout processes))
+     num-lines)))
 
 (define (pps-receiver message)
   (debug-message "pps-receiver " message)
   (cond
 
    ((init-with-result-message? message)
-    (let ((processes (init-with-result-message-result message))
+    (let* ((processes (init-with-result-message-result message))
-	  (width (init-with-result-message-width message)))
+	   (buffer (init-with-result-message-buffer message))
+	   (num-cols (result-buffer-num-cols buffer))
+	   (num-lines (result-buffer-num-lines buffer)))
       (make-plugin-state 
-       processes (make-process-selection-list width processes) 1)))
+       processes 
+       (make-process-selection-list num-cols num-lines processes) 1)))
 
    ((print-message? message)
     (paint-selection-list

scheme/select-list.scm

@@ -13,25 +13,25 @@
   (make-element #f value text))
 
 (define-record-type select-list :select-list
-  (really-make-select-list elements view-index cursor-index cursor-y)
+  (really-make-select-list elements view-index cursor-index num-lines)
   select-list?
   (elements select-list-elements)
   (view-index select-list-view-index)
   (cursor-index select-list-cursor-index)
-  (cursor-y select-list-cursor-y))
+  (num-lines select-list-num-lines))
 
 (define-record-discloser :select-list
   (lambda (r)
     `(select-list (index ,(select-list-cursor-index r))
 		  (view-index ,(select-list-view-index r))
-		  (y ,(select-list-cursor-y r)))))
+		  (num-lines ,(select-list-num-lines r)))))
 
-(define (make-select-list value/text-tuples)
+(define (make-select-list value/text-tuples num-lines)
   (really-make-select-list 
    (map (lambda (value/text)
 	  (apply make-unmarked-element value/text))
 	value/text-tuples)
-   0 0 1))
+   0 0 num-lines))
 
 (define key-m 109)
 
@@ -46,9 +46,9 @@
      ((= key key-u)
       (unmark-current-line select-list))
      ((= key key-up)
-      (move-cursor-up select-list result-buffer))
+      (move-cursor-up select-list))
      ((= key key-down)
-     (move-cursor-down select-list result-buffer))
+     (move-cursor-down select-list))
      (else
       select-list))))
 
@@ -68,7 +68,7 @@
 		  result)))
 	'() (zip elements (iota (length elements))))
        (select-list-view-index select-list)
-       index (select-list-cursor-y select-list)))))
+       index (select-list-num-lines select-list)))))
 
 (define unmark-current-line
   (mark/unmark-current-line-maker #f))
@@ -77,24 +77,24 @@
   (mark/unmark-current-line-maker #t))
 
 ;; returns: y cursor-index view-index
-(define (calculate-view index-move cursor-move 
+(define (calculate-view index-move elements 
- 			elements view-index cursor-index
+			view-index cursor-index
- 			num-lines y)
+ 			num-lines)
   (let ((new-index (index-move cursor-index))
  	(max-index (- (length elements) 1)))
     (cond
      ((< new-index 0) 
-      (values 0 0 view-index))
+      (values 0 view-index))
      ((> new-index max-index)
-      (values y max-index view-index))
+      (values max-index view-index))
      ((and (>= (- new-index view-index) num-lines)
  	   (> new-index cursor-index))
-      (values 1 new-index (+ view-index num-lines)))
+      (values new-index (+ view-index num-lines)))
      ((and (< new-index cursor-index)
 	   (>= view-index cursor-index))
-      (values num-lines new-index (- view-index num-lines)))
+      (values new-index (- view-index num-lines)))
      (else
-      (values (cursor-move y) (index-move cursor-index) view-index)))))
+      (values (index-move cursor-index) view-index)))))
 
 (define (copy-element-list elements)
   (fold-right
@@ -106,63 +106,64 @@
       result))
    '() elements))
 
-(define (move-cursor-maker index-move cursor-move)
+(define (move-cursor-maker index-move)
-  (lambda (select-list result-buffer)
+  (lambda (select-list)
     (let* ((elements (select-list-elements select-list))
-	   (old-index (select-list-cursor-index select-list)))
+	   (old-index (select-list-cursor-index select-list))
+	   (num-lines (select-list-num-lines select-list)))
       (call-with-values
 	  (lambda ()
-	    (calculate-view index-move cursor-move
+	    (calculate-view index-move
 			    elements
 			    (select-list-view-index select-list)
 			    old-index
-			    (result-buffer-num-lines result-buffer)
+			    num-lines))
-			    (select-list-cursor-y select-list)))
+      (lambda (cursor-index view-index)
-      (lambda (y cursor-index view-index)
 	(really-make-select-list
 	 (copy-element-list elements)
 	 view-index
 	 cursor-index 
-	 y))))))
+	 num-lines))))))
 
 (define move-cursor-up
-  (let ((sub-one (lambda (y) (- y 1))))
+  (move-cursor-maker (lambda (y) (- y 1))))
-    (move-cursor-maker sub-one sub-one)))
 
 (define move-cursor-down
-  (let ((add-one (lambda (y) (+ y 1))))
+  (move-cursor-maker (lambda (y) (+ y 1))))
-    (move-cursor-maker add-one add-one)))
 
 (define (take-max lst num)
   (if (>= num (length lst))
       lst
       (take lst num)))
 
-(define (select-visible-elements select-list result-buffer)
+(define (select-visible-elements select-list num-lines)
-  (let ((num-lines (result-buffer-num-lines result-buffer)))
+  (take-max (drop (select-list-elements select-list) 
-    (take-max (drop (select-list-elements select-list) 
+		  (select-list-view-index select-list))
-		    (select-list-view-index select-list))
+	    (+ 1 num-lines)))
-	      (+ 1 num-lines)))) ;;; wtf? why this
 
 (define (paint-selection-list select-list)
+  (paint-selection-list-at select-list 0 0))
+
+(define (paint-selection-list-at select-list x y)
   (lambda (win result-buffer have-focus?)
-    (let lp ((elts 
+    (let ((num-lines (select-list-num-lines select-list)))
-	      (select-visible-elements select-list result-buffer))
+      (let lp ((elts 
-	     (y 0) 
+		(select-visible-elements select-list num-lines))
-	     (i (select-list-view-index select-list)))
+	       (y y)
-      (cond
+	       (i (select-list-view-index select-list)))
-       ((null? elts)
+	(cond
-	(values))
+	 ((null? elts)
-       ((= i (select-list-cursor-index select-list))
+	  (values))
-	(wattron win (A-REVERSE))
+	 ((= i (select-list-cursor-index select-list))
-	(mvwaddstr win y 0 (element-text (car elts)))
+	  (wattron win (A-REVERSE))
-	(wattrset win (A-NORMAL))
+	  (mvwaddstr win y x (element-text (car elts)))
-	(lp (cdr elts) (+ y 1) (+ i 1)))
+	  (wattrset win (A-NORMAL))
-       ((element-marked? (car elts))
+	  (lp (cdr elts) (+ y 1) (+ i 1)))
-	(wattron win (A-BOLD))
+	 ((element-marked? (car elts))
-	(mvwaddstr win y 0 (element-text (car elts)))
+	  (wattron win (A-BOLD))
-	(wattrset win (A-NORMAL))
+	  (mvwaddstr win y x (element-text (car elts)))
-	(lp (cdr elts) (+ y 1) (+ i 1)))
+	  (wattrset win (A-NORMAL))
-       (else
+	  (lp (cdr elts) (+ y 1) (+ i 1)))
-	(mvwaddstr win y 0 (element-text (car elts)))
+	 (else
-	(lp (cdr elts) (+ y 1) (+ i 1)))))))
+	  (mvwaddstr win y x (element-text (car elts)))
+	  (lp (cdr elts) (+ y 1) (+ i 1))))))))