formatting etc

svn: r5045

original commit: f17f7bc479
This commit is contained in:
Eli Barzilay 2006-12-06 21:23:38 +00:00
parent e6fc4d4027
commit c276d448fe
19 changed files with 533 additions and 553 deletions

View File

@ -1,7 +1,5 @@
(module cgi mzscheme
(require (lib "unit.ss")
"cgi-sig.ss"
"cgi-unit.ss")
(require (lib "unit.ss") "cgi-sig.ss" "cgi-unit.ss")
(define-values/invoke-unit/infer cgi@)

View File

@ -1,7 +1,5 @@
(module cookie mzscheme
(require (lib "unit.ss")
"cookie-sig.ss"
"cookie-unit.ss")
(require (lib "unit.ss") "cookie-sig.ss" "cookie-unit.ss")
(provide-signature-elements cookie^)

View File

@ -1,7 +1,5 @@
(module dns mzscheme
(require (lib "unit.ss")
"dns-sig.ss"
"dns-unit.ss")
(require (lib "unit.ss") "dns-sig.ss" "dns-unit.ss")
(define-values/invoke-unit/infer dns@)

View File

@ -1,7 +1,5 @@
(module ftp mzscheme
(require (lib "unit.ss")
"ftp-sig.ss"
"ftp-unit.ss")
(require (lib "unit.ss") "ftp-sig.ss" "ftp-unit.ss")
(define-values/invoke-unit/infer ftp@)

View File

@ -1,8 +1,5 @@
(module imap mzscheme
(require (lib "unit.ss")
(lib "contract.ss")
"imap-sig.ss"
"imap-unit.ss")
(require (lib "unit.ss") (lib "contract.ss") "imap-sig.ss" "imap-unit.ss")
(define-values/invoke-unit/infer imap@)

View File

@ -40,18 +40,18 @@
;; that has character c
(define string-index
(lambda (s c)
(let ((n (string-length s)))
(let loop ((i 0))
(cond ((>= i n) #f)
((char=? (string-ref s i) c) i)
(else (loop (+ i 1))))))))
(let ([n (string-length s)])
(let loop ([i 0])
(cond [(>= i n) #f]
[(char=? (string-ref s i) c) i]
[else (loop (+ i 1))])))))
;; string-tokenizer breaks string s into substrings separated by character c
(define string-tokenizer
(lambda (c s)
(let loop ((s s))
(let loop ([s s])
(if (string=? s "") '()
(let ((i (string-index s c)))
(let ([i (string-index s c)])
(if i (cons (substring s 0 i)
(loop (substring s (+ i 1)
(string-length s))))
@ -65,7 +65,7 @@
;; Break out alternate quoted and unquoted parts.
;; Initial and final string are unquoted.
(let-values ([(unquoted quoted)
(let loop ([str str][unquoted null][quoted null])
(let loop ([str str] [unquoted null] [quoted null])
(let ([m (regexp-match-positions re:quote-start str)])
(if m
(let ([prefix (substring str 0 (caar m))]
@ -108,7 +108,7 @@
(define re:comments (regexp "^[^\"]*(\"[^\"]*\")*[^\"]*(\\(.*\\))"))
(define trim-comments
(lambda (str)
(let* ((positions (regexp-match-positions re:comments str)))
(let ([positions (regexp-match-positions re:comments str)])
(if positions
(string-append (substring str 0 (caaddr positions))
(substring str (cdaddr positions) (string-length str)))
@ -116,31 +116,33 @@
(define lowercase
(lambda (str)
(let loop ((out "") (rest str) (size (string-length str)))
(cond ((zero? size) out)
(else
(let loop ([out ""] [rest str] [size (string-length str)])
(cond [(zero? size) out]
[else
(loop (string-append out (string
(char-downcase
(string-ref rest 0))))
(substring rest 1 size)
(sub1 size)))))))
(sub1 size))]))))
(define warning void)
#|
(define warning
void
#;
(lambda (msg . args)
(fprintf (current-error-port)
(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
;; current-output-port if out is not provided.
(define cat
(opt-lambda (in (out (current-output-port)))
(let loop ((ln (read-line in)))
(let loop ([ln (read-line in)])
(unless (eof-object? ln)
(fprintf out "~a~n" ln)
(fprintf out "~a\n" ln)
(loop (read-line in))))))
)
;;; mime-util.ss ends here

View File

@ -1,7 +1,5 @@
(module nntp mzscheme
(require (lib "unit.ss")
"nntp-sig.ss"
"nntp-unit.ss")
(require (lib "unit.ss") "nntp-sig.ss" "nntp-unit.ss")
(define-values/invoke-unit/infer nntp@)

View File

@ -1,7 +1,5 @@
(module pop3 mzscheme
(require (lib "unit.ss")
"pop3-sig.ss"
"pop3-unit.ss")
(require (lib "unit.ss") "pop3-sig.ss" "pop3-unit.ss")
(define-values/invoke-unit/infer pop3@)
@ -29,5 +27,4 @@
"Status: RO")
("some body" "text" "goes" "." "here" "." "")
> (disconnect-from-server c)
|#

View File

@ -321,7 +321,7 @@ Tests:
[(< n 0) (fetch-delete! t (- n))]
[(inexact? n) (fetch-shift! t (inexact->exact n))]
[else (fetch-insert! t (list n))])
(printf "Check ~a~n" v)
(printf "Check ~a\n" v)
(let ([v (map list v)])
(unless (equal? (fetch-tree->list t) v)
(error 'bad "~s != ~s" (fetch-tree->list t) v))))

View File

@ -26,9 +26,7 @@
;; Commentary:
(module qp mzscheme
(require (lib "unit.ss")
"qp-sig.ss"
"qp-unit.ss")
(require (lib "unit.ss") "qp-sig.ss" "qp-unit.ss")
(define-values/invoke-unit/infer qp@)

View File

@ -1,7 +1,5 @@
(module sendmail mzscheme
(require (lib "unit.ss")
"sendmail-sig.ss"
"sendmail-unit.ss")
(require (lib "unit.ss") "sendmail-sig.ss" "sendmail-unit.ss")
(define-values/invoke-unit/infer sendmail@)

View File

@ -1,7 +1,5 @@
(module smtp mzscheme
(require (lib "unit.ss")
"smtp-sig.ss"
"smtp-unit.ss")
(require (lib "unit.ss") "smtp-sig.ss" "smtp-unit.ss")
(define-values/invoke-unit/infer smtp@)

View File

@ -1,7 +1,6 @@
(module tcp-unit mzscheme
(provide tcp@)
(require (lib "unit.ss")
"tcp-sig.ss")
(require (lib "unit.ss") "tcp-sig.ss")
(define-unit-from-context tcp@ tcp^))

View File

@ -91,7 +91,8 @@
[(regexp-match? re:utf-8 encoding)
(bytes->string/utf-8 s #\?)]
[else (let ([c (bytes-open-converter
(bytes->string/latin-1 encoding) "UTF-8")])
(bytes->string/latin-1 encoding)
"UTF-8")])
(if c
(let-values ([(r got status)
(bytes-convert c s)])