1 ;;; fuel-listener.el --- starting the fuel listener -*- lexical-binding: t -*-
3 ;; Copyright (C) 2008, 2009, 2010 Jose Antonio Ortega Ruiz
4 ;; See http://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
11 ;; Utilities to maintain and switch to a factor listener comint
12 ;; buffer, with an accompanying major fuel-listener-mode.
17 (require 'fuel-completion)
19 (require 'fuel-connection)
28 (defgroup fuel-listener nil
29 "Interacting with a Factor listener inside Emacs."
32 (defcustom fuel-factor-root-dir nil
33 "Full path to the factor root directory when starting a listener."
35 :group 'fuel-listener)
37 ;;; Is factor.com still valid on Windows...?
38 (defcustom fuel-listener-factor-binary nil
39 "Full path to the factor executable to use when starting a listener."
40 :type '(file :must-match t)
41 :group 'fuel-listener)
43 (defcustom fuel-listener-factor-image nil
44 "Full path to the factor image to use when starting a listener."
45 :type '(file :must-match t)
46 :group 'fuel-listener)
48 (defcustom fuel-listener-use-other-window t
49 "Use a window other than the current buffer's when switching to
50 the factor-listener buffer."
52 :group 'fuel-listener)
54 (defcustom fuel-listener-history-filename
55 (expand-file-name "~/.fuel_history.eld")
56 "File where listener input history is saved, so that it persists between
59 :group 'fuel-listener)
61 (defcustom fuel-listener-history-size comint-input-ring-size
62 "Maximum size of the saved listener input history."
64 :group 'fuel-listener)
66 (defcustom fuel-listener-prompt-read-only-p t
67 "Whether listener's prompt should be read-only."
69 :group 'fuel-listener)
74 (defun fuel-listener-factor-binary ()
75 "Full path to the factor executable to use when starting a listener."
76 (or fuel-listener-factor-binary
77 (expand-file-name (cond ((eq system-type 'windows-nt)
79 ((eq system-type 'darwin)
80 "Factor.app/Contents/MacOS/factor")
82 fuel-factor-root-dir)))
84 (defun fuel-listener-factor-image ()
85 "Full path to the factor image to use when starting a listener."
86 (or fuel-listener-factor-image
87 (expand-file-name "factor.image" fuel-factor-root-dir)))
92 (defun fuel-listener--sentinel (proc event)
93 (when (string= event "finished\n")
94 (with-current-buffer (process-buffer proc)
95 (let ((comint-input-ring-file-name fuel-listener-history-filename))
96 (comint-write-input-ring)
97 (when (buffer-name (current-buffer))
98 (insert "\nBye bye. It's been nice listening to you!\n")
99 (insert "Press C-c C-z to bring me back.\n" ))))))
101 (defun fuel-listener--history-setup ()
102 (setq-local comint-input-ring-file-name fuel-listener-history-filename)
103 (setq-local comint-input-ring-size fuel-listener-history-size)
104 (add-hook 'kill-buffer-hook 'comint-write-input-ring nil t)
105 (comint-read-input-ring t)
106 (set-process-sentinel (get-buffer-process (current-buffer))
107 'fuel-listener--sentinel))
110 ;;; Fuel listener buffer/process:
112 (defvar fuel-listener--buffer nil
113 "The buffer in which the Factor listener is running.")
115 (defun fuel-listener--buffer ()
116 (if (buffer-live-p fuel-listener--buffer)
117 fuel-listener--buffer
118 (with-current-buffer (get-buffer-create "*fuel listener*")
120 (setq fuel-listener--buffer (current-buffer)))))
122 (defun fuel-listener--start-process ()
123 (let ((factor (expand-file-name (fuel-listener-factor-binary)))
124 (image (expand-file-name (fuel-listener-factor-image)))
125 (comint-redirect-perform-sanity-check nil))
126 (unless (file-executable-p factor)
127 (error "Could not run factor: %s is not executable" factor))
128 (unless (file-readable-p image)
129 (error "Could not run factor: image file %s not readable" image))
130 (message "Starting FUEL listener (this may take a while) ...")
131 (pop-to-buffer (fuel-listener--buffer))
132 (make-comint-in-buffer "fuel listener" (current-buffer) factor nil
133 "-run=fuel.listener" (format "-i=%s" image))
134 (fuel-listener--wait-for-prompt 60000)
135 (fuel-listener--history-setup)
136 (fuel-con--setup-connection (current-buffer))))
138 ;;; TODO Add the ability to debug to non-localhost
139 (defun fuel-listener--connect-process (port)
140 (message "Connecting to remote listener ...")
141 (pop-to-buffer (fuel-listener--buffer))
142 (let ((process (get-buffer-process (current-buffer))))
143 (when (or (not process)
144 (y-or-n-p "Kill current listener? "))
145 (make-comint-in-buffer "fuel listener" (current-buffer)
146 (cons "localhost" port))
147 (fuel-listener--wait-for-prompt 10000)
148 (fuel-con--setup-connection (current-buffer)))))
150 (defun fuel-listener--process (&optional start)
151 (or (and (buffer-live-p (fuel-listener--buffer))
152 (get-buffer-process (fuel-listener--buffer)))
154 (error "No running factor listener (try M-x run-factor)")
155 (fuel-listener--start-process)
156 (fuel-listener--process))))
158 (setq fuel-eval--default-proc-function 'fuel-listener--process)
160 (defun fuel-listener--wait-for-prompt (timeout)
161 (let ((p (point)) (seen))
162 (while (and (not seen) (> timeout 0))
164 (setq timeout (- timeout 100))
166 (setq seen (re-search-forward comint-prompt-regexp nil t)))
167 (goto-char (point-max))
168 (unless seen (error "No prompt found!"))))
171 ;;; Interface: starting and interacting with fuel listener:
174 (defun run-factor (&optional arg)
175 "Show the fuel-listener buffer, starting the process if needed."
177 (let ((buf (process-buffer (fuel-listener--process t))))
178 (if fuel-listener-use-other-window
180 (switch-to-buffer buf))
181 (add-hook 'factor-mode-hook 'fuel-mode)))
184 (defun connect-to-factor (&optional arg)
185 "Connects to a remote listener running in the same host.
186 Without prefix argument, the default port, 9000, is used.
187 Otherwise, you'll be prompted for it. To make this work, in the
188 remote listener you need to issue the words
189 'fuel-start-remote-listener*' or 'port
190 fuel-start-remote-listener', from the fuel vocabulary."
192 (let ((port (if (not arg) 9000 (read-number "Port: "))))
193 (fuel-listener--connect-process port)
194 (add-hook 'factor-mode-hook 'fuel-mode)))
196 (defun fuel-listener-nuke ()
197 "Try this command if the listener becomes unresponsive."
199 (goto-char (point-max))
200 (comint-kill-region comint-last-input-start (point))
201 (comint-redirect-cleanup)
202 (fuel-con--setup-connection fuel-listener--buffer))
204 (defun fuel-refresh-all (&optional arg)
205 "Switch to the listener buffer and invokes Factor's refresh-all.
206 With prefix, you're teletransported to the listener's buffer."
208 (let ((buf (process-buffer (fuel-listener--process))))
209 (with-current-buffer buf
210 (comint-send-string nil "\"Refreshing loaded vocabs...\" write nl flush")
211 (comint-send-string nil " refresh-all \"Done!\" write nl flush\n"))
212 (when arg (pop-to-buffer buf))))
214 (defun fuel-refresh-and-test-all (&optional arg)
215 "Switch to the listener buffer and invokes Factor's refresh-and-test-all.
216 With prefix, you're teletransporteded to the listener's buffer."
218 (let ((buf (process-buffer (fuel-listener--process))))
219 (with-current-buffer buf
220 (comint-send-string nil "\"Refreshing loaded vocabs and running tests...\" write nl flush")
221 (comint-send-string nil " refresh-and-test-all \"Done!\" write nl flush\n"))
222 (when arg (pop-to-buffer buf))))
224 (defun fuel-test-vocab (&optional arg)
225 "Run the unit tests for the current vocabulary. With prefix argument, ask for
226 the vocabulary name."
228 (let* ((vocab (or (and (not arg) (factor-current-vocab))
229 (fuel-completion--read-vocab nil))))
230 (comint-send-string (fuel-listener--process)
231 (concat "\"" vocab "\" reload nl flush\n"
232 "\"" vocab "\" test nl flush\n"))))
235 ;;; Completion support:
237 (defsubst fuel-listener--current-vocab () nil)
238 (defsubst fuel-listener--usings () nil)
240 (defun fuel-listener--setup-completion ()
241 (setq factor-current-vocab-function 'fuel-listener--current-vocab)
242 (setq factor-usings-function 'fuel-listener--usings))
245 ;;; Stack mode support:
247 (defun fuel-listener--stack-region ()
248 (fuel-region-to-string
249 (if (zerop (factor-brackets-depth))
250 (comint-line-beginning-position)
251 (1+ (factor-brackets-start)))))
253 (defun fuel-listener--setup-stack-mode ()
254 (setq fuel-stack--region-function 'fuel-listener--stack-region))
257 ;;; Fuel listener mode:
259 (defun fuel-listener--bol ()
261 (when (= (point) (comint-bol)) (beginning-of-line)))
264 (define-derived-mode fuel-listener-mode comint-mode "FUEL Listener"
265 "Major mode for interacting with an inferior Factor listener process.
266 \\{fuel-listener-mode-map}"
267 (setq-local comint-prompt-regexp fuel-con--prompt-regex)
268 (setq-local comint-use-prompt-regexp nil)
269 (setq-local comint-prompt-read-only fuel-listener-prompt-read-only-p)
270 (fuel-listener--setup-completion)
271 (fuel-listener--setup-stack-mode)
272 (set-syntax-table (fuel-syntax-table)))
274 (define-key fuel-listener-mode-map "\C-a" 'fuel-listener--bol)
276 (fuel-menu--defmenu listener fuel-listener-mode-map
277 ("Complete symbol" ((kbd "TAB") (kbd "M-TAB"))
278 fuel-completion--complete-symbol :enable (symbol-at-point))
280 ("Edit word or vocab at point" "\M-." fuel-edit-word-at-point)
281 ("Edit vocabulary" "\C-c\C-v" fuel-edit-vocabulary)
283 ("Help on word" "\C-c\C-w" fuel-help)
284 ("Apropos..." "\C-c\C-p" fuel-apropos)
285 (mode "Show stack mode" "\C-c\C-s" fuel-stack-mode)
288 ("Word callers" "\C-c\M-<"
289 fuel-show-callers :enable (symbol-at-point))
290 ("Word callees" "\C-c\M->"
291 fuel-show-callees :enable (symbol-at-point))
292 (mode "Autodoc mode" "\C-c\C-a" fuel-autodoc-mode))
293 ("Run file" "\C-c\C-k" fuel-run-file)
294 ("Refresh vocabs" "\C-c\C-r" fuel-refresh-all)
295 ("Refresh vocabs and test" "\C-c\M-r" fuel-refresh-and-test-all))
297 (define-key fuel-listener-mode-map [menu-bar completion] 'undefined)
300 (provide 'fuel-listener)
302 ;;; fuel-listener.el ends here