From c769e596fff2053a1c3186425671ed0fd0542814 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 8 Jun 2000 18:02:58 +0000 Subject: [PATCH] Import RFC-822 support from IMAIL. --- v7/src/edwin/decls.scm | 3 ++- v7/src/edwin/ed-ffi.scm | 6 +++--- v7/src/edwin/edwin.ldr | 4 +++- v7/src/edwin/rfc822.scm | 8 ++++++-- v7/src/edwin/sendmail.scm | 33 +++++++++------------------------ v7/src/edwin/snr.scm | 8 ++++---- 6 files changed, 27 insertions(+), 35 deletions(-) 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 -- 2.25.1