make the completion code work for arbitrary set of strings (called `completion-set')

scheme/complete.scm

@@ -1,9 +1,36 @@
+(define-record-type completion-set :completion-set
+  (really-make-completion-set strings cache)
+  completion-set?
+  (strings completion-set-strings set-completion-set-strings!)
+  (cache completion-set-cache set-completion-set-cache!))
+
+(define (make-empty-completion-set)
+  (really-make-completion-set '() '()))
+
+(define (make-completion-set strings)
+  (really-make-completion-set 
+   (lset-intersection strings strings) '()))
+
+(define (make-completion-set-for-executables path-list)
+  (really-make-completion-set
+   (executables-in-path-list path-list) '()))
+
+(define (adjoin-completion-set cs string)
+  (really-make-completion-set 
+   (cons string (completion-set-strings cs)) '()))
+
+(define (completions-for cs prefix)
+  (let ((maybe-result (check-cache-for-prefix cs prefix)))
+    (or maybe-result
+	(let ((result (strings-with-prefix 
+		       (completion-set-strings cs) prefix)))
+	  (add-to-cache cs prefix result)
+	  result))))
+
 ;; cached prefix version
 
 (define *completion-check-executable* #f)
 
-(define *cache-alist* '())
-
 (define (strings-with-prefix strings prefix)
   (let ((plen (string-length prefix)))
     (filter (lambda (s)
@@ -11,43 +38,49 @@
                    (string=? (substring s 0 plen) prefix)))
             strings)))
 
-(define (check-cache-for-prefix prefix)
+(define (check-cache-for-prefix cs prefix)
-  (let ((p (assoc prefix *cache-alist*)))
+  (let* ((cache-alist (completion-set-cache cs))
-    (if p
+	 (p (assoc prefix cache-alist)))
-        (cdr p)
+    (cond
-        (let loop ((nprefix prefix))
+     (p => cdr)
-           (if (string=? nprefix "")
+     (else
-               #f
+      (let loop ((nprefix prefix))
-               (let* ((nprefix (substring prefix 0 (- (string-length nprefix) 1)))
+	(if (string=? nprefix "")
-                      (p (assoc nprefix *cache-alist*)))
+	    #f
-                 (if p
+	    (let* ((nprefix (substring prefix 0 (- (string-length nprefix) 1)))
-                     (strings-with-prefix (cdr p) prefix)
+		   (p (assoc nprefix cache-alist)))
-                     (loop nprefix))))))))
+	      (if p
+		  (strings-with-prefix (cdr p) prefix)
+		  (loop nprefix)))))))))
 
 (define (has-prefix prefix s)
   (let ((pl (string-length prefix)))
     (and (>= (string-length s) (string-length prefix))
          (string=? (substring s 0 pl) prefix))))
 
-(define (add-to-cache prefix list)
+(define (add-to-cache cs prefix list)
-  (let ((prefixes (strings-with-prefix (map car *cache-alist*) prefix)))
+  (let* ((cache-alist (completion-set-cache cs))
+	 (prefixes (strings-with-prefix (map car cache-alist) prefix)))
     (receive (longer-ones others)
       (partition (lambda (p)
                    (has-prefix prefix (car p)))
-                 *cache-alist*)
+                 cache-alist)
-      (set! *cache-alist*
+      (set-completion-set-cache!
-            (cons (cons prefix (append list (append-map cdr longer-ones)))
+       cs
-                  others)))))
+       (cons (cons prefix (append list (append-map cdr longer-ones)))
+	     others)))))
 
-(define (executables-in-path/prefix prefix)
+(define (executables-in-path/prefix cs prefix)
-  (let ((maybe-result (check-cache-for-prefix prefix)))
+  (let ((maybe-result (check-cache-for-prefix cs prefix)))
     (or maybe-result
         (let ((result (append-map! (lambda (dir)
 		                     (dir-executables/prefix dir prefix))
 	                           (thread-fluid exec-path-list))))
-          (add-to-cache prefix result)
+          (add-to-cache cs prefix result)
           result))))
 
+(define completions-for-executables executables-in-path/prefix)
+
 (define (dir-executables/prefix dir prefix)
   (if (file-readable? dir)
       (map file-name-nondirectory