misc/fuel/fuel-help.el

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