summaryrefslogtreecommitdiff
path: root/scheme/guile/geiser
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-21 01:56:02 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-21 01:56:02 +0100
commit1d725a8c087b66b2cd2c0e5006c376faf612d6ff (patch)
treee660e30075c5b03b64da49988683af048eb4f6b0 /scheme/guile/geiser
parent481f0ea2e5577ad5bb1a718b8023af92202e7423 (diff)
downloadgeiser-chez-1d725a8c087b66b2cd2c0e5006c376faf612d6ff.tar.gz
geiser-chez-1d725a8c087b66b2cd2c0e5006c376faf612d6ff.tar.bz2
Better module help
We now display procedure signatures in module help, and keep a cache in Guile, using procedure properties.
Diffstat (limited to 'scheme/guile/geiser')
-rw-r--r--scheme/guile/geiser/doc.scm62
-rw-r--r--scheme/guile/geiser/modules.scm34
-rw-r--r--scheme/guile/geiser/utils.scm8
3 files changed, 58 insertions, 46 deletions
diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm
index 902f2a3..345febd 100644
--- a/scheme/guile/geiser/doc.scm
+++ b/scheme/guile/geiser/doc.scm
@@ -12,6 +12,7 @@
(define-module (geiser doc)
#:export (autodoc
symbol-documentation
+ module-exports
object-signature)
#:use-module (geiser utils)
#:use-module (geiser modules)
@@ -58,9 +59,17 @@
(define default-macro-args '(((required ...))))
+(define geiser-args-key (gensym "geiser-args-key-"))
+
(define (obj-args obj)
(cond ((not obj) #f)
- ((or (procedure? obj) (program? obj)) (arguments obj))
+ ((or (procedure? obj) (program? obj))
+ (cond ((procedure-property obj geiser-args-key))
+ ((arguments obj) =>
+ (lambda (args)
+ (set-procedure-property! obj geiser-args-key args)
+ args))
+ (else #f)))
((and (macro? obj) (macro-transformer obj)) => macro-args)
((macro? obj) default-macro-args)
(else 'variable)))
@@ -121,17 +130,12 @@
(define (doc->args proc)
(define proc-rx "-- Scheme Procedure: ([^[\n]+)\n")
(define proc-rx2 "-- Scheme Procedure: ([^[\n]+\\[[^\n]*(\n[^\n]+\\]+)?)")
- (cond ((procedure-property proc 'geiser-document-args))
- ((object-documentation proc)
- => (lambda (doc)
- (let* ((match (or (string-match proc-rx doc)
- (string-match proc-rx2 doc)))
- (args (and match
- (parse-signature-string
- (match:substring match 1)))))
- (set-procedure-property! proc 'geiser-document-args args)
- args)))
- (else #f)))
+ (let ((doc (object-documentation proc)))
+ (and doc
+ (let ((match (or (string-match proc-rx doc)
+ (string-match proc-rx2 doc))))
+ (and match
+ (parse-signature-string (match:substring match 1)))))))
(define (parse-signature-string str)
(define opt-arg-rx "\\[([^] ]+)\\]?")
@@ -204,4 +208,36 @@
(let ((args (obj-args obj)))
(and args (signature sym args))))
-;;; doc.scm ends here
+(define (module-exports mod-name)
+ (define elt-sort (make-symbol-sort car))
+ (let* ((mod (catch #t
+ (lambda () (resolve-interface mod-name))
+ (lambda args (resolve-module mod-name))))
+ (elts (hash-fold classify-module-object
+ (list '() '() '())
+ (module-obarray mod)))
+ (elts (map elt-sort elts))
+ (subs (map (lambda (m) (list (module-name m)))
+ (submodules (resolve-module mod-name #f)))))
+ (list (cons 'modules subs)
+ (cons 'procs (car elts))
+ (cons 'syntax (cadr elts))
+ (cons 'vars (caddr elts)))))
+
+(define (classify-module-object name var elts)
+ (let ((obj (and (variable-bound? var)
+ (variable-ref var))))
+ (cond ((or (not obj) (module? obj)) elts)
+ ((or (procedure? obj) (program? obj))
+ (list (cons (list name `(signature . ,(obj-signature name obj)))
+ (car elts))
+ (cadr elts)
+ (caddr elts)))
+ ((macro? obj)
+ (list (car elts)
+ (cons (list name `(signature . ,(obj-signature name obj)))
+ (cadr elts))
+ (caddr elts)))
+ (else (list (car elts)
+ (cadr elts)
+ (cons (list name) (caddr elts)))))))
diff --git a/scheme/guile/geiser/modules.scm b/scheme/guile/geiser/modules.scm
index a1697a7..df53acb 100644
--- a/scheme/guile/geiser/modules.scm
+++ b/scheme/guile/geiser/modules.scm
@@ -15,7 +15,7 @@
module-path
find-module
all-modules
- module-exports
+ submodules
module-location)
#:use-module (geiser utils)
#:use-module (system vm program)
@@ -76,35 +76,3 @@
(list mod)
cs)))
-(define (module-exports mod-name)
- (let* ((mod (catch #t
- (lambda () (resolve-interface mod-name))
- (lambda args (resolve-module mod-name))))
- (elts (hash-fold classify-module-object
- (list '() '() '())
- (module-obarray mod)))
- (elts (map sort-symbols! elts))
- (subs (map module-name (submodules (resolve-module mod-name #f)))))
- (list (cons 'modules (append subs
- (map (lambda (m)
- `(,@mod-name ,m)) (car elts))))
- (cons 'procs (cadr elts))
- (cons 'vars (caddr elts)))))
-
-(define (classify-module-object name var elts)
- (let ((obj (and (variable-bound? var)
- (variable-ref var))))
- (cond ((not obj) elts)
- ((and (module? obj) (eq? (module-kind obj) 'directory))
- (list (cons name (car elts))
- (cadr elts)
- (caddr elts)))
- ((or (procedure? obj) (program? obj) (macro? obj))
- (list (car elts)
- (cons name (cadr elts))
- (caddr elts)))
- (else (list (car elts)
- (cadr elts)
- (cons name (caddr elts)))))))
-
-;;; modules.scm ends here
diff --git a/scheme/guile/geiser/utils.scm b/scheme/guile/geiser/utils.scm
index 01dfaa0..632fe76 100644
--- a/scheme/guile/geiser/utils.scm
+++ b/scheme/guile/geiser/utils.scm
@@ -14,6 +14,7 @@
symbol->object
pair->list
sort-symbols!
+ make-symbol-sort
gensym?)
#:use-module (ice-9 regex))
@@ -37,6 +38,13 @@
(string<? (symbol->string l) (symbol->string r)))))
(sort! syms cmp)))
+(define (make-symbol-sort sel)
+ (let ((cmp (lambda (a b)
+ (string<? (symbol->string (sel a))
+ (symbol->string (sel b))))))
+ (lambda (syms)
+ (sort! syms cmp))))
+
(define (gensym? sym)
(and (symbol? sym) (gensym-name? (format "~A" sym))))