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

.

Browse Source 
original commit: cc7088edf2d2de8a17e655e96cde5415c63c56bc
This commit is contained in:
Robby Findler 2004-06-29 17:06:33 +00:00
parent b7dc5a7f3a
commit f742bfa6ae
1 changed files with 27 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/net/imap-unit.ss
View File

@ -98,16 +98,19 @@
[eol-k (lambda (accum) (reverse! accum))] [eol-k (lambda (accum) (reverse! accum))]
[eop-k (lambda (s accum) (error 'imap-read "unxpected close parenthesis"))]) [eop-k (lambda (s accum) (error 'imap-read "unxpected close parenthesis"))])
(cond (cond
[(bytes=? #"" s) (eol-k accum)] [(bytes=? #"" s)
(eol-k accum)]
[(char-whitespace? (integer->char (bytes-ref s 0))) [(char-whitespace? (integer->char (bytes-ref s 0)))
(loop (skip s 1) r accum eol-k eop-k)] (loop (skip s 1) r accum eol-k eop-k)]
[else [else
(case (integer->char (bytes-ref s 0)) (case (integer->char (bytes-ref s 0))
[(#\") (let ([m (regexp-match #rx#"\"([^\"]*)\"(.*)" s)]) [(#\")
(let ([m (regexp-match #rx#"\"([^\"]*)\"(.*)" s)])
(if m (if m
(loop (caddr m) r (cons (cadr m) accum) eol-k eop-k) (loop (caddr m) r (cons (cadr m) accum) eol-k eop-k)
(error 'imap-read "didn't find end of quoted string in: ~a" s)))] (error 'imap-read "didn't find end of quoted string in: ~a" s)))]
[(#\)) (eop-k (skip s 1) accum)] [(#\))
(eop-k (skip s 1) accum)]
[(#\() (letrec ([next-line [(#\() (letrec ([next-line
(lambda (accum) (lambda (accum)
(loop (read-bytes-line r eol) r (loop (read-bytes-line r eol) r
@ -124,7 +127,8 @@
(cond (cond
[(not m) (error 'imap-read "couldn't read {} number: ~a" s)] [(not m) (error 'imap-read "couldn't read {} number: ~a" s)]
[(not (bytes=? (caddr m) #"")) (error 'imap-read "{} not at end-of-line: ~a" s)] [(not (bytes=? (caddr m) #"")) (error 'imap-read "{} not at end-of-line: ~a" s)]
[else (loop #"" r [else
(loop #"" r
(cons (read-bytes (string->number (cons (read-bytes (string->number
(bytes->string/latin-1 (cadr m))) (bytes->string/latin-1 (cadr m)))
r) r)
@ -144,7 +148,7 @@
(define (get-response r id info-handler continuation-handler) (define (get-response r id info-handler continuation-handler)
(let loop () (let loop ()
(let ([l (read-bytes-line r eol)]) (let ([l (read-bytes-line r eol)])
;; (log "raw-reply: ~s~n" l) (log "raw-reply: ~s~n" l)
(cond (cond
[(and id (starts-with? l id)) [(and id (starts-with? l id))
(let ([reply (imap-read (skip l id) r)]) (let ([reply (imap-read (skip l id) r)])
@ -543,10 +547,14 @@
(lambda (x) (lambda (x)
(when (and (pair? x) (when (and (pair? x)
(tag-eq? (car x) 'LIST)) (tag-eq? (car x) 'LIST))
(let ([flags (cadr x)] (let* ([flags (cadr x)]
[name (cadddr x)]) [name (cadddr x)]
[bytes-name (if (symbol? name)
(string->bytes/utf-8 (symbol->string name))
name)])
(printf "~s\n" (list 'bytes=? bytes-name except))
(unless (and except (unless (and except
(bytes=? name except)) (bytes=? bytes-name except))
(set! sub-folders (set! sub-folders
(cons (cons
(list flags name) (list flags name)