From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 8 Jun 2000 18:02:58 +0000 (+0000)
Subject: Import RFC-822 support from IMAIL.
X-Git-Tag: 20090517-FFI~3579
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c769e596fff2053a1c3186425671ed0fd0542814;p=mit-scheme.git
Import RFC-822 support from IMAIL.
---
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index 5db8fc083..8b15aaec3 100644
--- a/v7/src/edwin/decls.scm
+++ b/v7/src/edwin/decls.scm
@@ -1,6 +1,6 @@
#| -*-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
@@ -85,6 +85,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
"paths"
"rcsparse"
"rename"
+ "rfc822"
"ring"
"strpad"
"strtab"
diff --git a/v7/src/edwin/ed-ffi.scm b/v7/src/edwin/ed-ffi.scm
index efcc998ca..c20222f09 100644
--- a/v7/src/edwin/ed-ffi.scm
+++ b/v7/src/edwin/ed-ffi.scm
@@ -1,6 +1,6 @@
#| -*-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
@@ -228,8 +228,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
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)
@@ -244,6 +242,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
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)
diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr
index 4daf0ae5c..cdc490cf1 100644
--- a/v7/src/edwin/edwin.ldr
+++ b/v7/src/edwin/edwin.ldr
@@ -1,6 +1,6 @@
#| -*-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
@@ -72,6 +72,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
(load-option 'RB-TREE)
(load-option 'HASH-TABLE)
(load-option 'REGULAR-EXPRESSION)
+ (load-option 'MIME-CODEC)
(let ((environment (->environment '(EDWIN))))
(load "utils" environment)
@@ -233,6 +234,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
(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)))
diff --git a/v7/src/edwin/rfc822.scm b/v7/src/edwin/rfc822.scm
index a8b0b86e1..e2c732002 100644
--- a/v7/src/edwin/rfc822.scm
+++ b/v7/src/edwin/rfc822.scm
@@ -1,6 +1,6 @@
;;; -*-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
;;;
@@ -468,4 +468,8 @@
(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
diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index 878d9f0bf..fbc6a8b82 100644
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,6 +1,6 @@
;;; -*-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
;;;
@@ -339,28 +339,13 @@ is inserted."
(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))
@@ -767,8 +752,8 @@ the user from the mailer."
(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)
@@ -837,7 +822,7 @@ the user from the mailer."
(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)))))))
diff --git a/v7/src/edwin/snr.scm b/v7/src/edwin/snr.scm
index 33cd6e992..fdcf994f1 100644
--- a/v7/src/edwin/snr.scm
+++ b/v7/src/edwin/snr.scm
@@ -1,6 +1,6 @@
;;; -*-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
;;;
@@ -1386,7 +1386,7 @@ This shows News groups that have been created since the last time that
(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))))
(define (news-group-buffer:header-mark buffer header)
(let ((index (news-header:index header)))
@@ -2749,8 +2749,8 @@ While composing the reply, use \\[mail-yank-original] to yank the
,(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