From eefce5d839de9822fa645c604a29ccd104e85b69 Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Fri, 19 Aug 2005 12:30:37 +0000
Subject: [PATCH] - make the completion mechanism use the new unparser - fix a
 crash: Check if a plugin actually offers a completion function

---
 scheme/completer.scm     | 53 +++++++++-------------------------------
 scheme/nuit-engine.scm   | 15 +++++++-----
 scheme/nuit-packages.scm |  7 +++---
 scheme/std-command.scm   |  2 +-
 4 files changed, 25 insertions(+), 52 deletions(-)

diff --git a/scheme/completer.scm b/scheme/completer.scm
index d292ece..de885a0 100644
--- a/scheme/completer.scm
+++ b/scheme/completer.scm
@@ -143,7 +143,7 @@
 
 (define (complete-executables/path partial-name)
   (complete-with-filesystem-objects
-   (lambda (file) 
+   (lambda (file)
      (call-with-current-continuation
       (lambda (esc)
 	(with-handler
@@ -156,41 +156,10 @@
    partial-name))
 
 (define (complete-files/path partial-name)
+  (debug-message "complete-files/path " partial-name)
   (complete-with-filesystem-objects
    (lambda (file) #t) partial-name))
 
-;; insert the completion into the command line
-
-(define (assemble-redirection replacer redir)
-  (make-redirection
-   (redirection-op redir)
-   (replacer (redirection-dest redir))))
-
-(define (assemble-command replacer cmd)
-  (let ((assemble-redirection
-	 (lambda (obj) (assemble-redirection replacer obj))))
-    (make-command 
-     (replacer (command-executable cmd))
-     (map replacer (command-args cmd))
-     (map assemble-redirection (command-redirections cmd)))))
-
-(define (assemble-command-line replacer cmdln)
-  (let ((assemble-command 
-	 (lambda (cmd) (assemble-command replacer cmd))))
-    (make-command-line
-     (assemble-command (command-line-first-cmd cmdln))
-     (map (lambda (p)
-	    (cons (car p) (assemble-command (cdr p))))
-	  (command-line-combinator/cmds cmdln))
-     (command-line-job-ctrl cmdln))))
-
-(define (assemble-with-completion cmdln to-complete completion)
-  (assemble-command-line (lambda (obj)
-			   (if (eq? obj to-complete)
-			       completion
-			       obj))
-			 cmdln))
-
 ;; the main part
 
 (define (find-plugin-completer cmd)
@@ -199,13 +168,14 @@
      ((find (lambda (p)
 	      (string=? (command-plugin-command p) cmd-name))
 	    (command-plugin-list))
-      => command-plugin-completer)
+      => (lambda (plugin)
+	   (or (command-plugin-completer plugin)
+	       find-completions-for-arg)))
      (else find-completions-for-arg))))
 
 (define (find-completer type . args)
   (let-optionals args
       ((cmd #f))
-    (debug-message "find-completer " type "," cmd)
     (case type
       ((command) find-completions-for-command)
       ((redir-dest) find-completions-for-redir)
@@ -230,12 +200,13 @@
 	   (let ((completions ((find-completer type cmd) cmd to-complete)))
 	     (cond
 	      ((= (length completions) 1)
-	       (list (unparse-command-line
-		      (assemble-with-completion parsed to-complete
-						(car completions)))
-		     (calculate-cursor-index to-complete 
-					     (car completions))
-		     to-complete parsed))
+	       (call-with-values
+		   (lambda ()
+		     (unparse-command-line 
+		      parsed (lambda (to-complete)
+			       (display (car completions)))))
+		 (lambda (completed-line cursor-index)
+		   (list completed-line cursor-index parsed))))
 	      (else 
 	       (list completions cursor-index to-complete parsed))))))))
 
diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm
index a3d4926..86eef89 100644
--- a/scheme/nuit-engine.scm
+++ b/scheme/nuit-engine.scm
@@ -726,7 +726,7 @@
   (- (buffer-pos-col (command-buffer)) 2))
 
 (define (offer-completions command)
-  (debug-message "offer-completions '" command "'")
+  (debug-message "offer-completions '" command "' " (current-cursor-index))
   (let ((completion-info (complete command (current-cursor-index))))
     (if (not completion-info)
 	(begin
@@ -765,11 +765,14 @@
 	     (select-list-selected-entry select-list)))
 	(focus-command-buffer!)
 	;; #### No, I will not comment on this.
-	(display-completed-line 
-	 (unparse-command-line
-	  (assemble-with-completion
-	   cmdln to-complete completion))
-	 (+ 2 (calculate-cursor-index to-complete completion)))
+	(call-with-values
+	    (lambda ()
+	      (unparse-command-line cmdln
+				    (lambda (to-complete)
+				      (display completion))))
+	  (lambda (completed-line new-cursor-pos)
+	    (display-completed-line completed-line 
+				    (+ 2 new-cursor-pos))))
 	#f))
      ((or (select-list-navigation-key? key)
 	  (select-list-marking-key? key))
diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm
index c594874..f402ea5 100644
--- a/scheme/nuit-packages.scm
+++ b/scheme/nuit-packages.scm
@@ -467,9 +467,7 @@
 
 (define-interface completer-interface
   (export init-executables-completion-set!
-	  complete
-	  calculate-cursor-index
-	  assemble-with-completion))
+	  complete))
 
 (define-structure completer completer-interface
   (open scheme
@@ -672,14 +670,15 @@
 			command-line-absyn-interface
 			command-line-absyn-constructors-interface)))
   (open scheme
+	(subset scsh (with-current-output-port))
 	extended-ports
 	define-record-types
 	(subset srfi-1 (filter drop-right))
-	srfi-6
 	srfi-8
 	(subset srfi-13 (string-join))
 	srfi-14
 	let-opt
+	cells
 	silly
 	conditions
 	signals 
diff --git a/scheme/std-command.scm b/scheme/std-command.scm
index cffe1ab..9a04fc6 100644
--- a/scheme/std-command.scm
+++ b/scheme/std-command.scm
@@ -107,7 +107,7 @@
 
 ;; some common commands
 
-(define no-completer (lambda args #f))
+(define no-completer #f)
 
 ;; Parse options for ls command using args-fold (SRFI 37)
 ;; We don't care for options that format the output.