Re: Solution: Extension for non-polling and non-blocking input

From: M.Vodslon <vodslon_at_fokus.gmd.de>
Date: Tue, 11 Oct 1994 15:10:31 +0100

Oops, in my previous message I included an old version of the STk
program to test the extension. Here is the correct version.

Miroslav Vodslon

Gesellschaft fuer Mathematik und Datenverarbeitung, Forschungsinstitut
fuer offene Kommunikationssysteme.
Mail: GMD-FOKUS, Hardenbergplatz 2,D-10623 Berlin
Voice: 49-30-25499185. Fax: 49-30-25499202. E-mail: vodslon_at_fokus.gmd.de

----BEGIN testrw.stk----------------------------------
;;;; Test for following extensions of STk2.1.3 from kaolin.unice.fr by
;;;; eg_at_kaolin.unice.fr (Erick Gallesio) :

;;;; run-process and relatives, by Gregory Nickonov, [gn_at_jet.msk.su],
;;;; David Tolpin Dvd_at_CIM.Msk.SU and A.Taranov tay_at_jet.msk.su;

;;;; register-file-handler by Berry Kercheval <kerch_at_parc.xerox.com>;

;;;; my (Miroslav Vodslon, vodslon_at_fokus.gmd.de) very own (:-) char-buffered?.
;;;; and unregister-file-handler.

;;; Load this, then do (test) and click on the "Send to myprocess"
;;; button or type (snd "whatever string" myprocess) several times.
;;; Finaly, kill the cat process from a shell or by clicking on button
;;; "Kill myprocess". DO NOT CALL (process-kill myprocess) without
;;; unregistering the input handler first.

(define myprocess #f)

(define (_read-while-ready port)
  (let ((result '()))
    (while (char-buffered? port) (set! result (cons (read-char port) result)))
    result))

;;; This handler looses. The handler must read the port or it will be
;;; called again!:
'(define (handler port) (display "Input ready!\n"))

;;; This does not work: before the first read-char, fd's buffer is empty.
(define (read-while-ready port)
  (list->string (reverse (_read-while-ready port))))

;;; This one assumes that at least one thing is in buffer. It works.
(define (read-as-long-as-ready port)
  (let ((firstchar (read-char port)))
    (if (eof-object? firstchar) '()
        (list->string (cons firstchar (reverse (_read-while-ready port)))))))

;;; This handler works. It reads the port and it unregisters itself
;;; when port is at end. (If it didn't, and the subprocess died, STk
;;; would dump core; anyway, if process-kill is called without
;;; unregistering the file-handler beforehand, STK will be blocked):
(define (handler port)
  (let ((msg (read-as-long-as-ready port)))
    (display (format #t "got : ~A\n" msg))
    (if (and (null? msg) (input-port? port)) (unregister-file-handler port)))
  )

(define (snd msg proces)
  (display msg (process-input proces))
  (flush (process-input proces)))

(define (untest)
  (destroy .send)
  (destroy .kill)
  (unregister-file-handler (process-output myprocess))
  (set! myprocess '())
)

(define (test)
  (set! myprocess (run-process "cat" '() '(#t #t #t)))
  (register-file-handler handler (process-output myprocess))
  (snd "Initial test message" myprocess)
  (button '.send
          :text "Send to myprocess"
          :command '(begin (display "Button pressed\n")
                           (snd "aaa\nbbbb\ncccccc\nx" myprocess)))
  (button '.kill
          :text "Kill myprocess"
          :command '(begin (destroy .send)
                           (destroy .kill)
                           (unregister-file-handler
                             (process-output myprocess))
                           (process-kill myprocess)
                           ))
  (pack '.send)
  (pack '.kill)
)
----END testrw.stk----------------------------------
Received on Tue Oct 11 1994 - 15:22:00 CET