(defvar mime-header-default-charset-encoding "Q")
+(defvar mime-header-encode-method-alist
+ '((eword-encode-address-list
+ . (Reply-To
+ From Sender
+ Resent-Reply-To Resent-From
+ Resent-Sender To Resent-To
+ Cc Resent-Cc Bcc Resent-Bcc
+ Dcc))
+ (eword-encode-in-reply-to . (In-Reply-To))
+ (eword-encode-structured-field-body . (Mime-Version User-Agent))
+ (eword-encode-unstructured-field-body)))
;;; @ encoded-text encoder
;;;
(setq field-body (std11-unfold-string field-body))
(if (string= field-body "")
""
- (let (start)
+ (let ((method-alist mime-header-encode-method-alist)
+ start ret)
(if (symbolp field-name)
(setq start (1+ (length (symbol-name field-name))))
(setq start (1+ (length field-name))
field-name (intern (capitalize field-name))))
- (cond ((memq field-name
- '(Reply-To
- From Sender
- Resent-Reply-To Resent-From
- Resent-Sender To Resent-To
- Cc Resent-Cc Bcc Resent-Bcc
- Dcc))
- (eword-encode-address-list field-body start))
- ((eq field-name 'In-Reply-To)
- (eword-encode-in-reply-to field-body start))
- ((memq field-name '(Mime-Version User-Agent))
- (eword-encode-structured-field-body field-body start))
- (t
- (eword-encode-unstructured-field-body field-body start))))))
+ (while (car method-alist)
+ (if (or (not (cdr (car method-alist)))
+ (memq field-name
+ (cdr (car method-alist))))
+ (progn
+ (setq ret
+ (apply (caar method-alist) (list field-body start)))
+ (setq method-alist nil)))
+ (setq method-alist (cdr method-alist)))
+ ret)))
(defalias 'eword-encode-field-body 'mime-encode-field-body)
(make-obsolete 'eword-encode-field-body 'mime-encode-field-body)
(let ((method (eword-find-field-encoding-method
(downcase field-name))))
(cond ((eq method 'mime)
- (let ((field-body
- (buffer-substring-no-properties bbeg end)
- ))
- (delete-region bbeg end)
- (insert (mime-encode-field-body field-body
- field-name))))
+ (let* ((field-body
+ (buffer-substring-no-properties bbeg end))
+ (encoded-body
+ (mime-encode-field-body
+ field-body field-name)))
+ (if (not encoded-body)
+ (error "Cannot encode %s:%s"
+ field-name field-body)
+ (delete-region bbeg end)
+ (insert encoded-body))))
(code-conversion
(let ((cs
(or (mime-charset-to-coding-system