src/TeXmacs/progs/remote/texmacs-server.scm

   1
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; MODULE      : texmacs-server.scm
   5 ;; DESCRIPTION : TeXmacs servers
   6 ;; COPYRIGHT   : (C) 2007  Joris van der Hoeven
   7 ;;
   8 ;; This software falls under the GNU general public license version 3 or later.
   9 ;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
  10 ;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
  11 ;;
  12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13
  14 (texmacs-module (remote texmacs-server))
  15
  16 (define server-client-active? (make-ahash-table))
  17 (define server-client-waiting? (make-ahash-table))
  18
  19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20 ;; Asynchroneous servers
  21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22
  23 (tm-define (server-clients)
  24   (ahash-set->list server-client-active?))
  25
  26 (define (server-eval cmd)
  27   ;;(display* "Server command: " cmd "\n")
  28   (object->string* (eval (string->object cmd))))
  29
  30 (tm-define (server-add client)
  31   (ahash-set! server-client-active? client #t)
  32   (with wait 1
  33     (delayed
  34       (:while (ahash-ref server-client-active? client))
  35       (:pause ((lambda () (inexact->exact wait))))
  36       (:do (set! wait (min (* 1.001 wait) 2500)))
  37       (when (not (ahash-ref server-client-waiting? client))
  38         (with cmd (server-read client)
  39           (when (!= cmd "")
  40             (with result (server-eval cmd)
  41               (server-write client result)
  42               (set! wait 1))))))))
  43
  44 (tm-define (server-remove client)
  45   (ahash-remove! server-client-active? client))
  46
  47 (define (server-remote-sub client cmd return)
  48   (when (not (ahash-ref server-client-waiting? client))
  49     (ahash-set! server-client-waiting? client #t)
  50     (server-write client (object->string* cmd))
  51     (with wait 1
  52       (delayed
  53         (:while (ahash-ref server-client-waiting? client))
  54         (:pause ((lambda () (inexact->exact wait))))
  55         (:do (set! wait (min (* 1.001 wait) 2500)))
  56         (with result (server-read client)
  57           (when (!= result "")
  58             (ahash-set! server-client-waiting? client #f)
  59             (set! wait 1)
  60             (return (string->object result))))))))
  61
  62 (tm-define (server-remote client cmd)
  63   (if dialogue-break
  64       (dialogue-user local-continue
  65         (with return (dialogue-machine local-continue)
  66           (server-remote-sub client cmd return)))
  67       (texmacs-error "dialogue-ask" "Not in dialogue")))