From 052e7fb476f018e1426e1bd9394d4fe63db33f45 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Tue, 10 Feb 2009 01:08:04 +0100
Subject: Optionally show procedure modules in autodoc.

---
 elisp/geiser-autodoc.el         | 15 ++++++++++++++-
 scheme/geiser/introspection.scm | 19 +++++++++++--------
 2 files changed, 25 insertions(+), 9 deletions(-)

diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index 4c6c44c..2d286ff 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -50,6 +50,17 @@
   :type 'number
   :group 'geiser-autodoc)
 
+(defcustom geiser-autodoc-display-module-p t
+  "Whether to display procedure module in autodoc strings."
+  :type 'boolean
+  :group 'geiser-autodoc)
+
+(defcustom geiser-autodoc-procedure-name-format "%s:%s"
+  "Format for displaying module and procedure name, in that order,
+when `geiser-autodoc-display-module-p' is on."
+  :type 'string
+  :group 'geiser-autodoc)
+
 
 ;;; Procedure arguments:
 
@@ -75,7 +86,9 @@
   (save-current-buffer
     (set-buffer (geiser-syntax--font-lock-buffer))
     (erase-buffer)
-    (let ((current 0))
+    (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)))
       (insert "(")
       (geiser-autodoc--insert fun current pos)
       (dolist (arg (cdr (assoc 'required args)))
diff --git a/scheme/geiser/introspection.scm b/scheme/geiser/introspection.scm
index ae2b0d3..991b62d 100644
--- a/scheme/geiser/introspection.scm
+++ b/scheme/geiser/introspection.scm
@@ -44,28 +44,31 @@
   (let* ((arity (program-arity program))
          (arg-no (first arity))
          (opt (> (second arity) 0))
-         (args (map first (take (program-bindings program) arg-no))))
-    (format-args (if opt (drop-right args 1) args) (and opt (last args)))))
+         (args (map first (take (program-bindings program) arg-no)))
+         (module (program-module program)))
+    (format-args (if opt (drop-right args 1) args) (and opt (last args)) module)))
 
 (define (procedure-args proc)
   (let* ((arity (procedure-property proc 'arity))
          (req (first arity))
-         (opt (third arity)))
+         (opt (third arity))
+         (env (procedure-environment proc)))
     (format-args (map (lambda (n)
                         (string->symbol (format "arg~A" (+ 1 n))))
                       (iota req))
-                 (and opt 'rest))))
+                 (and opt 'rest)
+                 (and (not (null? env)) env))))
 
 (define (macro-args macro)
   (let ((prog (macro-transformer macro)))
     (if prog
         (program-args prog)
-        (format-args '(...) #f))))
+        (format-args '(...) #f #f))))
 
-(define (foobar) 6)
-(define (format-args args opt)
+(define (format-args args opt module)
   (list (cons 'required args)
-        (cons 'optional (or opt '()))))
+        (cons 'optional (or opt '()))
+        (cons 'module (if module (module-name module) '()))))
 
 (define (completions prefix)
   (map symbol->string (apropos-internal (string-append "^" prefix))))
-- 
cgit v1.2.3