#| -*-Scheme-*-
-$Id: decls.scm,v 1.68 2000/02/28 22:51:28 cph Exp $
+$Id: decls.scm,v 1.69 2000/06/08 18:00:42 cph Exp $
Copyright (c) 1989-2000 Massachusetts Institute of Technology
"paths"
"rcsparse"
"rename"
+ "rfc822"
"ring"
"strpad"
"strtab"
#| -*-Scheme-*-
-$Id: ed-ffi.scm,v 1.49 2000/02/28 22:51:24 cph Exp $
+$Id: ed-ffi.scm,v 1.50 2000/06/08 18:00:43 cph Exp $
Copyright (c) 1990-2000 Massachusetts Institute of Technology
edwin-syntax-table)
("pwparse" (edwin password-edit)
edwin-syntax-table)
- #|("rcs" (edwin rcs)
- edwin-syntax-table)|#
("rcsparse" (edwin rcs-parse)
syntax-table/system-internal)
("reccom" (edwin rectangle)
syntax-table/system-internal)
("replaz" (edwin)
edwin-syntax-table)
+ ("rfc822" (edwin rfc822)
+ syntax-table/system-internal)
("ring" (edwin)
syntax-table/system-internal)
("rmail" (edwin rmail)
#| -*-Scheme-*-
-$Id: edwin.ldr,v 1.69 2000/02/28 22:51:21 cph Exp $
+$Id: edwin.ldr,v 1.70 2000/06/08 18:00:44 cph Exp $
Copyright (c) 1989-2000 Massachusetts Institute of Technology
(load-option 'RB-TREE)
(load-option 'HASH-TABLE)
(load-option 'REGULAR-EXPRESSION)
+ (load-option 'MIME-CODEC)
(let ((environment (->environment '(EDWIN))))
(load "utils" environment)
(load "reccom" (->environment '(EDWIN RECTANGLE)))
(load "regcom" (->environment '(EDWIN REGISTER-COMMAND)))
(load "replaz" environment)
+ (load "rfc822" (->environment '(EDWIN RFC822)))
(load "rmail" (->environment '(EDWIN RMAIL)))
(load "rmailsum" (->environment '(EDWIN RMAIL)))
(load "rmailsrt" (->environment '(EDWIN RMAIL)))
;;; -*-Scheme-*-
;;;
-;;; $Id: rfc822.scm,v 3.1 2000/06/08 17:58:24 cph Exp $
+;;; $Id: rfc822.scm,v 3.2 2000/06/08 18:02:58 cph Exp $
;;;
;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
;;;
(else
(dispatch)))))
- (dispatch)))))
\ No newline at end of file
+ (dispatch)))))
+
+(define (char-lwsp? char)
+ (or (char=? #\space char)
+ (char=? #\tab char)))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Id: sendmail.scm,v 1.46 2000/03/15 03:37:01 cph Exp $
+;;; $Id: sendmail.scm,v 1.47 2000/06/08 17:58:27 cph Exp $
;;;
;;; Copyright (c) 1991-2000 Massachusetts Institute of Technology
;;;
(if (string-null? full-name)
address
(case (ref-variable mail-from-style buffer)
- ((PARENS) (string-append address " (" full-name ")"))
- ((ANGLES) (string-append (rfc822-quote full-name) " <" address ">"))
+ ((PARENS)
+ (string-append address " (" full-name ")"))
+ ((ANGLES)
+ (string-append (rfc822:quote-string full-name)
+ " <" address ">"))
(else address)))))
-(define (rfc822-quote string)
- (if (string-find-next-char-in-set string char-set:rfc822-quoted)
- (let loop ((chars (string->list string)) (result (list #\")))
- (if (null? chars)
- (list->string (reverse! (cons #\" result)))
- (loop (cdr chars)
- (cons (car chars)
- (if (or (char=? #\\ (car chars))
- (char=? #\" (car chars)))
- (cons #\\ result)
- result)))))
- string))
-
-(define char-set:rfc822-quoted
- (char-set-invert
- (char-set-union char-set:alphanumeric
- (apply char-set (string->list " !#$%&'*+-/=?^_`{|}~")))))
-
(define (mail-organization-string buffer)
(let ((organization (ref-variable mail-organization buffer)))
(and (not (string-null? organization))
(let ((msg "Sending..."))
(message msg)
(let ((from
- (rfc822-addresses->string
- (rfc822-strip-quoted-names (mail-from-string lookup-buffer))))
+ (rfc822:canonicalize-address-string
+ (mail-from-string lookup-buffer)))
(rcpts (mail-deduce-address-list mail-buffer))
(trace-buffer
(and (ref-variable smtp-trace lookup-buffer)
(if field-start
(let ((field-end (%mail-field-end field-start header-end)))
(loop field-end
- (cons (rfc822-strip-quoted-names
+ (cons (rfc822:string->addresses
(extract-string field-start field-end))
addresses)))
(apply append (reverse! addresses)))))))
;;; -*-Scheme-*-
;;;
-;;; $Id: snr.scm,v 1.56 2000/03/27 20:43:25 cph Exp $
+;;; $Id: snr.scm,v 1.57 2000/06/08 17:58:29 cph Exp $
;;;
;;; Copyright (c) 1995-2000 Massachusetts Institute of Technology
;;;
(string-trim (substring from
(re-match-start-index 1 r)
(re-match-end-index 1 r)))
- (or (rfc822-first-address from) from))))
+ (or (rfc822:first-address from) from))))
\f
(define (news-group-buffer:header-mark buffer header)
(let ((index (news-header:index header)))
,(string-append
"["
(let ((from
- (rfc822-addresses->string
- (rfc822-strip-quoted-names (news-header:from header))))
+ (rfc822:canonicalize-address-string
+ (news-header:from header)))
(subject (news-header:subject header)))
(if (string-null? from)
subject