From 432e405274205c91784456449f344044c8d62e48 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Thu, 12 Feb 2009 23:33:58 +0100
Subject: Better arg lists.

---
 elisp/geiser-edit.el                  |  7 +++++--
 scheme/guile/geiser/introspection.scm | 38 +++++++++++++++++++++++------------
 2 files changed, 30 insertions(+), 15 deletions(-)

diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el
index 3a5618a..f0b854d 100644
--- a/elisp/geiser-edit.el
+++ b/elisp/geiser-edit.el
@@ -63,14 +63,17 @@
   (regexp-opt '("define" "defmacro" "define-macro" "define-syntax" "define*")))
 
 (defsubst geiser-edit--def-re (symbol)
-  (format "(%s +(?%s" geiser-edit--def-re symbol))
+  (format "(%s +(?%s" geiser-edit--def-re (regexp-quote (symbol-name symbol))))
+
+(defsubst geiser-edit--symbol-re (symbol)
+  (format "\\_<%s\\_>" (regexp-quote (symbol-name symbol))))
 
 (defun geiser-edit--goto-line (symbol line)
   (if (numberp line)
       (goto-line line)
     (goto-char (point-min))
     (when (or (re-search-forward (geiser-edit--def-re symbol) nil t)
-              (re-search-forward (format "\\_<%s\\_>" symbol) nil t))
+              (re-search-forward (geiser-edit--symbol-re symbol) nil t))
       (goto-char (match-beginning 0)))))
 
 (defun geiser-edit--try-edit (symbol ret)
diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm
index 7fce4c9..38c0b79 100644
--- a/scheme/guile/geiser/introspection.scm
+++ b/scheme/guile/geiser/introspection.scm
@@ -30,6 +30,9 @@
   #:use-module (ice-9 session)
   #:use-module (srfi srfi-1))
 
+(define (proc-args proc)
+  (obj-args (resolve-symbol proc)))
+
 (define (resolve-symbol sym)
   (and (symbol? sym)
        (module-bound? (current-module) sym)
@@ -52,15 +55,25 @@
                  (program-module program))))
 
 (define (procedure-args proc)
-  (let* ((arity (procedure-property proc 'arity))
-         (req (first 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 (not (null? env)) env))))
+  (let ((name (procedure-name proc)))
+    (cond ((procedure-source proc) => (lambda (src)
+                                        (procedure-args-from-source name src)))
+          (else (let* ((arity (procedure-property proc 'arity))
+                       (req (first arity))
+                       (opt (third arity)))
+                  (format-args (map (lambda (n)
+                                      (string->symbol (format "arg~A" (+ 1 n))))
+                                    (iota req))
+                               (and opt 'rest)
+                               (and name (symbol-module name))))))))
+
+(define (procedure-args-from-source name src)
+  (let ((formals (cadr src)))
+    (cond ((list? formals) (format-args formals #f (symbol-module name)))
+          ((pair? formals) (format-args (car formals)
+                                        (cdr formals)
+                                        (symbol-module name)))
+          (else '()))))
 
 (define (macro-args macro)
   (let ((prog (macro-transformer macro)))
@@ -71,10 +84,9 @@
 (define (format-args args opt module)
   (list (cons 'required args)
         (cons 'optional (or opt '()))
-        (cons 'module (if module (module-name module) '()))))
-
-(define (proc-args proc)
-  (obj-args (resolve-symbol proc)))
+        (cons 'module (cond ((module? module) (module-name module))
+                            ((list? module) module)
+                            (else '())))))
 
 (define (completions prefix)
   (sort! (map symbol->string
-- 
cgit v1.2.3