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