- make the lexer work if called without CURSOR-INDEX

- revamp the unparser to track the cursor-position after a TO-COMPLETE
  tokens was replaced by some completion or so.

scheme/cmdline.scm

@@ -135,7 +135,8 @@
       (let ((start-pos (current-column port)))
 	(read-char port)
 	(let read-whitspaces ((c (peek-char port))
-			      (cursor? (= start-pos cursor-index)))
+			      (cursor? (and cursor-index 
+					    (= start-pos cursor-index))))
 	  (cond
 	   ((eof-object? c)
 	    (lp c (if (or cursor?
@@ -147,7 +148,8 @@
 	    (read-char port)
 	    (read-whitspaces (peek-char port) 
 			     (or cursor?
-				 (= (current-column port) cursor-index))))
+				 (and cursor-index
+				      (= (current-column port) cursor-index)))))
 	   (else (lp c tokens))))))
      (else
       (let ((token (lex-token cursor-index port)))
@@ -224,7 +226,7 @@
    ((to-complete? t) 
     t)
    ((cursor-on-token? t)
-    (make-to-complete (token-token t) (token-start-pos t)))
+    (make-to-complete (token-token t) (token-cursor-pos t)))
    (else 
     (token-token t))))
 
@@ -364,58 +366,63 @@
 
 ;; unparser
 
-(define append* 
+(define (unparse-string/s-expr completion pos v)
-  (lambda args
-    (apply append
-	   (map (lambda (arg)
-		  (if (pair? arg)
-		      arg
-		      (list arg)))
-		(filter (lambda (v) (not (null? v)))
-			args)))))
-
-(define string-join*
-  (lambda args
-    (string-join (apply append* args))))
-
-(define (unparse-arbitrary v)
-  (let ((p (open-output-string)))
-    (display v p)
-    (get-output-string p)))
-
-(define (unparse-string/s-expr v)
   (cond
-   ((string? v) v)
+   ((and completion (to-complete? v))
+    (completion v)
+    (cell-set! pos (current-column (current-output-port))))
+   ((string? v)
+    (display v))
    ((and (pair? v) (eq? (car v) 'unquote))
-    (string-append 
+    (display ",")
-     "," (unparse-arbitrary (cadr v))))
+    (display (cadr v)))
    ((and (pair? v) (eq? (car v) 'unquote-splicing))
-    (string-append
+    (display ",@")
-     ",@" (unparse-arbitrary (cadr v))))
+    (display (cadr v)))
    (else
-    (unparse-arbitrary v))))
+    (error "Don't know how to unparse this." v))))
 
-(define (unparse-redirection rd)
+(define (unparse-redirection completion pos rd)
-  (string-join*
+  (display (symbol->string (redirection-op rd)))
-   (symbol->string (redirection-op rd))
+  (display " ")
-   (unparse-string/s-expr (redirection-dest rd))))
+  (unparse-string/s-expr completion pos
+			 (redirection-dest rd)))
 
-(define (unparse-command cmd)
+(define (unparse-command completion pos cmd)
-  (string-join*
+  (unparse-string/s-expr completion pos (command-executable cmd))
-   (unparse-string/s-expr (command-executable cmd))
+  (display " ")
-   (map unparse-string/s-expr (command-args cmd))
+  (for-each (lambda (arg)
-   (map unparse-redirection 
+	      (unparse-string/s-expr completion pos arg)
-	(command-redirections cmd))))
+	      (display " "))
+	    (command-args cmd))
+  (for-each (lambda (arg)
+	      (unparse-redirection completion pos arg)
+	      (display " "))
+	    (command-redirections cmd)))
 
-(define (unparse-command-line cmdln)
+(define (unparse-command-line cmdln . arg)
-  (string-join*
+  (let-optionals arg
-   (unparse-command (command-line-first-cmd cmdln))
+      ((completion #f))
-   (map (lambda (comb.cmd)
+    (let* ((pos (make-cell #f))
-	  (string-append
+	   (string-port (make-string-output-port))
-	   (symbol->string (car comb.cmd))
+	   (track-port (make-tracking-output-port string-port)))
-	   " "
+      (with-current-output-port track-port
-	   (unparse-command (cdr comb.cmd))))
+	(unparse-command completion pos
+			 (command-line-first-cmd cmdln))
+	(display " ")
+	(for-each 
+	 (lambda (comb.cmd)
+	   (display (symbol->string (car comb.cmd)))
+	   (display " ")
+	   (unparse-command completion pos (cdr comb.cmd)))
 	 (command-line-combinator/cmds cmdln))
-   (cond ((command-line-job-ctrl cmdln)
+	(cond
-	  => symbol->string)
+	 ((command-line-job-ctrl cmdln)
-	 (else '()))))
+	  => (lambda (sym)
+	       (display " ")
+	       (display (symbol->string sym)))))
+	;; we're done
+	(close-output-port track-port)
+	(values (string-output-port-output string-port)
+		(cell-ref pos))))))
+