|
0
|
1 ;;; Interface between Emacs Lisp and Python - Lisp part. -*- emacs-lisp -*- |
|
|
2 ;;; Copyright © 2001, 2002, 2003 Progiciels Bourbeau-Pinard inc. |
|
|
3 ;;; François Pinard <pinard@iro.umontreal.ca>, 2001. |
|
|
4 |
|
|
5 ;;; This program is free software; you can redistribute it and/or modify |
|
|
6 ;;; it under the terms of the GNU General Public License as published by |
|
|
7 ;;; the Free Software Foundation; either version 2, or (at your option) |
|
|
8 ;;; any later version. |
|
|
9 ;;; |
|
|
10 ;;; This program is distributed in the hope that it will be useful, |
|
|
11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
|
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
|
13 ;;; GNU General Public License for more details. |
|
|
14 ;;; |
|
|
15 ;;; You should have received a copy of the GNU General Public License |
|
|
16 ;;; along with this program; if not, write to the Free Software Foundation, |
|
|
17 ;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ |
|
|
18 |
|
|
19 ;;; Portability stunts. |
|
|
20 |
|
|
21 (defvar pymacs-use-hash-tables |
|
|
22 (and (fboundp 'make-hash-table) (fboundp 'gethash) (fboundp 'puthash)) |
|
|
23 "Set to t if hash tables are available.") |
|
|
24 |
|
|
25 (eval-and-compile |
|
|
26 |
|
|
27 (if (fboundp 'multibyte-string-p) |
|
|
28 (defalias 'pymacs-multibyte-string-p 'multibyte-string-p) |
|
|
29 (defun pymacs-multibyte-string-p (string) |
|
|
30 "Tell XEmacs if STRING should be handled as multibyte." |
|
|
31 (not (equal (find-charset-string string) '(ascii)))))) |
|
|
32 |
|
|
33 (defalias 'pymacs-report-error (symbol-function 'error)) |
|
|
34 |
|
|
35 ;;; Published variables and functions. |
|
|
36 |
|
|
37 (defvar pymacs-load-path nil |
|
|
38 "List of additional directories to search for Python modules. |
|
|
39 The directories listed will be searched first, in the order given.") |
|
|
40 |
|
|
41 (defvar pymacs-trace-transit '(5000 . 30000) |
|
|
42 "Keep the communication buffer growing, for debugging. |
|
|
43 When this variable is nil, the `*Pymacs*' communication buffer gets erased |
|
|
44 before each communication round-trip. Setting it to `t' guarantees that |
|
|
45 the full communication is saved, which is useful for debugging. |
|
|
46 It could also be given as (KEEP . LIMIT): whenever the buffer exceeds LIMIT |
|
|
47 bytes, it is reduced to approximately KEEP bytes.") |
|
|
48 |
|
|
49 (defvar pymacs-forget-mutability nil |
|
|
50 "Transmit copies to Python instead of Lisp handles, as much as possible. |
|
|
51 When this variable is nil, most mutable objects are transmitted as handles. |
|
|
52 This variable is meant to be temporarily rebound to force copies.") |
|
|
53 |
|
|
54 (defvar pymacs-mutable-strings nil |
|
|
55 "Prefer transmitting Lisp strings to Python as handles. |
|
|
56 When this variable is nil, strings are transmitted as copies, and the |
|
|
57 Python side thus has no way for modifying the original Lisp strings. |
|
|
58 This variable is ignored whenever `forget-mutability' is set.") |
|
|
59 |
|
|
60 (defvar pymacs-timeout-at-start 30 |
|
|
61 "Maximum reasonable time, in seconds, for starting the Pymacs helper. |
|
|
62 A machine should be pretty loaded before one needs to increment this.") |
|
|
63 |
|
|
64 (defvar pymacs-timeout-at-reply 5 |
|
|
65 "Expected maximum time, in seconds, to get the first line of a reply. |
|
|
66 The status of the Pymacs helper is checked at every such timeout.") |
|
|
67 |
|
|
68 (defvar pymacs-timeout-at-line 2 |
|
|
69 "Expected maximum time, in seconds, to get another line of a reply. |
|
|
70 The status of the Pymacs helper is checked at every such timeout.") |
|
|
71 |
|
|
72 (defvar pymacs-dreadful-zombies nil |
|
|
73 "If zombies should trigger hard errors, whenever they get called. |
|
|
74 If `nil', calling a zombie will merely produce a diagnostic message.") |
|
|
75 |
|
|
76 (defun pymacs-load (module &optional prefix noerror) |
|
|
77 "Import the Python module named MODULE into Emacs. |
|
|
78 Each function in the Python module is made available as an Emacs function. |
|
|
79 The Lisp name of each function is the concatenation of PREFIX with |
|
|
80 the Python name, in which underlines are replaced by dashes. If PREFIX is |
|
|
81 not given, it defaults to MODULE followed by a dash. |
|
|
82 If NOERROR is not nil, do not raise error when the module is not found." |
|
|
83 (interactive |
|
|
84 (let* ((module (read-string "Python module? ")) |
|
|
85 (default (concat (car (last (split-string module "\\."))) "-")) |
|
|
86 (prefix (read-string (format "Prefix? [%s] " default) |
|
|
87 nil nil default))) |
|
|
88 (list module prefix))) |
|
|
89 (message "Pymacs loading %s..." module) |
|
|
90 (let ((lisp-code (pymacs-call "pymacs_load_helper" module prefix))) |
|
|
91 (cond (lisp-code (let ((result (eval lisp-code))) |
|
|
92 (message "Pymacs loading %s...done" module) |
|
|
93 result)) |
|
|
94 (noerror (message "Pymacs loading %s...failed" module) nil) |
|
|
95 (t (pymacs-report-error "Pymacs loading %s...failed" module))))) |
|
|
96 |
|
|
97 (defun pymacs-eval (text) |
|
|
98 "Compile TEXT as a Python expression, and return its value." |
|
|
99 (interactive "sPython expression? ") |
|
|
100 (let ((value (pymacs-serve-until-reply "eval" `(princ ,text)))) |
|
|
101 (when (interactive-p) |
|
|
102 (message "%S" value)) |
|
|
103 value)) |
|
|
104 |
|
|
105 (defun pymacs-exec (text) |
|
|
106 "Compile and execute TEXT as a sequence of Python statements. |
|
|
107 This functionality is experimental, and does not appear to be useful." |
|
|
108 (interactive "sPython statements? ") |
|
|
109 (let ((value (pymacs-serve-until-reply "exec" `(princ ,text)))) |
|
|
110 (when (interactive-p) |
|
|
111 (message "%S" value)) |
|
|
112 value)) |
|
|
113 |
|
|
114 (defun pymacs-call (function &rest arguments) |
|
|
115 "Return the result of calling a Python function FUNCTION over ARGUMENTS. |
|
|
116 FUNCTION is a string denoting the Python function, ARGUMENTS are separate |
|
|
117 Lisp expressions, one per argument. Immutable Lisp constants are converted |
|
|
118 to Python equivalents, other structures are converted into Lisp handles." |
|
|
119 (pymacs-serve-until-reply |
|
|
120 "eval" `(pymacs-print-for-apply ',function ',arguments))) |
|
|
121 |
|
|
122 (defun pymacs-apply (function arguments) |
|
|
123 "Return the result of calling a Python function FUNCTION over ARGUMENTS. |
|
|
124 FUNCTION is a string denoting the Python function, ARGUMENTS is a list of |
|
|
125 Lisp expressions. Immutable Lisp constants are converted to Python |
|
|
126 equivalents, other structures are converted into Lisp handles." |
|
|
127 (pymacs-serve-until-reply |
|
|
128 "eval" `(pymacs-print-for-apply ',function ',arguments))) |
|
|
129 |
|
|
130 ;;; Integration details. |
|
|
131 |
|
|
132 ;; Python functions and modules should ideally look like Lisp functions and |
|
|
133 ;; modules. This page tries to increase the integration seamlessness. |
|
|
134 |
|
|
135 (defadvice documentation (around pymacs-ad-documentation activate) |
|
|
136 ;; Integration of doc-strings. |
|
|
137 (let* ((reference (pymacs-python-reference function)) |
|
|
138 (python-doc (when reference |
|
|
139 (pymacs-eval (format "doc_string(%s)" reference))))) |
|
|
140 (if (or reference python-doc) |
|
|
141 (setq ad-return-value |
|
|
142 (concat |
|
|
143 "It interfaces to a Python function.\n\n" |
|
|
144 (when python-doc |
|
|
145 (if raw python-doc (substitute-command-keys python-doc))))) |
|
|
146 ad-do-it))) |
|
|
147 |
|
|
148 (defun pymacs-python-reference (object) |
|
|
149 ;; Return the text reference of a Python object if possible, else nil. |
|
|
150 (when (functionp object) |
|
|
151 (let* ((definition (indirect-function object)) |
|
|
152 (body (and (pymacs-proper-list-p definition) |
|
|
153 (> (length definition) 2) |
|
|
154 (eq (car definition) 'lambda) |
|
|
155 (cddr definition)))) |
|
|
156 (when (and body (listp (car body)) (eq (caar body) 'interactive)) |
|
|
157 ;; Skip the interactive specification of a function. |
|
|
158 (setq body (cdr body))) |
|
|
159 (when (and body |
|
|
160 ;; Advised functions start with a string. |
|
|
161 (not (stringp (car body))) |
|
|
162 ;; Python trampolines hold exactly one expression. |
|
|
163 (= (length body) 1)) |
|
|
164 (let ((expression (car body))) |
|
|
165 ;; EXPRESSION might now hold something like: |
|
|
166 ;; (pymacs-apply (quote (pymacs-python . N)) ARGUMENT-LIST) |
|
|
167 (when (and (pymacs-proper-list-p expression) |
|
|
168 (= (length expression) 3) |
|
|
169 (eq (car expression) 'pymacs-apply) |
|
|
170 (eq (car (cadr expression)) 'quote)) |
|
|
171 (setq object (cadr (cadr expression)))))))) |
|
|
172 (when (eq (car-safe object) 'pymacs-python) |
|
|
173 (format "python[%d]" (cdr object)))) |
|
|
174 |
|
|
175 ;; The following functions are experimental -- they are not satisfactory yet. |
|
|
176 |
|
|
177 (defun pymacs-file-handler (operation &rest arguments) |
|
|
178 ;; Integration of load-file, autoload, etc. |
|
|
179 ;; Emacs might want the contents of some `MODULE.el' which does not exist, |
|
|
180 ;; while there is a `MODULE.py' or `MODULE.pyc' file in the same directory. |
|
|
181 ;; The goal is to generate a virtual contents for this `MODULE.el' file, as |
|
|
182 ;; a set of Lisp trampoline functions to the Python module functions. |
|
|
183 ;; Python modules can then be loaded or autoloaded as if they were Lisp. |
|
|
184 (cond ((and (eq operation 'file-readable-p) |
|
|
185 (let ((module (substring (car arguments) 0 -3))) |
|
|
186 (or (pymacs-file-force operation arguments) |
|
|
187 (file-readable-p (concat module ".py")) |
|
|
188 (file-readable-p (concat module ".pyc")))))) |
|
|
189 ((and (eq operation 'load) |
|
|
190 (not (pymacs-file-force |
|
|
191 'file-readable-p (list (car arguments)))) |
|
|
192 (file-readable-p (car arguments))) |
|
|
193 (let ((lisp-code (pymacs-call "pymacs_load_helper" |
|
|
194 (substring (car arguments) 0 -3) |
|
|
195 nil))) |
|
|
196 (unless lisp-code |
|
|
197 (pymacs-report-error "Python import error")) |
|
|
198 (eval lisp-code))) |
|
|
199 ((and (eq operation 'insert-file-contents) |
|
|
200 (not (pymacs-file-force |
|
|
201 'file-readable-p (list (car arguments)))) |
|
|
202 (file-readable-p (car arguments))) |
|
|
203 (let ((lisp-code (pymacs-call "pymacs_load_helper" |
|
|
204 (substring (car arguments) 0 -3) |
|
|
205 nil))) |
|
|
206 (unless lisp-code |
|
|
207 (pymacs-report-error "Python import error")) |
|
|
208 (insert (prin1-to-string lisp-code)))) |
|
|
209 (t (pymacs-file-force operation arguments)))) |
|
|
210 |
|
|
211 (defun pymacs-file-force (operation arguments) |
|
|
212 ;; Bypass the file handler. |
|
|
213 (let ((inhibit-file-name-handlers |
|
|
214 (cons 'pymacs-file-handler |
|
|
215 (and (eq inhibit-file-name-operation operation) |
|
|
216 inhibit-file-name-handlers))) |
|
|
217 (inhibit-file-name-operation operation)) |
|
|
218 (apply operation arguments))) |
|
|
219 |
|
|
220 ;(add-to-list 'file-name-handler-alist '("\\.el\\'" . pymacs-file-handler)) |
|
|
221 |
|
|
222 ;;; Gargabe collection of Python IDs. |
|
|
223 |
|
|
224 ;; Python objects which have no Lisp representation are allocated on the |
|
|
225 ;; Python side as `python[INDEX]', and INDEX is transmitted to Emacs, with |
|
|
226 ;; the value to use on the Lisp side for it. Whenever Lisp does not need a |
|
|
227 ;; Python object anymore, it should be freed on the Python side. The |
|
|
228 ;; following variables and functions are meant to fill this duty. |
|
|
229 |
|
|
230 (defvar pymacs-used-ids nil |
|
|
231 "List of received IDs, currently allocated on the Python side.") |
|
|
232 |
|
|
233 (defvar pymacs-weak-hash nil |
|
|
234 "Weak hash table, meant to find out which IDs are still needed.") |
|
|
235 |
|
|
236 (defvar pymacs-gc-wanted nil |
|
|
237 "Flag if it is time to clean up unused IDs on the Python side.") |
|
|
238 |
|
|
239 (defvar pymacs-gc-running nil |
|
|
240 "Flag telling that a Pymacs garbage collection is in progress.") |
|
|
241 |
|
|
242 (defvar pymacs-gc-timer nil |
|
|
243 "Timer to trigger Pymacs garbage collection at regular time intervals. |
|
|
244 The timer is used only if `post-gc-hook' is not available.") |
|
|
245 |
|
|
246 (defun pymacs-schedule-gc (&optional xemacs-list) |
|
|
247 (unless pymacs-gc-running |
|
|
248 (setq pymacs-gc-wanted t))) |
|
|
249 |
|
|
250 (defun pymacs-garbage-collect () |
|
|
251 ;; Clean up unused IDs on the Python side. |
|
|
252 (when pymacs-use-hash-tables |
|
|
253 (let ((pymacs-gc-running t) |
|
|
254 (pymacs-forget-mutability t) |
|
|
255 (ids pymacs-used-ids) |
|
|
256 used-ids unused-ids) |
|
|
257 (while ids |
|
|
258 (let ((id (car ids))) |
|
|
259 (setq ids (cdr ids)) |
|
|
260 (if (gethash id pymacs-weak-hash) |
|
|
261 (setq used-ids (cons id used-ids)) |
|
|
262 (setq unused-ids (cons id unused-ids))))) |
|
|
263 (setq pymacs-used-ids used-ids |
|
|
264 pymacs-gc-wanted nil) |
|
|
265 (when unused-ids |
|
|
266 (pymacs-apply "free_python" unused-ids))))) |
|
|
267 |
|
|
268 (defun pymacs-defuns (arguments) |
|
|
269 ;; Take one argument, a list holding a number of items divisible by 3. The |
|
|
270 ;; first argument is an INDEX, the second is a NAME, the third is the |
|
|
271 ;; INTERACTION specification, and so forth. Register Python INDEX with a |
|
|
272 ;; function with that NAME and INTERACTION on the Lisp side. The strange |
|
|
273 ;; calling convention is to minimise quoting at call time. |
|
|
274 (while (>= (length arguments) 3) |
|
|
275 (let ((index (nth 0 arguments)) |
|
|
276 (name (nth 1 arguments)) |
|
|
277 (interaction (nth 2 arguments))) |
|
|
278 (fset name (pymacs-defun index interaction)) |
|
|
279 (setq arguments (nthcdr 3 arguments))))) |
|
|
280 |
|
|
281 (defun pymacs-defun (index interaction) |
|
|
282 ;; Register INDEX on the Lisp side with a Python object that is a function, |
|
|
283 ;; and return a lambda form calling that function. If the INTERACTION |
|
|
284 ;; specification is nil, the function is not interactive. Otherwise, the |
|
|
285 ;; function is interactive, INTERACTION is then either a string, or the |
|
|
286 ;; index of an argument-less Python function returning the argument list. |
|
|
287 (let ((object (pymacs-python index))) |
|
|
288 (cond ((null interaction) |
|
|
289 `(lambda (&rest arguments) |
|
|
290 (pymacs-apply ',object arguments))) |
|
|
291 ((stringp interaction) |
|
|
292 `(lambda (&rest arguments) |
|
|
293 (interactive ,interaction) |
|
|
294 (pymacs-apply ',object arguments))) |
|
|
295 (t `(lambda (&rest arguments) |
|
|
296 (interactive (pymacs-call ',(pymacs-python interaction))) |
|
|
297 (pymacs-apply ',object arguments)))))) |
|
|
298 |
|
|
299 (defun pymacs-python (index) |
|
|
300 ;; Register on the Lisp side a Python object having INDEX, and return it. |
|
|
301 ;; The result is meant to be recognised specially by `print-for-eval', and |
|
|
302 ;; in the function position by `print-for-apply'. |
|
|
303 (let ((object (cons 'pymacs-python index))) |
|
|
304 (when pymacs-use-hash-tables |
|
|
305 (puthash index object pymacs-weak-hash) |
|
|
306 (setq pymacs-used-ids (cons index pymacs-used-ids))) |
|
|
307 object)) |
|
|
308 |
|
|
309 ;;; Generating Python code. |
|
|
310 |
|
|
311 ;; Many Lisp expressions cannot fully be represented in Python, at least |
|
|
312 ;; because the object is mutable on the Lisp side. Such objects are allocated |
|
|
313 ;; somewhere into a vector of handles, and the handle index is used for |
|
|
314 ;; communication instead of the expression itself. |
|
|
315 |
|
|
316 (defvar pymacs-lisp nil |
|
|
317 "Vector of handles to hold transmitted expressions.") |
|
|
318 |
|
|
319 (defvar pymacs-freed-list nil |
|
|
320 "List of unallocated indices in Lisp.") |
|
|
321 |
|
|
322 ;; When the Python GC is done with a Lisp object, a communication occurs so to |
|
|
323 ;; free the object on the Lisp side as well. |
|
|
324 |
|
|
325 (defun pymacs-allocate-lisp (expression) |
|
|
326 ;; This function allocates some handle for an EXPRESSION, and return its |
|
|
327 ;; index. |
|
|
328 (unless pymacs-freed-list |
|
|
329 (let* ((previous pymacs-lisp) |
|
|
330 (old-size (length previous)) |
|
|
331 (new-size (if (zerop old-size) 100 (+ old-size (/ old-size 2)))) |
|
|
332 (counter new-size)) |
|
|
333 (setq pymacs-lisp (make-vector new-size nil)) |
|
|
334 (while (> counter 0) |
|
|
335 (setq counter (1- counter)) |
|
|
336 (if (< counter old-size) |
|
|
337 (aset pymacs-lisp counter (aref previous counter)) |
|
|
338 (setq pymacs-freed-list (cons counter pymacs-freed-list)))))) |
|
|
339 (let ((index (car pymacs-freed-list))) |
|
|
340 (setq pymacs-freed-list (cdr pymacs-freed-list)) |
|
|
341 (aset pymacs-lisp index expression) |
|
|
342 index)) |
|
|
343 |
|
|
344 (defun pymacs-free-lisp (indices) |
|
|
345 ;; This function is triggered from Python side for Lisp handles which lost |
|
|
346 ;; their last reference. These references should be cut on the Lisp side as |
|
|
347 ;; well, or else, the objects will never be garbage-collected. |
|
|
348 (while indices |
|
|
349 (let ((index (car indices))) |
|
|
350 (aset pymacs-lisp index nil) |
|
|
351 (setq pymacs-freed-list (cons index pymacs-freed-list) |
|
|
352 indices (cdr indices))))) |
|
|
353 |
|
|
354 (defun pymacs-print-for-apply (function arguments) |
|
|
355 ;; This function prints a Python expression calling FUNCTION, which is a |
|
|
356 ;; string naming a Python function, or a Python reference, over all its |
|
|
357 ;; ARGUMENTS, which are Lisp expressions. |
|
|
358 (let ((separator "") |
|
|
359 argument) |
|
|
360 (if (eq (car-safe function) 'pymacs-python) |
|
|
361 (princ (format "python[%d]" (cdr function))) |
|
|
362 (princ function)) |
|
|
363 (princ "(") |
|
|
364 (while arguments |
|
|
365 (setq argument (car arguments) |
|
|
366 arguments (cdr arguments)) |
|
|
367 (princ separator) |
|
|
368 (setq separator ", ") |
|
|
369 (pymacs-print-for-eval argument)) |
|
|
370 (princ ")"))) |
|
|
371 |
|
|
372 (defun pymacs-print-for-eval (expression) |
|
|
373 ;; This function prints a Python expression out of a Lisp EXPRESSION. |
|
|
374 (let (done) |
|
|
375 (cond ((not expression) |
|
|
376 (princ "None") |
|
|
377 (setq done t)) |
|
|
378 ((eq expression t) |
|
|
379 (princ "True") |
|
|
380 (setq done t)) |
|
|
381 ((numberp expression) |
|
|
382 (princ expression) |
|
|
383 (setq done t)) |
|
|
384 ((stringp expression) |
|
|
385 (when (or pymacs-forget-mutability |
|
|
386 (not pymacs-mutable-strings)) |
|
|
387 (let* ((multibyte (pymacs-multibyte-string-p expression)) |
|
|
388 (text (if multibyte |
|
|
389 (encode-coding-string expression 'utf-8) |
|
|
390 (copy-sequence expression)))) |
|
|
391 (set-text-properties 0 (length text) nil text) |
|
|
392 (princ (mapconcat 'identity |
|
|
393 (split-string (prin1-to-string text) "\n") |
|
|
394 "\\n")) |
|
|
395 (when (and multibyte |
|
|
396 (not (equal (find-charset-string text) '(ascii)))) |
|
|
397 (princ ".decode('UTF-8')"))) |
|
|
398 (setq done t))) |
|
|
399 ((symbolp expression) |
|
|
400 (let ((name (symbol-name expression))) |
|
|
401 ;; The symbol can only be transmitted when in the main oblist. |
|
|
402 (when (eq expression (intern-soft name)) |
|
|
403 (princ "lisp[") |
|
|
404 (prin1 name) |
|
|
405 (princ "]") |
|
|
406 (setq done t)))) |
|
|
407 ((vectorp expression) |
|
|
408 (when pymacs-forget-mutability |
|
|
409 (let ((limit (length expression)) |
|
|
410 (counter 0)) |
|
|
411 (princ "(") |
|
|
412 (while (< counter limit) |
|
|
413 (unless (zerop counter) |
|
|
414 (princ ", ")) |
|
|
415 (pymacs-print-for-eval (aref expression counter)) |
|
|
416 (setq counter (1+ counter))) |
|
|
417 (when (= limit 1) |
|
|
418 (princ ",")) |
|
|
419 (princ ")") |
|
|
420 (setq done t)))) |
|
|
421 ((eq (car-safe expression) 'pymacs-python) |
|
|
422 (princ "python[") |
|
|
423 (princ (cdr expression)) |
|
|
424 (princ "]") |
|
|
425 (setq done t)) |
|
|
426 ((pymacs-proper-list-p expression) |
|
|
427 (when pymacs-forget-mutability |
|
|
428 (princ "[") |
|
|
429 (pymacs-print-for-eval (car expression)) |
|
|
430 (while (setq expression (cdr expression)) |
|
|
431 (princ ", ") |
|
|
432 (pymacs-print-for-eval (car expression))) |
|
|
433 (princ "]") |
|
|
434 (setq done t)))) |
|
|
435 (unless done |
|
|
436 (let ((class (cond ((vectorp expression) "Vector") |
|
|
437 ((and pymacs-use-hash-tables |
|
|
438 (hash-table-p expression)) |
|
|
439 "Table") |
|
|
440 ((bufferp expression) "Buffer") |
|
|
441 ((pymacs-proper-list-p expression) "List") |
|
|
442 (t "Lisp")))) |
|
|
443 (princ class) |
|
|
444 (princ "(") |
|
|
445 (princ (pymacs-allocate-lisp expression)) |
|
|
446 (princ ")"))))) |
|
|
447 |
|
|
448 ;;; Communication protocol. |
|
|
449 |
|
|
450 (defvar pymacs-transit-buffer nil |
|
|
451 "Communication buffer between Emacs and Python.") |
|
|
452 |
|
|
453 ;; The principle behind the communication protocol is that it is easier to |
|
|
454 ;; generate than parse, and that each language already has its own parser. |
|
|
455 ;; So, the Emacs side generates Python text for the Python side to interpret, |
|
|
456 ;; while the Python side generates Lisp text for the Lisp side to interpret. |
|
|
457 ;; About nothing but expressions are transmitted, which are evaluated on |
|
|
458 ;; arrival. The pseudo `reply' function is meant to signal the final result |
|
|
459 ;; of a series of exchanges following a request, while the pseudo `error' |
|
|
460 ;; function is meant to explain why an exchange could not have been completed. |
|
|
461 |
|
|
462 ;; The protocol itself is rather simple, and contains human readable text |
|
|
463 ;; only. A message starts at the beginning of a line in the communication |
|
|
464 ;; buffer, either with `>' for the Lisp to Python direction, or `<' for the |
|
|
465 ;; Python to Lisp direction. This is followed by a decimal number giving the |
|
|
466 ;; length of the message text, a TAB character, and the message text itself. |
|
|
467 ;; Message direction alternates systematically between messages, it never |
|
|
468 ;; occurs that two successive messages are sent in the same direction. The |
|
|
469 ;; first message is received from the Python side, it is `(version VERSION)'. |
|
|
470 |
|
|
471 (defun pymacs-start-services () |
|
|
472 ;; This function gets called automatically, as needed. |
|
|
473 (let ((buffer (get-buffer-create "*Pymacs*"))) |
|
|
474 (with-current-buffer buffer |
|
|
475 (buffer-disable-undo) |
|
|
476 (set-buffer-multibyte nil) |
|
|
477 (set-buffer-file-coding-system 'raw-text) |
|
|
478 (save-match-data |
|
|
479 ;; Launch the Pymacs helper. |
|
|
480 (let ((process |
|
|
481 (apply 'start-process "pymacs" buffer |
|
|
482 (let ((python (getenv "PYMACS_PYTHON"))) |
|
|
483 (if (or (null python) (equal python "")) |
|
|
484 "python" |
|
|
485 python)) |
|
|
486 "-c" (concat "import sys;" |
|
|
487 " from Pymacs.pymacs import main;" |
|
|
488 " main(*sys.argv[1:])") |
|
|
489 (mapcar 'expand-file-name pymacs-load-path)))) |
|
|
490 (cond ((fboundp 'set-process-query-on-exit-flag) |
|
|
491 (set-process-query-on-exit-flag process nil)) |
|
|
492 ((fboundp 'process-kill-without-query-process) |
|
|
493 (process-kill-without-query process))) |
|
|
494 ;; Receive the synchronising reply. |
|
|
495 (while (progn |
|
|
496 (goto-char (point-min)) |
|
|
497 (not (re-search-forward "<\\([0-9]+\\)\t" nil t))) |
|
|
498 (unless (accept-process-output process pymacs-timeout-at-start) |
|
|
499 (pymacs-report-error |
|
|
500 "Pymacs helper did not start within %d seconds" |
|
|
501 pymacs-timeout-at-start))) |
|
|
502 (let ((marker (process-mark process)) |
|
|
503 (limit-position (+ (match-end 0) |
|
|
504 (string-to-number (match-string 1))))) |
|
|
505 (while (< (marker-position marker) limit-position) |
|
|
506 (unless (accept-process-output process pymacs-timeout-at-start) |
|
|
507 (pymacs-report-error |
|
|
508 "Pymacs helper probably was interrupted at start"))))) |
|
|
509 ;; Check that synchronisation occurred. |
|
|
510 (goto-char (match-end 0)) |
|
|
511 (let ((reply (read (current-buffer)))) |
|
|
512 (if (and (pymacs-proper-list-p reply) |
|
|
513 (= (length reply) 2) |
|
|
514 (eq (car reply) 'version)) |
|
|
515 (unless (string-equal (cadr reply) "0.23") |
|
|
516 (pymacs-report-error |
|
|
517 "Pymacs Lisp version is 0.23, Python is %s" |
|
|
518 (cadr reply))) |
|
|
519 (pymacs-report-error "Pymacs got an invalid initial reply"))))) |
|
|
520 (when pymacs-use-hash-tables |
|
|
521 (if pymacs-weak-hash |
|
|
522 ;; A previous Pymacs session occurred in *this* Emacs session. Some |
|
|
523 ;; IDs may hang around, which do not correspond to anything on the |
|
|
524 ;; Python side. Python should not recycle such IDs for new objects. |
|
|
525 (when pymacs-used-ids |
|
|
526 (let ((pymacs-transit-buffer buffer) |
|
|
527 (pymacs-forget-mutability t)) |
|
|
528 (pymacs-apply "zombie_python" pymacs-used-ids))) |
|
|
529 (setq pymacs-weak-hash (make-hash-table :weakness 'value))) |
|
|
530 (if (boundp 'post-gc-hook) |
|
|
531 (add-hook 'post-gc-hook 'pymacs-schedule-gc) |
|
|
532 (setq pymacs-gc-timer (run-at-time 20 20 'pymacs-schedule-gc)))) |
|
|
533 ;; If nothing failed, only then declare that Pymacs has started! |
|
|
534 (setq pymacs-transit-buffer buffer))) |
|
|
535 |
|
|
536 (defun pymacs-terminate-services () |
|
|
537 ;; This function is mainly provided for documentation purposes. |
|
|
538 (interactive) |
|
|
539 (garbage-collect) |
|
|
540 (pymacs-garbage-collect) |
|
|
541 (when (or (not pymacs-used-ids) |
|
|
542 (yes-or-no-p "\ |
|
|
543 Killing the Pymacs helper might create zombie objects. Kill? ")) |
|
|
544 (cond ((boundp 'post-gc-hook) |
|
|
545 (remove-hook 'post-gc-hook 'pymacs-schedule-gc)) |
|
|
546 ((timerp pymacs-gc-timer) |
|
|
547 (cancel-timer pymacs-gc-timer))) |
|
|
548 (when pymacs-transit-buffer |
|
|
549 (kill-buffer pymacs-transit-buffer)) |
|
|
550 (setq pymacs-gc-running nil |
|
|
551 pymacs-gc-timer nil |
|
|
552 pymacs-transit-buffer nil |
|
|
553 pymacs-lisp nil |
|
|
554 pymacs-freed-list nil))) |
|
|
555 |
|
|
556 (defun pymacs-serve-until-reply (action inserter) |
|
|
557 ;; This function builds a Python request by printing ACTION and |
|
|
558 ;; evaluating INSERTER, which itself prints an argument. It then |
|
|
559 ;; sends the request to the Pymacs helper, and serves all |
|
|
560 ;; sub-requests coming from the Python side, until either a reply or |
|
|
561 ;; an error is finally received. |
|
|
562 (unless (and pymacs-transit-buffer |
|
|
563 (buffer-name pymacs-transit-buffer) |
|
|
564 (get-buffer-process pymacs-transit-buffer)) |
|
|
565 (pymacs-start-services)) |
|
|
566 (when pymacs-gc-wanted |
|
|
567 (pymacs-garbage-collect)) |
|
|
568 (let ((inhibit-quit t) |
|
|
569 done value) |
|
|
570 (while (not done) |
|
|
571 (let ((form (pymacs-round-trip action inserter))) |
|
|
572 (setq action (car form)) |
|
|
573 (when (eq action 'free) |
|
|
574 (pymacs-free-lisp (cadr form)) |
|
|
575 (setq form (cddr form) |
|
|
576 action (car form))) |
|
|
577 (let* ((pair (pymacs-interruptible-eval (cadr form))) |
|
|
578 (success (cdr pair))) |
|
|
579 (setq value (car pair)) |
|
|
580 (cond ((eq action 'eval) |
|
|
581 (if success |
|
|
582 (setq action "return" |
|
|
583 inserter `(pymacs-print-for-eval ',value)) |
|
|
584 (setq action "raise" |
|
|
585 inserter `(let ((pymacs-forget-mutability t)) |
|
|
586 (pymacs-print-for-eval ,value))))) |
|
|
587 ((eq action 'expand) |
|
|
588 (if success |
|
|
589 (setq action "return" |
|
|
590 inserter `(let ((pymacs-forget-mutability t)) |
|
|
591 (pymacs-print-for-eval ,value))) |
|
|
592 (setq action "raise" |
|
|
593 inserter `(let ((pymacs-forget-mutability t)) |
|
|
594 (pymacs-print-for-eval ,value))))) |
|
|
595 ((eq action 'return) |
|
|
596 (if success |
|
|
597 (setq done t) |
|
|
598 (pymacs-report-error "%s" value))) |
|
|
599 ((eq action 'raise) |
|
|
600 (if success |
|
|
601 (pymacs-report-error "Python: %s" value) |
|
|
602 (pymacs-report-error "%s" value))) |
|
|
603 (t (pymacs-report-error "Protocol error: %s" form)))))) |
|
|
604 value)) |
|
|
605 |
|
|
606 (defun pymacs-round-trip (action inserter) |
|
|
607 ;; This function produces a Python request by printing and |
|
|
608 ;; evaluating INSERTER, which itself prints an argument. It sends |
|
|
609 ;; the request to the Pymacs helper, awaits for any kind of reply, |
|
|
610 ;; and returns it. |
|
|
611 (with-current-buffer pymacs-transit-buffer |
|
|
612 ;; Possibly trim the beginning of the transit buffer. |
|
|
613 (cond ((not pymacs-trace-transit) |
|
|
614 (erase-buffer)) |
|
|
615 ((consp pymacs-trace-transit) |
|
|
616 (when (> (buffer-size) (cdr pymacs-trace-transit)) |
|
|
617 (let ((cut (- (buffer-size) (car pymacs-trace-transit)))) |
|
|
618 (when (> cut 0) |
|
|
619 (save-excursion |
|
|
620 (goto-char cut) |
|
|
621 (unless (memq (preceding-char) '(0 ?\n)) |
|
|
622 (forward-line 1)) |
|
|
623 (delete-region (point-min) (point)))))))) |
|
|
624 ;; Send the request, wait for a reply, and process it. |
|
|
625 (let* ((process (get-buffer-process pymacs-transit-buffer)) |
|
|
626 (status (process-status process)) |
|
|
627 (marker (process-mark process)) |
|
|
628 (moving (= (point) marker)) |
|
|
629 send-position reply-position reply) |
|
|
630 (save-excursion |
|
|
631 (save-match-data |
|
|
632 ;; Encode request. |
|
|
633 (setq send-position (marker-position marker)) |
|
|
634 (let ((standard-output marker)) |
|
|
635 (princ action) |
|
|
636 (princ " ") |
|
|
637 (eval inserter)) |
|
|
638 (goto-char marker) |
|
|
639 (unless (= (preceding-char) ?\n) |
|
|
640 (princ "\n" marker)) |
|
|
641 ;; Send request text. |
|
|
642 (goto-char send-position) |
|
|
643 (insert (format ">%d\t" (- marker send-position))) |
|
|
644 (setq reply-position (marker-position marker)) |
|
|
645 (process-send-region process send-position marker) |
|
|
646 ;; Receive reply text. |
|
|
647 (while (and (eq status 'run) |
|
|
648 (progn |
|
|
649 (goto-char reply-position) |
|
|
650 (not (re-search-forward "<\\([0-9]+\\)\t" nil t)))) |
|
|
651 (unless (accept-process-output process pymacs-timeout-at-reply) |
|
|
652 (setq status (process-status process)))) |
|
|
653 (when (eq status 'run) |
|
|
654 (let ((limit-position (+ (match-end 0) |
|
|
655 (string-to-number (match-string 1))))) |
|
|
656 (while (and (eq status 'run) |
|
|
657 (< (marker-position marker) limit-position)) |
|
|
658 (unless (accept-process-output process pymacs-timeout-at-line) |
|
|
659 (setq status (process-status process)))))) |
|
|
660 ;; Decode reply. |
|
|
661 (if (not (eq status 'run)) |
|
|
662 (pymacs-report-error "Pymacs helper status is `%S'" status) |
|
|
663 (goto-char (match-end 0)) |
|
|
664 (setq reply (read (current-buffer)))))) |
|
|
665 (when (and moving (not pymacs-trace-transit)) |
|
|
666 (goto-char marker)) |
|
|
667 reply))) |
|
|
668 |
|
|
669 (defun pymacs-interruptible-eval (expression) |
|
|
670 ;; This function produces a pair (VALUE . SUCCESS) for EXPRESSION. |
|
|
671 ;; A cautious evaluation of EXPRESSION is attempted, and any |
|
|
672 ;; error while evaluating is caught, including Emacs quit (C-g). |
|
|
673 ;; Any Emacs quit also gets forward as a SIGINT to the Pymacs handler. |
|
|
674 ;; With SUCCESS being true, VALUE is the expression value. |
|
|
675 ;; With SUCCESS being false, VALUE is an interruption diagnostic. |
|
|
676 (condition-case info |
|
|
677 (cons (let ((inhibit-quit nil)) (eval expression)) t) |
|
|
678 (quit (setq quit-flag t) |
|
|
679 (interrupt-process pymacs-transit-buffer) |
|
|
680 (cons "*Interrupted!*" nil)) |
|
|
681 (error (cons (prin1-to-string info) nil)))) |
|
|
682 |
|
|
683 (defun pymacs-proper-list-p (expression) |
|
|
684 ;; Tell if a list is proper, id est, that it is `nil' or ends with `nil'. |
|
|
685 (cond ((not expression)) |
|
|
686 ((consp expression) (not (cdr (last expression)))))) |
|
|
687 |
|
|
688 (provide 'pymacs) |
