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

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

@ -38,30 +38,27 @@
;; 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)
@ -88,34 +85,29 @@
(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
@ -123,7 +115,7 @@
(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