- renamed packages
- using srfi-9 instead of defrec-package
This commit is contained in:
parent
9a645ede38
commit
62bb1116e4
|
@ -1,5 +1,5 @@
|
|||
#!/bin/sh
|
||||
exec scsh -lm ../scheme/packages.scm -o threads -o chat-package -o expect-package -o let-opt -e main -s "$0" "$@"
|
||||
exec scsh -lm ../scheme/packages.scm -o threads -o chat -o expect -o let-opt -e main -s "$0" "$@"
|
||||
!#
|
||||
|
||||
;; TODO:
|
||||
|
|
|
@ -28,12 +28,19 @@
|
|||
|
||||
;;; A task is a guy with whom we can interact.
|
||||
|
||||
(define-record task
|
||||
process
|
||||
in
|
||||
out
|
||||
(buf "")
|
||||
(pre-match #f)) ; Everything before the current match.
|
||||
(define-record-type task
|
||||
(really-make-task process in out buf pre-match)
|
||||
task?
|
||||
(process task:process)
|
||||
(in task:in)
|
||||
(out task:out)
|
||||
(buf task:buf set-task:buf!)
|
||||
(pre-match task:pre-match set-task:pre-match!) ;; Everything before
|
||||
;; the current match.
|
||||
)
|
||||
|
||||
(define (make-task process in out)
|
||||
(really-make-task process in out "" #f))
|
||||
|
||||
(define (tsend task fmt . args)
|
||||
(apply format (task:out task) fmt args))
|
||||
|
@ -98,14 +105,14 @@
|
|||
; ;; BUF := some of BUF + all of STR.
|
||||
; ((<= str-size max-size)
|
||||
; (let ((i (- total-size max-size)))
|
||||
; (set-task:pre-match (string-append (task:pre-match task)
|
||||
; (set-task:pre-match! (string-append (task:pre-match task)
|
||||
; (substring buf 0 i)))
|
||||
; (string-append (substring buf i buf-size)
|
||||
; str)))
|
||||
;
|
||||
; ;; BUF := some of STR.
|
||||
; (else (let ((i (- str-size max-size)))
|
||||
; (set-task:pre-match (string-append (task:pre-match task)
|
||||
; (set-task:pre-match! (string-append (task:pre-match task)
|
||||
; buf
|
||||
; (substring str 0 i)))
|
||||
; (substring str i str-size))))))
|
||||
|
@ -116,8 +123,8 @@
|
|||
;;; - Put everything in BUFFER *after* the match into (TASK:BUF TASK).
|
||||
|
||||
(define (set-prematch task buffer m)
|
||||
(set-task:pre-match task (substring buffer 0 (match:start m)))
|
||||
(set-task:buf task
|
||||
(set-task:pre-match! task (substring buffer 0 (match:start m)))
|
||||
(set-task:buf! task
|
||||
(substring buffer (match:end m) (string-length buffer))))
|
||||
|
||||
|
||||
|
@ -136,7 +143,7 @@
|
|||
(read-string/partial 256 port))))
|
||||
|
||||
(and s (let ((newbuf (string-append (task:buf task) s)))
|
||||
(set-task:buf task newbuf)
|
||||
(set-task:buf! task newbuf)
|
||||
s))))
|
||||
|
||||
;;; A (<task> <aclause> ...) task-clause becomes the following chunk of code
|
||||
|
@ -172,8 +179,8 @@
|
|||
(cond ((do-input task) =>
|
||||
(lambda (i) (try-match-clauses (task:buf task) i do-next)))
|
||||
(else
|
||||
(set-task:pre-match task (task:buf task))
|
||||
(set-task:buf task "")
|
||||
(set-task:pre-match! task (task:buf task))
|
||||
(set-task:buf! task "")
|
||||
(monitor task #f) ; Signal EOF
|
||||
(do-eof)
|
||||
(vector-set! ivec i #f)))
|
||||
|
|
|
@ -10,13 +10,13 @@
|
|||
(access signals) ; for ERROR
|
||||
(files expect-syntax))
|
||||
|
||||
(define-structure expect-package
|
||||
(export task? make-task copy-task
|
||||
task:process set-task:process modify-task:process
|
||||
task:in set-task:in modify-task:in
|
||||
task:out set-task:out modify-task:out
|
||||
task:buf set-task:buf modify-task:buf
|
||||
task:pre-match set-task:pre-match modify-task:pre-match
|
||||
(define-structure expect
|
||||
(export task? make-task
|
||||
task:process
|
||||
task:in
|
||||
task:out
|
||||
task:buf set-task:buf!
|
||||
task:pre-match set-task:pre-match!
|
||||
|
||||
port->monitor
|
||||
|
||||
|
@ -27,19 +27,19 @@
|
|||
(for-syntax (open expect-syntax-support scheme))
|
||||
|
||||
(open scsh formats structure-refs
|
||||
receiving defrec-package scheme srfi-13)
|
||||
receiving srfi-9 scheme srfi-13)
|
||||
(access signals) ; for ERROR
|
||||
|
||||
(files expect))
|
||||
|
||||
(define-structure chat-package
|
||||
(define-structure chat
|
||||
(export chat-abort chat-timeout chat-monitor
|
||||
port->chat-logger file->chat-logger
|
||||
(look-for :syntax)
|
||||
(chat :syntax)
|
||||
send send/cr)
|
||||
|
||||
(open scsh expect-package fluids scheme)
|
||||
(open scsh expect fluids scheme)
|
||||
|
||||
(files chat))
|
||||
|
||||
|
|
Loading…
Reference in New Issue