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