suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more formatting etc

Browse Source 
svn: r5048

original commit: 680c0f419a
This commit is contained in:
Eli Barzilay 2006-12-06 21:44:21 +00:00
parent c276d448fe
commit df4458f899
1 changed files with 63 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
collects/net/mime-util.ss
View File

@ -38,92 +38,84 @@
;; string-index returns the leftmost index in string s ;; string-index returns the leftmost index in string s
;; that has character c ;; that has character c
(define string-index (define (string-index 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 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)))) (list s))))))
(list s)))))))
;; Trim all spaces, except those in quoted strings. ;; Trim all spaces, except those in quoted strings.
(define re:quote-start (regexp "\"")) (define re:quote-start (regexp "\""))
(define re:space (regexp "[ \t\n\r\v]")) (define re:space (regexp "[ \t\n\r\v]"))
(define trim-all-spaces (define (trim-all-spaces str)
(lambda (str) ;; Break out alternate quoted and unquoted parts.
;; Break out alternate quoted and unquoted parts. ;; Initial and final string are unquoted.
;; Initial and final string are unquoted. (let-values ([(unquoted quoted)
(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)])
(let ([m (regexp-match-positions re:quote-start str)]) (if m
(if m (let ([prefix (substring str 0 (caar m))]
(let ([prefix (substring str 0 (caar m))] [rest (substring str (add1 (caar m)) (string-length str))])
[rest (substring str (add1 (caar m)) (string-length str))]) ;; Find closing quote
;; Find closing quote (let ([m (regexp-match-positions re:quote-start rest)])
(let ([m (regexp-match-positions re:quote-start rest)]) (if m
(if m (let ([inside (substring rest 0 (caar m))]
(let ([inside (substring rest 0 (caar m))] [rest (substring rest (add1 (caar m)) (string-length rest))])
[rest (substring rest (add1 (caar m)) (string-length rest))]) (loop rest (cons prefix unquoted) (cons (format "\"~a\"" inside) quoted)))
(loop rest (cons prefix unquoted) (cons (format "\"~a\"" inside) quoted))) ;; No closing quote!
;; No closing quote! (loop "" (cons prefix unquoted) (cons (format "\"~a" rest) quoted)))))
(loop "" (cons prefix unquoted) (cons (format "\"~a" rest) quoted))))) (values (reverse! (cons str unquoted)) (reverse! quoted)))))])
(values (reverse! (cons str unquoted)) (reverse! quoted)))))]) ;; Put the pieces back together, stripping spaces for unquoted parts:
;; Put the pieces back together, stripping spaces for unquoted parts: (apply
(apply string-append
string-append (let loop ([unquoted unquoted][quoted quoted])
(let loop ([unquoted unquoted][quoted quoted]) (let ([clean (regexp-replace* re:space (car unquoted) "")])
(let ([clean (regexp-replace* re:space (car unquoted) "")]) (if (null? quoted)
(if (null? quoted) (list clean)
(list clean) (list* clean
(list* clean (car quoted)
(car quoted) (loop (cdr unquoted) (cdr quoted)))))))))
(loop (cdr unquoted) (cdr quoted))))))))))
;; Only trims left and right spaces: ;; Only trims left and right spaces:
(define trim-spaces (define (trim-spaces str)
(lambda (str) (trim-right (trim-left str)))
(trim-right (trim-left str))))
(define re:left-spaces (regexp "^[ \t\r\n\v]+")) (define re:left-spaces (regexp "^[ \t\r\n\v]+"))
(define trim-left (define (trim-left str)
(lambda (str) (regexp-replace re:left-spaces str ""))
(regexp-replace re:left-spaces str "")))
(define re:right-spaces (regexp "[ \t\r\n\v]+$")) (define re:right-spaces (regexp "[ \t\r\n\v]+$"))
(define trim-right (define (trim-right str)
(lambda (str) (regexp-replace re:right-spaces str ""))
(regexp-replace re:right-spaces str "")))
(define re:comments (regexp "^[^\"]*(\"[^\"]*\")*[^\"]*(\\(.*\\))")) (define re:comments (regexp "^[^\"]*(\"[^\"]*\")*[^\"]*(\\(.*\\))"))
(define trim-comments (define (trim-comments 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))) str)))
str))))
(define lowercase (define (lowercase 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 (define warning
void void