|
0
|
1 ;;; -*-Emacs-Lisp-*-
|
|
|
2 ;;;%Header
|
|
|
3 ;;; Bridge process filter, V1.0
|
|
|
4 ;;; Copyright (C) 1991 Chris McConnell, ccm@cs.cmu.edu
|
|
|
5 ;;;
|
|
4
|
6 ;;; Send mail to ilisp@naggum.no if you have problems.
|
|
0
|
7 ;;;
|
|
4
|
8 ;;; Send mail to ilisp-request@naggum.no if you want to be on the
|
|
0
|
9 ;;; ilisp mailing list.
|
|
|
10
|
|
|
11 ;;; This file is part of GNU Emacs.
|
|
|
12
|
|
|
13 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
14 ;;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
|
15 ;;; accepts responsibility to anyone for the consequences of using it
|
|
|
16 ;;; or for whether it serves any particular purpose or works at all,
|
|
|
17 ;;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
|
18 ;;; License for full details.
|
|
|
19
|
|
|
20 ;;; Everyone is granted permission to copy, modify and redistribute
|
|
|
21 ;;; GNU Emacs, but only under the conditions described in the
|
|
|
22 ;;; GNU Emacs General Public License. A copy of this license is
|
|
|
23 ;;; supposed to have been given to you along with GNU Emacs so you
|
|
|
24 ;;; can know your rights and responsibilities. It should be in a
|
|
|
25 ;;; file named COPYING. Among other things, the copyright notice
|
|
|
26 ;;; and this notice must be preserved on all copies.
|
|
|
27
|
|
|
28 ;;; Send any bugs or comments. Thanks to Todd Kaufmann for rewriting
|
|
|
29 ;;; the process filter for continuous handlers.
|
|
|
30
|
|
|
31 ;;; USAGE: M-x install-bridge will add a process output filter to the
|
|
|
32 ;;; current buffer. Any output that the process does between
|
|
|
33 ;;; bridge-start-regexp and bridge-end-regexp will be bundled up and
|
|
|
34 ;;; passed to the first handler on bridge-handlers that matches the
|
|
|
35 ;;; output using string-match. If bridge-prompt-regexp shows up
|
|
|
36 ;;; before bridge-end-regexp, the bridge will be cancelled. If no
|
|
|
37 ;;; handler matches the output, the first symbol in the output is
|
|
|
38 ;;; assumed to be a buffer name and the rest of the output will be
|
|
|
39 ;;; sent to that buffer's process. This can be used to communicate
|
|
|
40 ;;; between processes or to set up two way interactions between Emacs
|
|
|
41 ;;; and an inferior process.
|
|
|
42
|
|
|
43 ;;; You can write handlers that process the output in special ways.
|
|
|
44 ;;; See bridge-send-handler for the default handler. The command
|
|
|
45 ;;; hand-bridge is useful for testing. Keep in mind that all
|
|
|
46 ;;; variables are buffer local.
|
|
|
47
|
|
|
48 ;;; YOUR .EMACS FILE:
|
|
|
49 ;;;
|
|
|
50 ;;; ;;; Set up load path to include bridge
|
|
|
51 ;;; (setq load-path (cons "/bridge-directory/" load-path))
|
|
|
52 ;;; (autoload 'install-bridge "bridge" "Install a process bridge." t)
|
|
|
53 ;;; (setq bridge-hook
|
|
|
54 ;;; '(lambda ()
|
|
|
55 ;;; ;; Example options
|
|
|
56 ;;; (setq bridge-source-insert nil) ;Don't insert in source buffer
|
|
|
57 ;;; (setq bridge-destination-insert nil) ;Don't insert in dest buffer
|
|
|
58 ;;; ;; Handle copy-it messages yourself
|
|
|
59 ;;; (setq bridge-handlers
|
|
|
60 ;;; '(("copy-it" . my-copy-handler)))))
|
|
|
61
|
|
|
62 ;;; EXAMPLE:
|
|
|
63 ;;; # This pipes stdin to the named buffer in a Unix shell
|
|
|
64 ;;; alias devgnu '(echo -n "\!* "; cat -; echo -n " ")'
|
|
|
65 ;;;
|
|
|
66 ;;; ls | devgnu *scratch*
|
|
|
67
|
|
|
68 ;;;%Parameters
|
|
|
69 (defvar bridge-hook nil
|
|
|
70 "Hook called when a bridge is installed by install-hook.")
|
|
|
71
|
|
|
72 (defvar bridge-start-regexp ""
|
|
|
73 "*Regular expression to match the start of a process bridge in
|
|
|
74 process output. It should be followed by a buffer name, the data to
|
|
|
75 be sent and a bridge-end-regexp.")
|
|
|
76
|
|
|
77 (defvar bridge-end-regexp " "
|
|
|
78 "*Regular expression to match the end of a process bridge in process
|
|
|
79 output.")
|
|
|
80
|
|
|
81 (defvar bridge-prompt-regexp nil
|
|
|
82 "*Regular expression for detecting a prompt. If there is a
|
|
|
83 comint-prompt-regexp, it will be initialized to that. A prompt before
|
|
|
84 a bridge-end-regexp will stop the process bridge.")
|
|
|
85
|
|
|
86 (defvar bridge-handlers nil
|
|
|
87 "Alist of (regexp . handler) for handling process output delimited
|
|
|
88 by bridge-start-regexp and bridge-end-regexp. The first entry on the
|
|
|
89 list whose regexp matches the output will be called on the process and
|
|
|
90 the delimited output.")
|
|
|
91
|
|
|
92 (defvar bridge-source-insert t
|
|
|
93 "*T to insert bridge input in the source buffer minus delimiters.")
|
|
|
94
|
|
|
95 (defvar bridge-destination-insert t
|
|
|
96 "*T for bridge-send-handler to insert bridge input into the
|
|
|
97 destination buffer minus delimiters.")
|
|
|
98
|
|
|
99 (defvar bridge-chunk-size 512
|
|
|
100 "*Long inputs send to comint processes are broken up into chunks of
|
|
|
101 this size. If your process is choking on big inputs, try lowering the
|
|
|
102 value.")
|
|
|
103
|
|
|
104 ;;;%Internal variables
|
|
|
105 (defvar bridge-old-filter nil
|
|
|
106 "Old filter for a bridged process buffer.")
|
|
|
107
|
|
|
108 (defvar bridge-string nil
|
|
|
109 "The current output in the process bridge.")
|
|
|
110
|
|
|
111 (defvar bridge-in-progress nil
|
|
|
112 "The current handler function, if any, that bridge passes strings on to,
|
|
|
113 or nil if none.")
|
|
|
114
|
|
|
115 (defvar bridge-send-to-buffer nil
|
|
|
116 "The buffer that the default bridge-handler (bridge-send-handler) is
|
|
|
117 currently sending to, or nil if it hasn't started yet. Your handler
|
|
|
118 function can use this variable also.")
|
|
|
119
|
|
|
120 (defvar bridge-last-failure ()
|
|
|
121 "Last thing that broke the bridge handler. First item is function call
|
|
|
122 (eval'able); last item is error condition which resulted. This is provided
|
|
|
123 to help handler-writers in their debugging.")
|
|
|
124
|
|
|
125 ;;;%Utilities
|
|
|
126 (defun bridge-insert (output)
|
|
|
127 "Insert process OUTPUT into the current buffer."
|
|
|
128 (if output
|
|
|
129 (let* ((buffer (current-buffer))
|
|
|
130 (process (get-buffer-process buffer))
|
|
|
131 (mark (process-mark process))
|
|
|
132 (window (selected-window))
|
|
|
133 (at-end nil))
|
|
|
134 (if (eq (window-buffer window) buffer)
|
|
|
135 (setq at-end (= (point) mark))
|
|
|
136 (setq window (get-buffer-window buffer)))
|
|
|
137 (save-excursion
|
|
|
138 (goto-char mark)
|
|
|
139 (insert output)
|
|
|
140 (set-marker mark (point)))
|
|
|
141 (if window
|
|
|
142 (progn
|
|
|
143 (if at-end (goto-char mark))
|
|
|
144 (if (not (pos-visible-in-window-p (point) window))
|
|
|
145 (let ((original (selected-window)))
|
|
|
146 (save-excursion
|
|
|
147 (select-window window)
|
|
|
148 (recenter '(center))
|
|
|
149 (select-window original)))))))))
|
|
|
150
|
|
|
151 ;;;
|
|
4
|
152 ;(defun bridge-send-string (process string)
|
|
|
153 ; "Send PROCESS the contents of STRING as input.
|
|
|
154 ;This is equivalent to process-send-string, except that long input strings
|
|
|
155 ;are broken up into chunks of size comint-input-chunk-size. Processes
|
|
|
156 ;are given a chance to output between chunks. This can help prevent processes
|
|
|
157 ;from hanging when you send them long inputs on some OS's."
|
|
|
158 ; (let* ((len (length string))
|
|
|
159 ; (i (min len bridge-chunk-size)))
|
|
|
160 ; (process-send-string process (substring string 0 i))
|
|
|
161 ; (while (< i len)
|
|
|
162 ; (let ((next-i (+ i bridge-chunk-size)))
|
|
|
163 ; (accept-process-output)
|
|
|
164 ; (process-send-string process (substring string i (min len next-i)))
|
|
|
165 ; (setq i next-i)))))
|
|
0
|
166
|
|
|
167 ;;;
|
|
|
168 (defun bridge-call-handler (handler proc string)
|
|
|
169 "Funcall HANDLER on PROC, STRING carefully. Error is caught if happens,
|
|
|
170 and user is signaled. State is put in bridge-last-failure. Returns t if
|
|
|
171 handler executed without error."
|
|
|
172 (let ((inhibit-quit nil)
|
|
|
173 (failed nil))
|
|
|
174 (condition-case err
|
|
|
175 (funcall handler proc string)
|
|
|
176 (error
|
|
|
177 (ding)
|
|
|
178 (setq failed t)
|
|
|
179 (message "bridge-handler \"%s\" failed %s (see bridge-last-failure)"
|
|
|
180 handler err)
|
|
|
181 (setq bridge-last-failure
|
|
|
182 (` ((funcall '(, handler) '(, proc) (, string))
|
|
|
183 "Caused: "
|
|
|
184 (, err))))))
|
|
|
185 (not failed)))
|
|
|
186
|
|
|
187 ;;;%Handlers
|
|
|
188 (defun bridge-send-handler (process input)
|
|
|
189 "Send PROCESS INPUT to the buffer name found at the start of the
|
|
|
190 input. The input after the buffer name is sent to the buffer's
|
|
|
191 process if it has one. If bridge-destination-insert is T, the input
|
|
|
192 will be inserted into the buffer. If it does not have a process, it
|
|
|
193 will be inserted at the end of the buffer."
|
|
|
194 (if (null input)
|
|
|
195 (setq bridge-send-to-buffer nil) ; end of bridge
|
|
|
196 (let (buffer-and-start buffer-name dest to)
|
|
|
197 ;; if this is first time, get the buffer out of the first line
|
|
|
198 (cond ((not bridge-send-to-buffer)
|
|
|
199 (setq buffer-and-start (read-from-string input)
|
|
|
200 buffer-name (format "%s" (car (read-from-string input)))
|
|
|
201 dest (get-buffer buffer-name)
|
|
|
202 to (get-buffer-process dest)
|
|
|
203 input (substring input (cdr buffer-and-start)))
|
|
|
204 (setq bridge-send-to-buffer dest))
|
|
|
205 (t
|
|
|
206 (setq buffer-name bridge-send-to-buffer
|
|
|
207 dest (get-buffer buffer-name)
|
|
|
208 to (get-buffer-process dest)
|
|
|
209 )))
|
|
|
210 (if dest
|
|
|
211 (let ((buffer (current-buffer)))
|
|
|
212 (if bridge-destination-insert
|
|
|
213 (unwind-protect
|
|
|
214 (progn
|
|
|
215 (set-buffer dest)
|
|
|
216 (if to
|
|
|
217 (bridge-insert input)
|
|
|
218 (goto-char (point-max))
|
|
|
219 (insert input)))
|
|
|
220 (set-buffer buffer)))
|
|
4
|
221 (if to
|
|
|
222 ;; (bridge-send-string to input)
|
|
|
223 (process-send-string to input)
|
|
|
224 ))
|
|
0
|
225 (error "%s is not a buffer" buffer-name)))))
|
|
|
226
|
|
|
227 ;;;%Filter
|
|
|
228 (defun bridge-filter (process output)
|
|
|
229 "Given PROCESS and some OUTPUT, check for the presence of
|
|
|
230 bridge-start-regexp. Everything prior to this will be passed to the
|
|
|
231 normal filter function or inserted in the buffer if it is nil. The
|
|
|
232 output up to bridge-end-regexp will be sent to the first handler on
|
|
|
233 bridge-handlers that matches the string. If no handlers match, the
|
|
|
234 input will be sent to bridge-send-handler. If bridge-prompt-regexp is
|
|
|
235 encountered before the bridge-end-regexp, the bridge will be cancelled."
|
|
|
236 (let ((inhibit-quit t)
|
|
|
237 (match-data (match-data))
|
|
|
238 (buffer (current-buffer))
|
|
|
239 (process-buffer (process-buffer process))
|
|
|
240 (case-fold-search t)
|
|
|
241 (start 0) (end 0)
|
|
|
242 function
|
|
|
243 b-start b-start-end b-end)
|
|
|
244 (set-buffer process-buffer) ;; access locals
|
|
|
245 (setq function bridge-in-progress)
|
|
|
246
|
|
|
247 ;; How it works:
|
|
|
248 ;;
|
|
|
249 ;; start, end delimit the part of string we are interested in;
|
|
|
250 ;; initially both 0; after an iteration we move them to next string.
|
|
|
251
|
|
|
252 ;; b-start, b-end delimit part of string to bridge (possibly whole string);
|
|
|
253 ;; this will be string between corresponding regexps.
|
|
|
254
|
|
|
255 ;; There are two main cases when we come into loop:
|
|
|
256
|
|
|
257 ;; bridge in progress
|
|
|
258 ;;0 setq b-start = start
|
|
|
259 ;;1 setq b-end (or end-pattern end)
|
|
|
260 ;;4 process string
|
|
|
261 ;;5 remove handler if end found
|
|
|
262
|
|
|
263 ;; no bridge in progress
|
|
|
264 ;;0 setq b-start if see start-pattern
|
|
|
265 ;;1 setq b-end if bstart to (or end-pattern end)
|
|
|
266 ;;2 send (substring start b-start) to normal place
|
|
|
267 ;;3 find handler (in b-start, b-end) if not set
|
|
|
268 ;;4 process string
|
|
|
269 ;;5 remove handler if end found
|
|
|
270
|
|
|
271 ;; equivalent sections have the same numbers here;
|
|
|
272 ;; we fold them together in this code.
|
|
|
273
|
|
|
274 (unwind-protect
|
|
|
275 (while (< end (length output))
|
|
|
276
|
|
|
277 ;;0 setq b-start if find
|
|
|
278 (setq b-start
|
|
|
279 (cond (bridge-in-progress
|
|
|
280 (setq b-start-end start)
|
|
|
281 start)
|
|
|
282 ((string-match bridge-start-regexp output start)
|
|
|
283 (setq b-start-end (match-end 0))
|
|
|
284 (match-beginning 0))
|
|
|
285 (t nil)))
|
|
|
286 ;;1 setq b-end
|
|
|
287 (setq b-end
|
|
|
288 (if b-start
|
|
|
289 (let ((end-seen (string-match bridge-end-regexp
|
|
|
290 output b-start-end)))
|
|
|
291 (if end-seen (setq end (match-end 0)))
|
|
|
292 end-seen)))
|
|
|
293 (if (not b-end) (setq end (length output)
|
|
|
294 b-end (length output)))
|
|
|
295
|
|
|
296 ;;1.5 - if see prompt before end, remove current
|
|
|
297 (if b-start
|
|
|
298 (let ((prompt (string-match bridge-prompt-regexp
|
|
|
299 output b-start-end)))
|
|
|
300 (if (and prompt (<= (match-end 0) b-end))
|
|
|
301 (setq b-start nil ; b-start-end start
|
|
|
302 b-end start
|
|
|
303 end (match-end 0)
|
|
|
304 bridge-in-progress nil
|
|
|
305 ))))
|
|
|
306
|
|
|
307 ;;2 send (substring start b-start) to old filter, if any
|
|
|
308 (if (/= start (or b-start end)) ; don't bother on empty string
|
|
|
309 (let ((pass-on (substring output start (or b-start end))))
|
|
|
310 (if bridge-old-filter
|
|
|
311 (let ((old bridge-old-filter))
|
|
|
312 (store-match-data match-data)
|
|
|
313 (funcall old process pass-on)
|
|
|
314 ;; if filter changed, re-install ourselves
|
|
|
315 (let ((new (process-filter process)))
|
|
|
316 (if (not (eq new 'bridge-filter))
|
|
|
317 (progn (setq bridge-old-filter new)
|
|
|
318 (set-process-filter process 'bridge-filter)))))
|
|
|
319 (set-buffer process-buffer)
|
|
|
320 (bridge-insert pass-on))))
|
|
|
321
|
|
|
322 ;;3 find handler (in b-start, b-end) if none current
|
|
|
323 (if (and b-start (not bridge-in-progress))
|
|
|
324 (let ((handlers bridge-handlers))
|
|
|
325 (while (and handlers (not function))
|
|
|
326 (let* ((handler (car handlers))
|
|
|
327 (m (string-match (car handler) output b-start-end)))
|
|
|
328 (if (and m (< m b-end))
|
|
|
329 (setq function (cdr handler))
|
|
|
330 (setq handlers (cdr handlers)))))
|
|
|
331 ;; Set default handler if none
|
|
|
332 (if (null function)
|
|
|
333 (setq function 'bridge-send-handler))
|
|
|
334 (setq bridge-in-progress function)))
|
|
|
335 ;;4 process string
|
|
|
336 (if function
|
|
|
337 (let ((ok t))
|
|
|
338 (if (/= b-start-end b-end)
|
|
|
339 (let ((send (substring output b-start-end b-end)))
|
|
|
340 ;; also, insert the stuff in buffer between
|
|
|
341 ;; iff bridge-source-insert.
|
|
|
342 (if bridge-source-insert (bridge-insert send))
|
|
|
343 ;; call handler on string
|
|
|
344 (setq ok (bridge-call-handler function process send))))
|
|
|
345 ;;5 remove handler if end found
|
|
|
346 ;; if function removed then tell it that's all
|
|
|
347 (if (or (not ok) (/= b-end end));; saw end before end-of-string
|
|
|
348 (progn
|
|
|
349 (bridge-call-handler function process nil)
|
|
|
350 ;; have to remove function too for next time around
|
|
|
351 (setq function nil
|
|
|
352 bridge-in-progress nil)
|
|
|
353 ))
|
|
|
354 ))
|
|
|
355
|
|
|
356 ;; continue looping, in case there's more string
|
|
|
357 (setq start end)
|
|
|
358 ))
|
|
|
359 ;; protected forms: restore buffer, match-data
|
|
|
360 (set-buffer buffer)
|
|
|
361 (store-match-data match-data)
|
|
|
362 ))
|
|
|
363
|
|
|
364 ;;;%Interface
|
|
|
365 (defun install-bridge ()
|
|
|
366 "Set up a process bridge in the current buffer."
|
|
|
367 (interactive)
|
|
|
368 (if (not (get-buffer-process (current-buffer)))
|
|
|
369 (error "%s does not have a process" (buffer-name (current-buffer)))
|
|
|
370 (make-local-variable 'bridge-start-regexp)
|
|
|
371 (make-local-variable 'bridge-end-regexp)
|
|
|
372 (make-local-variable 'bridge-prompt-regexp)
|
|
|
373 (make-local-variable 'bridge-handlers)
|
|
|
374 (make-local-variable 'bridge-source-insert)
|
|
|
375 (make-local-variable 'bridge-destination-insert)
|
|
|
376 (make-local-variable 'bridge-chunk-size)
|
|
|
377 (make-local-variable 'bridge-old-filter)
|
|
|
378 (make-local-variable 'bridge-string)
|
|
|
379 (make-local-variable 'bridge-in-progress)
|
|
|
380 (make-local-variable 'bridge-send-to-buffer)
|
|
|
381 (setq bridge-string nil bridge-in-progress nil
|
|
|
382 bridge-send-to-buffer nil)
|
|
|
383 (if (boundp 'comint-prompt-regexp)
|
|
|
384 (setq bridge-prompt-regexp comint-prompt-regexp))
|
|
|
385 (let ((process (get-buffer-process (current-buffer))))
|
|
|
386 (if process
|
|
|
387 (if (not (eq (process-filter process) 'bridge-filter))
|
|
|
388 (progn
|
|
|
389 (setq bridge-old-filter (process-filter process))
|
|
|
390 (set-process-filter process 'bridge-filter)))
|
|
|
391 (error "%s does not have a process"
|
|
|
392 (buffer-name (current-buffer)))))
|
|
|
393 (run-hooks 'bridge-hook)
|
|
|
394 (message "Process bridge is installed")))
|
|
|
395
|
|
|
396 ;;;
|
|
|
397 (defun reset-bridge ()
|
|
|
398 "Must be called from the process's buffer. Removes any active bridge."
|
|
|
399 (interactive)
|
|
|
400 ;; for when things get wedged
|
|
|
401 (if bridge-in-progress
|
|
|
402 (unwind-protect
|
|
|
403 (funcall bridge-in-progress (get-buffer-process
|
|
|
404 (current-buffer))
|
|
|
405 nil)
|
|
|
406 (setq bridge-in-progress nil))
|
|
|
407 (message "No bridge in progress.")))
|
|
|
408
|
|
|
409 ;;;
|
|
|
410 (defun remove-bridge ()
|
|
|
411 "Remove bridge from the current buffer."
|
|
|
412 (interactive)
|
|
|
413 (let ((process (get-buffer-process (current-buffer))))
|
|
|
414 (if (or (not process) (not (eq (process-filter process) 'bridge-filter)))
|
|
|
415 (error "%s has no bridge" (buffer-name (current-buffer)))
|
|
|
416 ;; remove any bridge-in-progress
|
|
|
417 (reset-bridge)
|
|
|
418 (set-process-filter process bridge-old-filter)
|
|
|
419 (funcall bridge-old-filter process bridge-string)
|
|
|
420 (message "Process bridge is removed."))))
|
|
|
421
|
|
|
422 ;;;% Utility for testing
|
|
|
423 (defun hand-bridge (start end)
|
|
|
424 "With point at bridge-start, sends bridge-start + string +
|
|
|
425 bridge-end to bridge-filter. With prefix, use current region to send."
|
|
|
426 (interactive "r")
|
|
|
427 (let ((p0 (if current-prefix-arg (min start end)
|
|
|
428 (if (looking-at bridge-start-regexp) (point)
|
|
|
429 (error "Not looking at bridge-start-regexp"))))
|
|
|
430 (p1 (if current-prefix-arg (max start end)
|
|
|
431 (if (re-search-forward bridge-end-regexp nil t)
|
|
|
432 (point) (error "Didn't see bridge-end-regexp")))))
|
|
|
433
|
|
|
434 (bridge-filter (get-buffer-process (current-buffer))
|
|
|
435 (buffer-substring p0 p1))
|
|
|
436 ))
|
|
|
437
|
|
|
438 (provide 'bridge)
|
