]> gitweb.factorcode.org Git - factor.git/blob - misc/fuel/fuel-listener.el
Merge branch 'master' of git://factorcode.org/git/factor
[factor.git] / misc / fuel / fuel-listener.el
1 ;;; fuel-listener.el --- starting the fuel listener
2
3 ;; Copyright (C) 2008, 2009  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
8
9 ;;; Commentary:
10
11 ;; Utilities to maintain and switch to a factor listener comint
12 ;; buffer, with an accompanying major fuel-listener-mode.
13
14 ;;; Code:
15
16 (require 'fuel-stack)
17 (require 'fuel-completion)
18 (require 'fuel-xref)
19 (require 'fuel-eval)
20 (require 'fuel-connection)
21 (require 'fuel-syntax)
22 (require 'fuel-base)
23
24 (require 'comint)
25
26 \f
27 ;;; Customization:
28
29 (defgroup fuel-listener nil
30   "Interacting with a Factor listener inside Emacs."
31   :group 'fuel)
32
33 (defcustom fuel-listener-factor-binary
34   (expand-file-name (cond ((eq system-type 'windows-nt)
35                            "factor.exe")
36                           ((eq system-type 'darwin)
37                            "Factor.app/Contents/MacOS/factor")
38                           (t "factor"))
39                     fuel-factor-root-dir)
40   "Full path to the factor executable to use when starting a listener."
41   :type '(file :must-match t)
42   :group 'fuel-listener)
43
44 (defcustom fuel-listener-factor-image
45   (expand-file-name "factor.image" fuel-factor-root-dir)
46   "Full path to the factor image to use when starting a listener."
47   :type '(file :must-match t)
48   :group 'fuel-listener)
49
50 (defcustom fuel-listener-use-other-window t
51   "Use a window other than the current buffer's when switching to
52 the factor-listener buffer."
53   :type 'boolean
54   :group 'fuel-listener)
55
56 (defcustom fuel-listener-window-allow-split t
57   "Allow window splitting when switching to the fuel listener
58 buffer."
59   :type 'boolean
60   :group 'fuel-listener)
61
62 \f
63 ;;; Fuel listener buffer/process:
64
65 (defvar fuel-listener--buffer nil
66   "The buffer in which the Factor listener is running.")
67
68 (defun fuel-listener--buffer ()
69   (if (buffer-live-p fuel-listener--buffer)
70       fuel-listener--buffer
71     (with-current-buffer (get-buffer-create "*fuel listener*")
72       (fuel-listener-mode)
73       (setq fuel-listener--buffer (current-buffer)))))
74
75 (defun fuel-listener--start-process ()
76   (let ((factor (expand-file-name fuel-listener-factor-binary))
77         (image (expand-file-name fuel-listener-factor-image))
78         (comint-redirect-perform-sanity-check nil))
79     (unless (file-executable-p factor)
80       (error "Could not run factor: %s is not executable" factor))
81     (unless (file-readable-p image)
82       (error "Could not run factor: image file %s not readable" image))
83     (message "Starting FUEL listener (this may take a while) ...")
84     (pop-to-buffer (fuel-listener--buffer))
85     (make-comint-in-buffer "fuel listener" (current-buffer) factor nil
86                            "-run=listener" (format "-i=%s" image))
87     (fuel-listener--wait-for-prompt 10000)
88     (fuel-con--setup-connection (current-buffer))))
89
90 (defun fuel-listener--process (&optional start)
91   (or (and (buffer-live-p (fuel-listener--buffer))
92            (get-buffer-process (fuel-listener--buffer)))
93       (if (not start)
94           (error "No running factor listener (try M-x run-factor)")
95         (fuel-listener--start-process)
96         (fuel-listener--process))))
97
98 (setq fuel-eval--default-proc-function 'fuel-listener--process)
99
100 (defun fuel-listener--wait-for-prompt (timeout)
101   (let ((p (point)) (seen))
102     (while (and (not seen) (> timeout 0))
103       (sleep-for 0.1)
104       (setq timeout (- timeout 100))
105       (goto-char p)
106       (setq seen (re-search-forward comint-prompt-regexp nil t)))
107     (goto-char (point-max))
108     (unless seen (error "No prompt found!"))))
109
110
111 \f
112 ;;; Interface: starting and interacting with fuel listener:
113
114 (defalias 'switch-to-factor 'run-factor)
115 (defalias 'switch-to-fuel-listener 'run-factor)
116 ;;;###autoload
117 (defun run-factor (&optional arg)
118   "Show the fuel-listener buffer, starting the process if needed."
119   (interactive)
120   (let ((buf (process-buffer (fuel-listener--process t)))
121         (pop-up-windows fuel-listener-window-allow-split))
122     (if fuel-listener-use-other-window
123         (pop-to-buffer buf)
124       (switch-to-buffer buf))))
125
126 (defun fuel-listener-nuke ()
127   "Try this command if the listener becomes unresponsive."
128   (interactive)
129   (goto-char (point-max))
130   (comint-kill-region comint-last-input-start (point))
131   (comint-redirect-cleanup)
132   (fuel-con--setup-connection fuel-listener--buffer))
133
134 (defun fuel-refresh-all ()
135   "Switch to the listener buffer and invokes Factor's refresh-all.
136 With prefix, you're teletransported to the listener's buffer."
137   (interactive)
138   (let ((buf (process-buffer (fuel-listener--process))))
139     (pop-to-buffer buf)
140     (comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush")
141     (comint-send-string nil " refresh-all \"Done!\" write nl flush\n")))
142
143 \f
144 ;;; Completion support
145
146 (defsubst fuel-listener--current-vocab () nil)
147 (defsubst fuel-listener--usings () nil)
148
149 (defun fuel-listener--setup-completion ()
150   (setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
151   (setq fuel-syntax--usings-function 'fuel-listener--usings))
152
153 \f
154 ;;; Stack mode support
155
156 (defun fuel-listener--stack-region ()
157   (fuel--region-to-string (if (zerop (fuel-syntax--brackets-depth))
158                               (comint-line-beginning-position)
159                             (1+ (fuel-syntax--brackets-start)))))
160
161 (defun fuel-listener--setup-stack-mode ()
162   (setq fuel-stack--region-function 'fuel-listener--stack-region))
163
164 \f
165 ;;; Fuel listener mode:
166
167 (defun fuel-listener--bol ()
168   (interactive)
169   (when (= (point) (comint-bol)) (beginning-of-line)))
170
171 ;;;###autoload
172 (define-derived-mode fuel-listener-mode comint-mode "Fuel Listener"
173   "Major mode for interacting with an inferior Factor listener process.
174 \\{fuel-listener-mode-map}"
175   (set (make-local-variable 'comint-prompt-regexp) fuel-con--prompt-regex)
176   (set (make-local-variable 'comint-use-prompt-regexp) t)
177   (set (make-local-variable 'comint-prompt-read-only) t)
178   (fuel-listener--setup-completion)
179   (fuel-listener--setup-stack-mode))
180
181 (define-key fuel-listener-mode-map "\C-cz" 'run-factor)
182 (define-key fuel-listener-mode-map "\C-c\C-z" 'run-factor)
183 (define-key fuel-listener-mode-map "\C-a" 'fuel-listener--bol)
184 (define-key fuel-listener-mode-map "\C-ca" 'fuel-autodoc-mode)
185 (define-key fuel-listener-mode-map "\C-ch" 'fuel-help)
186 (define-key fuel-listener-mode-map "\C-cr" 'fuel-refresh-all)
187 (define-key fuel-listener-mode-map "\C-cs" 'fuel-stack-mode)
188 (define-key fuel-listener-mode-map "\C-cp" 'fuel-apropos)
189 (define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point)
190 (define-key fuel-listener-mode-map "\C-cv" 'fuel-edit-vocabulary)
191 (define-key fuel-listener-mode-map "\C-c\C-v" 'fuel-edit-vocabulary)
192 (define-key fuel-listener-mode-map "\C-ck" 'fuel-run-file)
193 (define-key fuel-listener-mode-map (kbd "TAB") 'fuel-completion--complete-symbol)
194
195 \f
196 (provide 'fuel-listener)
197 ;;; fuel-listener.el ends here