fc11dce7bf8e6b91af932ee4459cc0907a2974f6
[riece] / lisp / riece-ruby.el
1 ;;; riece-ruby.el --- interact with Ruby interpreter
2 ;; Copyright (C) 1998-2005 Daiki Ueno
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Created: 1998-09-28
6 ;; Keywords: IRC, riece
7
8 ;; This file is part of Riece.
9
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Commentary:
26
27 ;; riece-ruby.el is a library to interact with the Ruby interpreter.
28 ;; It supports concurrent execution of Ruby programs in a single
29 ;; session.  For example:
30 ;; 
31 ;; (riece-ruby-execute "sleep 30"); returns immediately
32 ;; => "rubyserv0"
33 ;;
34 ;; (riece-ruby-execute "1 + 1")
35 ;; => "rubyserv1"
36 ;;
37 ;; (riece-ruby-execute "\"")
38 ;; => "rubyserv2"
39 ;;
40 ;; (riece-ruby-inspect "rubyserv0")
41 ;; => ((OK nil) nil "running")
42 ;;
43 ;; (riece-ruby-inspect "rubyserv1")
44 ;; => ((OK nil) "2" "finished")
45 ;;
46 ;; (riece-ruby-inspect "rubyserv2")
47 ;; => ((OK nil) "(eval):1: unterminated string meets end of file" "exited")
48
49 ;;; Code:
50
51 (defgroup riece-ruby nil
52   "Interact with the Ruby interpreter."
53   :group 'riece)
54
55 (defcustom riece-ruby-command "ruby"
56   "Command name for Ruby interpreter."
57   :type 'string
58   :group 'riece-ruby)
59
60 (defvar riece-ruby-server-program "server.rb"
61   "The server program file.  If the filename is not absolute, it is
62 assumed that the file is in the same directory of this file.")
63
64 (defvar riece-ruby-process nil
65   "Process object of the Ruby interpreter.")
66
67 (defvar riece-ruby-lock nil
68   "Lock for waiting server response.
69 Local to the process buffer.")
70 (defvar riece-ruby-response nil
71   "The server response.
72 Local to the process buffer.")
73 (defvar riece-ruby-data nil
74   "Data from server.
75 Local to the process buffer.")
76 (defvar riece-ruby-escaped-data nil
77   "Escaped data from server.  This variable is cleared every time
78 server response arrives.
79 Local to the process buffer.")
80 (defvar riece-ruby-status-alist nil
81   "Status from server.
82 Local to the process buffer.")
83
84 (defvar riece-ruby-output-handler-alist nil
85   "An alist mapping from program name to output handler.
86 Output handlers are called every time \"# output\" line arrives.
87 Use `riece-ruby-set-output-handler' to set this variable.")
88 (defvar riece-ruby-exit-handler-alist nil
89   "An alist mapping from program name to exit handler.
90 Exit handlers are called once when \"# exit\" line arrives.
91 Use `riece-ruby-set-exit-handler' to set this variable.")
92 (defvar riece-ruby-property-alist nil
93   "An alist mapping from program name to the property list.
94 Use `riece-ruby-set-property' to set this variable.")
95
96 (defvar riece-ruby-enabled nil)
97
98 (defconst riece-ruby-description
99   "Evaluate an input string as Ruby program.")
100
101 (defun riece-ruby-substitute-variables (program alist)
102   (setq program (copy-sequence program))
103   (while alist
104     (let ((pointer program))
105       (while pointer
106         (setq pointer (memq (car (car alist)) program))
107         (if pointer
108             (setcar pointer (cdr (car alist))))))
109     (setq alist (cdr alist)))
110   (apply #'concat program))
111
112 (defun riece-ruby-escape-data (data)
113   (let ((index 0))
114     (while (string-match "[%\r\n]+" data index)
115       (setq data (replace-match
116                   (mapconcat (lambda (c) (format "%%%02X" c))
117                              (match-string 0 data) "")
118                   nil nil data)
119             index (+ (match-end 0)
120                      (* (- (match-end 0) (match-beginning 0)) 2))))
121     data))
122
123 (defun riece-ruby-unescape-data (data)
124   (let ((index 0))
125     (while (string-match "%\\([0-9A-F][0-9A-F]\\)" data index)
126       (setq data (replace-match
127                   (read (concat "\"\\x" (match-string 1 data) "\""))
128                   nil nil data)
129             index (- (match-end 0) 2)))
130     data))
131
132 (defun riece-ruby-reset-process-buffer ()
133   (save-excursion
134     (set-buffer (process-buffer riece-ruby-process))
135     (buffer-disable-undo)
136     (make-local-variable 'riece-ruby-response)
137     (setq riece-ruby-response nil)
138     (make-local-variable 'riece-ruby-data)
139     (setq riece-ruby-data nil)
140     (make-local-variable 'riece-ruby-escaped-data)
141     (setq riece-ruby-escaped-data nil)
142     (make-local-variable 'riece-ruby-status-alist)
143     (setq riece-ruby-status-alist nil)))
144
145 (defun riece-ruby-send-eval (program)
146   (let* ((string (riece-ruby-escape-data program))
147          (length (- (length string) 998))
148          (index 0)
149          data)
150     (while (< index length)
151       (setq data (cons (substring string index (setq index (+ index 998)))
152                        data)))
153     (setq data (cons (substring string index) data)
154           data (nreverse data))
155     (process-send-string riece-ruby-process "EVAL\r\n")
156     (while data
157       (process-send-string riece-ruby-process
158                            (concat "D " (car data) "\r\n"))
159       (setq data (cdr data)))
160     (process-send-string riece-ruby-process "END\r\n")))
161
162 (defun riece-ruby-send-poll (name)
163   (process-send-string riece-ruby-process
164                        (concat "POLL " name "\r\n")))
165
166 (defun riece-ruby-send-exit (name)
167   (process-send-string riece-ruby-process
168                        (concat "EXIT " name "\r\n")))
169
170 (defun riece-ruby-filter (process input)
171   (save-excursion
172     (set-buffer (process-buffer process))
173     (goto-char (point-max))
174     (insert input)
175     (goto-char (process-mark process))
176     (beginning-of-line)
177     (while (looking-at ".*\r\n")
178       (if (looking-at "OK\\( \\(.*\\)\\)?\r")
179           (progn
180             (if riece-ruby-escaped-data
181                 (setq riece-ruby-data (mapconcat #'riece-ruby-unescape-data
182                                                  riece-ruby-escaped-data "")))
183             (setq riece-ruby-escaped-data nil
184                   riece-ruby-response (list 'OK (match-string 2))
185                   riece-ruby-lock nil))
186         (if (looking-at "ERR \\([0-9]+\\)\\( \\(.*\\)\\)?\r")
187             (progn
188               (setq riece-ruby-escaped-data nil
189                     riece-ruby-response
190                     (list 'ERR (string-to-number (match-string 2))
191                           (match-string 3))
192                     riece-ruby-lock nil))
193           (if (looking-at "D \\(.*\\)\r")
194               (setq riece-ruby-escaped-data (cons (match-string 1)
195                                                   riece-ruby-escaped-data))
196             (if (looking-at "S \\([^ ]*\\) \\(.*\\)\r")
197                 (progn
198                   (setq riece-ruby-status-alist (cons (cons (match-string 1)
199                                                             (match-string 2))
200                                                       riece-ruby-status-alist))
201                   (if (member (car (car riece-ruby-status-alist))
202                               '("finished" "exited"))
203                       (riece-ruby-run-exit-handler
204                        (cdr (car riece-ruby-status-alist)))))
205               (if (looking-at "# output \\([^ ]*\\) \\(.*\\)\r")
206                   (let ((entry (assoc (match-string 1)
207                                       riece-ruby-output-handler-alist)))
208                     (if entry
209                         (funcall (cdr entry) (car entry) (match-string 2))))
210                 (if (looking-at "# exit \\(.*\\)\r")
211                     (riece-ruby-run-exit-handler (match-string 1))))))))
212       (forward-line))
213     (set-marker (process-mark process) (point-marker))))
214
215 (defun riece-ruby-run-exit-handler (name)
216   (let ((entry (assoc name riece-ruby-exit-handler-alist)))
217     (if entry
218         (progn
219           (setq riece-ruby-exit-handler-alist
220                 (delq entry riece-ruby-exit-handler-alist))
221           (funcall (cdr entry) (car entry))))))
222
223 (defun riece-ruby-sentinel (process status)
224   (kill-buffer (process-buffer process)))
225
226 (defun riece-ruby-execute (program)
227   (unless (and riece-ruby-process
228                (eq (process-status riece-ruby-process) 'run))
229     (let (selective-display
230           (coding-system-for-write 'binary)
231           (coding-system-for-read 'binary))
232       (setq riece-ruby-process
233             (start-process "riece-ruby" (generate-new-buffer " *Ruby*")
234                            riece-ruby-command
235                            (if (file-name-absolute-p riece-ruby-server-program)
236                                riece-ruby-server-program
237                              (expand-file-name
238                               riece-ruby-server-program
239                               (file-name-directory
240                                (locate-library
241                                 (symbol-file 'riece-ruby-execute)))))))
242       (set-process-filter riece-ruby-process #'riece-ruby-filter)
243       (set-process-sentinel riece-ruby-process #'riece-ruby-sentinel)))
244   (save-excursion
245     (set-buffer (process-buffer riece-ruby-process))
246     (riece-ruby-reset-process-buffer)
247     (make-local-variable 'riece-ruby-lock)
248     (setq riece-ruby-lock t)
249     (riece-ruby-send-eval program)
250     (while riece-ruby-lock
251       (accept-process-output riece-ruby-process))
252     (if (eq (car riece-ruby-response) 'ERR)
253         (error "Couldn't execute: %S" (cdr riece-ruby-response)))
254     (cdr (assoc "name" riece-ruby-status-alist))))
255
256 (defun riece-ruby-inspect (name)
257   (save-excursion
258     (set-buffer (process-buffer riece-ruby-process))
259     (riece-ruby-reset-process-buffer)
260     (make-local-variable 'riece-ruby-lock)
261     (setq riece-ruby-lock t)
262     (riece-ruby-send-poll name)
263     (while riece-ruby-lock
264       (accept-process-output riece-ruby-process))
265     (list riece-ruby-response
266           riece-ruby-data
267           riece-ruby-status-alist)))
268
269 (defun riece-ruby-clear (name)
270   (save-excursion
271     (set-buffer (process-buffer riece-ruby-process))
272     (riece-ruby-reset-process-buffer)
273     (make-local-variable 'riece-ruby-lock)
274     (setq riece-ruby-lock t)
275     (riece-ruby-send-exit name)
276     (while riece-ruby-lock
277       (accept-process-output riece-ruby-process)))
278   (let ((entry (assoc name riece-ruby-property-alist)))
279     (if entry
280         (delq entry riece-ruby-property-alist))))
281
282 (defun riece-ruby-set-exit-handler (name handler)
283   (let ((entry (assoc name riece-ruby-exit-handler-alist)))
284     (if handler
285         (progn
286           (if entry
287               (setcdr entry handler)
288             (setq riece-ruby-exit-handler-alist
289                   (cons (cons name handler)
290                         riece-ruby-exit-handler-alist)))
291           ;;check if the program already exited
292           (riece-ruby-inspect name))
293       (if entry
294           (setq riece-ruby-exit-handler-alist
295                 (delq entry riece-ruby-exit-handler-alist))))))
296
297 (defun riece-ruby-set-output-handler (name handler)
298   (let ((entry (assoc name riece-ruby-output-handler-alist)))
299     (if handler
300         (progn
301           (if entry
302               (setcdr entry handler)
303             (setq riece-ruby-output-handler-alist
304                   (cons (cons name handler)
305                         riece-ruby-output-handler-alist))))
306       (if entry
307           (setq riece-ruby-output-handler-alist
308                 (delq entry riece-ruby-output-handler-alist))))))
309
310 (defun riece-ruby-set-property (name property value)
311   (let ((entry (assoc name riece-ruby-property-alist))
312         property-entry)
313     (unless entry
314       (setq entry (list name)
315             riece-ruby-property-alist (cons entry riece-ruby-property-alist)))
316     (if (setq property-entry (assoc property (cdr entry)))
317         (setcdr property-entry value)
318       (setcdr entry (cons (cons property value) (cdr entry))))))
319
320 (defun riece-ruby-property (name property)
321   (cdr (assoc property (cdr (assoc name riece-ruby-property-alist)))))
322
323 (defun riece-ruby-exit-handler (name)
324   (riece-ruby-inspect name)
325   (let ((data (copy-sequence riece-ruby-data))
326         (length (length data))
327         (index 0))
328     (while (< index length)
329       (if (eq (aref data index) ?\n)
330           (aset data index " ")))
331     (riece-send-string
332      (format "NOTICE %s :%s\r\n"
333              (riece-identity-prefix
334               (riece-ruby-property name 'riece-ruby-target))
335              data))
336     (riece-display-message
337      (riece-make-message (riece-current-nickname)
338                          (riece-ruby-property name 'riece-ruby-target)
339                          data
340                          'notice))
341     (riece-ruby-clear name)))
342
343 (defun riece-ruby-display-message-function (message)
344   (if (and riece-ruby-enabled
345            (riece-message-own-p message)
346            (string-match "^,ruby\\s-+" (riece-message-text message)))
347       (let ((name (riece-ruby-execute
348                    (substring (riece-message-text message)
349                               (match-end 0)))))
350         (riece-ruby-set-property name
351                                  'riece-ruby-target
352                                  (riece-message-target message))
353         (riece-ruby-set-exit-handler name
354                                      #'riece-ruby-exit-handler))))
355
356 (defun riece-ruby-insinuate ()
357   (add-hook 'riece-after-display-message-functions
358             'riece-ruby-display-message-function))
359
360 (defun riece-ruby-enable ()
361   (setq riece-ruby-enabled t))
362
363 (defun riece-ruby-disable ()
364   (setq riece-ruby-enabled nil))
365
366 (provide 'riece-ruby)
367
368 ;;; riece-ruby.el ends here