Make completion work on (almost) all positions of the cursor in the

command line.

scheme/nuit-engine.scm

@@ -286,46 +286,31 @@
   ;;Loop
   (paint)
   (let loop ((ch (wait-for-input)) (c-x-pressed? #f)
-	     (completion-select-list #f))
+	     (completion-selector #f))
 
     (cond
 
      ;; Ctrl-x -> wait for next input
      ((= ch key-control-x)
-      (loop (wait-for-input) #t completion-select-list))
+      (loop (wait-for-input) #t completion-selector))
 
-     ;; user hit tab twice and pressed some other key to navigate the
+     ((and (focus-on-result-buffer?) completion-selector)
-     ;; completion-select-list
+      (let ((new-selector (completion-selector ch)))
-     ((and (focus-on-result-buffer?) completion-select-list)
+	(loop (wait-for-input) c-x-pressed? new-selector)))
-      (if (= ch 10)
-	  (begin
-	    (focus-command-buffer!)
-	    (complete-in-command-buffer 
-	     (last (buffer-text command-buffer))
-	     (select-list-selected-entry completion-select-list))
-	    (loop (wait-for-input) c-x-pressed? #f))
-	  (let ((select-list
-		 (select-list-handle-key-press 
-		  completion-select-list
-		  (make-key-pressed-message (active-command) (current-result)
-					    result-buffer ch #f))))
-	    (paint-completion-select-list 
-	     select-list (last (buffer-text command-buffer)))
-	    (loop (wait-for-input) c-x-pressed? select-list))))
 
      ;; tab pressed twice, select completion using select-list
      ((and (focus-on-command-buffer?)
-	   completion-select-list
+	   completion-selector
 	   (= ch key-tab))
       (focus-result-buffer!)
-      (loop (wait-for-input) #f completion-select-list))
+      (loop (wait-for-input) #f completion-selector))
 
      ;; tab is pressed in the first place, offer completions
      ((and (focus-on-command-buffer?)
 	   (= ch key-tab))
-      (let ((maybe-select-list
+      (let ((maybe-selector
 	     (offer-completions (last (buffer-text command-buffer)))))
-	(loop (wait-for-input) #f maybe-select-list)))
+	(loop (wait-for-input) #f maybe-selector)))
 
      ;; F7 toggle scheme-mode / command-mode (FIXME: find a better key)
      ((= ch key-f7)
@@ -800,11 +785,11 @@
       (string-contains command "~")
       (string-contains command "..")))
 
-(define (executables-in-dir dir)
+(define (files-in-dir file-filter dir)
   (with-cwd dir
     (filter-map 
      (lambda (file)
-       (and (or (file-executable? file) (file-directory? file))
+       (and (file-filter file)
 	    (absolute-file-name file dir)))
      (directory-files))))
 
@@ -816,38 +801,72 @@
 	       (string-append dir p)))
 	 (glob (string-append path "*")))))
 
-(define (complete-executable/path command)
+(define (complete-with-filesystem-objects filter partial-name)
-  (if (and (file-exists? command) (file-directory? command))
+  (if (and (file-exists? partial-name) (file-directory? partial-name))
-      (executables-in-dir command)
+      (files-in-dir filter partial-name)
-      (complete-path command)))
+      (complete-path partial-name)))
 
-(define (command-mode-complete command)
+(define (complete-executables/path partial-name)
+  (complete-with-filesystem-objects
+   (lambda (file) 
+     (or (file-executable? file) (file-directory? file)))
+   partial-name))
+
+(define (complete-files/path partial-name)
+  (complete-with-filesystem-objects
+   (lambda (file) #t) partial-name))
+
+(define (command-mode-completer command prefix args args-pos)
+  (debug-message "command-mode-completer" prefix "|" args "|" args-pos)
   (cond
-   ((command-contains-path? command)
+   ((command-contains-path? prefix)
-    (let ((new
+    ;; #### FIXME ignore errors here?
-	   (complete-executable/path (expand-file-name command (cwd)))))
+    ((if (zero? args-pos)
-      (debug-message "command-mode-complete " command)
+	 complete-executables/path 
-      new))
+	 complete-files/path)
+     (expand-file-name prefix (cwd))))
    (else
     (append
-     (completions-for (command-completions) command)
+     (completions-for (command-completions) prefix)
-     (completions-for-executables executable-completions command)))))
+     (completions-for-executables executable-completions prefix)))))
-	
+
-(define (complete-in-command-buffer command completion)
+(define (assemble-line-with-completion command arg arg-pos completion)
-  (let ((rest (substring completion 
+  (debug-message "assemble-line-with-completion "
-			 (string-length command)
+		 command "," arg "," arg-pos "," completion)
-			 (string-length completion))))
+  (let ((string-append* (lambda (s t)
-    (debug-message "complete-in-command-buffer "
+			  (if (string=? s "") 
-		   "'" command "'; '" completion "'; "
+			      t
-		   "'" rest "'")
+			      (string-append s " " t)))))
-    (for-each (lambda (c)
+    (let lp ((tokens (cons command arg)) 
-		(input command-buffer (char->ascii c)))
+	     (arg-count 0)
-	      (string->list rest))
+	     (cursor-pos 0)
-    (wclrtoeol (app-window-curses-win command-window))
+	     (line ""))
-    (print-command-buffer (app-window-curses-win command-window)
+      (cond
-			  command-buffer)
+       ((null? tokens)
-    (move-cursor command-buffer result-buffer)
+	(values line (+ 2 cursor-pos)))
-    (refresh-command-window)))
+       ((= arg-count arg-pos)
+	(lp (cdr tokens) 
+	    (+ arg-count 1)
+	    (+ cursor-pos (string-length completion))
+	    (string-append* line completion)))
+       (else
+	(lp (cdr tokens) 
+	    (+ arg-count 1)
+	    (+ 1 (+ cursor-pos (string-length (car tokens))))
+	    (string-append* line (car tokens))))))))
+
+(define (display-completed-line line cursor-pos)
+  (debug-message "display-completed-line " line "," cursor-pos)
+  (set-buffer-pos-col! command-buffer cursor-pos)
+  (set-buffer-text! command-buffer
+		    (append
+		     (drop-right (buffer-text command-buffer) 1)
+		     (list line)))
+  (wclrtoeol (app-window-curses-win command-window))
+  (print-command-buffer (app-window-curses-win command-window)
+			command-buffer)
+  (move-cursor command-buffer result-buffer)
+  (refresh-command-window))
 
 (define (paint-completion-select-list select-list command)
   (let ((win (app-window-curses-win result-window)))
@@ -859,26 +878,84 @@
     (paint-result-buffer (paint-selection-list-at select-list 0 2))
     (refresh-result-window)))
 
+;; #### implement me
+(define (completer-function-for-command command)
+  #f)
+
+(define (call-completer command args prefix arg-pos)
+  (cond
+   ((= 0 arg-pos)
+    (command-mode-completer command prefix args arg-pos))
+   ((completer-function-for-command command)
+    => (lambda (completer)
+	 (completer command prefix args arg-pos)))
+   (else 
+    (command-mode-completer command prefix args arg-pos))))
+
 (define (offer-completions command)
   (let* ((tokens/cursor-list (tokenize-command command))
+	 (args (map car (cdr tokens/cursor-list)))
 	 (command (caar tokens/cursor-list)))
     (call-with-values
 	(lambda ()
 	  (find-token-with-cursor tokens/cursor-list))
       (lambda (prefix arg-pos)
-	;; hook in completer functions here
+	;; #### FIXME
-	(let ((completions (command-mode-complete command)))
+	(if (not prefix)
+	    (error "could not determine token with cursor position"
+		   tokens/cursor-list command 
+		   (- (buffer-pos-col command-buffer) 2)))
+	(let ((completions 
+	       (call-completer command args
+			       prefix arg-pos)))
 	  (if (= (length completions) 1)
 	      (begin
-		(complete-in-command-buffer command (car completions))
+		(call-with-values
+		    (lambda ()
+		      (assemble-line-with-completion 
+		       command args arg-pos (car completions)))
+		  display-completed-line)
 		#f)
-	      (let ((select-list 
+	      (let* ((select-list
-		     (completions->select-list 
+		      (completions->select-list 
-		      completions (- (result-buffer-num-lines result-buffer) 3))))
+		       completions 
+		       (- (result-buffer-num-lines result-buffer) 3)))
+		     (selector
+		      (make-completion-selector 
+		       select-list completions
+		       command args arg-pos)))
 		(paint-completion-select-list select-list command)
-		select-list)))))))
+		(move-cursor command-buffer result-buffer)
+		(refresh-command-window)
+		selector)))))))
+
+(define (make-completion-selector select-list completions
+				  command arg arg-pos)
+  (lambda (key)
+    (cond
+     ((= key 10)
+      (focus-command-buffer!) 
+      (call-with-values
+	  (lambda ()
+	    (assemble-line-with-completion
+	     command arg arg-pos
+	     (select-list-selected-entry select-list)))
+	display-completed-line)
+      #f)
+     (else
+      (let ((new-select-list
+	     (select-list-handle-key-press
+	      select-list
+	      (make-key-pressed-message 
+	       (active-command) (current-result)
+	       result-buffer key #f))))
+	(paint-completion-select-list
+	 new-select-list (last (buffer-text command-buffer)))
+	(make-completion-selector 
+	 new-select-list completions command arg arg-pos))))))
 
 (define (find-token-with-cursor tokens/cursor-list)
+  (debug-message "find-token-with-cursor " tokens/cursor-list)
   (let lp ((lst tokens/cursor-list) (i 0))
     (cond
      ((null? lst)