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 (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@)

View File

@ -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^)

View File

@ -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@)

View File

@ -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@)

View File

@ -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@)

View File

@ -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

View File

@ -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@)

View File

@ -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)
|# |#

View File

@ -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))))

View File

@ -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@)

View File

@ -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@)

View File

@ -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@)

View File

@ -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^))

View File

@ -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)])