From: Chris Hanson Date: Thu, 8 Jun 2000 04:16:20 +0000 (+0000) Subject: Restrict set of recognized character sets to US-ASCII, ISO-8859, and X-Git-Tag: 20090517-FFI~3586 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=838a0d634db9a61021fef0a6510cba1a9a062540;p=mit-scheme.git Restrict set of recognized character sets to US-ASCII, ISO-8859, and Windows-. 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 6ff38f92d..fecdff08b 100644 --- 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 ) enclosure selector mark) + (insert-mime-message-binary message body enclosure selector mark)) + (define-method insert-mime-message-part (message (body ) 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)))))) + +(define-method insert-mime-message-part + (message (body ) 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 ) 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))) -(define-method insert-mime-message-part - (message (body ) 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 ) 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 "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 c55c0aeca..d4916ca44 100644 --- 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- for some value of . 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.