Restrict set of recognized character sets to US-ASCII, ISO-8859, and

Windows-<n>.  Messages in other sets are treated as unknowns;
character set appears in attachment descriptor.

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 6ff38f92d8a21b24f4bb608f0eea9ed32cc2ba09..fecdff08b47e92a6599283b489812cc478094b0d 100644 (file)
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.138 2000/06/08 03:24:01 cph Exp $
+;;; $Id: imail-top.scm,v 1.139 2000/06/08 04:16:07 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -1037,6 +1037,10 @@ With prefix argument N moves backward N messages with these flags."
 (define-generic insert-mime-message-part
     (message body enclosure selector mark))
 
+(define-method insert-mime-message-part
+    (message (body <mime-body>) enclosure selector mark)
+  (insert-mime-message-binary message body enclosure selector mark))
+
 (define-method insert-mime-message-part
     (message (body <mime-body-multipart>) enclosure selector mark)
   enclosure
@@ -1057,13 +1061,33 @@ With prefix argument N moves backward N messages with these flags."
                  (insert-newline mark)))
            (insert-mime-message-part message (car parts) body `(,@selector ,i)
                                      mark))))))
+\f
+(define-method insert-mime-message-part
+    (message (body <mime-body-message>) enclosure selector mark)
+  enclosure
+  (insert-string
+   (header-fields->string
+    (maybe-reformat-headers
+     (string->header-fields
+      (message-mime-body-part message `(,@selector HEADER) #t))
+     mark))
+   mark)
+  (insert-newline mark)
+  (insert-mime-message-part message
+                           (mime-body-message-body body)
+                           body
+                           selector
+                           mark))
 
 (define-method insert-mime-message-part
     (message (body <mime-body-text>) enclosure selector mark)
-  (if (or (eq? (mime-body-subtype body) 'PLAIN)
-         (let ((charset (mime-body-parameter body 'CHARSET "us-ascii")))
-           (or (string-ci=? charset "us-ascii")
-               (re-string-match "\\`iso-8859-[0-9]+\\'" charset #t))))
+  (if (re-string-match (string-append "\\`"
+                                     (regexp-group "us-ascii"
+                                                   "iso-8859-[0-9]+"
+                                                   "windows-[0-9]+")
+                                     "\\'")
+                      (mime-body-parameter body 'CHARSET "us-ascii")
+                      #t)
       (let ((text
             (message-mime-body-part
              message
@@ -1095,41 +1119,29 @@ With prefix argument N moves backward N messages with these flags."
        (guarantee-newline mark))
       (insert-mime-message-binary message body enclosure selector mark)))
 \f
-(define-method insert-mime-message-part
-    (message (body <mime-body-message>) enclosure selector mark)
-  enclosure
-  (insert-string
-   (header-fields->string
-    (maybe-reformat-headers
-     (string->header-fields
-      (message-mime-body-part message `(,@selector HEADER) #t))
-     mark))
-   mark)
-  (insert-newline mark)
-  (insert-mime-message-part message
-                           (mime-body-message-body body)
-                           body
-                           selector
-                           mark))
-
-(define-method insert-mime-message-part
-    (message (body <mime-body>) enclosure selector mark)
-  (insert-mime-message-binary message body enclosure selector mark))
-
 (define (insert-mime-message-binary message body enclosure selector mark)
   message enclosure
   (let ((start (mark-right-inserting-copy mark)))
     (insert-string "<IMAIL-ATTACHMENT " mark)
     (let ((column (mark-column mark)))
-      (insert-string "name=" mark)
-      (insert (mime-attachment-name body selector) mark)
-      (insert-newline mark)
-      (change-column column mark)
+      (let ((name (mime-attachment-name body selector #f)))
+       (if name
+           (begin
+             (insert-string "name=" mark)
+             (insert name mark)
+             (insert-newline mark)
+             (change-column column mark))))
       (insert-string "type=" mark)
       (insert (mime-body-type body) mark)
       (insert-string "/" mark)
       (insert (mime-body-subtype body) mark)
       (insert-newline mark)
+      (if (eq? (mime-body-type body) 'TEXT)
+         (begin
+           (change-column column mark)
+           (insert-string "charset=" mark)
+           (insert (mime-body-parameter body 'CHARSET "us-ascii") mark)
+           (insert-newline mark)))
       (change-column column mark)
       (insert-string "encoding=" mark)
       (insert (mime-body-one-part-encoding body) mark)
@@ -1142,15 +1154,16 @@ With prefix argument N moves backward N messages with these flags."
     (mark-temporary! start))
   (insert-newline mark))
 
-(define (mime-attachment-name body selector)
+(define (mime-attachment-name body selector provide-default?)
   (or (mime-body-parameter body 'NAME #f)
-      (string-append "unnamed-attachment-"
-                    (if (null? selector)
-                        "0"
-                        (decorated-string-append
-                         "" "." ""
-                         (map (lambda (n) (number->string (+ n 1)))
-                              selector))))))
+      (and provide-default?
+          (string-append "unnamed-attachment-"
+                         (if (null? selector)
+                             "0"
+                             (decorated-string-append
+                              "" "." ""
+                              (map (lambda (n) (number->string (+ n 1)))
+                                   selector)))))))
 
 (define (mark-mime-attachment mark)
   (region-get mark 'IMAIL-MIME-ATTACHMENT #f))
@@ -1588,7 +1601,7 @@ With prefix argument, prompt even when point is on an attachment."
          (let ((alist
                 (uniquify-mime-attachment-names
                  (map (lambda (b.s)
-                        (cons (mime-attachment-name (car b.s) (cdr b.s))
+                        (cons (mime-attachment-name (car b.s) (cdr b.s) #t)
                               b.s))
                       attachments))))
            (prompt-for-alist-value "Save attachment"
@@ -1627,7 +1640,8 @@ With prefix argument, prompt even when point is on an attachment."
          (let ((filename (mime-body-disposition-filename body)))
            (and filename
                 (list
-                 (merge-pathnames (filter-mime-attachment-filename filename)
+                 (merge-pathnames
+                  (filter-mime-attachment-filename filename)
                   (or (buffer-get buffer 'IMAIL-MIME-ATTACHMENT-DIRECTORY #f)
                       (buffer-default-directory buffer)))))))))
     (if (or (not (file-exists? filename))

diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index c55c0aeca78686d0e05c1bd2ba029437aaf655fb..d4916ca44c258fe7b99e06d593bb04c18e0b1e48 100644 (file)
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,5 +1,5 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.67 2000/06/08 02:03:30 cph Exp $
+$Id: todo.txt,v 1.68 2000/06/08 04:16:20 cph Exp $
 
 Bug fixes
 ---------
@@ -9,11 +9,6 @@ Bug fixes
   attribute and uses the message indexes.  It should pay attention to
   UNSEEN and to UIDNEXT to figure out what it needs to do.
 
-* Restrict set of recognized character sets to US-ASCII, ISO-8859, and
-  Windows-<n> for some value of <n>.  Messages in other sets should be
-  treated as unknowns; character set should appear in attachment
-  descriptor.
-
 * Treat messages in unrecognized encodings as type
   application/octet-stream.
 
@@ -51,8 +46,6 @@ New features
   folder is locally modified.  Meaningful only for file folders.  Hook
   up the save-folder code into M-x save-some-buffers.
 
-* Add command to rename folders.
-
 * Add mail notification in mode line, active across the editor as long
   as there is an IMAP connection open in some buffer.