misc/fuel/fuel-help.el

   1 ;;; fuel-help.el -- accessing Factor's help system
   2
   3 ;; Copyright (C) 2008 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-eval)
  18 (require 'fuel-completion)
  19 (require 'fuel-font-lock)
  20 (require 'fuel-base)
  21
  22 \f
  23 ;;; Customization:
  24
  25 (defgroup fuel-help nil
  26   "Options controlling FUEL's help system"
  27   :group 'fuel)
  28
  29 (defcustom fuel-help-minibuffer-font-lock t
  30   "Whether to use font lock for info messages in the minibuffer."
  31   :group 'fuel-help
  32   :type 'boolean)
  33
  34 (defcustom fuel-help-always-ask t
  35   "When enabled, always ask for confirmation in help prompts."
  36   :type 'boolean
  37   :group 'fuel-help)
  38
  39 (defcustom fuel-help-use-minibuffer t
  40   "When enabled, use the minibuffer for short help messages."
  41   :type 'boolean
  42   :group 'fuel-help)
  43
  44 (defcustom fuel-help-mode-hook nil
  45   "Hook run by `factor-help-mode'."
  46   :type 'hook
  47   :group 'fuel-help)
  48
  49 (defcustom fuel-help-history-cache-size 50
  50   "Maximum number of pages to keep in the help browser cache."
  51   :type 'integer
  52   :group 'fuel-help)
  53
  54 (defface fuel-help-font-lock-headlines '((t (:bold t :weight bold)))
  55   "Face for headlines in help buffers."
  56   :group 'fuel-help
  57   :group 'faces)
  58
  59 \f
  60 ;;; Autodoc mode:
  61
  62 (defvar fuel-help--font-lock-buffer
  63   (let ((buffer (get-buffer-create " *fuel help minibuffer messages*")))
  64     (set-buffer buffer)
  65     (fuel-font-lock--font-lock-setup)
  66     buffer))
  67
  68 (defun fuel-help--font-lock-str (str)
  69   (set-buffer fuel-help--font-lock-buffer)
  70   (erase-buffer)
  71   (insert str)
  72   (let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
  73   (buffer-string))
  74
  75 (defun fuel-help--word-synopsis (&optional word)
  76   (let ((word (or word (fuel-syntax-symbol-at-point)))
  77         (fuel-log--inhibit-p t))
  78     (when word
  79       (let* ((cmd (if (fuel-syntax--in-using)
  80                       `(:fuel* (,word fuel-vocab-summary) t t)
  81                     `(:fuel* (((:quote ,word) synopsis :get)) t)))
  82              (ret (fuel-eval--send/wait cmd 20))
  83              (res (fuel-eval--retort-result ret)))
  84         (when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
  85           (if fuel-help-minibuffer-font-lock
  86               (fuel-help--font-lock-str res)
  87             res))))))
  88
  89 (make-variable-buffer-local
  90  (defvar fuel-autodoc-mode-string " A"
  91    "Modeline indicator for fuel-autodoc-mode"))
  92
  93 (define-minor-mode fuel-autodoc-mode
  94   "Toggle Fuel's Autodoc mode.
  95 With no argument, this command toggles the mode.
  96 Non-null prefix argument turns on the mode.
  97 Null prefix argument turns off the mode.
  98
  99 When Autodoc mode is enabled, a synopsis of the word at point is
 100 displayed in the minibuffer."
 101   :init-value nil
 102   :lighter fuel-autodoc-mode-string
 103   :group 'fuel
 104
 105   (set (make-local-variable 'eldoc-documentation-function)
 106        (when fuel-autodoc-mode 'fuel-help--word-synopsis))
 107   (set (make-local-variable 'eldoc-minor-mode-string) nil)
 108   (eldoc-mode fuel-autodoc-mode)
 109   (message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
 110
 111 \f
 112 ;;; Help browser history:
 113
 114 (defvar fuel-help--history
 115   (list nil                                        ; current
 116         (make-ring fuel-help-history-cache-size)   ; previous
 117         (make-ring fuel-help-history-cache-size))) ; next
 118
 119 (defvar fuel-help--history-idx 0)
 120
 121 (defun fuel-help--history-push (term)
 122   (when (and (car fuel-help--history)
 123              (not (string= (caar fuel-help--history) (car term))))
 124     (ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
 125   (setcar fuel-help--history term))
 126
 127 (defun fuel-help--history-next ()
 128   (when (not (ring-empty-p (nth 2 fuel-help--history)))
 129     (when (car fuel-help--history)
 130       (ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
 131     (setcar fuel-help--history (ring-remove (nth 2 fuel-help--history) 0))))
 132
 133 (defun fuel-help--history-previous ()
 134   (when (not (ring-empty-p (nth 1 fuel-help--history)))
 135     (when (car fuel-help--history)
 136       (ring-insert (nth 2 fuel-help--history) (car fuel-help--history)))
 137     (setcar fuel-help--history (ring-remove (nth 1 fuel-help--history) 0))))
 138
 139 \f
 140 ;;; Fuel help buffer and internals:
 141
 142 (defun fuel-help--help-buffer ()
 143   (with-current-buffer (get-buffer-create "*fuel help*")
 144     (fuel-help-mode)
 145     (current-buffer)))
 146
 147 (defvar fuel-help--prompt-history nil)
 148
 149 (defun fuel-help--show-help (&optional see word)
 150   (let* ((def (or word (fuel-syntax-symbol-at-point)))
 151          (prompt (format "See%s help on%s: " (if see " short" "")
 152                          (if def (format " (%s)" def) "")))
 153          (ask (or (not (memq major-mode '(factor-mode fuel-help-mode)))
 154                   (not def)
 155                   fuel-help-always-ask))
 156          (def (if ask (fuel-completion--read-word prompt
 157                                                   def
 158                                                   'fuel-help--prompt-history
 159                                                   t)
 160                 def))
 161          (cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t)))
 162     (message "Looking up '%s' ..." def)
 163     (fuel-eval--send cmd `(lambda (r) (fuel-help--show-help-cont ,def r)))))
 164
 165 (defun fuel-help--show-help-cont (def ret)
 166   (let ((out (fuel-eval--retort-output ret)))
 167     (if (or (fuel-eval--retort-error ret) (empty-string-p out))
 168         (message "No help for '%s'" def)
 169       (fuel-help--insert-contents def out))))
 170
 171 (defun fuel-help--insert-contents (def str &optional nopush)
 172   (let ((hb (fuel-help--help-buffer))
 173         (inhibit-read-only t)
 174         (font-lock-verbose nil))
 175     (set-buffer hb)
 176     (erase-buffer)
 177     (insert str)
 178     (unless nopush
 179       (goto-char (point-min))
 180       (when (re-search-forward (format "^%s" def) nil t)
 181         (beginning-of-line)
 182         (kill-region (point-min) (point))
 183         (fuel-help--history-push (cons def (buffer-string)))))
 184     (set-buffer-modified-p nil)
 185     (pop-to-buffer hb)
 186     (goto-char (point-min))
 187     (message "%s" def)))
 188
 189 \f
 190 ;;; Help mode font lock:
 191
 192 (defconst fuel-help--headlines
 193   (regexp-opt '("Class description"
 194                 "Definition"
 195                 "Errors"
 196                 "Examples"
 197                 "Generic word contract"
 198                 "Inputs and outputs"
 199                 "Methods"
 200                 "Notes"
 201                 "Parent topics:"
 202                 "See also"
 203                 "Syntax"
 204                 "Variable description"
 205                 "Variable value"
 206                 "Vocabulary"
 207                 "Warning"
 208                 "Word description")
 209               t))
 210
 211 (defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
 212
 213 (defconst fuel-help--font-lock-keywords
 214   `(,@fuel-font-lock--font-lock-keywords
 215     (,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
 216
 217
 218 \f
 219 ;;; Interactive help commands:
 220
 221 (defun fuel-help-short (&optional arg)
 222   "See a help summary of symbol at point.
 223 By default, the information is shown in the minibuffer. When
 224 called with a prefix argument, the information is displayed in a
 225 separate help buffer."
 226   (interactive "P")
 227   (if (if fuel-help-use-minibuffer (not arg) arg)
 228       (fuel-help--word-synopsis)
 229     (fuel-help--show-help t)))
 230
 231 (defun fuel-help ()
 232   "Show extended help about the symbol at point, using a help
 233 buffer."
 234   (interactive)
 235   (fuel-help--show-help))
 236
 237 (defun fuel-help-next ()
 238   "Go to next page in help browser."
 239   (interactive)
 240   (let ((item (fuel-help--history-next))
 241         (fuel-help-always-ask nil))
 242     (unless item
 243       (error "No next page"))
 244     (fuel-help--insert-contents (car item) (cdr item) t)))
 245
 246 (defun fuel-help-previous ()
 247   "Go to next page in help browser."
 248   (interactive)
 249   (let ((item (fuel-help--history-previous))
 250         (fuel-help-always-ask nil))
 251     (unless item
 252       (error "No previous page"))
 253     (fuel-help--insert-contents (car item) (cdr item) t)))
 254
 255 (defun fuel-help-next-headline (&optional count)
 256   (interactive "P")
 257   (end-of-line)
 258   (when (re-search-forward fuel-help--headlines-regexp nil t (or count 1))
 259     (beginning-of-line)))
 260
 261 (defun fuel-help-previous-headline (&optional count)
 262   (interactive "P")
 263   (re-search-backward fuel-help--headlines-regexp nil t count))
 264
 265 \f
 266 ;;;; Help mode map:
 267
 268 (defvar fuel-help-mode-map
 269   (let ((map (make-sparse-keymap)))
 270     (define-key map "\C-m" 'fuel-help)
 271     (define-key map "q" 'bury-buffer)
 272     (define-key map "b" 'fuel-help-previous)
 273     (define-key map "f" 'fuel-help-next)
 274     (define-key map "l" 'fuel-help-previous)
 275     (define-key map "p" 'fuel-help-previous)
 276     (define-key map "n" 'fuel-help-next)
 277     (define-key map (kbd "TAB") 'fuel-help-next-headline)
 278     (define-key map (kbd "S-TAB") 'fuel-help-previous-headline)
 279     (define-key map [(backtab)] 'fuel-help-previous-headline)
 280     (define-key map (kbd "SPC")  'scroll-up)
 281     (define-key map (kbd "S-SPC") 'scroll-down)
 282     (define-key map "\C-cz" 'run-factor)
 283     (define-key map "\C-c\C-z" 'run-factor)
 284     map))
 285
 286 \f
 287 ;;; Help mode definition:
 288
 289 (defun fuel-help-mode ()
 290   "Major mode for browsing Factor documentation.
 291 \\{fuel-help-mode-map}"
 292   (interactive)
 293   (kill-all-local-variables)
 294   (buffer-disable-undo)
 295   (use-local-map fuel-help-mode-map)
 296   (setq mode-name "Factor Help")
 297   (setq major-mode 'fuel-help-mode)
 298
 299   (fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t)
 300
 301   (setq fuel-autodoc-mode-string "")
 302   (fuel-autodoc-mode)
 303
 304   (run-mode-hooks 'fuel-help-mode-hook)
 305   (setq buffer-read-only t))
 306
 307 \f
 308 (provide 'fuel-help)
 309 ;;; fuel-help.el ends here