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