From 2476b86e0b6b9b220b476f0076a354d929e06882 Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Fri, 19 Aug 2005 12:28:53 +0000
Subject: [PATCH] - 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 | 111 ++++++++++++++++++++++++---------------------
 1 file changed, 59 insertions(+), 52 deletions(-)

diff --git a/scheme/cmdline.scm b/scheme/cmdline.scm
index cd4eca6..4e409b5 100644
--- a/scheme/cmdline.scm
+++ b/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?
@@ -146,8 +147,9 @@
 	   ((char-set-contains? char-set:whitespace c)
 	    (read-char port)
 	    (read-whitspaces (peek-char port) 
-			     (or cursor? 
-				 (= (current-column port) cursor-index))))
+			     (or cursor?
+				 (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* 
-  (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)
+(define (unparse-string/s-expr completion pos 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 
-     "," (unparse-arbitrary (cadr v))))
+    (display ",")
+    (display (cadr v)))
    ((and (pair? v) (eq? (car v) 'unquote-splicing))
-    (string-append
-     ",@" (unparse-arbitrary (cadr v))))
+    (display ",@")
+    (display (cadr v)))
    (else
-    (unparse-arbitrary v))))
+    (error "Don't know how to unparse this." v))))
 
-(define (unparse-redirection rd)
-  (string-join*
-   (symbol->string (redirection-op rd))
-   (unparse-string/s-expr (redirection-dest rd))))
+(define (unparse-redirection completion pos rd)
+  (display (symbol->string (redirection-op rd)))
+  (display " ")
+  (unparse-string/s-expr completion pos
+			 (redirection-dest rd)))
 
-(define (unparse-command cmd)
-  (string-join*
-   (unparse-string/s-expr (command-executable cmd))
-   (map unparse-string/s-expr (command-args cmd))
-   (map unparse-redirection 
-	(command-redirections cmd))))
+(define (unparse-command completion pos cmd)
+  (unparse-string/s-expr completion pos (command-executable cmd))
+  (display " ")
+  (for-each (lambda (arg)
+	      (unparse-string/s-expr completion pos arg)
+	      (display " "))
+	    (command-args cmd))
+  (for-each (lambda (arg)
+	      (unparse-redirection completion pos arg)
+	      (display " "))
+	    (command-redirections cmd)))
+
+(define (unparse-command-line cmdln . arg)
+  (let-optionals arg
+      ((completion #f))
+    (let* ((pos (make-cell #f))
+	   (string-port (make-string-output-port))
+	   (track-port (make-tracking-output-port string-port)))
+      (with-current-output-port track-port
+	(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)
+	  => (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))))))
 
-(define (unparse-command-line cmdln)
-  (string-join*
-   (unparse-command (command-line-first-cmd cmdln))
-   (map (lambda (comb.cmd)
-	  (string-append
-	   (symbol->string (car comb.cmd))
-	   " "
-	   (unparse-command (cdr comb.cmd))))
-	(command-line-combinator/cmds cmdln))
-   (cond ((command-line-job-ctrl cmdln)
-	  => symbol->string)
-	 (else '()))))