Changeset 15133 in project


Ignore:
Timestamp:
07/02/09 07:36:27 (10 years ago)
Author:
Ivan Raikov
Message:

smtp save

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/smtp/trunk/smtp.scm

    r15131 r15133  
    104104(define-syntax define-enumerated-type
    105105  (lambda (x r c)
    106     (match-let (((typename pred vector inject project . rest) x))
     106    (match-let (((_ typename pred vector inject project . rest) x))
    107107    (let ((%define  (r 'define))
    108108          (%begin   (r 'begin))
     
    116116           (if (null? variants)
    117117               `(,%begin ,@defs)
    118                (let* ((variantname  (car variants))
    119                       (def  `(,%define (,variantname)   (##sys#make-structure ',typename ',variantname ,i))))
     118               (let* ((variant  (car variants))
     119                      (def  `(,%define ,variant   (##sys#make-structure ',typename ',(car variant) ,i))))
    120120                 (loop (cdr variants) (+ i 1) (cons def defs)))))
    121121        ,(let loop ((variants rest) (defs (list)))
    122122           (if (null? variants)
    123123               `(,%define ,vector (vector ,@(reverse defs)))
    124                (let* ((variantname  (car variants))
    125                       (def  `(,variantname)))
     124               (let* ((variant  (car variants))
     125                      (def  `(,(car variant))))
    126126                 (loop (cdr variants) (cons def defs)))))
    127127        )))))
     
    162162  (Reply (code code?) (msg list?)))
    163163
    164 (define-datatype code code?
    165   (Code (suc success-code?) (cat category?) (num integer?)))
    166 
    167164(define-enumerated-type
    168165  success-code success-code? success-vector
     
    185182  (MailSystem))
    186183
     184(define-datatype code code?
     185  (Code (suc success-code?) (cat category?) (num integer?)))
     186
    187187(define-record-printer (reply x out)
    188188  (match x
    189189         (($ reply 'Reply (and c ($ code 'Code suc cat _)) ())
    190           (let ((msg (sprintf "~S in category ~S" suc cat)))
     190          (let ((msg (sprintf "~A in category ~A" suc cat)))
    191191            (fprintf out "~A" (Reply c (list msg)))))
    192192
     
    194194          (let ((prefix-con (sprintf "~A-" code))
    195195                (prefix-end (sprintf "~A " code))
    196                 (fmt        (lambda (p) (lambda (l) (sprintf "~S~S\r\n" p l)))))
     196                (fmt        (lambda (p) (lambda (l) (sprintf "~A~A\r\n" p l)))))
    197197            (match-let (((x . xs) (reverse msg)))
    198198                       (let* ((msg-con (map (fmt prefix-con) xs))
    199199                              (msg-end ((fmt prefix-end) x))
    200200                              (msg1    (reverse (cons msg-end msg-con))))
    201                          (fprintf out "~S" (string-concatenate msg1))))))
     201                         (fprintf out "~A" (string-concatenate msg1))))))
    202202         ))
    203203
Note: See TracChangeset for help on using the changeset viewer.