From 6100a2e3ff7469f745dfa20892d0180973dd609d Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Fri, 27 Feb 2009 23:29:09 +0100
Subject: Autodoc system revamped.

---
 elisp/geiser-syntax.el | 90 ++++++++++++++++++--------------------------------
 1 file changed, 32 insertions(+), 58 deletions(-)

(limited to 'elisp/geiser-syntax.el')

diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index 2025f3d..c8ad338 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -55,27 +55,47 @@
 
 (geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode)
 
-(defun geiser-syntax--complete-partial-sexp (buffer begin end)
+(defun geiser-syntax--prepare-scheme-for-elisp-reader ()
+  (goto-char (point-min))
+  (while (re-search-forward "#\<\\([^>]*?\\)\>" nil t)
+    (let ((from (match-beginning 1))
+          (to (match-end 1)))
+      (goto-char from)
+      (while (re-search-forward "\\([() ;'`]\\)" to t)
+        (replace-match "\\\\\\1"))
+      (goto-char to)))
+  (goto-char (point-min))
+  (while (re-search-forward "#(" nil t) (replace-match "(vector "))
+  (goto-char (point-min))
+  (while (re-search-forward "#" nil t) (replace-match "\\\\#"))
+  (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))
   (geiser-syntax--with-buffer
     (goto-char (point-max))
-    (skip-syntax-backward "-")
+    (skip-syntax-backward "-<>")
+    (kill-region (point) (point-max))
     (let ((pps (parse-partial-sexp (point-min) (point))))
-      (cond ((nth 8 pps) ;; inside a comment or string
-             (delete-region (nth 8 pps) (point-max)))
-            ((nth 5 pps) (delete-char -1))) ;; after a quote
-      (let ((depth (nth 0 pps)))
-        (unless (zerop depth) (insert (make-string depth ?\)))))
+      (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")))
+    (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)))))
 
-(defsubst geiser-syntax--get-partial-sexp ()
-  (save-excursion
-    (let* ((begin (point))
-           (end (progn (beginning-of-defun) (point))))
-      (geiser-syntax--complete-partial-sexp (current-buffer) begin end))))
+(defsubst geiser-syntax--get-partial-sexp (&optional str)
+  (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)
@@ -100,52 +120,6 @@
     (mapcar 'symbol-name
             (geiser-syntax--collect-local-symbols (geiser-syntax--get-partial-sexp) '()))))
 
-(defsubst geiser-syntax--end-of-thing ()
-  (let ((sc (or (syntax-class (syntax-after (point))) 0)))
-    (when (= sc 7) (forward-char))
-    (cond ((nth 3 (syntax-ppss))
-           (skip-syntax-forward "^\"")
-           (forward-char))
-          ((and (= sc 5) (eq ?\( (char-before))) (forward-char))
-          ((not (or (= sc 0) (= sc 12))) ;; comment, whitespace
-           (ignore-errors (forward-sexp))))
-    (point)))
-
-(defun geiser-syntax--enclosing-form-data ()
-  (save-excursion
-    (let* ((p (geiser-syntax--end-of-thing))
-           (current (cons (symbol-at-point) 0))
-           (data))
-      (ignore-errors
-        (while (not (bobp))
-          (backward-up-list)
-          (save-excursion
-            (forward-char)
-            (let ((proc (symbol-at-point))
-                  (arg-no 0))
-              (when proc
-                (while (< (point) p)
-                  (forward-sexp)
-                  (when (< (point) p) (setq arg-no (1+ arg-no))))
-                (push (cons proc arg-no) data))))))
-      (reverse (if (car current) (push current data) data)))))
-
-(defun geiser-syntax--prepare-scheme-for-elisp-reader ()
-  (goto-char (point-min))
-  (while (re-search-forward "#\<\\([^>]*?\\)\>" nil t)
-    (let ((from (match-beginning 1))
-          (to (match-end 1)))
-      (goto-char from)
-      (while (re-search-forward "\\([() ;'`]\\)" to t)
-        (replace-match "\\\\\\1"))
-      (goto-char to)))
-  (goto-char (point-min))
-  (while (re-search-forward "#(" nil t) (replace-match "(vector "))
-  (goto-char (point-min))
-  (while (re-search-forward "#" nil t) (replace-match "\\\\#"))
-  (goto-char (point-min))
-  (skip-syntax-forward "^("))
-
 
 ;;; Fontify strings as Scheme code:
 
-- 
cgit v1.2.3