summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-05-08 01:48:52 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-05-08 01:48:52 +0200
commitc09f5bbaa836d04a9babdff0943dc596dbc68e38 (patch)
treee2c9c91fa86534ba9479c03a067164947fb034d1
parent9127a121c76f5d5606bca9a668bda5509ec3b830 (diff)
downloadgeiser-guile-c09f5bbaa836d04a9babdff0943dc596dbc68e38.tar.gz
geiser-guile-c09f5bbaa836d04a9babdff0943dc596dbc68e38.tar.bz2
Module completion generalized and implemented for PLT.
-rw-r--r--elisp/geiser-completion.el14
-rw-r--r--elisp/geiser-guile.el6
-rw-r--r--elisp/geiser-impl.el18
-rw-r--r--elisp/geiser-plt.el3
-rw-r--r--scheme/plt/geiser.ss8
-rw-r--r--scheme/plt/geiser/modules.ss42
6 files changed, 79 insertions, 12 deletions
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
index d2991b2..d27ef0f 100644
--- a/elisp/geiser-completion.el
+++ b/elisp/geiser-completion.el
@@ -196,11 +196,13 @@ terminates a current completion."
(minibuffer-message text)
(message "%s" text))))
-(defsubst geiser-completion--beg-pos (module)
- (if module
- (max (save-excursion (beginning-of-line) (point))
- (save-excursion (skip-syntax-backward "^(>") (1- (point))))
- (save-excursion (skip-syntax-backward "^-()>") (point))))
+(make-variable-buffer-local
+ (defvar geiser-completion--symbol-begin-function nil))
+
+(defsubst geiser-completion--symbol-begin (module)
+ (or (and geiser-completion--symbol-begin-function
+ (funcall geiser-completion--symbol-begin-function module))
+ (save-excursion (skip-syntax-backward "^-()>") (point))))
(defun geiser-completion--complete-symbol (&optional arg)
"Complete the symbol at point.
@@ -208,7 +210,7 @@ Perform completion similar to Emacs' complete-symbol.
With prefix, complete module name."
(interactive "P")
(let* ((end (point))
- (beg (geiser-completion--beg-pos arg))
+ (beg (geiser-completion--symbol-begin arg))
(prefix (buffer-substring-no-properties beg end))
(result (geiser-completion--complete prefix arg))
(completions (car result))
diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index a34f401..bfdca31 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -112,6 +112,12 @@ If MODULE is provided, transform it to such a datum."
((stringp module) (or (ignore-errors (car (read-from-string module))) :f))
(t :f)))
+(defun geiser-guile-symbol-begin (module)
+ (if module
+ (max (save-excursion (beginning-of-line) (point))
+ (save-excursion (skip-syntax-backward "^(>") (1- (point))))
+ (save-excursion (skip-syntax-backward "^-()>") (point))))
+
;;; Trying to ascertain whether a buffer is Guile Scheme:
diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el
index 75a4ca7..13e5ead 100644
--- a/elisp/geiser-impl.el
+++ b/elisp/geiser-impl.el
@@ -28,6 +28,7 @@
(require 'geiser-eval)
(require 'geiser-base)
(require 'geiser-doc)
+(require 'geiser-completion)
;;; Customization:
@@ -130,23 +131,32 @@
(let ((f (geiser-impl--sym impl "external-help")))
(and (fboundp f) f)))
+(defsubst geiser-impl--symbol-begin (impl)
+ (geiser-impl--sym impl "symbol-begin"))
+
(defun geiser-impl--install-eval (impl)
- (setq geiser-eval--get-module-function (geiser-impl--module-function impl))
+ (setq geiser-eval--get-module-function
+ (geiser-impl--module-function impl))
(setq geiser-eval--geiser-procedure-function
(geiser-impl--geiser-procedure-function impl))
(setq geiser-doc--external-help-function
- (geiser-impl--external-help-function impl)))
+ (geiser-impl--external-help-function impl))
+ (setq geiser-completion--symbol-begin-function
+ (geiser-impl--symbol-begin impl)))
;;; Evaluating Elisp in a given implementation context:
(defun with--geiser-implementation (imp thunk)
(let ((geiser-impl--implementation imp)
- (geiser-eval--get-module-function (geiser-impl--module-function imp))
+ (geiser-eval--get-module-function
+ (geiser-impl--module-function imp))
(geiser-eval--geiser-procedure-function
(geiser-impl--geiser-procedure-function imp))
(geiser-doc--external-help-function
- (geiser-impl--external-help-function imp)))
+ (geiser-impl--external-help-function imp))
+ (geiser-completion--symbol-begin-function
+ (geiser-impl--symbol-begin imp)))
(funcall thunk)))
(put 'with--geiser-implementation 'lisp-indent-function 1)
diff --git a/elisp/geiser-plt.el b/elisp/geiser-plt.el
index b93dc1d..1b539f8 100644
--- a/elisp/geiser-plt.el
+++ b/elisp/geiser-plt.el
@@ -101,6 +101,9 @@ This function uses `geiser-plt-init-file' if it exists."
((null module) (buffer-file-name))
(t module)))
+(defun geiser-plt-symbol-begin (module)
+ (save-excursion (skip-syntax-backward "^-()>") (point)))
+
;;; External help
(defun geiser-plt-external-help (symbol module)
diff --git a/scheme/plt/geiser.ss b/scheme/plt/geiser.ss
index 767b13b..89de51e 100644
--- a/scheme/plt/geiser.ss
+++ b/scheme/plt/geiser.ss
@@ -31,12 +31,17 @@
geiser/compile-file
geiser/macroexpand
geiser/completions
+ geiser/all-modules
geiser/symbol-location
geiser/autodoc
geiser/make-repl-reader)
(compile-enforce-module-constants #f)
- (require geiser/eval geiser/completions geiser/locations geiser/autodoc)
+ (require geiser/eval
+ geiser/modules
+ geiser/completions
+ geiser/locations
+ geiser/autodoc)
(define geiser/eval eval-in)
(define geiser/compile compile-in)
@@ -44,6 +49,7 @@
(define geiser/compile-file compile-file)
(define geiser/autodoc autodoc)
(define geiser/completions completions)
+ (define geiser/all-modules module-list)
(define geiser/symbol-location symbol-location)
(define geiser/macroexpand macroexpand)
diff --git a/scheme/plt/geiser/modules.ss b/scheme/plt/geiser/modules.ss
index 9ccb421..a1094af 100644
--- a/scheme/plt/geiser/modules.ss
+++ b/scheme/plt/geiser/modules.ss
@@ -26,7 +26,8 @@
module-spec->namespace
namespace->module-path-name
module-path-name->name
- module-spec->path-name)
+ module-spec->path-name
+ module-list)
(require srfi/13 scheme/enter)
@@ -84,4 +85,43 @@
((symbol? path) (symbol->string path))
(else "<top>")))
+
+(define (skippable-dir? path)
+ (call-with-values (lambda () (split-path path))
+ (lambda (_ basename __)
+ (member (path->string basename) '(".svn" "compiled")))))
+
+(define path->symbol (compose string->symbol path->string))
+
+(define (path->entry path)
+ (and (bytes=? (or (filename-extension path) #"") #"ss")
+ (let ((path (path->string path)))
+ (substring path 0 (- (string-length path) 3)))))
+
+(define (visit-module-path path kind acc)
+ (case kind
+ ((file) (let ((entry (path->entry path)))
+ (if entry (cons entry acc) acc)))
+ ((dir) (cond ((skippable-dir? path) (values acc #f))
+ ((file-exists? (build-path path "main.ss"))
+ (cons (path->string path) acc))
+ (else acc)))
+ (else acc)))
+
+(define (find-modules path acc)
+ (if (directory-exists? path)
+ (parameterize ((current-directory path))
+ (fold-files visit-module-path acc))
+ acc))
+
+(define module-cache #f)
+
+(define (module-list)
+ (when (not module-cache)
+ (set! module-cache
+ (sort (foldl find-modules '() (current-library-collection-paths))
+ string<?)))
+ module-cache)
+
+
;;; modules.ss ends here