summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-23 01:58:33 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-23 01:58:33 +0100
commit3b24e917fdfebc8df3fefbbcc747963eb4bbd126 (patch)
treea44d5f0cb47639d47bdb57f2233b2db5e5a878b7
parenta53249b83cdc0711f23b1b8860cd3582977230c6 (diff)
downloadgeiser-guile-3b24e917fdfebc8df3fefbbcc747963eb4bbd126.tar.gz
geiser-guile-3b24e917fdfebc8df3fefbbcc747963eb4bbd126.tar.bz2
Document browser improvements, and Racket using them
We have a new "manual lookup" command, and Racket now displays a doc browser buffer for help with a button activating it. In the process, we've cleaned-up a little mess in geiser-eval.el and geiser-doc.el, and refactored the affected Racket modules. Next in line is providing manual lookup for Guile.
-rw-r--r--doc/cheat.texi3
-rw-r--r--doc/img/geiser-mode.pngbin62445 -> 37636 bytes
-rw-r--r--doc/img/repl-mod.pngbin29938 -> 30503 bytes
-rw-r--r--doc/parens.texi33
-rw-r--r--doc/repl.texi40
-rw-r--r--elisp/geiser-completion.el11
-rw-r--r--elisp/geiser-doc.el168
-rw-r--r--elisp/geiser-eval.el20
-rw-r--r--elisp/geiser-mode.el2
-rw-r--r--elisp/geiser-racket.el2
-rw-r--r--scheme/guile/geiser/evaluation.scm2
-rw-r--r--scheme/racket/geiser/autodoc.rkt75
-rw-r--r--scheme/racket/geiser/locations.rkt11
-rw-r--r--scheme/racket/geiser/main.rkt2
-rw-r--r--scheme/racket/geiser/modules.rkt21
15 files changed, 243 insertions, 147 deletions
diff --git a/doc/cheat.texi b/doc/cheat.texi
index 108d5a2..f6e1924 100644
--- a/doc/cheat.texi
+++ b/doc/cheat.texi
@@ -137,6 +137,9 @@
@item C-c C-d C-d
@tab geiser-doc-symbol-at-point
@tab See documentation for symbol at point
+@item C-c C-d C-i
+@tab geiser-doc-lookup-manual
+@tab Lookup manual for symbol at point
@item C-c C-d C-m
@tab geiser-repl--doc-module
@tab See documentation for module
diff --git a/doc/img/geiser-mode.png b/doc/img/geiser-mode.png
index 6e6e564..799745c 100644
--- a/doc/img/geiser-mode.png
+++ b/doc/img/geiser-mode.png
Binary files differ
diff --git a/doc/img/repl-mod.png b/doc/img/repl-mod.png
index 9814b7e..1fee5f0 100644
--- a/doc/img/repl-mod.png
+++ b/doc/img/repl-mod.png
Binary files differ
diff --git a/doc/parens.texi b/doc/parens.texi
index 439e56c..c4aa228 100644
--- a/doc/parens.texi
+++ b/doc/parens.texi
@@ -278,10 +278,10 @@ controls how the current argument position is highlighted.
@subsubheading Other documentation commands
-Sometimes, autodoc won't provide enough information for you to
-understand what a function does. In those cases, you can ask Geiser to
-ask the running Scheme for further information on a given identifier or
-module.
+@anchor{doc-browser}Sometimes, autodoc won't provide enough information
+for you to understand what a function does. In those cases, you can ask
+Geiser to ask the running Scheme for further information on a given
+identifier or module.
@cindex documentation for symbol
@cindex docstrings, maybe
@@ -301,14 +301,29 @@ navigation commands available in that buffer, which you can discover by
means of its menu or via the good old @kbd{C-h m} command.
For Racket, which does not support docstrings out of the box, this
-command will invoke Racket's @code{help} procedure, thereby opening your
-configured web browser with the corresponding manual page for you to
-peruse.
+command will provide less information, but the documentation browser
+will display the corresponding contract when it's available.
You can also ask Geiser to display information about a module, in the
form of a list of its exported identifiers, using @kbd{C-c C-d C-m},
-exactly as you would do @ref{repl-mod,,in the REPL}. This commands works
-with all supported Schemes, no strings attached.
+exactly as you would do @ref{repl-mod,,in the REPL}.
+
+In both cases, the documentation browser will show a couple of buttons
+giving you access to further documentation. First, you'll see a button
+named @i{source}: pressing it you'll jump to the symbol's definition.
+The second button, dubbed @i{manual}, will open the scheme
+implementation's manual page for the symbol at hand. For Racket, that
+will open your web browser displaying the corresponding reference's page
+(using Emacs' @code{browser-url} command), while in Guile a lookup will
+be performed in the texinfo manual.
+
+@cindex opening manual pages
+You can also jump directly to the manual page for the symbol at point
+with the command @code{geiser-doc-lookup-manual}, bound to @kbd{C-c C-d
+i}.
+
+See also our @xref{Documentation browser,,cheat-sheet} for a list of
+navigation commands available in the documentation browser.
@node To eval or not to eval, To err perchance to debug, Documentation helpers, Between the parens
@section To eval or not to eval
diff --git a/doc/repl.texi b/doc/repl.texi
index ffb733b..a87c547 100644
--- a/doc/repl.texi
+++ b/doc/repl.texi
@@ -217,11 +217,26 @@ argument is a keyword argument, its name has ``#:'' as a prefix.
@cindex help on identifier
If that's not enough documentation for you, @kbd{C-c C-d d} will open a
-separate documentation buffer with help on the symbol at point. For some
-implementations (e.g. Racket), this separate buffer will actually be a
-web page displaying the corresponding page in the manual, while for
-implementations supporting docstrings (e.g. (you guessed it) Guile)
-it'll be a real Emacs buffer displaying that information.
+separate documentation buffer with help on the symbol at point. This
+buffer will contain implementation-specific information about the
+identifier (e.g., its docstring for Guile, or its contract, if any, for
+Racket), and a handy button to open the corresponding manual entry for
+the symbol, which will open an HTML page (for Racket) or the texinfo
+manual (for Guile).
+
+@cindex module exports
+@anchor{repl-mod} Geiser can also produce for you a list, classified by
+kind, of the identifiers exported by a given module: all you need to do
+is press @kbd{C-c C-d m}, and type or complete the desired module's
+name.
+
+@imgc{repl-mod}
+
+The list of exported bindings is shown, again, in a buffer belonging to
+Geiser's documentation browser, where you have at your disposal a bunch
+of navigation commands listed in @xref{Documentation browser,,our
+cheat-sheet}. We'll have a bit more to say about the documentation
+browser in @xref{doc-browser,,a later section}.
@cindex jump, at the REPL
If that's still not enough, Geiser can jump, via @kbd{M-.}, to the
@@ -232,21 +247,6 @@ will see, these commands are also available in scheme buffers. @kbd{M-.}
also works for modules: if your point is on an unambiguous module name,
the file where it's defined will be opened for you.
-@cindex module exports
-@anchor{repl-mod}
-Finally, Geiser can produce for you a list, classified by kind, of the
-identifiers exported by a given module: all you need to do is press
-@kbd{C-c C-d m}, and type or complete the desired module's name.
-
-@imgc{repl-mod}
-
-The list of exported bindings is shown in a buffer belonging to Geiser's
-documentation browser, of which more details are given in forthcoming
-sections (but just perusing its associated key bindings, by any of the
-methods we've already mentioned, will give you enough information to use
-it). Racketeers will be pleased (i hope) to note that contracts are part
-of the information displayed.
-
@node Customization and tips, , Autodoc and friends, The REPL
@section Customization and tips
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
index bf0f036..d462308 100644
--- a/elisp/geiser-completion.el
+++ b/elisp/geiser-completion.el
@@ -175,11 +175,12 @@ terminates a current completion."
(defun geiser-completion--read-symbol (prompt &optional default history)
(let ((minibuffer-local-completion-map geiser-completion--minibuffer-map))
- (completing-read prompt
- geiser-completion--symbol-list-func
- nil nil nil
- (or history geiser-completion--symbol-history)
- (or default (symbol-at-point)))))
+ (make-symbol (completing-read prompt
+ geiser-completion--symbol-list-func
+ nil nil nil
+ (or history
+ geiser-completion--symbol-history)
+ (or default (symbol-at-point))))))
(defvar geiser-completion--module-history nil)
diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index 1606dc4..67e46dd 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -41,6 +41,15 @@
'button geiser-doc "buttons in documentation buffers")
+;;; Implementation
+(geiser-impl--define-caller geiser-doc--external-help external-help
+ (symbol module)
+ "By default, Geiser will display help about an identifier in a
+help buffer, after collecting the associated signature and
+docstring. You can provide an alternative function for displaying
+help (e.g. browse an HTML page) implementing this method.")
+
+
;;; Documentation browser history:
(defvar geiser-doc-history-size 50)
@@ -108,7 +117,8 @@
(with--geiser-implementation impl
(if (null target)
(geiser-doc-module module impl)
- (geiser-doc-symbol target module impl))))))
+ (let ((geiser-eval--get-module-function (lambda (x) module)))
+ (geiser-doc-symbol target module impl)))))))
(make-variable-buffer-local
(defvar geiser-doc--buffer-link nil))
@@ -146,9 +156,13 @@
(module (geiser-doc--link-module geiser-doc--buffer-link))
(impl (geiser-doc--link-impl geiser-doc--buffer-link)))
(with--geiser-implementation impl
- (if (eq kind 'source)
- (if target (geiser-edit-symbol target nil (point-marker))
- (geiser-edit-module module)))))))
+ (cond ((eq kind 'source)
+ (if target (geiser-edit-symbol target nil (point-marker))
+ (geiser-edit-module module)))
+ ((eq kind 'manual)
+ (geiser-doc--external-help impl
+ (or target module)
+ module)))))))
(define-button-type 'geiser-doc--xbutton
'action 'geiser-doc--xbutton-action
@@ -160,27 +174,25 @@
:type 'geiser-doc--xbutton
'x-kind (if manual 'manual 'source)))
-(defun geiser-doc--insert-xbuttons ()
+(defun geiser-doc--insert-xbuttons (impl)
+ (when (geiser-impl--method 'external-help impl)
+ (geiser-doc--insert-xbutton t)
+ (insert " "))
(geiser-doc--insert-xbutton))
-(defun geiser-doc--insert-footer ()
- (newline 3)
- (when (geiser-doc--history-previous-p)
- (insert-text-button "[back]"
- 'action '(lambda (b) (geiser-doc-previous))
- 'face 'geiser-font-lock-doc-button
- 'follow-link t)
- (insert " "))
- (when (geiser-doc--history-next-p)
- (insert-text-button "[forward]"
- 'action '(lambda (b) (geiser-doc-next))
- 'face 'geiser-font-lock-doc-button
- 'follow-link t)))
-
;;; Auxiliary functions:
-(defun geiser-doc--insert-title (title &optional top)
+(defun geiser-doc--manual-available-p ()
+ (geiser-impl--method 'external-help geiser-impl--implementation))
+
+(defun geiser-doc--module (&optional mod impl)
+ (let* ((impl (or (geiser-doc--link-impl geiser-doc--buffer-link)))
+ (method (geiser-impl--method 'find-module impl))
+ (mod (or mod (geiser-doc--link-module geiser-doc--buffer-link))))
+ (funcall method mod)))
+
+(defun geiser-doc--insert-title (title)
(let ((p (point)))
(if (not (listp title))
(insert (format "%s" title))
@@ -189,12 +201,6 @@
(insert " " (if (eq a :rest) "." (format "%s" a))))
(insert ")"))
(put-text-property p (point) 'face 'geiser-font-lock-doc-title)
- (when top
- (let ((len (max 1 (- (window-width)
- (- (point) (line-beginning-position))
- 10))))
- (insert (make-string len ?\ ))
- (geiser-doc--insert-xbuttons)))
(newline)))
(defun geiser-doc--insert-list (title lst module impl)
@@ -213,45 +219,61 @@
(newline)))
(newline)))
+(defun geiser-doc--insert-footer (impl)
+ (newline 2)
+ (geiser-doc--insert-xbuttons impl)
+ (let* ((prev (and (geiser-doc--history-previous-p) 8))
+ (nxt (and (geiser-doc--history-next-p) 10))
+ (len (max 1 (- (window-width)
+ (- (point) (line-beginning-position))
+ (or prev 0)
+ (or nxt 0)))))
+ (when (or prev nxt)
+ (insert (make-string len ?\ )))
+ (when (geiser-doc--history-previous-p)
+ (insert-text-button "[back]"
+ 'action '(lambda (b) (geiser-doc-previous))
+ 'face 'geiser-font-lock-doc-button
+ 'follow-link t)
+ (insert " "))
+ (when (geiser-doc--history-next-p)
+ (insert-text-button "[forward]"
+ 'action '(lambda (b) (geiser-doc-next))
+ 'face 'geiser-font-lock-doc-button
+ 'follow-link t))))
+
;;; Commands:
-(geiser-impl--define-caller geiser-doc--external-help display-help
- (symbol module)
- "By default, Geiser will display help about an identifier in a
-help buffer, after collecting the associated signature and
-docstring. You can provide an alternative function for displaying
-help (e.g. browse an HTML page) implementing this method.")
-
(defun geiser-doc--get-docstring (symbol module)
(geiser-eval--send/result
`(:eval (:ge symbol-documentation ',symbol) ,module)))
(defun geiser-doc--get-module-exports (module)
(geiser-eval--send/result
- `(:eval (:ge module-exports '(:module ,module)))))
+ `(:eval (:ge module-exports '(:module ,module)) :f)))
(defun geiser-doc-symbol (symbol &optional module impl)
- (let ((module (or module (geiser-eval--get-module)))
- (impl (or impl geiser-impl--implementation)))
- (unless (geiser-doc--external-help impl symbol module)
- (let ((ds (geiser-doc--get-docstring symbol module)))
- (if (or (not ds) (not (listp ds)))
- (message "No documentation available for '%s'" symbol)
- (geiser-doc--with-buffer
- (erase-buffer)
- (geiser-doc--insert-title
- (geiser-autodoc--str (list (symbol-name symbol) 0)
- (cdr (assoc 'signature ds)))
- t)
- (newline)
- (insert (or (cdr (assoc 'docstring ds)) ""))
- (setq geiser-doc--buffer-link
- (geiser-doc--history-push
- (geiser-doc--make-link symbol module impl)))
- (geiser-doc--insert-footer)
- (goto-char (point-min)))
- (geiser-doc--pop-to-buffer))))))
+ (let* ((impl (or impl geiser-impl--implementation))
+ (module (geiser-doc--module (or module (geiser-eval--get-module))
+ impl)))
+ (let ((ds (geiser-doc--get-docstring symbol module)))
+ (if (or (not ds) (not (listp ds)))
+ (message "No documentation available for '%s'" symbol)
+ (geiser-doc--with-buffer
+ (erase-buffer)
+ (geiser-doc--insert-title
+ (geiser-autodoc--str (list (symbol-name symbol) 0)
+ (cdr (assoc 'signature ds))))
+ (newline)
+ (insert (or (cdr (assoc 'docstring ds)) ""))
+ (setq geiser-doc--buffer-link
+ (geiser-doc--history-push (geiser-doc--make-link symbol
+ module
+ impl)))
+ (geiser-doc--insert-footer impl)
+ (goto-char (point-min)))
+ (geiser-doc--pop-to-buffer)))))
(defun geiser-doc-symbol-at-point (&optional arg)
"Get docstring for symbol at point.
@@ -262,6 +284,18 @@ With prefix argument, ask for symbol (with completion)."
(symbol-at-point)))))
(when symbol (geiser-doc-symbol symbol))))
+(defun geiser-doc-lookup-manual (&optional arg)
+ "Lookup manual for symbol at point.
+With prefix argument, ask for the lookup symbol (with completion)."
+ (interactive "P")
+ (unless (geiser-doc--manual-available-p)
+ (error "No manual available"))
+ (let ((symbol (or (and (not arg) (symbol-at-point))
+ (geiser-completion--read-symbol "Symbol: "))))
+ (geiser-doc--external-help geiser-impl--implementation
+ symbol
+ (geiser-eval--get-module))))
+
(defconst geiser-doc--sections '(("Procedures:" procs)
("Syntax:" syntax)
("Variables:" vars)
@@ -273,17 +307,19 @@ With prefix argument, ask for symbol (with completion)."
(defun geiser-doc-module (&optional module impl)
"Display information about a given module."
(interactive)
- (let* ((module (or module (geiser-completion--read-module)))
+ (let* ((impl (or impl geiser-impl--implementation))
+ (module (geiser-doc--module (or module
+ (geiser-completion--read-module))
+ impl))
(msg (format "Retrieving documentation for %s ..." module))
(exports (progn
(message "%s" msg)
- (geiser-doc--get-module-exports module)))
- (impl (or impl geiser-impl--implementation)))
+ (geiser-doc--get-module-exports module))))
(if (not exports)
(message "No information available for %s" module)
(geiser-doc--with-buffer
(erase-buffer)
- (geiser-doc--insert-title (format "%s" module) t)
+ (geiser-doc--insert-title (format "%s" module))
(newline)
(dolist (g geiser-doc--sections)
(geiser-doc--insert-list (car g)
@@ -293,7 +329,7 @@ With prefix argument, ask for symbol (with completion)."
(setq geiser-doc--buffer-link
(geiser-doc--history-push
(geiser-doc--make-link nil module impl)))
- (geiser-doc--insert-footer)
+ (geiser-doc--insert-footer impl)
(goto-char (point-min)))
(message "%s done" msg)
(geiser-doc--pop-to-buffer))))
@@ -301,9 +337,9 @@ With prefix argument, ask for symbol (with completion)."
(defun geiser-doc-next-section ()
"Move to next section in this page."
(interactive)
- (next-line)
+ (forward-line)
(re-search-forward geiser-doc--sections-re nil t)
- (previous-line))
+ (forward-line -1))
(defun geiser-doc-previous-section ()
"Move to previous section in this page."
@@ -350,12 +386,6 @@ With prefix, the current page is deleted from history."
;;; Documentation browser and mode:
-(defsubst geiser-doc--module ()
- (geiser-impl--call-method
- 'find-module
- (geiser-doc--implementation)
- (geiser-doc--link-module geiser-doc--buffer-link)))
-
(defun geiser-doc-edit-symbol-at-point ()
"Open definition of symbol at point."
(interactive)
@@ -364,8 +394,7 @@ With prefix, the current page is deleted from history."
(unless (and impl module)
(error "I don't know what module this buffer refers to."))
(with--geiser-implementation impl
- (let ((geiser-eval--get-module-function (lambda (&rest x) module)))
- (geiser-edit-symbol-at-point)))))
+ (geiser-edit-symbol-at-point))))
(defvar geiser-doc-mode-map nil)
(setq geiser-doc-mode-map
@@ -413,6 +442,7 @@ With prefix, the current page is deleted from history."
(set-syntax-table scheme-mode-syntax-table)
(setq mode-name "Geiser Doc")
(setq major-mode 'geiser-doc-mode)
+ (setq geiser-eval--get-module-function 'geiser-doc--module)
(setq buffer-read-only t))
(geiser-popup--define doc "*Geiser documentation*" geiser-doc-mode)
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index 64b36ee..2ca20b4 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -23,19 +23,23 @@
;;; Plug-able functions:
-(defvar geiser-eval--get-module-function nil)
+(make-variable-buffer-local
+ (defvar geiser-eval--get-module-function nil))
+(set-default 'geiser-eval--get-module-function nil)
+(defvar geiser-eval--get-impl-module)
(geiser-impl--register-local-method
- 'geiser-eval--get-module-function 'find-module '(lambda (&rest) nil)
+ 'geiser-eval--get-impl-module 'find-module '(lambda (&rest) nil)
"Function used to obtain the module for current buffer. It takes
an optional argument, for cases where we want to force its
value.")
-(defsubst geiser-eval--get-module (&optional module)
- (and geiser-eval--get-module-function
- (funcall geiser-eval--get-module-function module)))
+(defun geiser-eval--get-module (&optional module)
+ (if geiser-eval--get-module-function
+ (funcall geiser-eval--get-module-function module)
+ (funcall geiser-eval--get-impl-module module)))
-(defvar geiser-eval--geiser-procedure-function nil)
+(defvar geiser-eval--geiser-procedure-function)
(geiser-impl--register-local-method
'geiser-eval--geiser-procedure-function 'marshall-procedure 'identity
"Function to translate a bare procedure symbol to one executable
@@ -86,9 +90,9 @@ module-exports, autodoc, callers, callees and generic-methods.")
(defsubst geiser-eval--module (code)
(geiser-eval--scheme-str
(cond ((or (null code) (eq code :t) (eq code :buffer))
- (funcall geiser-eval--get-module-function))
+ (geiser-eval--get-module))
((or (eq code :repl) (eq code :f)) :f)
- (t (funcall geiser-eval--get-module-function code)))))
+ (t (geiser-eval--get-module code)))))
(defsubst geiser-eval--ge (proc args)
(apply 'geiser-eval--form (cons proc
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index fe7936f..f755540 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -282,6 +282,8 @@ interacting with the Geiser REPL is at your disposal.
("Symbol documentation" ("\C-c\C-d\C-d" "\C-c\C-dd")
geiser-doc-symbol-at-point :enable (symbol-at-point))
("Module documentation" ("\C-c\C-d\C-m" "\C-c\C-dm") geiser-doc-module)
+ ("Symbol manual lookup" ("\C-c\C-d\C-i" "\C-c\C-di")
+ geiser-doc-lookup-manual :enable (geiser-doc--manual-available-p))
(mode "Autodoc mode" ("\C-c\C-d\C-a" "\C-c\C-da") geiser-autodoc-mode)
--
("Compile buffer" "\C-c\C-k" geiser-compile-current-buffer)
diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el
index 616c3af..112b3c4 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -262,7 +262,7 @@ using start-geiser, a procedure in the geiser/server module."
(exit-command geiser-racket--exit-command)
(find-symbol-begin geiser-racket--symbol-begin)
(display-error geiser-racket--display-error)
- (display-help geiser-racket--external-help)
+ (external-help geiser-racket--external-help)
(check-buffer geiser-racket--guess)
(keywords geiser-racket--keywords)
(binding-forms geiser-racket--binding-forms)
diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm
index 305ccfd..3741c6a 100644
--- a/scheme/guile/geiser/evaluation.scm
+++ b/scheme/guile/geiser/evaluation.scm
@@ -104,5 +104,3 @@
(with-output-to-string
(lambda ()
(pretty-print (tree-il->scheme (macroexpand form)))))))
-
-;;; evaluation.scm ends here
diff --git a/scheme/racket/geiser/autodoc.rkt b/scheme/racket/geiser/autodoc.rkt
index 54cac24..02b4f0f 100644
--- a/scheme/racket/geiser/autodoc.rkt
+++ b/scheme/racket/geiser/autodoc.rkt
@@ -11,19 +11,57 @@
#lang racket
-(provide autodoc module-exports update-signature-cache get-help)
+(provide autodoc
+ symbol-documentation
+ module-exports
+ update-signature-cache
+ get-help)
(require racket/help
- syntax/modcode
- syntax/modresolve
geiser/utils
geiser/modules
geiser/locations)
(define (get-help symbol mod)
- (with-handlers ([exn? (lambda (_)
- (eval `(help ,symbol)))])
- (eval `(help ,symbol #:from ,(ensure-module-spec mod)))))
+ (if (eq? symbol mod)
+ (get-mod-help mod)
+ (with-handlers ([exn? (lambda (_)
+ (eval `(help ,symbol)))])
+ (eval `(help ,symbol #:from ,(ensure-module-spec mod))))))
+
+(define (get-mod-help mod)
+ (let-values ([(ids syns) (module-identifiers mod)])
+ (let ([sym (cond [(not (null? syns)) (car syns)]
+ [(not (null? ids)) (car ids)]
+ [else #f])])
+ (and sym (get-help sym mod)))))
+
+(define (symbol-documentation id)
+ (let* ([val (value id (symbol-module id))]
+ [sign (autodoc* id)])
+ (and sign
+ (list (cons 'signature (autodoc* id #f))
+ (cons 'docstring (docstring id val sign))))))
+
+(define (docstring id val sign)
+ (let* ([mod (assoc 'module (cdr sign))]
+ [mod (if mod (cdr mod) "<unknown>")])
+ (if val
+ (format "A ~a in module ~a.~a~a"
+ (if (procedure? val) "procedure" "variable")
+ mod
+ (if (procedure? val)
+ ""
+ (format "~%~%Value:~%~% ~a" val))
+ (if (has-contract? val)
+ (format "~%~%Contract:~%~% ~a"
+ (contract-name (value-contract val)))
+ ""))
+ (format "A syntax object in module ~a." mod))))
+
+(define (value id mod)
+ (with-handlers ([exn? (const #f)])
+ (dynamic-require mod id (const #f))))
(define (autodoc ids)
(if (not (list? ids))
@@ -33,7 +71,8 @@
(define (autodoc* id (extra #t))
(define (val)
(with-handlers ([exn? (const "")])
- (format "~.a" (namespace-variable-value id))))
+ (parameterize ([error-print-width 60])
+ (format "~.a" (namespace-variable-value id)))))
(and
(symbol? id)
(let* ([loc (symbol-location* id)]
@@ -201,11 +240,8 @@
(hash-remove! signatures path)))
(define (module-exports mod)
- (define (value id)
- (with-handlers ([exn? (const #f)])
- (dynamic-require mod id (const #f))))
(define (contracted id)
- (let ([v (value id)])
+ (let ([v (value id mod)])
(if (has-contract? v)
(list id (cons 'info (contract-name (value-contract v))))
(entry id))))
@@ -213,22 +249,15 @@
(let ((sign (eval `(,autodoc* ',id #f)
(module-spec->namespace mod #f #f))))
(if sign (list id (cons 'signature sign)) (list id))))
- (define (extract-ids ls)
- (append-map (lambda (idls)
- (map car (cdr idls)))
- ls))
(define (classify-ids ids)
(let loop ([ids ids] [procs '()] [vars '()])
(cond [(null? ids)
`((procs ,@(map entry (reverse procs)))
(vars ,@(map list (reverse vars))))]
- [(procedure? (value (car ids)))
+ [(procedure? (value (car ids) mod))
(loop (cdr ids) (cons (car ids) procs) vars)]
[else (loop (cdr ids) procs (cons (car ids) vars))])))
- (let-values ([(reg syn)
- (module-compiled-exports
- (get-module-code (resolve-module-path mod #f)))])
- (let ([syn (map contracted (extract-ids syn))]
- [reg (extract-ids reg)]
- [subm (map list (or (submodules mod) '()))])
- `((syntax ,@syn) ,@(classify-ids reg) (modules ,@subm)))))
+ (let-values ([(ids syn) (module-identifiers mod)])
+ `(,@(classify-ids ids)
+ (syntax ,@(map contracted syn))
+ (modules ,@(map list (or (submodules mod) '()))))))
diff --git a/scheme/racket/geiser/locations.rkt b/scheme/racket/geiser/locations.rkt
index 7f69d3a..4715b8f 100644
--- a/scheme/racket/geiser/locations.rkt
+++ b/scheme/racket/geiser/locations.rkt
@@ -14,8 +14,8 @@
(provide symbol-location
symbol-location*
module-location
- symbol-module-name
- symbol-module-path-name)
+ symbol-module
+ symbol-module-name)
(require geiser/utils geiser/modules)
@@ -42,13 +42,10 @@
(make-location name path #f)
(module-location sym))))
-(define symbol-module-path-name (compose cdr symbol-location*))
+(define symbol-module (compose cdr symbol-location*))
(define symbol-module-name
- (compose module-path-name->name symbol-module-path-name))
+ (compose module-path-name->name symbol-module))
(define (module-location sym)
(make-location sym (module-spec->path-name sym) 1))
-
-
-;;; locations.rkt ends here
diff --git a/scheme/racket/geiser/main.rkt b/scheme/racket/geiser/main.rkt
index 0c7de4e..c759089 100644
--- a/scheme/racket/geiser/main.rkt
+++ b/scheme/racket/geiser/main.rkt
@@ -22,6 +22,7 @@
geiser:module-location
geiser:module-exports
geiser:autodoc
+ geiser:symbol-documentation
geiser:help
geiser:no-values)
@@ -52,6 +53,7 @@
(define geiser:module-location module-location)
(define geiser:module-exports module-exports)
(define geiser:macroexpand macroexpand)
+(define geiser:symbol-documentation symbol-documentation)
(define (geiser:no-values) (values))
;;; main.rkt ends here
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index 02fd460..eac3a6c 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -18,10 +18,14 @@
namespace->module-path-name
module-path-name->name
module-spec->path-name
+ module-identifiers
module-list
submodules)
-(require srfi/13 geiser/enter)
+(require srfi/13
+ syntax/modcode
+ syntax/modresolve
+ geiser/enter)
(define (ensure-module-spec spec)
(cond [(symbol? spec) spec]
@@ -48,7 +52,7 @@
(define (namespace->module-path-name ns)
(let ([rmp (variable-reference->resolved-module-path
- (eval '(#%variable-reference) ns))])
+ (eval '(#%variable-reference) (or ns (current-namespace))))])
(and (resolved-module-path? rmp)
(resolved-module-path-name rmp))))
@@ -57,7 +61,7 @@
(or (get-path spec)
(register-path spec
(namespace->module-path-name
- (module-spec->namespace spec) #f #f)))))
+ (module-spec->namespace spec #f #f))))))
(define (module-path-name->name path)
(cond [(path? path)
@@ -83,6 +87,17 @@
(define namespace->module-name
(compose module-path-name->name namespace->module-path-name))
+(define (module-identifiers mod)
+ (define (extract-ids ls)
+ (append-map (lambda (idls)
+ (map car (cdr idls)))
+ ls))
+ (let-values ([(reg syn)
+ (module-compiled-exports
+ (get-module-code (resolve-module-path
+ (ensure-module-spec mod) #f)))])
+ (values (extract-ids reg) (extract-ids syn))))
+
(define (skippable-dir? path)
(call-with-values (lambda () (split-path path))
(lambda (_ basename __)