misc/fuel/fuel-mode.el

   1 ;;; fuel-mode.el -- Minor mode enabling FUEL niceties
   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: Sat Dec 06, 2008 00:52
   9
  10 ;;; Comentary:
  11
  12 ;; Enhancements to vanilla factor-mode (notably, listener interaction)
  13 ;; enabled by means of a minor mode.
  14
  15 ;;; Code:
  16
  17 (require 'factor-mode)
  18 (require 'fuel-base)
  19 (require 'fuel-syntax)
  20 (require 'fuel-font-lock)
  21 (require 'fuel-debug)
  22 (require 'fuel-help)
  23 (require 'fuel-eval)
  24 (require 'fuel-completion)
  25 (require 'fuel-listener)
  26
  27 \f
  28 ;;; Customization:
  29
  30 (defgroup fuel-mode nil
  31   "Mode enabling FUEL's ultimate abilities."
  32   :group 'fuel)
  33
  34 (defcustom fuel-mode-autodoc-p t
  35   "Whether `fuel-autodoc-mode' gets enable by default in fuel buffers."
  36   :group 'fuel-mode
  37   :type 'boolean)
  38
  39 \f
  40 ;;; User commands
  41
  42 (defun fuel-run-file (&optional arg)
  43   "Sends the current file to Factor for compilation.
  44 With prefix argument, ask for the file to run."
  45   (interactive "P")
  46   (let* ((file (or (and arg (read-file-name "File: " nil (buffer-file-name) t))
  47                    (buffer-file-name)))
  48          (file (expand-file-name file))
  49          (buffer (find-file-noselect file)))
  50     (when buffer
  51       (with-current-buffer buffer
  52         (message "Compiling %s ..." file)
  53         (fuel-eval--send `(:fuel (,file fuel-run-file))
  54                          `(lambda (r) (fuel--run-file-cont r ,file)))))))
  55
  56 (defun fuel--run-file-cont (ret file)
  57   (if (fuel-debug--display-retort ret
  58                                   (format "%s successfully compiled" file)
  59                                   nil
  60                                   file)
  61       (message "Compiling %s ... OK!" file)
  62     (message "")))
  63
  64 (defun fuel-eval-region (begin end &optional arg)
  65   "Sends region to Fuel's listener for evaluation.
  66 Unless called with a prefix, switchs to the compilation results
  67 buffer in case of errors."
  68   (interactive "r\nP")
  69   (let* ((lines (split-string (buffer-substring-no-properties begin end)
  70                               "[\f\n\r\v]+" t))
  71          (cmd `(:fuel (,(mapcar (lambda (l) `(:factor ,l)) lines))))
  72          (cv (fuel-syntax--current-vocab)))
  73     (fuel-debug--display-retort
  74      (fuel-eval--send/wait cmd 10000)
  75      (format "%s%s"
  76              (if cv (format "IN: %s " cv) "")
  77              (fuel--shorten-region begin end 70))
  78      arg
  79      (buffer-file-name))))
  80
  81 (defun fuel-eval-extended-region (begin end &optional arg)
  82   "Sends region extended outwards to nearest definitions,
  83 to Fuel's listener for evaluation.
  84 Unless called with a prefix, switchs to the compilation results
  85 buffer in case of errors."
  86   (interactive "r\nP")
  87   (fuel-eval-region (save-excursion (goto-char begin) (mark-defun) (point))
  88                     (save-excursion (goto-char end) (mark-defun) (mark))
  89                     arg))
  90
  91 (defun fuel-eval-definition (&optional arg)
  92   "Sends definition around point to Fuel's listener for evaluation.
  93 Unless called with a prefix, switchs to the compilation results
  94 buffer in case of errors."
  95   (interactive "P")
  96   (save-excursion
  97     (mark-defun)
  98     (let* ((begin (point))
  99            (end (mark)))
 100       (unless (< begin end) (error "No evaluable definition around point"))
 101       (fuel-eval-region begin end arg))))
 102
 103 (defun fuel--try-edit (ret)
 104   (let* ((err (fuel-eval--retort-error ret))
 105          (loc (fuel-eval--retort-result ret)))
 106     (when (or err (not loc) (not (listp loc)) (not (stringp (car loc))))
 107       (error "Couldn't find edit location for '%s'" word))
 108     (unless (file-readable-p (car loc))
 109       (error "Couldn't open '%s' for read" (car loc)))
 110     (find-file-other-window (car loc))
 111     (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
 112
 113 (defun fuel-edit-word-at-point (&optional arg)
 114   "Opens a new window visiting the definition of the word at point.
 115 With prefix, asks for the word to edit."
 116   (interactive "P")
 117   (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
 118                   (fuel-completion--read-word "Edit word: ")))
 119          (cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
 120     (condition-case nil
 121         (fuel--try-edit (fuel-eval--send/wait cmd))
 122       (error (fuel-edit-vocabulary nil word)))))
 123
 124 (defvar fuel-mode--word-history nil)
 125
 126 (defun fuel-edit-word (&optional arg)
 127   "Asks for a word to edit, with completion.
 128 With prefix, only words visible in the current vocabulary are
 129 offered."
 130   (interactive "P")
 131   (let* ((word (fuel-completion--read-word "Edit word: "
 132                                            nil
 133                                            fuel-mode--word-history
 134                                            arg))
 135          (cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
 136     (fuel--try-edit (fuel-eval--send/wait cmd))))
 137
 138 (defvar fuel--vocabs-prompt-history nil)
 139
 140 (defun fuel--read-vocabulary-name (refresh)
 141   (let* ((vocabs (fuel-completion--vocabs refresh))
 142          (prompt "Vocabulary name: "))
 143     (if vocabs
 144         (completing-read prompt vocabs nil t nil fuel--vocabs-prompt-history)
 145       (read-string prompt nil fuel--vocabs-prompt-history))))
 146
 147 (defun fuel-edit-vocabulary (&optional refresh vocab)
 148   "Visits vocabulary file in Emacs.
 149 When called interactively, asks for vocabulary with completion.
 150 With prefix argument, refreshes cached vocabulary list."
 151   (interactive "P")
 152   (let* ((vocab (or vocab (fuel--read-vocabulary-name refresh)))
 153          (cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
 154     (fuel--try-edit (fuel-eval--send/wait cmd))))
 155
 156 \f
 157 ;;; Minor mode definition:
 158
 159 (make-variable-buffer-local
 160  (defvar fuel-mode-string " F"
 161    "Modeline indicator for fuel-mode"))
 162
 163 (defvar fuel-mode-map (make-sparse-keymap)
 164   "Key map for fuel-mode")
 165
 166 (define-minor-mode fuel-mode
 167   "Toggle Fuel's mode.
 168 With no argument, this command toggles the mode.
 169 Non-null prefix argument turns on the mode.
 170 Null prefix argument turns off the mode.
 171
 172 When Fuel mode is enabled, a host of nice utilities for
 173 interacting with a factor listener is at your disposal.
 174 \\{fuel-mode-map}"
 175   :init-value nil
 176   :lighter fuel-mode-string
 177   :group 'fuel
 178   :keymap fuel-mode-map
 179
 180   (setq fuel-autodoc-mode-string "/A")
 181   (when fuel-mode-autodoc-p (fuel-autodoc-mode fuel-mode)))
 182
 183 \f
 184 ;;; Keys:
 185
 186 (defun fuel-mode--key-1 (k c)
 187   (define-key fuel-mode-map (vector '(control ?c) k) c)
 188   (define-key fuel-mode-map (vector '(control ?c) `(control ,k))  c))
 189
 190 (defun fuel-mode--key (p k c)
 191   (define-key fuel-mode-map (vector '(control ?c) `(control ,p) k) c)
 192   (define-key fuel-mode-map (vector '(control ?c) `(control ,p) `(control ,k)) c))
 193
 194 (fuel-mode--key-1 ?z 'run-factor)
 195 (fuel-mode--key-1 ?k 'fuel-run-file)
 196 (fuel-mode--key-1 ?r 'fuel-eval-region)
 197
 198 (define-key fuel-mode-map "\C-\M-x" 'fuel-eval-definition)
 199 (define-key fuel-mode-map "\C-\M-r" 'fuel-eval-extended-region)
 200 (define-key fuel-mode-map "\M-." 'fuel-edit-word-at-point)
 201 (define-key fuel-mode-map (kbd "M-TAB") 'fuel-completion--complete-symbol)
 202
 203 (fuel-mode--key ?e ?e 'fuel-eval-extended-region)
 204 (fuel-mode--key ?e ?r 'fuel-eval-region)
 205 (fuel-mode--key ?e ?v 'fuel-edit-vocabulary)
 206 (fuel-mode--key ?e ?w 'fuel-edit-word)
 207 (fuel-mode--key ?e ?x 'fuel-eval-definition)
 208
 209 (fuel-mode--key ?d ?a 'fuel-autodoc-mode)
 210 (fuel-mode--key ?d ?d 'fuel-help)
 211 (fuel-mode--key ?d ?s 'fuel-help-short)
 212
 213 \f
 214 (provide 'fuel-mode)
 215 ;;; fuel-mode.el ends here