/misc/fuel/fuel-help.el

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