summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-17 01:31:26 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-17 01:31:26 +0100
commit02b4dbe81d4662aaf207677c53b869cc055b06a3 (patch)
tree300e5c63d6f7373dae9f4ee86013f6ec2b796cfb
parent6e89d965f1b0a8329ddc012feb36fd43c591acbf (diff)
downloadgeiser-chez-02b4dbe81d4662aaf207677c53b869cc055b06a3.tar.gz
geiser-chez-02b4dbe81d4662aaf207677c53b869cc055b06a3.tar.bz2
Better symbol documentation.
-rw-r--r--elisp/geiser-doc.el11
-rw-r--r--scheme/guile/geiser/emacs.scm2
-rw-r--r--scheme/guile/geiser/introspection.scm54
3 files changed, 35 insertions, 32 deletions
diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index 3a1759c..a7d6eae 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -53,7 +53,7 @@
;;; Docstrings:
(defun geiser-doc--get-docstring (symbol)
- (geiser-eval--send/result `(:eval ((:ge docstring) ',symbol))))
+ (geiser-eval--send/result `(:eval ((:ge symbol-documentation) ',symbol))))
(defun geiser-doc--get-module-children (module)
(geiser-eval--send/result `(:eval ((:ge module-children) (quote (:scm ,module))))))
@@ -63,7 +63,7 @@
(defun geiser-doc--insert-title (title)
(let ((p (point)))
- (insert title)
+ (insert (format "%s" title))
(put-text-property p (point) 'face 'geiser-font-lock-doc-title))
(newline))
@@ -86,11 +86,14 @@ With prefix argument, ask for symbol (with completion)."
(geiser-completion--read-symbol "Symbol: " (symbol-at-point)))))
(when symbol
(let ((ds (geiser-doc--get-docstring symbol)))
- (if (or (not (stringp ds)) (zerop (length ds)))
+ (if (or (not ds) (not (listp ds)))
(message "No documentation available for '%s'" symbol)
(geiser-doc--with-buffer
(erase-buffer)
- (insert ds))
+ (geiser-doc--insert-title (cdr (assoc 'signature ds)))
+ (newline)
+ (insert (or (cdr (assoc 'docstring ds)) ""))
+ (goto-line (point-min)))
(geiser-doc--pop-to-buffer))))))
(defun geiser-doc-module (module)
diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm
index b5ba284..36428f9 100644
--- a/scheme/guile/geiser/emacs.scm
+++ b/scheme/guile/geiser/emacs.scm
@@ -30,7 +30,7 @@
ge:symbol-location
ge:compile-file
ge:load-file
- ge:docstring
+ ge:symbol-documentation
ge:all-modules
ge:module-children
ge:module-location)
diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm
index 2021a32..5d86d62 100644
--- a/scheme/guile/geiser/introspection.scm
+++ b/scheme/guile/geiser/introspection.scm
@@ -28,7 +28,7 @@
#:export (arguments
completions
symbol-location
- docstring
+ symbol-documentation
all-modules
module-children
module-location)
@@ -128,34 +128,34 @@
(define module-filename (@@ (ice-9 session) module-filename))
-(define (display-docstring sym)
+(define (docstring sym obj)
+ (with-output-to-string
+ (lambda ()
+ (let* ((type (cond ((macro? obj) "A macro")
+ ((procedure? obj) "A procedure")
+ ((program? obj) "A compiled program")
+ (else "An object")))
+ (modname (symbol-module sym))
+ (doc (object-documentation obj)))
+ (display type)
+ (if modname
+ (begin
+ (display " in module ")
+ (display modname)))
+ (newline)
+ (if doc (display doc))))))
+
+(define (obj-signature sym obj)
+ (let* ((args (obj-args obj))
+ (req (and args (car args)))
+ (opt (and args (cadr args))))
+ (and args (if (not opt) `(,sym ,@req) `(,sym ,@req . ,opt)) sym)))
+
+(define (symbol-documentation sym)
(let ((obj (symbol->obj sym)))
(if obj
- (let* ((args (obj-args obj))
- (req (and args (car args)))
- (opt (and args (cadr args)))
- (signature (if args
- (if (not opt) `(,sym ,@req) `(,sym ,@req . ,opt))
- sym))
- (type (cond ((macro? obj) "A macro")
- ((procedure? obj) "A procedure")
- ((program? obj) "A compiled program")
- (else "An object")))
- (modname (symbol-module sym))
- (doc (object-documentation obj)))
- (display signature)
- (newline)
- (display type)
- (if modname
- (begin
- (display " in module ")
- (display modname)))
- (newline)
- (if doc (display doc))))))
-
-(define (docstring sym)
- (with-output-to-string
- (lambda () (display-docstring sym))))
+ `((signature . ,(or (obj-signature sym obj) sym))
+ (docstring . ,(docstring sym obj))))))
(define (all-modules)
(let ((roots ((@@ (ice-9 session) root-modules))))