From 36ac636e82a9ce4e6fa49b514de149a889dfebdd Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Tue, 10 Feb 2009 17:11:45 +0100
Subject: Multi-level form arity recognition in autodoc.

---
 elisp/geiser-autodoc.el | 28 ++++++++++++++++------------
 elisp/geiser-syntax.el  | 22 +++++++++++++---------
 2 files changed, 29 insertions(+), 21 deletions(-)

diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index 2d286ff..f5db63b 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -70,8 +70,7 @@ when `geiser-autodoc-display-module-p' is on."
 (defun geiser-autodoc--function-args (fun)
   (if (eq fun (car geiser-autodoc--last))
       (cdr geiser-autodoc--last)
-    (let* ((cmd `(:gs ((:ge proc-args) ',fun)))
-           (result (geiser-eval--retort-result (geiser-eval--send/wait cmd))))
+    (let ((result (geiser-eval--send/result `(:gs ((:ge proc-args) ',fun)))))
       (when (not (listp result)) (setq result 'undefined))
       (setq geiser-autodoc--last (cons fun result))
       result)))
@@ -79,7 +78,9 @@ when `geiser-autodoc-display-module-p' is on."
 (defun geiser-autodoc--insert (sym current pos)
   (let ((str (format "%s" sym)))
     (when (= current pos)
-      (put-text-property 0 (length str) 'face 'geiser-font-lock-autodoc-current-arg str))
+      (put-text-property 0 (length str)
+                         'face 'geiser-font-lock-autodoc-current-arg
+                         str))
     (insert str)))
 
 (defun geiser-autodoc--fun-args-str (fun args pos)
@@ -87,8 +88,11 @@ when `geiser-autodoc-display-module-p' is on."
     (set-buffer (geiser-syntax--font-lock-buffer))
     (erase-buffer)
     (let* ((current 0)
-           (module (and geiser-autodoc-display-module-p (cdr (assoc 'module args))))
-           (fun (if module (format geiser-autodoc-procedure-name-format module fun) fun)))
+           (module (and geiser-autodoc-display-module-p
+                        (cdr (assoc 'module args))))
+           (fun (if module
+                    (format geiser-autodoc-procedure-name-format module fun)
+                  fun)))
       (insert "(")
       (geiser-autodoc--insert fun current pos)
       (dolist (arg (cdr (assoc 'required args)))
@@ -107,13 +111,13 @@ when `geiser-autodoc-display-module-p' is on."
 ;;; Autodoc function:
 
 (defun geiser-autodoc--eldoc-function ()
-  (let* ((f/a (geiser-syntax--enclosing-form-data))
-         (fun (car f/a))
-         (arg-no (cdr f/a)))
-    (when fun
-      (let ((args (geiser-autodoc--function-args fun)))
-        (when (listp args)
-          (geiser-autodoc--fun-args-str fun args arg-no))))))
+  (let ((data (geiser-syntax--enclosing-form-data)))
+    (catch 'doc-msg
+      (dolist (f/a data)
+        (let ((args (geiser-autodoc--function-args (car f/a))))
+          (when (listp args)
+            (throw 'doc-msg
+                   (geiser-autodoc--fun-args-str (car f/a) args (cdr f/a)))))))))
 
 
 ;;; Autodoc mode:
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index 5f109cf..32b28bb 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -66,16 +66,20 @@
 (defun geiser-syntax--enclosing-form-data ()
   (save-excursion
     (let ((p (geiser-syntax--end-of-thing))
-          (arg-no 0)
-          (proc))
+          (current (cons (symbol-at-point) 0))
+          (data))
       (ignore-errors
-        (backward-up-list)
-        (forward-char)
-        (setq proc (symbol-at-point))
-        (while (< (point) p)
-          (forward-sexp)
-          (when (< (point) p) (setq arg-no (1+ arg-no))))
-        (cons proc arg-no)))))
+        (while (not (bobp))
+          (backward-up-list)
+          (save-excursion
+            (forward-char)
+            (let ((proc (symbol-at-point))
+                  (arg-no 0))
+              (while (< (point) p)
+                (forward-sexp)
+                (when (< (point) p) (setq arg-no (1+ arg-no))))
+              (push (cons proc arg-no) data)))))
+      (reverse (push current data)))))
 
 (defun geiser-syntax--prepare-scheme-for-elisp-reader ()
   (goto-char (point-min))
-- 
cgit v1.2.3