parent
e6fc4d4027
commit
c276d448fe
|
@ -1,7 +1,5 @@
|
||||||
(module cgi mzscheme
|
(module cgi mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "cgi-sig.ss" "cgi-unit.ss")
|
||||||
"cgi-sig.ss"
|
|
||||||
"cgi-unit.ss")
|
|
||||||
|
|
||||||
(define-values/invoke-unit/infer cgi@)
|
(define-values/invoke-unit/infer cgi@)
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
(module cookie mzscheme
|
(module cookie mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "cookie-sig.ss" "cookie-unit.ss")
|
||||||
"cookie-sig.ss"
|
|
||||||
"cookie-unit.ss")
|
|
||||||
|
|
||||||
(provide-signature-elements cookie^)
|
(provide-signature-elements cookie^)
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
(module dns mzscheme
|
(module dns mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "dns-sig.ss" "dns-unit.ss")
|
||||||
"dns-sig.ss"
|
|
||||||
"dns-unit.ss")
|
|
||||||
|
|
||||||
(define-values/invoke-unit/infer dns@)
|
(define-values/invoke-unit/infer dns@)
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
(module ftp mzscheme
|
(module ftp mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "ftp-sig.ss" "ftp-unit.ss")
|
||||||
"ftp-sig.ss"
|
|
||||||
"ftp-unit.ss")
|
|
||||||
|
|
||||||
(define-values/invoke-unit/infer ftp@)
|
(define-values/invoke-unit/infer ftp@)
|
||||||
|
|
||||||
|
|
|
@ -1,8 +1,5 @@
|
||||||
(module imap mzscheme
|
(module imap mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") (lib "contract.ss") "imap-sig.ss" "imap-unit.ss")
|
||||||
(lib "contract.ss")
|
|
||||||
"imap-sig.ss"
|
|
||||||
"imap-unit.ss")
|
|
||||||
|
|
||||||
(define-values/invoke-unit/infer imap@)
|
(define-values/invoke-unit/infer imap@)
|
||||||
|
|
||||||
|
|
|
@ -40,18 +40,18 @@
|
||||||
;; that has character c
|
;; that has character c
|
||||||
(define string-index
|
(define string-index
|
||||||
(lambda (s c)
|
(lambda (s c)
|
||||||
(let ((n (string-length s)))
|
(let ([n (string-length s)])
|
||||||
(let loop ((i 0))
|
(let loop ([i 0])
|
||||||
(cond ((>= i n) #f)
|
(cond [(>= i n) #f]
|
||||||
((char=? (string-ref s i) c) i)
|
[(char=? (string-ref s i) c) i]
|
||||||
(else (loop (+ i 1))))))))
|
[else (loop (+ i 1))])))))
|
||||||
|
|
||||||
;; string-tokenizer breaks string s into substrings separated by character c
|
;; string-tokenizer breaks string s into substrings separated by character c
|
||||||
(define string-tokenizer
|
(define string-tokenizer
|
||||||
(lambda (c s)
|
(lambda (c s)
|
||||||
(let loop ((s s))
|
(let loop ([s s])
|
||||||
(if (string=? s "") '()
|
(if (string=? s "") '()
|
||||||
(let ((i (string-index s c)))
|
(let ([i (string-index s c)])
|
||||||
(if i (cons (substring s 0 i)
|
(if i (cons (substring s 0 i)
|
||||||
(loop (substring s (+ i 1)
|
(loop (substring s (+ i 1)
|
||||||
(string-length s))))
|
(string-length s))))
|
||||||
|
@ -108,7 +108,7 @@
|
||||||
(define re:comments (regexp "^[^\"]*(\"[^\"]*\")*[^\"]*(\\(.*\\))"))
|
(define re:comments (regexp "^[^\"]*(\"[^\"]*\")*[^\"]*(\\(.*\\))"))
|
||||||
(define trim-comments
|
(define trim-comments
|
||||||
(lambda (str)
|
(lambda (str)
|
||||||
(let* ((positions (regexp-match-positions re:comments str)))
|
(let ([positions (regexp-match-positions re:comments str)])
|
||||||
(if positions
|
(if positions
|
||||||
(string-append (substring str 0 (caaddr positions))
|
(string-append (substring str 0 (caaddr positions))
|
||||||
(substring str (cdaddr positions) (string-length str)))
|
(substring str (cdaddr positions) (string-length str)))
|
||||||
|
@ -116,31 +116,33 @@
|
||||||
|
|
||||||
(define lowercase
|
(define lowercase
|
||||||
(lambda (str)
|
(lambda (str)
|
||||||
(let loop ((out "") (rest str) (size (string-length str)))
|
(let loop ([out ""] [rest str] [size (string-length str)])
|
||||||
(cond ((zero? size) out)
|
(cond [(zero? size) out]
|
||||||
(else
|
[else
|
||||||
(loop (string-append out (string
|
(loop (string-append out (string
|
||||||
(char-downcase
|
(char-downcase
|
||||||
(string-ref rest 0))))
|
(string-ref rest 0))))
|
||||||
(substring rest 1 size)
|
(substring rest 1 size)
|
||||||
(sub1 size)))))))
|
(sub1 size))]))))
|
||||||
|
|
||||||
(define warning void)
|
(define warning
|
||||||
#|
|
void
|
||||||
|
#;
|
||||||
(lambda (msg . args)
|
(lambda (msg . args)
|
||||||
(fprintf (current-error-port)
|
(fprintf (current-error-port)
|
||||||
(apply format (cons msg args)))
|
(apply format (cons msg args)))
|
||||||
(newline (current-error-port))))
|
(newline (current-error-port)))
|
||||||
|#
|
)
|
||||||
|
|
||||||
;; Copies its input `in' to its ouput port if given, it uses
|
;; Copies its input `in' to its ouput port if given, it uses
|
||||||
;; current-output-port if out is not provided.
|
;; current-output-port if out is not provided.
|
||||||
(define cat
|
(define cat
|
||||||
(opt-lambda (in (out (current-output-port)))
|
(opt-lambda (in (out (current-output-port)))
|
||||||
(let loop ((ln (read-line in)))
|
(let loop ([ln (read-line in)])
|
||||||
(unless (eof-object? ln)
|
(unless (eof-object? ln)
|
||||||
(fprintf out "~a~n" ln)
|
(fprintf out "~a\n" ln)
|
||||||
(loop (read-line in))))))
|
(loop (read-line in))))))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
;;; mime-util.ss ends here
|
;;; mime-util.ss ends here
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
(module nntp mzscheme
|
(module nntp mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "nntp-sig.ss" "nntp-unit.ss")
|
||||||
"nntp-sig.ss"
|
|
||||||
"nntp-unit.ss")
|
|
||||||
|
|
||||||
(define-values/invoke-unit/infer nntp@)
|
(define-values/invoke-unit/infer nntp@)
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
(module pop3 mzscheme
|
(module pop3 mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "pop3-sig.ss" "pop3-unit.ss")
|
||||||
"pop3-sig.ss"
|
|
||||||
"pop3-unit.ss")
|
|
||||||
|
|
||||||
(define-values/invoke-unit/infer pop3@)
|
(define-values/invoke-unit/infer pop3@)
|
||||||
|
|
||||||
|
@ -29,5 +27,4 @@
|
||||||
"Status: RO")
|
"Status: RO")
|
||||||
("some body" "text" "goes" "." "here" "." "")
|
("some body" "text" "goes" "." "here" "." "")
|
||||||
> (disconnect-from-server c)
|
> (disconnect-from-server c)
|
||||||
|
|
||||||
|#
|
|#
|
||||||
|
|
|
@ -321,7 +321,7 @@ Tests:
|
||||||
[(< n 0) (fetch-delete! t (- n))]
|
[(< n 0) (fetch-delete! t (- n))]
|
||||||
[(inexact? n) (fetch-shift! t (inexact->exact n))]
|
[(inexact? n) (fetch-shift! t (inexact->exact n))]
|
||||||
[else (fetch-insert! t (list n))])
|
[else (fetch-insert! t (list n))])
|
||||||
(printf "Check ~a~n" v)
|
(printf "Check ~a\n" v)
|
||||||
(let ([v (map list v)])
|
(let ([v (map list v)])
|
||||||
(unless (equal? (fetch-tree->list t) v)
|
(unless (equal? (fetch-tree->list t) v)
|
||||||
(error 'bad "~s != ~s" (fetch-tree->list t) v))))
|
(error 'bad "~s != ~s" (fetch-tree->list t) v))))
|
||||||
|
|
|
@ -26,9 +26,7 @@
|
||||||
;; Commentary:
|
;; Commentary:
|
||||||
|
|
||||||
(module qp mzscheme
|
(module qp mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "qp-sig.ss" "qp-unit.ss")
|
||||||
"qp-sig.ss"
|
|
||||||
"qp-unit.ss")
|
|
||||||
|
|
||||||
(define-values/invoke-unit/infer qp@)
|
(define-values/invoke-unit/infer qp@)
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
(module sendmail mzscheme
|
(module sendmail mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "sendmail-sig.ss" "sendmail-unit.ss")
|
||||||
"sendmail-sig.ss"
|
|
||||||
"sendmail-unit.ss")
|
|
||||||
|
|
||||||
(define-values/invoke-unit/infer sendmail@)
|
(define-values/invoke-unit/infer sendmail@)
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
(module smtp mzscheme
|
(module smtp mzscheme
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "smtp-sig.ss" "smtp-unit.ss")
|
||||||
"smtp-sig.ss"
|
|
||||||
"smtp-unit.ss")
|
|
||||||
|
|
||||||
(define-values/invoke-unit/infer smtp@)
|
(define-values/invoke-unit/infer smtp@)
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
(module tcp-unit mzscheme
|
(module tcp-unit mzscheme
|
||||||
(provide tcp@)
|
(provide tcp@)
|
||||||
|
|
||||||
(require (lib "unit.ss")
|
(require (lib "unit.ss") "tcp-sig.ss")
|
||||||
"tcp-sig.ss")
|
|
||||||
|
|
||||||
(define-unit-from-context tcp@ tcp^))
|
(define-unit-from-context tcp@ tcp^))
|
||||||
|
|
|
@ -91,7 +91,8 @@
|
||||||
[(regexp-match? re:utf-8 encoding)
|
[(regexp-match? re:utf-8 encoding)
|
||||||
(bytes->string/utf-8 s #\?)]
|
(bytes->string/utf-8 s #\?)]
|
||||||
[else (let ([c (bytes-open-converter
|
[else (let ([c (bytes-open-converter
|
||||||
(bytes->string/latin-1 encoding) "UTF-8")])
|
(bytes->string/latin-1 encoding)
|
||||||
|
"UTF-8")])
|
||||||
(if c
|
(if c
|
||||||
(let-values ([(r got status)
|
(let-values ([(r got status)
|
||||||
(bytes-convert c s)])
|
(bytes-convert c s)])
|
||||||
|
|
Loading…
Reference in New Issue
Block a user