Lookup is a name, look up, a verb
[geiser.git] / elisp / geiser-doc.el
blobf1f0aa0e7848df62edb324eec217e3110f9ce4d7
1 ;;; geiser-doc.el -- accessing scheme-provided documentation
3 ;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the Modified BSD License. You should
7 ;; have received a copy of the license along with this program. If
8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
10 ;; Start date: Sat Feb 14, 2009 14:09
14 (require 'geiser-edit)
15 (require 'geiser-impl)
16 (require 'geiser-completion)
17 (require 'geiser-autodoc)
18 (require 'geiser-eval)
19 (require 'geiser-syntax)
20 (require 'geiser-menu)
21 (require 'geiser-popup)
22 (require 'geiser-custom)
23 (require 'geiser-base)
25 (require 'button)
28 ;;; Customization:
30 (defgroup geiser-doc nil
31 "Options for documentation buffers."
32 :group 'geiser)
34 (geiser-custom--defface doc-title
35 'bold geiser-doc "article titles in documentation buffers")
37 (geiser-custom--defface doc-link
38 'link geiser-doc "links in documentation buffers")
40 (geiser-custom--defface doc-button
41 'button geiser-doc "buttons in documentation buffers")
44 ;;; Implementation
45 (geiser-impl--define-caller geiser-doc--external-help external-help
46 (symbol module)
47 "By default, Geiser will display help about an identifier in a
48 help buffer, after collecting the associated signature and
49 docstring. You can provide an alternative function for displaying
50 help (e.g. browse an HTML page) implementing this method.")
53 ;;; Documentation browser history:
55 (defvar geiser-doc-history-size 50)
56 (defvar geiser-doc--history nil)
58 (defun geiser-doc--make-history ()
59 (list nil ; current
60 (make-ring geiser-doc-history-size) ; previous
61 (make-ring geiser-doc-history-size))) ; next
63 (setq geiser-doc--history (geiser-doc--make-history))
65 (defsubst geiser-doc--history-current ()
66 (car geiser-doc--history))
68 (defun geiser-doc--history-push (link)
69 (unless (or (null link) (equal link (geiser-doc--history-current)))
70 (when (not (null (geiser-doc--history-current)))
71 (let ((next (geiser-doc--history-next)))
72 (unless (equal link next)
73 (when next (geiser-doc--history-previous))
74 (ring-insert (nth 1 geiser-doc--history)
75 (car geiser-doc--history)))))
76 (setcar geiser-doc--history link))
77 link)
79 (defsubst geiser-doc--history-next-p ()
80 (not (ring-empty-p (nth 2 geiser-doc--history))))
82 (defun geiser-doc--history-next (&optional forget-current)
83 (when (geiser-doc--history-next-p)
84 (when (and (car geiser-doc--history) (not forget-current))
85 (ring-insert (nth 1 geiser-doc--history) (car geiser-doc--history)))
86 (setcar geiser-doc--history (ring-remove (nth 2 geiser-doc--history) 0))))
88 (defsubst geiser-doc--history-previous-p ()
89 (not (ring-empty-p (nth 1 geiser-doc--history))))
91 (defun geiser-doc--history-previous (&optional forget-current)
92 (when (geiser-doc--history-previous-p)
93 (when (and (car geiser-doc--history) (not forget-current))
94 (ring-insert (nth 2 geiser-doc--history) (car geiser-doc--history)))
95 (setcar geiser-doc--history (ring-remove (nth 1 geiser-doc--history) 0))))
98 ;;; Links
100 (defsubst geiser-doc--make-link (target module impl)
101 (list target module impl))
103 (defsubst geiser-doc--link-target (link)
104 (nth 0 link))
106 (defsubst geiser-doc--link-module (link)
107 (nth 1 link))
109 (defsubst geiser-doc--link-impl (link)
110 (nth 2 link))
112 (defun geiser-doc--follow-link (link)
113 (let ((target (geiser-doc--link-target link))
114 (module (geiser-doc--link-module link))
115 (impl (geiser-doc--link-impl link)))
116 (when (and (or target module) impl)
117 (with--geiser-implementation impl
118 (if (null target)
119 (geiser-doc-module module impl)
120 (let ((geiser-eval--get-module-function (lambda (x) module)))
121 (geiser-doc-symbol target module impl)))))))
123 (make-variable-buffer-local
124 (defvar geiser-doc--buffer-link nil))
126 (defsubst geiser-doc--implementation ()
127 (geiser-doc--link-impl geiser-doc--buffer-link))
129 (defun geiser-doc--button-action (button)
130 (let ((link (button-get button 'geiser-link)))
131 (when link (geiser-doc--follow-link link))))
133 (define-button-type 'geiser-doc--button
134 'action 'geiser-doc--button-action
135 'follow-link t)
137 (defun geiser-doc--insert-button (target module impl &optional sign)
138 (let ((link (geiser-doc--make-link target module impl))
139 (text (format "%s" (or (and sign (geiser-autodoc--str* sign))
140 target
141 module)))
142 (help (format "%smodule %s"
143 (if target (format "%s in " target) "")
144 (or module "<unknown>"))))
145 (apply 'insert-text-button
146 `(,text
147 :type geiser-doc--button
148 ,@(and (not sign) (list 'face 'geiser-font-lock-doc-link))
149 geiser-link ,link
150 help-echo ,help))))
152 (defun geiser-doc--xbutton-action (button)
153 (when geiser-doc--buffer-link
154 (let ((kind (or (button-get button 'x-kind) 'source))
155 (target (geiser-doc--link-target geiser-doc--buffer-link))
156 (module (geiser-doc--link-module geiser-doc--buffer-link))
157 (impl (geiser-doc--link-impl geiser-doc--buffer-link)))
158 (with--geiser-implementation impl
159 (cond ((eq kind 'source)
160 (if target (geiser-edit-symbol target nil (point-marker))
161 (geiser-edit-module module)))
162 ((eq kind 'manual)
163 (geiser-doc--external-help impl
164 (or target module)
165 module)))))))
167 (define-button-type 'geiser-doc--xbutton
168 'action 'geiser-doc--xbutton-action
169 'face 'geiser-font-lock-doc-button
170 'follow-link t)
172 (defun geiser-doc--insert-xbutton (&optional manual)
173 (insert-text-button (if manual "[manual]" "[source]")
174 :type 'geiser-doc--xbutton
175 'x-kind (if manual 'manual 'source)))
177 (defun geiser-doc--insert-xbuttons (impl)
178 (when (geiser-impl--method 'external-help impl)
179 (geiser-doc--insert-xbutton t)
180 (insert " "))
181 (geiser-doc--insert-xbutton))
184 ;;; Auxiliary functions:
186 (defun geiser-doc--manual-available-p ()
187 (geiser-impl--method 'external-help geiser-impl--implementation))
189 (defun geiser-doc--module (&optional mod impl)
190 (let* ((impl (or (geiser-doc--link-impl geiser-doc--buffer-link)))
191 (method (geiser-impl--method 'find-module impl))
192 (mod (or mod (geiser-doc--link-module geiser-doc--buffer-link))))
193 (funcall method mod)))
195 (defun geiser-doc--insert-title (title)
196 (let ((p (point)))
197 (if (not (listp title))
198 (insert (format "%s" title))
199 (insert "(" (format "%s" (car title)))
200 (dolist (a (cdr title))
201 (insert " " (if (eq a :rest) "." (format "%s" a))))
202 (insert ")"))
203 (put-text-property p (point) 'face 'geiser-font-lock-doc-title)
204 (newline)))
206 (defun geiser-doc--insert-list (title lst module impl)
207 (when lst
208 (geiser-doc--insert-title title)
209 (newline)
210 (dolist (w lst)
211 (let ((name (car w))
212 (signature (cdr (assoc 'signature w)))
213 (info (cdr (assoc 'info w))))
214 (insert (format "\t- "))
215 (if module
216 (geiser-doc--insert-button name module impl signature)
217 (geiser-doc--insert-button nil name impl))
218 (when info (insert (format " %s" info)))
219 (newline)))
220 (newline)))
222 (defun geiser-doc--insert-footer (impl)
223 (newline 2)
224 (geiser-doc--insert-xbuttons impl)
225 (let* ((prev (and (geiser-doc--history-previous-p) 8))
226 (nxt (and (geiser-doc--history-next-p) 10))
227 (len (max 1 (- (window-width)
228 (- (point) (line-beginning-position))
229 (or prev 0)
230 (or nxt 0)))))
231 (when (or prev nxt)
232 (insert (make-string len ?\ )))
233 (when (geiser-doc--history-previous-p)
234 (insert-text-button "[back]"
235 'action '(lambda (b) (geiser-doc-previous))
236 'face 'geiser-font-lock-doc-button
237 'follow-link t)
238 (insert " "))
239 (when (geiser-doc--history-next-p)
240 (insert-text-button "[forward]"
241 'action '(lambda (b) (geiser-doc-next))
242 'face 'geiser-font-lock-doc-button
243 'follow-link t))))
246 ;;; Commands:
248 (defun geiser-doc--get-docstring (symbol module)
249 (geiser-eval--send/result
250 `(:eval (:ge symbol-documentation ',symbol) ,module)))
252 (defun geiser-doc--get-module-exports (module)
253 (geiser-eval--send/result
254 `(:eval (:ge module-exports '(:module ,module)) :f)))
256 (defun geiser-doc-symbol (symbol &optional module impl)
257 (let* ((impl (or impl geiser-impl--implementation))
258 (module (geiser-doc--module (or module (geiser-eval--get-module))
259 impl)))
260 (let ((ds (geiser-doc--get-docstring symbol module)))
261 (if (or (not ds) (not (listp ds)))
262 (message "No documentation available for '%s'" symbol)
263 (geiser-doc--with-buffer
264 (erase-buffer)
265 (geiser-doc--insert-title
266 (geiser-autodoc--str (list (symbol-name symbol) 0)
267 (cdr (assoc 'signature ds))))
268 (newline)
269 (insert (or (cdr (assoc 'docstring ds)) ""))
270 (setq geiser-doc--buffer-link
271 (geiser-doc--history-push (geiser-doc--make-link symbol
272 module
273 impl)))
274 (geiser-doc--insert-footer impl)
275 (goto-char (point-min)))
276 (geiser-doc--pop-to-buffer)))))
278 (defun geiser-doc-symbol-at-point (&optional arg)
279 "Get docstring for symbol at point.
280 With prefix argument, ask for symbol (with completion)."
281 (interactive "P")
282 (let ((symbol (or (and (not arg) (symbol-at-point))
283 (geiser-completion--read-symbol "Symbol: "
284 (symbol-at-point)))))
285 (when symbol (geiser-doc-symbol symbol))))
287 (defun geiser-doc-look-up-manual (&optional arg)
288 "Look up manual for symbol at point.
289 With prefix argument, ask for the lookup symbol (with completion)."
290 (interactive "P")
291 (unless (geiser-doc--manual-available-p)
292 (error "No manual available"))
293 (let ((symbol (or (and (not arg) (symbol-at-point))
294 (geiser-completion--read-symbol "Symbol: "))))
295 (geiser-doc--external-help geiser-impl--implementation
296 symbol
297 (geiser-eval--get-module))))
299 (defconst geiser-doc--sections '(("Procedures:" procs)
300 ("Syntax:" syntax)
301 ("Variables:" vars)
302 ("Submodules:" modules t)))
304 (defconst geiser-doc--sections-re
305 (format "^%s\n" (regexp-opt (mapcar 'car geiser-doc--sections))))
307 (defun geiser-doc-module (&optional module impl)
308 "Display information about a given module."
309 (interactive)
310 (let* ((impl (or impl geiser-impl--implementation))
311 (module (geiser-doc--module (or module
312 (geiser-completion--read-module))
313 impl))
314 (msg (format "Retrieving documentation for %s ..." module))
315 (exports (progn
316 (message "%s" msg)
317 (geiser-doc--get-module-exports module))))
318 (if (not exports)
319 (message "No information available for %s" module)
320 (geiser-doc--with-buffer
321 (erase-buffer)
322 (geiser-doc--insert-title (format "%s" module))
323 (newline)
324 (dolist (g geiser-doc--sections)
325 (geiser-doc--insert-list (car g)
326 (cdr (assoc (cadr g) exports))
327 (and (not (cddr g)) module)
328 impl))
329 (setq geiser-doc--buffer-link
330 (geiser-doc--history-push
331 (geiser-doc--make-link nil module impl)))
332 (geiser-doc--insert-footer impl)
333 (goto-char (point-min)))
334 (message "%s done" msg)
335 (geiser-doc--pop-to-buffer))))
337 (defun geiser-doc-next-section ()
338 "Move to next section in this page."
339 (interactive)
340 (forward-line)
341 (re-search-forward geiser-doc--sections-re nil t)
342 (forward-line -1))
344 (defun geiser-doc-previous-section ()
345 "Move to previous section in this page."
346 (interactive)
347 (re-search-backward geiser-doc--sections-re nil t))
349 (defun geiser-doc-next (&optional forget-current)
350 "Go to next page in documentation browser.
351 With prefix, the current page is deleted from history."
352 (interactive "P")
353 (let ((link (geiser-doc--history-next forget-current)))
354 (unless link (error "No next page"))
355 (geiser-doc--follow-link link)))
357 (defun geiser-doc-previous (&optional forget-current)
358 "Go to previous page in documentation browser.
359 With prefix, the current page is deleted from history."
360 (interactive "P")
361 (let ((link (geiser-doc--history-previous forget-current)))
362 (unless link (error "No previous page"))
363 (geiser-doc--follow-link link)))
365 (defun geiser-doc-kill-page ()
366 "Kill current page if a previous or next one exists."
367 (interactive)
368 (condition-case nil
369 (geiser-doc-previous t)
370 (error (geiser-doc-next t))))
372 (defun geiser-doc-refresh ()
373 "Refresh the contents of current page."
374 (interactive)
375 (when geiser-doc--buffer-link
376 (geiser-doc--follow-link geiser-doc--buffer-link)))
378 (defun geiser-doc-clean-history ()
379 "Clean up the document browser history."
380 (interactive)
381 (when (y-or-n-p "Clean browsing history? ")
382 (setq geiser-doc--history (geiser-doc--make-history))
383 (geiser-doc-refresh))
384 (message ""))
387 ;;; Documentation browser and mode:
389 (defun geiser-doc-edit-symbol-at-point ()
390 "Open definition of symbol at point."
391 (interactive)
392 (let* ((impl (geiser-doc--implementation))
393 (module (geiser-doc--module)))
394 (unless (and impl module)
395 (error "I don't know what module this buffer refers to."))
396 (with--geiser-implementation impl
397 (geiser-edit-symbol-at-point))))
399 (defvar geiser-doc-mode-map nil)
400 (setq geiser-doc-mode-map
401 (let ((map (make-sparse-keymap)))
402 (suppress-keymap map)
403 (set-keymap-parent map button-buffer-map)
404 map))
406 (defun geiser-doc-switch-to-repl ()
407 (interactive)
408 (switch-to-geiser nil nil (current-buffer)))
410 (geiser-menu--defmenu doc geiser-doc-mode-map
411 ("Next link" ("n") forward-button)
412 ("Previous link" ("p") backward-button)
413 ("Next section" ("N") geiser-doc-next-section)
414 ("Previous section" ("P") geiser-doc-previous-section)
416 ("Next page" ("f") geiser-doc-next "Next item"
417 :enable (geiser-doc--history-next-p))
418 ("Previous page" ("b") geiser-doc-previous "Previous item"
419 :enable (geiser-doc--history-previous-p))
421 ("Go to REPL" ("z" "\C-cz" "\C-c\C-z") geiser-doc-switch-to-repl)
422 ("Refresh" ("g" "r") geiser-doc-refresh "Refresh current page")
424 ("Edit symbol" ("." "\M-.") geiser-doc-edit-symbol-at-point
425 :enable (symbol-at-point))
427 ("Kill item" "k" geiser-doc-kill-page "Kill this page")
428 ("Clear history" "c" geiser-doc-clean-history)
430 (custom "Browser options" geiser-doc)
432 ("Quit" nil View-quit))
434 (defun geiser-doc-mode ()
435 "Major mode for browsing scheme documentation.
436 \\{geiser-doc-mode-map}"
437 (interactive)
438 (kill-all-local-variables)
439 (buffer-disable-undo)
440 (setq truncate-lines t)
441 (use-local-map geiser-doc-mode-map)
442 (set-syntax-table scheme-mode-syntax-table)
443 (setq mode-name "Geiser Doc")
444 (setq major-mode 'geiser-doc-mode)
445 (setq geiser-eval--get-module-function 'geiser-doc--module)
446 (setq buffer-read-only t))
448 (geiser-popup--define doc "*Geiser documentation*" geiser-doc-mode)
451 (provide 'geiser-doc)
452 ;;; geiser-doc.el ends here