misc/fuel/fuel-help.el

   1 ;;; fuel-help.el -- accessing Factor's help system
   2
   3 ;; Copyright (C) 2008, 2009 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-base)
  26
  27 (require 'button)
  28
  29 \f
  30 ;;; Customization:
  31
  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 \f
  52 ;;; Help browser history:
  53
  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
  58
  59 (defsubst fuel-help--history-current ()
  60   (car fuel-help--history))
  61
  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)
  70
  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))))
  76
  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))))
  82
  83 (defvar fuel-help--history (fuel-help--make-history))
  84
  85 \f
  86 ;;; Page cache:
  87
  88 (defun fuel-help--history-current-content ()
  89   (fuel-help--cache-get (car fuel-help--history)))
  90
  91 (defvar fuel-help--cache (make-hash-table :weakness 'key :test 'equal))
  92
  93 (defsubst fuel-help--cache-get (name)
  94   (gethash name fuel-help--cache))
  95
  96 (defsubst fuel-help--cache-insert (name str)
  97   (puthash name str fuel-help--cache))
  98
  99 (defsubst fuel-help--cache-clear ()
 100   (clrhash fuel-help--cache))
 101
 102 \f
 103 ;;; Fuel help buffer and internals:
 104
 105 (fuel-popup--define fuel-help--buffer
 106   "*fuel help*" 'fuel-help-mode)
 107
 108
 109 (defvar fuel-help--prompt-history nil)
 110
 111 (make-local-variable
 112  (defvar fuel-help--buffer-link nil))
 113
 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
 121                                         def
 122                                         'fuel-help--prompt-history
 123                                         t)
 124       def)))
 125
 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)))))))
 137
 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 ""))))
 148
 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 ""))))
 158
 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 ""))))
 168
 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 ""))))
 178
 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))))
 192
 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 "")))
 211
 212 \f
 213 ;;; Bookmarks:
 214
 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))))
 223
 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)))
 235
 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))))
 243
 244 \f
 245 ;;; Interactive help commands:
 246
 247 (defun fuel-help-short ()
 248   "See help summary of symbol at point."
 249   (interactive)
 250   (fuel-help--word-help t))
 251
 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))
 257
 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))
 262
 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)))
 270
 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)))
 278
 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))))
 285
 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)))))
 291
 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 ""))
 300
 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")))))
 309
 310 \f
 311 ;;;; Help mode map:
 312
 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))
 336
 337 \f
 338 ;;; IN: support
 339
 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)))))
 346
 347 \f
 348 ;;; Help mode definition:
 349
 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))
 363
 364 \f
 365 (provide 'fuel-help)
 366 ;;; fuel-help.el ends here