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