From 3b24e917fdfebc8df3fefbbcc747963eb4bbd126 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Tue, 23 Nov 2010 01:58:33 +0100
Subject: 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.
---
elisp/geiser-completion.el | 11 +--
elisp/geiser-doc.el | 168 ++++++++++++++++++++++++++-------------------
elisp/geiser-eval.el | 20 +++---
elisp/geiser-mode.el | 2 +
elisp/geiser-racket.el | 2 +-
5 files changed, 120 insertions(+), 83 deletions(-)
(limited to 'elisp')
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
@@ -40,6 +40,15 @@
(geiser-custom--defface doc-button
'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:
@@ -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)
--
cgit v1.2.3