summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-12 23:33:58 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-12 23:33:58 +0100
commit432e405274205c91784456449f344044c8d62e48 (patch)
tree57e885195ee02c933da9a643eed00257afd39586
parent09c532a18d33ab2e0a3dcb3a38e746992e3381aa (diff)
downloadgeiser-chez-432e405274205c91784456449f344044c8d62e48.tar.gz
geiser-chez-432e405274205c91784456449f344044c8d62e48.tar.bz2
Better arg lists.
-rw-r--r--elisp/geiser-edit.el7
-rw-r--r--scheme/guile/geiser/introspection.scm38
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