Source

python emacs / pymacs.el

Full commit
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
;;; Interface between Emacs Lisp and Python - Lisp part.    -*- emacs-lisp -*-
;;; Copyright © 2001, 2002, 2003 Progiciels Bourbeau-Pinard inc.
;;; François Pinard <pinard@iro.umontreal.ca>, 2001.

;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software Foundation,
;;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.  */

;;; Portability stunts.

(defvar pymacs-use-hash-tables
  (and (fboundp 'make-hash-table) (fboundp 'gethash) (fboundp 'puthash))
  "Set to t if hash tables are available.")

(eval-and-compile

  (if (fboundp 'multibyte-string-p)
      (defalias 'pymacs-multibyte-string-p 'multibyte-string-p)
    (defun pymacs-multibyte-string-p (string)
      "Tell XEmacs if STRING should be handled as multibyte."
      (not (equal (find-charset-string string) '(ascii))))))

(defalias 'pymacs-report-error (symbol-function 'error))

;;; Published variables and functions.

(defvar pymacs-load-path nil
  "List of additional directories to search for Python modules.
The directories listed will be searched first, in the order given.")

(defvar pymacs-trace-transit '(5000 . 30000)
  "Keep the communication buffer growing, for debugging.
When this variable is nil, the `*Pymacs*' communication buffer gets erased
before each communication round-trip.  Setting it to `t' guarantees that
the full communication is saved, which is useful for debugging.
It could also be given as (KEEP . LIMIT): whenever the buffer exceeds LIMIT
bytes, it is reduced to approximately KEEP bytes.")

(defvar pymacs-forget-mutability nil
  "Transmit copies to Python instead of Lisp handles, as much as possible.
When this variable is nil, most mutable objects are transmitted as handles.
This variable is meant to be temporarily rebound to force copies.")

(defvar pymacs-mutable-strings nil
  "Prefer transmitting Lisp strings to Python as handles.
When this variable is nil, strings are transmitted as copies, and the
Python side thus has no way for modifying the original Lisp strings.
This variable is ignored whenever `forget-mutability' is set.")

(defvar pymacs-timeout-at-start 30
  "Maximum reasonable time, in seconds, for starting the Pymacs helper.
A machine should be pretty loaded before one needs to increment this.")

(defvar pymacs-timeout-at-reply 5
  "Expected maximum time, in seconds, to get the first line of a reply.
The status of the Pymacs helper is checked at every such timeout.")

(defvar pymacs-timeout-at-line 2
  "Expected maximum time, in seconds, to get another line of a reply.
The status of the Pymacs helper is checked at every such timeout.")

(defvar pymacs-dreadful-zombies nil
  "If zombies should trigger hard errors, whenever they get called.
If `nil', calling a zombie will merely produce a diagnostic message.")

(defun pymacs-load (module &optional prefix noerror)
  "Import the Python module named MODULE into Emacs.
Each function in the Python module is made available as an Emacs function.
The Lisp name of each function is the concatenation of PREFIX with
the Python name, in which underlines are replaced by dashes.  If PREFIX is
not given, it defaults to MODULE followed by a dash.
If NOERROR is not nil, do not raise error when the module is not found."
  (interactive
   (let* ((module (read-string "Python module? "))
          (default (concat (car (last (split-string module "\\."))) "-"))
          (prefix (read-string (format "Prefix? [%s] " default)
                               nil nil default)))
     (list module prefix)))
  (message "Pymacs loading %s..." module)
  (let ((lisp-code (pymacs-call "pymacs_load_helper" module prefix)))
    (cond (lisp-code (let ((result (eval lisp-code)))
                       (message "Pymacs loading %s...done" module)
                       result))
          (noerror (message "Pymacs loading %s...failed" module) nil)
          (t (pymacs-report-error "Pymacs loading %s...failed" module)))))

(defun pymacs-eval (text)
  "Compile TEXT as a Python expression, and return its value."
  (interactive "sPython expression? ")
  (let ((value (pymacs-serve-until-reply "eval" `(princ ,text))))
    (when (interactive-p)
      (message "%S" value))
    value))

(defun pymacs-exec (text)
  "Compile and execute TEXT as a sequence of Python statements.
This functionality is experimental, and does not appear to be useful."
  (interactive "sPython statements? ")
  (let ((value (pymacs-serve-until-reply "exec" `(princ ,text))))
    (when (interactive-p)
      (message "%S" value))
    value))

(defun pymacs-call (function &rest arguments)
  "Return the result of calling a Python function FUNCTION over ARGUMENTS.
FUNCTION is a string denoting the Python function, ARGUMENTS are separate
Lisp expressions, one per argument.  Immutable Lisp constants are converted
to Python equivalents, other structures are converted into Lisp handles."
  (pymacs-serve-until-reply
   "eval" `(pymacs-print-for-apply ',function ',arguments)))

(defun pymacs-apply (function arguments)
  "Return the result of calling a Python function FUNCTION over ARGUMENTS.
FUNCTION is a string denoting the Python function, ARGUMENTS is a list of
Lisp expressions.  Immutable Lisp constants are converted to Python
equivalents, other structures are converted into Lisp handles."
  (pymacs-serve-until-reply
   "eval" `(pymacs-print-for-apply ',function ',arguments)))

;;; Integration details.

;; Python functions and modules should ideally look like Lisp functions and
;; modules.  This page tries to increase the integration seamlessness.

(defadvice documentation (around pymacs-ad-documentation activate)
  ;; Integration of doc-strings.
  (let* ((reference (pymacs-python-reference function))
         (python-doc (when reference
                       (pymacs-eval (format "doc_string(%s)" reference)))))
    (if (or reference python-doc)
        (setq ad-return-value
              (concat
               "It interfaces to a Python function.\n\n"
               (when python-doc
                 (if raw python-doc (substitute-command-keys python-doc)))))
      ad-do-it)))

(defun pymacs-python-reference (object)
  ;; Return the text reference of a Python object if possible, else nil.
  (when (functionp object)
    (let* ((definition (indirect-function object))
           (body (and (pymacs-proper-list-p definition)
                      (> (length definition) 2)
                      (eq (car definition) 'lambda)
                      (cddr definition))))
      (when (and body (listp (car body)) (eq (caar body) 'interactive))
        ;; Skip the interactive specification of a function.
        (setq body (cdr body)))
      (when (and body
                 ;; Advised functions start with a string.
                 (not (stringp (car body)))
                 ;; Python trampolines hold exactly one expression.
                 (= (length body) 1))
        (let ((expression (car body)))
          ;; EXPRESSION might now hold something like:
          ;;    (pymacs-apply (quote (pymacs-python . N)) ARGUMENT-LIST)
          (when (and (pymacs-proper-list-p expression)
                     (= (length expression) 3)
                     (eq (car expression) 'pymacs-apply)
                     (eq (car (cadr expression)) 'quote))
            (setq object (cadr (cadr expression))))))))
  (when (eq (car-safe object) 'pymacs-python)
    (format "python[%d]" (cdr object))))

;; The following functions are experimental -- they are not satisfactory yet.

(defun pymacs-file-handler (operation &rest arguments)
  ;; Integration of load-file, autoload, etc.
  ;; Emacs might want the contents of some `MODULE.el' which does not exist,
  ;; while there is a `MODULE.py' or `MODULE.pyc' file in the same directory.
  ;; The goal is to generate a virtual contents for this `MODULE.el' file, as
  ;; a set of Lisp trampoline functions to the Python module functions.
  ;; Python modules can then be loaded or autoloaded as if they were Lisp.
  (cond ((and (eq operation 'file-readable-p)
              (let ((module (substring (car arguments) 0 -3)))
                (or (pymacs-file-force operation arguments)
                    (file-readable-p (concat module ".py"))
                    (file-readable-p (concat module ".pyc"))))))
        ((and (eq operation 'load)
              (not (pymacs-file-force
                    'file-readable-p (list (car arguments))))
              (file-readable-p (car arguments)))
         (let ((lisp-code (pymacs-call "pymacs_load_helper"
                                       (substring (car arguments) 0 -3)
                                       nil)))
           (unless lisp-code
             (pymacs-report-error "Python import error"))
           (eval lisp-code)))
        ((and (eq operation 'insert-file-contents)
              (not (pymacs-file-force
                    'file-readable-p (list (car arguments))))
              (file-readable-p (car arguments)))
         (let ((lisp-code (pymacs-call "pymacs_load_helper"
                                       (substring (car arguments) 0 -3)
                                       nil)))
           (unless lisp-code
             (pymacs-report-error "Python import error"))
           (insert (prin1-to-string lisp-code))))
        (t (pymacs-file-force operation arguments))))

(defun pymacs-file-force (operation arguments)
  ;; Bypass the file handler.
  (let ((inhibit-file-name-handlers
         (cons 'pymacs-file-handler
               (and (eq inhibit-file-name-operation operation)
                    inhibit-file-name-handlers)))
        (inhibit-file-name-operation operation))
    (apply operation arguments)))

;(add-to-list 'file-name-handler-alist '("\\.el\\'" . pymacs-file-handler))

;;; Gargabe collection of Python IDs.

;; Python objects which have no Lisp representation are allocated on the
;; Python side as `python[INDEX]', and INDEX is transmitted to Emacs, with
;; the value to use on the Lisp side for it.  Whenever Lisp does not need a
;; Python object anymore, it should be freed on the Python side.  The
;; following variables and functions are meant to fill this duty.

(defvar pymacs-used-ids nil
  "List of received IDs, currently allocated on the Python side.")

(defvar pymacs-weak-hash nil
  "Weak hash table, meant to find out which IDs are still needed.")

(defvar pymacs-gc-wanted nil
  "Flag if it is time to clean up unused IDs on the Python side.")

(defvar pymacs-gc-running nil
  "Flag telling that a Pymacs garbage collection is in progress.")

(defvar pymacs-gc-timer nil
  "Timer to trigger Pymacs garbage collection at regular time intervals.
The timer is used only if `post-gc-hook' is not available.")

(defun pymacs-schedule-gc (&optional xemacs-list)
  (unless pymacs-gc-running
    (setq pymacs-gc-wanted t)))

(defun pymacs-garbage-collect ()
  ;; Clean up unused IDs on the Python side.
  (when pymacs-use-hash-tables
    (let ((pymacs-gc-running t)
          (pymacs-forget-mutability t)
          (ids pymacs-used-ids)
          used-ids unused-ids)
      (while ids
        (let ((id (car ids)))
          (setq ids (cdr ids))
          (if (gethash id pymacs-weak-hash)
              (setq used-ids (cons id used-ids))
            (setq unused-ids (cons id unused-ids)))))
      (setq pymacs-used-ids used-ids
            pymacs-gc-wanted nil)
      (when unused-ids
        (pymacs-apply "free_python" unused-ids)))))

(defun pymacs-defuns (arguments)
  ;; Take one argument, a list holding a number of items divisible by 3.  The
  ;; first argument is an INDEX, the second is a NAME, the third is the
  ;; INTERACTION specification, and so forth.  Register Python INDEX with a
  ;; function with that NAME and INTERACTION on the Lisp side.  The strange
  ;; calling convention is to minimise quoting at call time.
  (while (>= (length arguments) 3)
    (let ((index (nth 0 arguments))
          (name (nth 1 arguments))
          (interaction (nth 2 arguments)))
      (fset name (pymacs-defun index interaction))
      (setq arguments (nthcdr 3 arguments)))))

(defun pymacs-defun (index interaction)
  ;; Register INDEX on the Lisp side with a Python object that is a function,
  ;; and return a lambda form calling that function.  If the INTERACTION
  ;; specification is nil, the function is not interactive.  Otherwise, the
  ;; function is interactive, INTERACTION is then either a string, or the
  ;; index of an argument-less Python function returning the argument list.
  (let ((object (pymacs-python index)))
    (cond ((null interaction)
           `(lambda (&rest arguments)
              (pymacs-apply ',object arguments)))
          ((stringp interaction)
           `(lambda (&rest arguments)
              (interactive ,interaction)
              (pymacs-apply ',object arguments)))
          (t `(lambda (&rest arguments)
                (interactive (pymacs-call ',(pymacs-python interaction)))
                (pymacs-apply ',object arguments))))))

(defun pymacs-python (index)
  ;; Register on the Lisp side a Python object having INDEX, and return it.
  ;; The result is meant to be recognised specially by `print-for-eval', and
  ;; in the function position by `print-for-apply'.
  (let ((object (cons 'pymacs-python index)))
    (when pymacs-use-hash-tables
      (puthash index object pymacs-weak-hash)
      (setq pymacs-used-ids (cons index pymacs-used-ids)))
    object))

;;; Generating Python code.

;; Many Lisp expressions cannot fully be represented in Python, at least
;; because the object is mutable on the Lisp side.  Such objects are allocated
;; somewhere into a vector of handles, and the handle index is used for
;; communication instead of the expression itself.

(defvar pymacs-lisp nil
  "Vector of handles to hold transmitted expressions.")

(defvar pymacs-freed-list nil
  "List of unallocated indices in Lisp.")

;; When the Python GC is done with a Lisp object, a communication occurs so to
;; free the object on the Lisp side as well.

(defun pymacs-allocate-lisp (expression)
  ;; This function allocates some handle for an EXPRESSION, and return its
  ;; index.
  (unless pymacs-freed-list
    (let* ((previous pymacs-lisp)
           (old-size (length previous))
           (new-size (if (zerop old-size) 100 (+ old-size (/ old-size 2))))
           (counter new-size))
      (setq pymacs-lisp (make-vector new-size nil))
      (while (> counter 0)
        (setq counter (1- counter))
        (if (< counter old-size)
            (aset pymacs-lisp counter (aref previous counter))
          (setq pymacs-freed-list (cons counter pymacs-freed-list))))))
  (let ((index (car pymacs-freed-list)))
    (setq pymacs-freed-list (cdr pymacs-freed-list))
    (aset pymacs-lisp index expression)
    index))

(defun pymacs-free-lisp (indices)
  ;; This function is triggered from Python side for Lisp handles which lost
  ;; their last reference.  These references should be cut on the Lisp side as
  ;; well, or else, the objects will never be garbage-collected.
  (while indices
    (let ((index (car indices)))
      (aset pymacs-lisp index nil)
      (setq pymacs-freed-list (cons index pymacs-freed-list)
            indices (cdr indices)))))

(defun pymacs-print-for-apply (function arguments)
  ;; This function prints a Python expression calling FUNCTION, which is a
  ;; string naming a Python function, or a Python reference, over all its
  ;; ARGUMENTS, which are Lisp expressions.
  (let ((separator "")
        argument)
    (if (eq (car-safe function) 'pymacs-python)
        (princ (format "python[%d]" (cdr function)))
      (princ function))
    (princ "(")
    (while arguments
      (setq argument (car arguments)
            arguments (cdr arguments))
      (princ separator)
      (setq separator ", ")
      (pymacs-print-for-eval argument))
    (princ ")")))

(defun pymacs-print-for-eval (expression)
  ;; This function prints a Python expression out of a Lisp EXPRESSION.
  (let (done)
    (cond ((not expression)
           (princ "None")
           (setq done t))
          ((eq expression t)
           (princ "True")
           (setq done t))
          ((numberp expression)
           (princ expression)
           (setq done t))
          ((stringp expression)
           (when (or pymacs-forget-mutability
                     (not pymacs-mutable-strings))
             (let* ((multibyte (pymacs-multibyte-string-p expression))
                    (text (if multibyte
                              (encode-coding-string expression 'utf-8)
                            (copy-sequence expression))))
               (set-text-properties 0 (length text) nil text)
               (princ (mapconcat 'identity
                                 (split-string (prin1-to-string text) "\n")
                                 "\\n"))
               (when (and multibyte
                          (not (equal (find-charset-string text) '(ascii))))
                 (princ ".decode('UTF-8')")))
             (setq done t)))
          ((symbolp expression)
           (let ((name (symbol-name expression)))
             ;; The symbol can only be transmitted when in the main oblist.
             (when (eq expression (intern-soft name))
               (princ "lisp[")
               (prin1 name)
               (princ "]")
               (setq done t))))
          ((vectorp expression)
           (when pymacs-forget-mutability
             (let ((limit (length expression))
                   (counter 0))
               (princ "(")
               (while (< counter limit)
                 (unless (zerop counter)
                   (princ ", "))
                 (pymacs-print-for-eval (aref expression counter))
                 (setq counter (1+ counter)))
               (when (= limit 1)
                 (princ ","))
               (princ ")")
               (setq done t))))
          ((eq (car-safe expression) 'pymacs-python)
           (princ "python[")
           (princ (cdr expression))
           (princ "]")
           (setq done t))
          ((pymacs-proper-list-p expression)
           (when pymacs-forget-mutability
             (princ "[")
             (pymacs-print-for-eval (car expression))
             (while (setq expression (cdr expression))
               (princ ", ")
               (pymacs-print-for-eval (car expression)))
             (princ "]")
             (setq done t))))
    (unless done
      (let ((class (cond ((vectorp expression) "Vector")
                         ((and pymacs-use-hash-tables
                               (hash-table-p expression))
                          "Table")
                         ((bufferp expression) "Buffer")
                         ((pymacs-proper-list-p expression) "List")
                         (t "Lisp"))))
        (princ class)
        (princ "(")
        (princ (pymacs-allocate-lisp expression))
        (princ ")")))))

;;; Communication protocol.

(defvar pymacs-transit-buffer nil
  "Communication buffer between Emacs and Python.")

;; The principle behind the communication protocol is that it is easier to
;; generate than parse, and that each language already has its own parser.
;; So, the Emacs side generates Python text for the Python side to interpret,
;; while the Python side generates Lisp text for the Lisp side to interpret.
;; About nothing but expressions are transmitted, which are evaluated on
;; arrival.  The pseudo `reply' function is meant to signal the final result
;; of a series of exchanges following a request, while the pseudo `error'
;; function is meant to explain why an exchange could not have been completed.

;; The protocol itself is rather simple, and contains human readable text
;; only.  A message starts at the beginning of a line in the communication
;; buffer, either with `>' for the Lisp to Python direction, or `<' for the
;; Python to Lisp direction.  This is followed by a decimal number giving the
;; length of the message text, a TAB character, and the message text itself.
;; Message direction alternates systematically between messages, it never
;; occurs that two successive messages are sent in the same direction.  The
;; first message is received from the Python side, it is `(version VERSION)'.

(defun pymacs-start-services ()
  ;; This function gets called automatically, as needed.
  (let ((buffer (get-buffer-create "*Pymacs*")))
    (with-current-buffer buffer
      (buffer-disable-undo)
      (set-buffer-multibyte nil)
      (set-buffer-file-coding-system 'raw-text)
      (save-match-data
        ;; Launch the Pymacs helper.
        (let ((process
               (apply 'start-process "pymacs" buffer
                      (let ((python (getenv "PYMACS_PYTHON")))
                        (if (or (null python) (equal python ""))
                            "python"
                          python))
                      "-c" (concat "import sys;"
                                   " from Pymacs.pymacs import main;"
                                   " main(*sys.argv[1:])")
                      (mapcar 'expand-file-name pymacs-load-path))))
          (cond ((fboundp 'set-process-query-on-exit-flag)
                 (set-process-query-on-exit-flag process nil))
                ((fboundp 'process-kill-without-query-process)
                (process-query-on-exit-flag process)))
          ;; Receive the synchronising reply.
          (while (progn
                   (goto-char (point-min))
                   (not (re-search-forward "<\\([0-9]+\\)\t" nil t)))
            (unless (accept-process-output process pymacs-timeout-at-start)
              (pymacs-report-error
               "Pymacs helper did not start within %d seconds"
                     pymacs-timeout-at-start)))
          (let ((marker (process-mark process))
                (limit-position (+ (match-end 0)
                                   (string-to-number (match-string 1)))))
            (while (< (marker-position marker) limit-position)
              (unless (accept-process-output process pymacs-timeout-at-start)
                (pymacs-report-error
                 "Pymacs helper probably was interrupted at start")))))
        ;; Check that synchronisation occurred.
        (goto-char (match-end 0))
        (let ((reply (read (current-buffer))))
          (if (and (pymacs-proper-list-p reply)
                   (= (length reply) 2)
                   (eq (car reply) 'version))
              (unless (string-equal (cadr reply) "0.23")
                (pymacs-report-error
                 "Pymacs Lisp version is 0.23, Python is %s"
                 (cadr reply)))
            (pymacs-report-error "Pymacs got an invalid initial reply")))))
    (when pymacs-use-hash-tables
      (if pymacs-weak-hash
          ;; A previous Pymacs session occurred in *this* Emacs session.  Some
          ;; IDs may hang around, which do not correspond to anything on the
          ;; Python side.  Python should not recycle such IDs for new objects.
          (when pymacs-used-ids
            (let ((pymacs-transit-buffer buffer)
                  (pymacs-forget-mutability t))
              (pymacs-apply "zombie_python" pymacs-used-ids)))
        (setq pymacs-weak-hash (make-hash-table :weakness 'value)))
      (if (boundp 'post-gc-hook)
          (add-hook 'post-gc-hook 'pymacs-schedule-gc)
        (setq pymacs-gc-timer (run-at-time 20 20 'pymacs-schedule-gc))))
    ;; If nothing failed, only then declare that Pymacs has started!
    (setq pymacs-transit-buffer buffer)))

(defun pymacs-terminate-services ()
  ;; This function is mainly provided for documentation purposes.
  (interactive)
  (garbage-collect)
  (pymacs-garbage-collect)
  (when (or (not pymacs-used-ids)
            (yes-or-no-p "\
Killing the Pymacs helper might create zombie objects.  Kill? "))
    (cond ((boundp 'post-gc-hook)
           (remove-hook 'post-gc-hook 'pymacs-schedule-gc))
          ((timerp pymacs-gc-timer)
           (cancel-timer pymacs-gc-timer)))
    (when pymacs-transit-buffer
      (kill-buffer pymacs-transit-buffer))
    (setq pymacs-gc-running nil
          pymacs-gc-timer nil
          pymacs-transit-buffer nil
          pymacs-lisp nil
          pymacs-freed-list nil)))

(defun pymacs-serve-until-reply (action inserter)
  ;; This function builds a Python request by printing ACTION and
  ;; evaluating INSERTER, which itself prints an argument.  It then
  ;; sends the request to the Pymacs helper, and serves all
  ;; sub-requests coming from the Python side, until either a reply or
  ;; an error is finally received.
  (unless (and pymacs-transit-buffer
               (buffer-name pymacs-transit-buffer)
               (get-buffer-process pymacs-transit-buffer))
    (pymacs-start-services))
  (when pymacs-gc-wanted
    (pymacs-garbage-collect))
  (let ((inhibit-quit t)
        done value)
    (while (not done)
      (let ((form (pymacs-round-trip action inserter)))
        (setq action (car form))
        (when (eq action 'free)
          (pymacs-free-lisp (cadr form))
          (setq form (cddr form)
                action (car form)))
        (let* ((pair (pymacs-interruptible-eval (cadr form)))
               (success (cdr pair)))
          (setq value (car pair))
          (cond ((eq action 'eval)
                 (if success
                     (setq action "return"
                           inserter `(pymacs-print-for-eval ',value))
                   (setq action "raise"
                         inserter `(let ((pymacs-forget-mutability t))
                                     (pymacs-print-for-eval ,value)))))
                ((eq action 'expand)
                 (if success
                     (setq action "return"
                           inserter `(let ((pymacs-forget-mutability t))
                                       (pymacs-print-for-eval ,value)))
                   (setq action "raise"
                         inserter `(let ((pymacs-forget-mutability t))
                                     (pymacs-print-for-eval ,value)))))
                ((eq action 'return)
                 (if success
                     (setq done t)
                   (pymacs-report-error "%s" value)))
                ((eq action 'raise)
                 (if success
                     (pymacs-report-error "Python: %s" value)
                   (pymacs-report-error "%s" value)))
                (t (pymacs-report-error "Protocol error: %s" form))))))
    value))

(defun pymacs-round-trip (action inserter)
  ;; This function produces a Python request by printing and
  ;; evaluating INSERTER, which itself prints an argument.  It sends
  ;; the request to the Pymacs helper, awaits for any kind of reply,
  ;; and returns it.
  (with-current-buffer pymacs-transit-buffer
    ;; Possibly trim the beginning of the transit buffer.
    (cond ((not pymacs-trace-transit)
           (erase-buffer))
          ((consp pymacs-trace-transit)
           (when (> (buffer-size) (cdr pymacs-trace-transit))
             (let ((cut (- (buffer-size) (car pymacs-trace-transit))))
               (when (> cut 0)
                 (save-excursion
                   (goto-char cut)
                   (unless (memq (preceding-char) '(0 ?\n))
                     (forward-line 1))
                   (delete-region (point-min) (point))))))))
    ;; Send the request, wait for a reply, and process it.
    (let* ((process (get-buffer-process pymacs-transit-buffer))
           (status (process-status process))
           (marker (process-mark process))
           (moving (= (point) marker))
           send-position reply-position reply)
      (save-excursion
        (save-match-data
          ;; Encode request.
          (setq send-position (marker-position marker))
          (let ((standard-output marker))
            (princ action)
            (princ " ")
            (eval inserter))
          (goto-char marker)
          (unless (= (preceding-char) ?\n)
            (princ "\n" marker))
          ;; Send request text.
          (goto-char send-position)
          (insert (format ">%d\t" (- marker send-position)))
          (setq reply-position (marker-position marker))
          (process-send-region process send-position marker)
          ;; Receive reply text.
          (while (and (eq status 'run)
                      (progn
                        (goto-char reply-position)
                        (not (re-search-forward "<\\([0-9]+\\)\t" nil t))))
            (unless (accept-process-output process pymacs-timeout-at-reply)
              (setq status (process-status process))))
          (when (eq status 'run)
            (let ((limit-position (+ (match-end 0)
                                     (string-to-number (match-string 1)))))
              (while (and (eq status 'run)
                          (< (marker-position marker) limit-position))
                (unless (accept-process-output process pymacs-timeout-at-line)
                  (setq status (process-status process))))))
          ;; Decode reply.
          (if (not (eq status 'run))
              (pymacs-report-error "Pymacs helper status is `%S'" status)
            (goto-char (match-end 0))
            (setq reply (read (current-buffer))))))
      (when (and moving (not pymacs-trace-transit))
        (goto-char marker))
      reply)))

(defun pymacs-interruptible-eval (expression)
  ;; This function produces a pair (VALUE . SUCCESS) for EXPRESSION.
  ;; A cautious evaluation of EXPRESSION is attempted, and any
  ;; error while evaluating is caught, including Emacs quit (C-g).
  ;; Any Emacs quit also gets forward as a SIGINT to the Pymacs handler.
  ;; With SUCCESS being true, VALUE is the expression value.
  ;; With SUCCESS being false, VALUE is an interruption diagnostic.
  (condition-case info
      (cons (let ((inhibit-quit nil)) (eval expression)) t)
    (quit (setq quit-flag t)
          (interrupt-process pymacs-transit-buffer)
          (cons "*Interrupted!*" nil))
    (error (cons (prin1-to-string info) nil))))

(defun pymacs-proper-list-p (expression)
  ;; Tell if a list is proper, id est, that it is `nil' or ends with `nil'.
  (cond ((not expression))
        ((consp expression) (not (cdr (last expression))))))

(provide 'pymacs)