Improvements to module name support (using prefixes) and Guile support.

4 files changed, 25 insertions, 16 deletions

diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
index d27ef0f..1e036c6 100644
--- a/elisp/geiser-completion.el
+++ b/elisp/geiser-completion.el
@@ -153,14 +153,17 @@ terminates a current completion."
              (quote (:scm ,(or (geiser-syntax--get-partial-sexp) "()"))))))
    :test 'string=))
 
-(defsubst geiser-completion--module-list ()
-  (geiser-eval--send/result '(:eval ((:ge all-modules)))))
+(defsubst geiser-completion--module-list (prefix)
+  (geiser-eval--send/result `(:eval ((:ge module-completions) ,prefix))))
 
 (defvar geiser-completion--symbol-list-func
   (completion-table-dynamic 'geiser-completion--symbol-list))
 
+(defvar geiser-completion--module-list-func
+  (completion-table-dynamic 'geiser-completion--module-list))
+
 (defun geiser-completion--complete (prefix modules)
-  (let* ((symbols (if modules (geiser-completion--module-list)
+  (let* ((symbols (if modules (geiser-completion--module-list prefix)
                     (geiser-completion--symbol-list prefix)))
          (completions (all-completions prefix symbols))
          (partial (try-completion prefix symbols))
@@ -183,11 +186,11 @@ terminates a current completion."
   (let ((minibuffer-local-completion-map geiser-completion--module-minibuffer-map))
     (geiser-eval--get-module
      (completing-read (or prompt "Module name: ")
-                      (geiser-completion--module-list)
-                      nil nil
+                      geiser-completion--module-list-func
+                      nil nil nil
+                      (or history geiser-completion--module-history)
                       (or default
-                          (format "%s" (or (geiser-syntax--buffer-module) "(")))
-                      (or history geiser-completion--module-history)))))
+                          (format "%s" (or (geiser-syntax--buffer-module) "")))))))
 
 (defun geiser--respecting-message (format &rest format-args)
   "Display TEXT as a message, without hiding any minibuffer contents."
diff --git a/scheme/guile/geiser/completion.scm b/scheme/guile/geiser/completion.scm
index 4906368..f4342bb 100644
--- a/scheme/guile/geiser/completion.scm
+++ b/scheme/guile/geiser/completion.scm
@@ -25,8 +25,9 @@
 ;;; Code:
 
 (define-module (geiser completion)
-  #:export (completions)
+  #:export (completions module-completions)
   #:use-module (geiser utils)
+  #:use-module (geiser modules)
   #:use-module (ice-9 session)
   #:use-module (ice-9 regex))
 
@@ -53,4 +54,10 @@
            (loop (cons 'let (body form)) (cons (cadr form) bindings)))
           (else (loop (cdr form) bindings)))))
 
+(define (module-completions prefix)
+  (let* ((prefix (string-append "^" (regexp-quote prefix)))
+         (matcher (lambda (s) (string-match prefix s)))
+         (names (filter matcher (all-modules))))
+    (sort! names string<?)))
+
 ;;; completions.scm ends here
diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm
index 13bd8db..106b8b1 100644
--- a/scheme/guile/geiser/emacs.scm
+++ b/scheme/guile/geiser/emacs.scm
@@ -32,10 +32,10 @@
                ge:load-file
                ge:autodoc
                ge:completions
+               ge:module-completions
                ge:symbol-location
                ge:generic-methods
                ge:symbol-documentation
-               ge:all-modules
                ge:module-children
                ge:module-location
                ge:callers
diff --git a/scheme/guile/geiser/modules.scm b/scheme/guile/geiser/modules.scm
index fdc3f3f..834e51c 100644
--- a/scheme/guile/geiser/modules.scm
+++ b/scheme/guile/geiser/modules.scm
@@ -57,13 +57,12 @@
 
 (define (all-modules)
   (let ((roots ((@@ (ice-9 session) root-modules))))
-    (sort! (map (lambda (m)
-                  (format "~A" (module-name m)))
-                (fold (lambda (m all)
-                        (append (all-child-modules m) all))
-                      roots
-                      roots))
-           string<?)))
+    (map (lambda (m)
+           (format "~A" (module-name m)))
+         (fold (lambda (m all)
+                 (append (all-child-modules m) all))
+               roots
+               roots))))
 
 (define (module-children mod-name)
   (let* ((elts (hash-fold classify-module-object