45 lines
1.5 KiB

;;;; f i l e e v e n t . s t k -- Implement the Tk fileevent commeand
;;;; in term of when-port-{read|writ}able
;;;; For backward compatibility ...
;;;; Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <>
;;;; Permission to use, copy, modify, distribute,and license this
;;;; software and its documentation for any purpose is hereby granted,
;;;; provided that existing copyright notices are retained in all
;;;; copies and that this notice is included verbatim in any
;;;; distributions. No written agreement, license, or royalty fee is
;;;; required for any of the authorized uses.
;;;; This software is provided ``AS IS'' without express or implied
;;;; warranty.
;;;; Author: Erick Gallesio []
;;;; Creation date: 16-Jun-1996 22:37
;;;; Last file update: 3-Sep-1999 19:51 (eg)
(select-module Tk)
(define (fileevent file mode . script)
(define (err)
(error "fileeevent: bad mode specification ~S.\n(Note: fileevent is obsolete; use when-port-readable or when-port-writable)" mode))
(let ((smode (& mode))
(fct #f))
((equal? smode "readable") (set! fct when-port-readable))
((equal? smode "writable") (set! fct when-port-writable))
(ELSE (err)))
(if (null? script)
(fct file)
(let ((s (car script)))
((procedure? s) (fct file s))
((string? s) (if (string=? s "") (fct file #f) (err)))
(ELSE (err)))))))
(define Tk:fileevent fileevent)