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
)
30 (defgroup geiser-doc nil
31 "Options for documentation buffers."
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")
45 (geiser-impl--define-caller geiser-doc--external-help external-help
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 ()
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
))
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))))
100 (defsubst geiser-doc--make-link
(target module impl
)
101 (list target module impl
))
103 (defsubst geiser-doc--link-target
(link)
106 (defsubst geiser-doc--link-module
(link)
109 (defsubst geiser-doc--link-impl
(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
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
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
))
142 (help (format "%smodule %s"
143 (if target
(format "%s in " target
) "")
144 (or module
"<unknown>"))))
145 (apply 'insert-text-button
147 :type geiser-doc--button
148 ,@(and (not sign
) (list 'face
'geiser-font-lock-doc-link
))
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
)))
163 (geiser-doc--external-help impl
167 (define-button-type 'geiser-doc--xbutton
168 'action
'geiser-doc--xbutton-action
169 'face
'geiser-font-lock-doc-button
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
)
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)
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
))))
203 (put-text-property p
(point) 'face
'geiser-font-lock-doc-title
)
206 (defun geiser-doc--insert-list (title lst module impl
)
208 (geiser-doc--insert-title title
)
212 (signature (cdr (assoc 'signature w
)))
213 (info (cdr (assoc 'info w
))))
214 (insert (format "\t- "))
216 (geiser-doc--insert-button name module impl signature
)
217 (geiser-doc--insert-button nil name impl
))
218 (when info
(insert (format " %s" info
)))
222 (defun geiser-doc--insert-footer (impl)
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))
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
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
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))
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
265 (geiser-doc--insert-title
266 (geiser-autodoc--str (list (symbol-name symbol
) 0)
267 (cdr (assoc 'signature ds
))))
269 (insert (or (cdr (assoc 'docstring ds
)) ""))
270 (setq geiser-doc--buffer-link
271 (geiser-doc--history-push (geiser-doc--make-link symbol
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)."
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)."
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
297 (geiser-eval--get-module))))
299 (defconst geiser-doc--sections
'(("Procedures:" procs
)
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."
310 (let* ((impl (or impl geiser-impl--implementation
))
311 (module (geiser-doc--module (or module
312 (geiser-completion--read-module))
314 (msg (format "Retrieving documentation for %s ..." module
))
317 (geiser-doc--get-module-exports module
))))
319 (message "No information available for %s" module
)
320 (geiser-doc--with-buffer
322 (geiser-doc--insert-title (format "%s" module
))
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
)
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."
341 (re-search-forward geiser-doc--sections-re nil t
)
344 (defun geiser-doc-previous-section ()
345 "Move to previous section in this page."
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."
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."
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."
369 (geiser-doc-previous t
)
370 (error (geiser-doc-next t
))))
372 (defun geiser-doc-refresh ()
373 "Refresh the contents of current page."
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."
381 (when (y-or-n-p "Clean browsing history? ")
382 (setq geiser-doc--history
(geiser-doc--make-history))
383 (geiser-doc-refresh))
387 ;;; Documentation browser and mode:
389 (defun geiser-doc-edit-symbol-at-point ()
390 "Open definition of symbol at point."
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
)
406 (defun geiser-doc-switch-to-repl ()
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}"
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