diff options
| -rw-r--r-- | elisp/geiser-doc.el | 11 | ||||
| -rw-r--r-- | scheme/guile/geiser/emacs.scm | 2 | ||||
| -rw-r--r-- | scheme/guile/geiser/introspection.scm | 54 |
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)))) |