summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-10 01:08:04 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-10 01:08:04 +0100
commit052e7fb476f018e1426e1bd9394d4fe63db33f45 (patch)
treec10c7c5bc02be35e43a61dd0bfd91b9794a1e0ee
parent0490e6d2047aa97be3a0b3e34075557666336679 (diff)
downloadgeiser-guile-052e7fb476f018e1426e1bd9394d4fe63db33f45.tar.gz
geiser-guile-052e7fb476f018e1426e1bd9394d4fe63db33f45.tar.bz2
Optionally show procedure modules in autodoc.
-rw-r--r--elisp/geiser-autodoc.el15
-rw-r--r--scheme/geiser/introspection.scm19
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))))