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

   1
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; MODULE      : texmacs-client.scm
   5 ;; DESCRIPTION : clients of 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-client))
  15
  16 (define client-active? #f)
  17 (define client-waiting? #f)
  18
  19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20 ;; Asynchroneous clients
  21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22
  23 (define (client-eval cmd)
  24   ;;(display* "Client command: " cmd "\n")
  25   (object->string* (eval (string->object cmd))))
  26
  27 (tm-define (client-add)
  28   (set! client-active? #t)
  29   (with wait 1
  30     (delayed
  31       (:while client-active?)
  32       (:pause ((lambda () (inexact->exact wait))))
  33       (:do (set! wait (min (* 1.001 wait) 2500)))
  34       (when (not client-waiting?)
  35         (with cmd (client-read)
  36           (when (!= cmd "")
  37             (with result (client-eval cmd)
  38               (client-write result)
  39               (set! wait 1))))))))
  40
  41 (tm-define (client-remove)
  42   (set! client-active? #f))
  43
  44 (define (client-remote-sub cmd return)
  45   (when (not client-waiting?)
  46     (set! client-waiting? #t)
  47     (client-write (object->string* cmd))
  48     (with wait 1
  49       (delayed
  50         (:while client-waiting?)
  51         (:pause ((lambda () (inexact->exact wait))))
  52         (:do (set! wait (min (* 1.001 wait) 2500)))
  53         (with result (client-read)
  54           (when (!= result "")
  55             (set! client-waiting? #f)
  56             (set! wait 1)
  57             (return (string->object result))))))))
  58
  59 (tm-define (client-remote cmd)
  60   (if dialogue-break
  61       (dialogue-user local-continue
  62         (with return (dialogue-machine local-continue)
  63           (client-remote-sub cmd return)))
  64       (texmacs-error "dialogue-ask" "Not in dialogue")))