summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-28 17:16:20 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-28 17:16:20 +0100
commit034b3070c61888a0e88edd33506c58fdae9b2115 (patch)
treed44f44462d4bde5ef322398972bf48e4dc0d05c4
parent77253da86ac2d005a0802426c7ebe08bf8dca9ce (diff)
downloadgeiser-chez-034b3070c61888a0e88edd33506c58fdae9b2115.tar.gz
geiser-chez-034b3070c61888a0e88edd33506c58fdae9b2115.tar.bz2
Refactoring: local bindings discovery moved to schemeland.
-rw-r--r--elisp/geiser-autodoc.el2
-rw-r--r--elisp/geiser-completion.el8
-rw-r--r--elisp/geiser-syntax.el53
-rw-r--r--scheme/guile/geiser/introspection.scm31
4 files changed, 51 insertions, 43 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index 5d5befa..b1f5ae1 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -123,7 +123,7 @@ when `geiser-autodoc-display-module-p' is on."
(defun geiser-autodoc--eldoc-function ()
(condition-case e
- (or (geiser-autodoc--function-args (geiser-syntax--get-partial-sexp t)) "")
+ (or (geiser-autodoc--function-args (geiser-syntax--get-partial-sexp)) "")
(error (format "Autodoc not available (%s)" (error-message-string e)))))
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
index 7b5d7d7..7e1f642 100644
--- a/elisp/geiser-completion.el
+++ b/elisp/geiser-completion.el
@@ -29,6 +29,8 @@
(require 'geiser-syntax)
(require 'geiser-base)
+(eval-when-compile (require 'cl))
+
;;; Completions window handling, heavily inspired in slime's:
@@ -145,7 +147,11 @@ terminates a current completion."
;;; Completion functionality:
(defsubst geiser-completion--symbol-list (prefix)
- (geiser-eval--send/result `(:eval ((:ge completions) ,prefix))))
+ (delete-duplicates
+ (geiser-eval--send/result
+ `(:eval ((:ge completions) ,prefix
+ (quote (:scm ,(geiser-syntax--get-partial-sexp))))))
+ :test 'string=))
(defsubst geiser-completion--module-list ()
(geiser-eval--send/result '(:eval ((:ge all-modules)))))
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index a5e8878..8684f99 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -71,58 +71,37 @@
(goto-char (point-min))
(skip-syntax-forward "^("))
-(defun geiser-syntax--complete-partial-sexp (buffer begin end &optional str)
- (set-buffer buffer)
- (let ((inhibit-read-only t))
- (copy-to-buffer (geiser-syntax--buffer) begin end))
+(defsubst geiser-syntax--del-sexp (arg)
+ (let ((p (point)))
+ (forward-sexp arg)
+ (delete-region p (point))))
+
+(defun geiser-syntax--complete-partial-sexp (buffer begin end)
(geiser-syntax--with-buffer
- (goto-char (point-max))
+ (erase-buffer)
+ (insert-buffer-substring-no-properties buffer begin end)
(skip-syntax-backward "-<>")
(delete-region (point) (point-max))
(let ((pps (parse-partial-sexp (point-min) (point))))
(when (nth 8 pps) ;; inside a comment or string
(delete-region (nth 8 pps) (point-max))))
- (cond ((eq (char-after (1- (point))) ?\)) (kill-sexp -1) (insert "XXpointXX"))
- ((eq (char-after (point)) ?\() (kill-sexp 1) (insert "XXpointXX")))
+ (cond ((eq (char-after (1- (point))) ?\))
+ (geiser-syntax--del-sexp -1) (insert "XXpointXX"))
+ ((eq (char-after (point)) ?\()
+ (geiser-syntax--del-sexp 1) (insert "XXpointXX")))
(when (memq (char-after (1- (point))) (list ?@ ?, ?\' ?\` ?\#))
(skip-syntax-backward "^-(")
(delete-region (point) (point-max))
(insert "XXXpointXX"))
(let ((depth (nth 0 (parse-partial-sexp (point-min) (point)))))
(unless (zerop depth) (insert (make-string depth ?\)))))
- (if str
- (buffer-string)
- (geiser-syntax--prepare-scheme-for-elisp-reader)
- (read (current-buffer)))))
+ (buffer-substring-no-properties (point-min) (point))))
-(defsubst geiser-syntax--get-partial-sexp (&optional str)
+(defsubst geiser-syntax--get-partial-sexp ()
(unless (zerop (nth 0 (syntax-ppss)))
(let* ((end (save-excursion (skip-syntax-forward "^-()") (point)))
- (begin (save-excursion (beginning-of-defun) (point))))
- (geiser-syntax--complete-partial-sexp (current-buffer) begin end str))))
-
-(defun geiser-syntax--collect-local-symbols (sexp acc)
- (cond ((or (null sexp) (not (listp sexp))) acc)
- ((listp (car sexp))
- (geiser-syntax--collect-local-symbols
- (cdr sexp)
- (geiser-syntax--collect-local-symbols (car sexp) acc)))
- ((memq (car sexp) '(define define*))
- (let* ((name (cadr sexp))
- (name (if (symbolp name) name (car name)))
- (acc (if (symbolp name) (cons name acc) acc)))
- (geiser-syntax--collect-local-symbols (cddr sexp) acc)))
- ((memq (car sexp) '(let let* letrec))
- (let* ((n (if (listp (nth 1 sexp)) 1 2))
- (syms (mapcar 'car (nth n sexp)))
- (rest (if (= 1 n) (cddr sexp) (cdr (cddr sexp)))))
- (geiser-syntax--collect-local-symbols rest (append syms acc))))
- (t (geiser-syntax--collect-local-symbols (cdr sexp) acc))))
-
-(defsubst geiser-syntax--local-bindings ()
- (ignore-errors
- (mapcar 'symbol-name
- (geiser-syntax--collect-local-symbols (geiser-syntax--get-partial-sexp) '()))))
+ (begin (save-excursion (beginning-of-defun) (point))))
+ (geiser-syntax--complete-partial-sexp (current-buffer) begin end))))
;;; Fontify strings as Scheme code:
diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm
index 7e468e7..fd6784d 100644
--- a/scheme/guile/geiser/introspection.scm
+++ b/scheme/guile/geiser/introspection.scm
@@ -149,10 +149,33 @@ The alist keys that are currently defined are `required', `optional',
,@(if rest (list (cons 'rest 'rest)) '())))))
(else #f)))
-(define (completions prefix)
- (sort! (map symbol->string
- (apropos-internal (string-append "^" prefix)))
- string<?))
+(define (completions prefix . context)
+ (let ((context (and (not (null? context)) (car context)))
+ (prefix (string-append "^" (regexp-quote prefix))))
+ (append (filter (lambda (s) (string-match prefix s))
+ (map symbol->string (local-bindings context)))
+ (sort! (map symbol->string (apropos-internal prefix)) string<?))))
+
+(define (local-bindings form)
+ (define (body f) (if (> (length f) 2) (cddr f) '()))
+ (define (decl-list d)
+ (let loop ((d d) (s '()))
+ (cond ((null? d) s)
+ ((symbol? d) (cons d s))
+ (else (loop (cdr d) (cons (car d) s))))))
+ (let loop ((form form) (bindings '()))
+ (cond ((not (pair? form)) bindings)
+ ((list? (car form))
+ (loop (cdr form) (append (local-bindings (car form)) bindings)))
+ ((and (list? form) (< (length form) 2)) bindings)
+ ((memq (car form) '(define define* lambda))
+ (loop (body form) (append (decl-list (cadr form)) bindings)))
+ ((and (memq (car form) '(let let* letrec letrec*))
+ (list? (cadr form)))
+ (loop (body form) (append (map car (cadr form)) bindings)))
+ ((and (eq? 'let (car form)) (symbol? (cadr form)))
+ (loop (cons 'let (body form)) (cons (cadr form) bindings)))
+ (else (loop (cdr form) bindings)))))
(define (module-location name)
(make-location (module-filename name) #f))