/misc/fuel/fuel-help.el

http://github.com/abeaumont/factor · Emacs Lisp · 372 lines · 292 code · 60 blank · 20 comment · 7 complexity · b7cee3e971b45fa9cde9ab5f7faf7c88 MD5 · raw file

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