add using
[factor/jcg.git] / misc / fuel / fuel-help.el
bloba82de388da955748f960d6e6c8d7ea21e68a068c
1 ;;; fuel-help.el -- accessing Factor's help system
3 ;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
4 ;; See http://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
7 ;; Keywords: languages, fuel, factor
8 ;; Start date: Wed Dec 03, 2008 21:41
10 ;;; Comentary:
12 ;; Modes and functions interfacing Factor's 'see' and 'help'
13 ;; utilities, as well as an ElDoc-based autodoc mode.
15 ;;; Code:
17 (require 'fuel-edit)
18 (require 'fuel-eval)
19 (require 'fuel-markup)
20 (require 'fuel-autodoc)
21 (require 'fuel-completion)
22 (require 'fuel-syntax)
23 (require 'fuel-font-lock)
24 (require 'fuel-popup)
25 (require 'fuel-base)
27 (require 'button)
30 ;;; Customization:
32 (defgroup fuel-help nil
33 "Options controlling FUEL's help system."
34 :group 'fuel)
36 (defcustom fuel-help-always-ask t
37 "When enabled, always ask for confirmation in help prompts."
38 :type 'boolean
39 :group 'fuel-help)
41 (defcustom fuel-help-history-cache-size 50
42 "Maximum number of pages to keep in the help browser cache."
43 :type 'integer
44 :group 'fuel-help)
46 (defcustom fuel-help-bookmarks nil
47 "Bookmars. Maintain this list using the help browser."
48 :type 'list
49 :group 'fuel-help)
52 ;;; Help browser history:
54 (defun fuel-help--make-history ()
55 (list nil ; current
56 (make-ring fuel-help-history-cache-size) ; previous
57 (make-ring fuel-help-history-cache-size))) ; next
59 (defsubst fuel-help--history-current ()
60 (car fuel-help--history))
62 (defun fuel-help--history-push (link)
63 (unless (equal link (car fuel-help--history))
64 (let ((next (fuel-help--history-next)))
65 (unless (equal link next)
66 (when next (fuel-help--history-previous))
67 (ring-insert (nth 1 fuel-help--history) (car fuel-help--history))
68 (setcar fuel-help--history link))))
69 link)
71 (defun fuel-help--history-next (&optional forget-current)
72 (when (not (ring-empty-p (nth 2 fuel-help--history)))
73 (when (and (car fuel-help--history) (not forget-current))
74 (ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
75 (setcar fuel-help--history (ring-remove (nth 2 fuel-help--history) 0))))
77 (defun fuel-help--history-previous (&optional forget-current)
78 (when (not (ring-empty-p (nth 1 fuel-help--history)))
79 (when (and (car fuel-help--history) (not forget-current))
80 (ring-insert (nth 2 fuel-help--history) (car fuel-help--history)))
81 (setcar fuel-help--history (ring-remove (nth 1 fuel-help--history) 0))))
83 (defvar fuel-help--history (fuel-help--make-history))
86 ;;; Page cache:
88 (defun fuel-help--history-current-content ()
89 (fuel-help--cache-get (car fuel-help--history)))
91 (defvar fuel-help--cache (make-hash-table :weakness 'key :test 'equal))
93 (defsubst fuel-help--cache-get (name)
94 (gethash name fuel-help--cache))
96 (defsubst fuel-help--cache-insert (name str)
97 (puthash name str fuel-help--cache))
99 (defsubst fuel-help--cache-clear ()
100 (clrhash fuel-help--cache))
103 ;;; Fuel help buffer and internals:
105 (fuel-popup--define fuel-help--buffer
106 "*fuel help*" 'fuel-help-mode)
109 (defvar fuel-help--prompt-history nil)
111 (make-local-variable
112 (defvar fuel-help--buffer-link nil))
114 (defun fuel-help--read-word (see)
115 (let* ((def (fuel-syntax-symbol-at-point))
116 (prompt (format "See%s help on%s: " (if see " short" "")
117 (if def (format " (%s)" def) "")))
118 (ask (or (not def) fuel-help-always-ask)))
119 (if ask
120 (fuel-completion--read-word prompt
122 'fuel-help--prompt-history
124 def)))
126 (defun fuel-help--word-help (&optional see word)
127 (let ((def (or word (fuel-help--read-word see))))
128 (when def
129 (let ((cmd `(:fuel* (,def ,(if see 'fuel-word-see 'fuel-word-help))
130 "fuel" t)))
131 (message "Looking up '%s' ..." def)
132 (let* ((ret (fuel-eval--send/wait cmd))
133 (res (fuel-eval--retort-result ret)))
134 (if (not res)
135 (message "No help for '%s'" def)
136 (fuel-help--insert-contents (list def def 'word) res)))))))
138 (defun fuel-help--get-article (name label)
139 (message "Retrieving article ...")
140 (let* ((name (if (listp name) (cons :seq name) name))
141 (cmd `(:fuel* ((,name fuel-get-article)) "fuel" t))
142 (ret (fuel-eval--send/wait cmd))
143 (res (fuel-eval--retort-result ret)))
144 (if (not res)
145 (message "Article '%s' not found" label)
146 (fuel-help--insert-contents (list name label 'article) res)
147 (message ""))))
149 (defun fuel-help--get-vocab (name)
150 (message "Retrieving help vocabulary for vocabulary '%s' ..." name)
151 (let* ((cmd `(:fuel* ((,name fuel-vocab-help)) "fuel" (,name)))
152 (ret (fuel-eval--send/wait cmd))
153 (res (fuel-eval--retort-result ret)))
154 (if (not res)
155 (message "No help available for vocabulary '%s'" name)
156 (fuel-help--insert-contents (list name name 'vocab) res)
157 (message ""))))
159 (defun fuel-help--get-vocab/author (author)
160 (message "Retrieving vocabularies by %s ..." author)
161 (let* ((cmd `(:fuel* ((,author fuel-get-vocabs/author)) "fuel" t))
162 (ret (fuel-eval--send/wait cmd))
163 (res (fuel-eval--retort-result ret)))
164 (if (not res)
165 (message "No vocabularies by %s" author)
166 (fuel-help--insert-contents (list author author 'author) res)
167 (message ""))))
169 (defun fuel-help--get-vocab/tag (tag)
170 (message "Retrieving vocabularies tagged '%s' ..." tag)
171 (let* ((cmd `(:fuel* ((,tag fuel-get-vocabs/tag)) "fuel" t))
172 (ret (fuel-eval--send/wait cmd))
173 (res (fuel-eval--retort-result ret)))
174 (if (not res)
175 (message "No vocabularies tagged '%s'" tag)
176 (fuel-help--insert-contents (list tag tag 'tag) res)
177 (message ""))))
179 (defun fuel-help--follow-link (link label type &optional no-cache)
180 (let* ((llink (list link label type))
181 (cached (and (not no-cache) (fuel-help--cache-get llink))))
182 (if (not cached)
183 (let ((fuel-help-always-ask nil))
184 (cond ((eq type 'word) (fuel-help--word-help nil link))
185 ((eq type 'article) (fuel-help--get-article link label))
186 ((eq type 'vocab) (fuel-help--get-vocab link))
187 ((eq type 'author) (fuel-help--get-vocab/author label))
188 ((eq type 'tag) (fuel-help--get-vocab/tag label))
189 ((eq type 'bookmarks) (fuel-help-display-bookmarks))
190 (t (error "Links of type %s not yet implemented" type))))
191 (fuel-help--insert-contents llink cached))))
193 (defun fuel-help--insert-contents (key content)
194 (let ((hb (fuel-help--buffer))
195 (inhibit-read-only t)
196 (font-lock-verbose nil))
197 (set-buffer hb)
198 (erase-buffer)
199 (if (stringp content)
200 (insert content)
201 (fuel-markup--print content)
202 (fuel-markup--insert-newline)
203 (delete-blank-lines)
204 (fuel-help--cache-insert key (buffer-string)))
205 (fuel-help--history-push key)
206 (setq fuel-help--buffer-link key)
207 (set-buffer-modified-p nil)
208 (fuel-popup--display)
209 (goto-char (point-min))
210 (message "")))
213 ;;; Bookmarks:
215 (defun fuel-help-bookmark-page ()
216 "Add current help page to bookmarks."
217 (interactive)
218 (let ((link fuel-help--buffer-link))
219 (unless link (error "No link associated to this page"))
220 (add-to-list 'fuel-help-bookmarks link)
221 (customize-save-variable 'fuel-help-bookmarks fuel-help-bookmarks)
222 (message "Bookmark '%s' saved" (cadr link))))
224 (defun fuel-help-delete-bookmark ()
225 "Delete link at point from bookmarks."
226 (interactive)
227 (let ((link (fuel-markup--link-at-point)))
228 (unless link (error "No link at point"))
229 (unless (member link fuel-help-bookmarks)
230 (error "'%s' is not bookmarked" (cadr link)))
231 (customize-save-variable 'fuel-help-bookmarks
232 (remove link fuel-help-bookmarks))
233 (message "Bookmark '%s' delete" (cadr link))
234 (fuel-help-display-bookmarks)))
236 (defun fuel-help-display-bookmarks ()
237 "Display bookmarked pages."
238 (interactive)
239 (let ((links (mapcar (lambda (l) (cons '$subsection l)) fuel-help-bookmarks)))
240 (unless links (error "No links to display"))
241 (fuel-help--insert-contents '("bookmarks" "Bookmars" bookmarks)
242 `(article "Bookmarks" ,links))))
245 ;;; Interactive help commands:
247 (defun fuel-help-short ()
248 "See help summary of symbol at point."
249 (interactive)
250 (fuel-help--word-help t))
252 (defun fuel-help ()
253 "Show extended help about the symbol at point, using a help
254 buffer."
255 (interactive)
256 (fuel-help--word-help))
258 (defun fuel-help-vocab (vocab)
259 "Ask for a vocabulary name and show its help page."
260 (interactive (list (fuel-edit--read-vocabulary-name nil)))
261 (fuel-help--get-vocab vocab))
263 (defun fuel-help-next (&optional forget-current)
264 "Go to next page in help browser.
265 With prefix, the current page is deleted from history."
266 (interactive "P")
267 (let ((item (fuel-help--history-next forget-current)))
268 (unless item (error "No next page"))
269 (apply 'fuel-help--follow-link item)))
271 (defun fuel-help-previous (&optional forget-current)
272 "Go to previous page in help browser.
273 With prefix, the current page is deleted from history."
274 (interactive "P")
275 (let ((item (fuel-help--history-previous forget-current)))
276 (unless item (error "No previous page"))
277 (apply 'fuel-help--follow-link item)))
279 (defun fuel-help-kill-page ()
280 "Kill current page if a previous or next one exists."
281 (interactive)
282 (condition-case nil
283 (fuel-help-previous t)
284 (error (fuel-help-next t))))
286 (defun fuel-help-refresh ()
287 "Refresh the contents of current page."
288 (interactive)
289 (when fuel-help--buffer-link
290 (apply 'fuel-help--follow-link (append fuel-help--buffer-link '(t)))))
292 (defun fuel-help-clean-history ()
293 "Clean up the help browser cache of visited pages."
294 (interactive)
295 (when (y-or-n-p "Clean browsing history? ")
296 (fuel-help--cache-clear)
297 (setq fuel-help--history (fuel-help--make-history))
298 (fuel-help-refresh))
299 (message ""))
301 (defun fuel-help-edit ()
302 "Edit the current article or word help."
303 (interactive)
304 (let ((link (car fuel-help--buffer-link))
305 (type (nth 2 fuel-help--buffer-link)))
306 (cond ((eq type 'word) (fuel-edit-word-doc-at-point nil link))
307 ((member type '(article vocab)) (fuel-edit--edit-article link))
308 (t (error "No document associated with this page")))))
311 ;;;; Help mode map:
313 (defvar fuel-help-mode-map
314 (let ((map (make-sparse-keymap)))
315 (suppress-keymap map)
316 (set-keymap-parent map button-buffer-map)
317 (define-key map "a" 'fuel-apropos)
318 (define-key map "ba" 'fuel-help-bookmark-page)
319 (define-key map "bb" 'fuel-help-display-bookmarks)
320 (define-key map "bd" 'fuel-help-delete-bookmark)
321 (define-key map "c" 'fuel-help-clean-history)
322 (define-key map "e" 'fuel-help-edit)
323 (define-key map "h" 'fuel-help)
324 (define-key map "k" 'fuel-help-kill-page)
325 (define-key map "n" 'fuel-help-next)
326 (define-key map "l" 'fuel-help-previous)
327 (define-key map "p" 'fuel-help-previous)
328 (define-key map "r" 'fuel-help-refresh)
329 (define-key map "v" 'fuel-help-vocab)
330 (define-key map (kbd "SPC") 'scroll-up)
331 (define-key map (kbd "S-SPC") 'scroll-down)
332 (define-key map "\M-." 'fuel-edit-word-at-point)
333 (define-key map "\C-cz" 'run-factor)
334 (define-key map "\C-c\C-z" 'run-factor)
335 map))
338 ;;; IN: support
340 (defun fuel-help--find-in ()
341 (save-excursion
342 (or (fuel-syntax--find-in)
343 (and (goto-char (point-min))
344 (re-search-forward "Vocabulary: \\(.+\\)$" nil t)
345 (match-string-no-properties 1)))))
348 ;;; Help mode definition:
350 (defun fuel-help-mode ()
351 "Major mode for browsing Factor documentation.
352 \\{fuel-help-mode-map}"
353 (interactive)
354 (kill-all-local-variables)
355 (buffer-disable-undo)
356 (use-local-map fuel-help-mode-map)
357 (set-syntax-table fuel-syntax--syntax-table)
358 (setq mode-name "FUEL Help")
359 (setq major-mode 'fuel-help-mode)
360 (setq fuel-syntax--current-vocab-function 'fuel-help--find-in)
361 (setq fuel-markup--follow-link-function 'fuel-help--follow-link)
362 (setq buffer-read-only t))
365 (provide 'fuel-help)
366 ;;; fuel-help.el ends here