From 8563be5f22eda87cf676ad62a252295aa40f0b64 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Sat, 28 Feb 2009 17:16:20 +0100
Subject: Refactoring: local bindings discovery moved to schemeland.

---
 elisp/geiser-autodoc.el    |  2 +-
 elisp/geiser-completion.el |  8 ++++++-
 elisp/geiser-syntax.el     | 53 ++++++++++++++--------------------------------
 3 files changed, 24 insertions(+), 39 deletions(-)

(limited to 'elisp')

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:
-- 
cgit v1.2.3