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

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

@ -60,7 +60,7 @@
s))) s)))
(define (log-warning . args) (define (log-warning . args)
;; (apply printf args) ;; (apply printf args)
(void)) (void))
(define log log-warning) (define log log-warning)
@ -97,17 +97,20 @@
[accum null] [accum null]
[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
@ -119,19 +122,20 @@
(loop s r (loop s r
(cons (reverse! laccum) accum) (cons (reverse! laccum) accum)
eol-k eop-k))]) eol-k eop-k))])
(loop (skip s 1) r null next-line finish-parens))] (loop (skip s 1) r null next-line finish-parens))]
[(#\{) (let ([m (regexp-match #rx#"{([0-9]+)}(.*)" s)]) [(#\{) (let ([m (regexp-match #rx#"{([0-9]+)}(.*)" s)])
(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
(cons (read-bytes (string->number (loop #"" r
(bytes->string/latin-1 (cadr m))) (cons (read-bytes (string->number
r) (bytes->string/latin-1 (cadr m)))
accum) r)
eol-k eop-k)]))] accum)
eol-k eop-k)]))]
[else (let ([m (regexp-match #rx#"([^ (){}]+)(.*)" s)]) [else (let ([m (regexp-match #rx#"([^ (){}]+)(.*)" s)])
(if m (if m
(loop (caddr m) r (loop (caddr m) r
(cons (let ([v (cadr m)]) (cons (let ([v (cadr m)])
(if (regexp-match #rx#"^[0-9]*$" v) (if (regexp-match #rx#"^[0-9]*$" v)
@ -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)]
(unless (and except [bytes-name (if (symbol? name)
(bytes=? name except)) (string->bytes/utf-8 (symbol->string name))
name)])
(printf "~s\n" (list 'bytes=? bytes-name except))
(unless (and except
(bytes=? bytes-name except))
(set! sub-folders (set! sub-folders
(cons (cons
(list flags name) (list flags name)