Import RFC-822 support from IMAIL.
authorChris Hanson <org/chris-hanson/cph>
Thu, 8 Jun 2000 18:02:58 +0000 (18:02 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 8 Jun 2000 18:02:58 +0000 (18:02 +0000)
v7/src/edwin/decls.scm
v7/src/edwin/ed-ffi.scm
v7/src/edwin/edwin.ldr
v7/src/edwin/rfc822.scm
v7/src/edwin/sendmail.scm
v7/src/edwin/snr.scm

index 5db8fc0832f2a5cabf81cc7cce77be24e56520de..8b15aaec3de8f24f4f860e97112f479e4d7e7ada 100644 (file)
@@ -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"
index efcc998ca702264a86aee482ec59a042407d07d1..c20222f091bfcf0b62b0752b653d44e90cc99168 100644 (file)
@@ -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)
index 4daf0ae5c918f04c20ec90f16989dfec9860f04c..cdc490cf194e919f1aac550e2786b89710fd0487 100644 (file)
@@ -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)))
index a8b0b86e1e6fe7a24380c97bebf4ef6a2f6a71f6..e2c73200262c5de5fb6e530446a77aa7b3703fe5 100644 (file)
@@ -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
 ;;;
                  (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
index 878d9f0bff75bdc1fd1cba324cab01051576ed75..fbc6a8b82d0c4e33f6d9ad154db2c73297fe30a7 100644 (file)
@@ -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)))))))
index 33cd6e992d742b12945730611c9afa11a1477ce0..fdcf994f1fdb75fe625adec9a508a5bc925e3b7f 100644 (file)
@@ -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))))
 \f
 (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