From ca2baa2c563bcfc5995619036b4bdfd316ce6ce8 Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Thu, 18 Aug 2005 09:23:59 +0000
Subject: [PATCH] Bring back the programmable completion

---
 scheme/completer.scm     | 32 ++++++++++++++++++++++++--------
 scheme/nuit-packages.scm |  4 +++-
 scheme/std-command.scm   | 11 +++++------
 3 files changed, 32 insertions(+), 15 deletions(-)

diff --git a/scheme/completer.scm b/scheme/completer.scm
index 916cd87..d292ece 100644
--- a/scheme/completer.scm
+++ b/scheme/completer.scm
@@ -76,6 +76,7 @@
 ;; completion functions for arguments and redirection 
 
 (define (find-completions-for-arg cmd to-complete)
+  (debug-message "find-completions-for-arg " cmd "," to-complete)
   (let ((prefix (to-complete-prefix to-complete)))
     (if prefix
 	(complete-files/path (expand-file-name prefix (cwd)))
@@ -87,6 +88,7 @@
 ;; completion functions for commands
 
 (define (find-completions-for-command cmd to-complete)
+  (debug-message "find-completions-for-command " cmd "," to-complete)
   (let ((prefix (or (to-complete-prefix to-complete) "")))
     (cond
      ((command-contains-path? prefix)
@@ -191,13 +193,27 @@
 
 ;; the main part
 
-(define (find-completer type)  
-  (case type
-    ((arg) find-completions-for-arg)
-    ((command) find-completions-for-command)
-    ((redir-dest) find-completions-for-redir)
-    (else
-     (error "Unknown completion type" type))))
+(define (find-plugin-completer cmd)
+  (let ((cmd-name (command-executable cmd)))
+    (cond
+     ((find (lambda (p)
+	      (string=? (command-plugin-command p) cmd-name))
+	    (command-plugin-list))
+      => command-plugin-completer)
+     (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)
+      ((arg) (if cmd
+		 (find-plugin-completer cmd)
+		 find-completions-for-arg))
+      (else
+       (error "Unknown completion type" type)))))
 
 (define (calculate-cursor-index to-complete completion)
   (+ (to-complete-pos to-complete) (string-length completion)))
@@ -211,7 +227,7 @@
     (debug-message "complete " completion-info)
     (and completion-info
 	 (destructure (((type cmd to-complete) completion-info))
-	   (let ((completions ((find-completer type) cmd to-complete)))
+	   (let ((completions ((find-completer type cmd) cmd to-complete)))
 	     (cond
 	      ((= (length completions) 1)
 	       (list (unparse-command-line
diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm
index 52f6271..c594874 100644
--- a/scheme/nuit-packages.scm
+++ b/scheme/nuit-packages.scm
@@ -237,6 +237,7 @@
 	command-line-parser
 	command-line-absyn
 	command-line-compiler
+	completion-sets
 	joblist
 	jobs
 	run-jobs-internals
@@ -483,7 +484,8 @@
 	handle
 	conditions
 	destructuring
-	(subset srfi-1 (filter-map))
+	let-opt
+	(subset srfi-1 (filter-map find))
 	srfi-13
 	srfi-14
 
diff --git a/scheme/std-command.scm b/scheme/std-command.scm
index 7933c31..cffe1ab 100644
--- a/scheme/std-command.scm
+++ b/scheme/std-command.scm
@@ -245,12 +245,11 @@
 (register-plugin!
  (make-command-plugin 
   "ftp"
-  (lambda (command prefix args args-pos)
-    (cond 
-     ((getenv "FTPHOSTS")
-      => string-tokenize)
-     (else
-      '("ftp.gnu.org" "ftp.x.org"))))
+  (let* ((hosts '("ftp.gnu.org" "ftp.x.org"))
+	 (cs (make-completion-set hosts)))
+    (lambda (command to-complete)
+      (debug-message "ftp completer " command "," to-complete)
+      (completions-for cs (or (to-complete-prefix to-complete) ""))))
   (lambda (command args)
     (run/fg (,command ,@args)))))