1 ;;; fuel-connection.el -- asynchronous comms with the fuel listener
3 ;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
4 ;; See http://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
7 ;; Keywords: languages, fuel, factor
8 ;; Start date: Thu Dec 11, 2008 03:10
12 ;; Handling communications via a comint buffer running a factor
24 ;;; Default connection:
26 (make-variable-buffer-local
27 (defvar fuel-con--connection nil))
29 (defun fuel-con--get-connection (buffer/proc)
30 (if (processp buffer/proc)
31 (fuel-con--get-connection (process-buffer buffer/proc))
32 (with-current-buffer buffer/proc
33 (or fuel-con--connection
34 (setq fuel-con--connection
35 (fuel-con--setup-connection buffer/proc))))))
38 ;;; Request and connection datatypes:
40 (defun fuel-con--connection-queue-request (c r)
41 (let ((reqs (assoc :requests c)))
42 (setcdr reqs (append (cdr reqs) (list r)))))
44 (defun fuel-con--make-request (str cont &optional sender-buffer)
45 (list :fuel-connection-request
48 (cons :continuation cont)
49 (cons :buffer (or sender-buffer (current-buffer)))
52 (defsubst fuel-con--request-p (req)
53 (and (listp req) (eq (car req) :fuel-connection-request)))
55 (defsubst fuel-con--request-id (req)
56 (cdr (assoc :id req)))
58 (defsubst fuel-con--request-string (req)
59 (cdr (assoc :string req)))
61 (defsubst fuel-con--request-continuation (req)
62 (cdr (assoc :continuation req)))
64 (defsubst fuel-con--request-buffer (req)
65 (cdr (assoc :buffer req)))
67 (defun fuel-con--request-output (req &optional suffix)
68 (let ((cell (assoc :output req)))
69 (when suffix (setcdr cell (concat (cdr cell) suffix)))
72 (defsubst fuel-con--request-deactivate (req)
73 (setcdr (assoc :continuation req) nil))
75 (defsubst fuel-con--request-deactivated-p (req)
76 (null (cdr (assoc :continuation req))))
78 (defsubst fuel-con--make-connection (buffer)
79 (list :fuel-connection
80 (cons :requests (list))
82 (cons :completed (make-hash-table :weakness 'value))
86 (defsubst fuel-con--connection-p (c)
87 (and (listp c) (eq (car c) :fuel-connection)))
89 (defsubst fuel-con--connection-requests (c)
90 (cdr (assoc :requests c)))
92 (defsubst fuel-con--connection-current-request (c)
93 (cdr (assoc :current c)))
95 (defun fuel-con--connection-clean-current-request (c)
96 (let* ((cell (assoc :current c))
99 (puthash (fuel-con--request-id req) req (cdr (assoc :completed c)))
102 (defsubst fuel-con--connection-completed-p (c id)
103 (gethash id (cdr (assoc :completed c))))
105 (defsubst fuel-con--connection-buffer (c)
106 (cdr (assoc :buffer c)))
108 (defun fuel-con--connection-pop-request (c)
109 (let ((reqs (assoc :requests c))
110 (current (assoc :current c)))
111 (setcdr current (prog1 (cadr reqs) (setcdr reqs (cddr reqs))))
112 (if (and (cdr current)
113 (fuel-con--request-deactivated-p (cdr current)))
114 (fuel-con--connection-pop-request c)
117 (defun fuel-con--connection-start-timer (c)
118 (let ((cell (assoc :timer c)))
119 (when (cdr cell) (cancel-timer (cdr cell)))
120 (setcdr cell (run-at-time t 0.5 'fuel-con--process-next c))))
122 (defun fuel-con--connection-cancel-timer (c)
123 (let ((cell (assoc :timer c)))
124 (when (cdr cell) (cancel-timer (cdr cell)))))
127 ;;; Connection setup:
129 (defun fuel-con--cleanup-connection (c)
130 (fuel-con--connection-cancel-timer c))
132 (defun fuel-con--setup-connection (buffer)
134 (fuel-con--cleanup-connection fuel-con--connection)
135 (let ((conn (fuel-con--make-connection buffer)))
136 (fuel-con--setup-comint)
138 (setq fuel-con--connection conn)
139 (fuel-con--connection-start-timer conn))))
141 (defconst fuel-con--prompt-regex "( .+ ) ")
142 (defconst fuel-con--eot-marker "EOT:")
143 (defconst fuel-con--init-stanza (format "USE: fuel %S write" fuel-con--eot-marker))
145 (defconst fuel-con--comint-finished-regex
146 (format "%s%s" fuel-con--eot-marker fuel-con--prompt-regex))
148 (defun fuel-con--setup-comint ()
149 (comint-redirect-cleanup)
150 (add-hook 'comint-redirect-filter-functions
151 'fuel-con--comint-redirect-filter t t)
152 (add-hook 'comint-redirect-hook
153 'fuel-con--comint-redirect-hook nil t))
155 (defadvice comint-redirect-setup (after fuel-con--advice activate)
156 (setq comint-redirect-finished-regexp fuel-con--comint-finished-regex))
159 ;;; Requests handling:
161 (defun fuel-con--process-next (con)
162 (when (not (fuel-con--connection-current-request con))
163 (let* ((buffer (fuel-con--connection-buffer con))
164 (req (fuel-con--connection-pop-request con))
165 (str (and req (fuel-con--request-string req))))
166 (if (not (buffer-live-p buffer))
167 (fuel-con--connection-cancel-timer con)
168 (when (and buffer req str)
170 (fuel-log--info "<%s>: %s" (fuel-con--request-id req) str)
171 (comint-redirect-send-command (format "%s" str)
172 (fuel-log--buffer) nil t))))))
174 (defun fuel-con--process-completed-request (req)
175 (let ((str (fuel-con--request-output req))
176 (cont (fuel-con--request-continuation req))
177 (id (fuel-con--request-id req))
178 (rstr (fuel-con--request-string req))
179 (buffer (fuel-con--request-buffer req)))
181 (fuel-log--warn "<%s> Droping result for request %S (%s)"
184 (with-current-buffer (or buffer (current-buffer))
186 (fuel-log--info "<%s>: processed\n\t%s" id str))
187 (error (fuel-log--error "<%s>: continuation failed %S \n\t%s"
190 (defvar fuel-con--debug-comint-p nil)
192 (defun fuel-con--comint-redirect-filter (str)
193 (if (not fuel-con--connection)
194 (fuel-log--error "No connection in buffer (%s)" str)
195 (let ((req (fuel-con--connection-current-request fuel-con--connection)))
196 (if (not req) (fuel-log--error "No current request (%s)" str)
197 (fuel-con--request-output req str)
198 (fuel-log--info "<%s>: in progress" (fuel-con--request-id req)))))
199 (if fuel-con--debug-comint-p (fuel--shorten-str str 256) ""))
201 (defun fuel-con--comint-redirect-hook ()
202 (if (not fuel-con--connection)
203 (fuel-log--error "No connection in buffer")
204 (let ((req (fuel-con--connection-current-request fuel-con--connection)))
205 (if (not req) (fuel-log--error "No current request")
206 (fuel-con--process-completed-request req)
207 (fuel-con--connection-clean-current-request fuel-con--connection)))))
210 ;;; Message sending interface:
212 (defun fuel-con--send-string (buffer/proc str cont &optional sender-buffer)
214 (let ((con (fuel-con--get-connection buffer/proc)))
216 (error "FUEL: couldn't find connection"))
217 (let ((req (fuel-con--make-request str cont sender-buffer)))
218 (fuel-con--connection-queue-request con req)
219 (fuel-con--process-next con)
222 (defvar fuel-connection-timeout 30000
223 "Time limit, in msecs, blocking on synchronous evaluation requests")
225 (defun fuel-con--send-string/wait (buffer/proc str cont &optional timeout sbuf)
227 (let* ((con (fuel-con--get-connection buffer/proc))
228 (req (fuel-con--send-string buffer/proc str cont sbuf))
229 (id (and req (fuel-con--request-id req)))
230 (time (or timeout fuel-connection-timeout))
232 (waitsecs (/ step 1000.0)))
235 (while (and (> time 0)
236 (not (fuel-con--connection-completed-p con id)))
237 (accept-process-output nil waitsecs)
238 (setq time (- time step)))
239 (error (setq time 1)))
241 (fuel-con--request-deactivate req)
245 (provide 'fuel-connection)
246 ;;; fuel-connection.el ends here