(require 'base64)
(autoload 'mm-body-7-or-8 "mm-bodies")
-;; Avoid gnus-util for mm- code.
-(defalias 'rfc2047-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
+(eval-and-compile
+ ;; Avoid gnus-util for mm- code.
+ (defalias 'rfc2047-point-at-bol
+ (if (fboundp 'point-at-bol)
+ 'point-at-bol
+ 'line-beginning-position))
-(defalias 'rfc2047-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position))
+ (defalias 'rfc2047-point-at-eol
+ (if (fboundp 'point-at-eol)
+ 'point-at-eol
+ 'line-end-position)))
(defvar rfc2047-header-encoding-alist
'(("Newsgroups" . nil)
("Followup-To" . nil)
("Message-ID" . nil)
- ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
- address-mime)
+ ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\
+\\|Mail-Followup-To\\|Mail-Copies-To\\)" . address-mime)
(t . mime))
"*Header/encoding method alist.
The list is traversed sequentially. The keys can either be
(nil . ignore))
"Alist of RFC2047 encodings to encoding functions.")
-(defvar rfc2047-q-encoding-alist
- '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):"
- . "-A-Za-z0-9!*+/" )
- ;; = (\075), _ (\137), ? (\077) are used in the encoded word.
- ;; Avoid using 8bit characters.
- ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
- ("." . "\010\012\014\040-\074\076\100-\136\140-\177"))
- "Alist of header regexps and valid Q characters.")
-
;;;
;;; Functions for encoding RFC2047 messages
;;;
(progn
(forward-line 1)
(if (re-search-forward "^[^ \n\t]" nil t)
- (progn
- (beginning-of-line)
- (point))
+ (rfc2047-point-at-bol)
(point-max))))
(goto-char (point-min)))
((eq method 'address-mime)
(rfc2047-encode-region (point) (point-max)))
((eq method 'mime)
- (let (rfc2047-encoding-type)
+ (let ((rfc2047-encoding-type 'mime))
(rfc2047-encode-region (point) (point-max))))
((eq method 'default)
(if (and (featurep 'mule)
(require 'message) ; for message-posting-charset
(let ((charsets
(mm-find-mime-charset-region (point-min) (point-max))))
- (and charsets (not (equal charsets (list message-posting-charset))))))
+ (and charsets
+ (not (equal charsets (list (car message-posting-charset)))))))
;; Use this syntax table when parsing into regions that may need
;; encoding. Double quotes are string delimiters, backslash is
;; skip to the end of regions appropriately. Nb. ietf-drums does
;; things differently.
(defconst rfc2047-syntax-table
- ;; This is what we should do, but XEmacs doesn't support the optional
- ;; arg of `make-syntax-table':
-;; (let ((table (make-char-table 'syntax-table '(2))))
+ ;; (make-char-table 'syntax-table '(2)) only works in Emacs.
(let ((table (make-syntax-table)))
- (map-char-table (lambda (k v) (modify-syntax-entry k "w" table)) table)
+ ;; The following is done to work for setting all elements of the table
+ ;; in Emacs 21 and 22 and XEmacs; it appears to be the cleanest way.
+ ;; Play safe and don't assume the form of the word syntax entry --
+ ;; copy it from ?a.
+ (if (fboundp 'set-char-table-range) ; Emacs
+ (funcall (intern "set-char-table-range")
+ table t (aref (standard-syntax-table) ?a))
+ (if (fboundp 'put-char-table)
+ (if (fboundp 'get-char-table) ; warning avoidance
+ (put-char-table t (get-char-table ?a (standard-syntax-table))
+ table))))
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?\" "\"" table)
(modify-syntax-entry ?\( "." table)
(save-restriction
(narrow-to-region b e)
(if (eq 'mime rfc2047-encoding-type)
- ;; Simple case -- treat as single word.
+ ;; Simple case. Treat as single word after any initial ASCII
+ ;; part and before any tailing ASCII part. The leading ASCII
+ ;; is relevant for instance in Subject headers with `Re:' for
+ ;; interoperability with non-MIME clients, and we might as
+ ;; well avoid the tail too.
(progn
(goto-char (point-min))
;; Does it need encoding?
- (skip-chars-forward "\000-\177" e)
+ (skip-chars-forward "\000-\177")
(unless (eobp)
- (rfc2047-encode b e)))
+ (skip-chars-backward "^ \n") ; beginning of space-delimited word
+ (rfc2047-encode (point) (progn
+ (goto-char e)
+ (skip-chars-backward "\000-\177")
+ (skip-chars-forward "^ \n")
+ ;; end of space-delimited word
+ (point)))))
;; `address-mime' case -- take care of quoted words, comments.
(with-syntax-table rfc2047-syntax-table
(let ((start) ; start of current token
;; token, either immediately or separated by space.
last-encoded)
(goto-char (point-min))
- (condition-case nil ; in case of unbalanced quotes
+ (condition-case nil ; in case of unbalanced quotes
;; Look for rfc2822-style: sequences of atoms, quoted
;; strings, specials, whitespace. (Specials mustn't be
;; encoded.)
(while (not (eobp))
(setq start (point))
;; Skip whitespace.
- (unless (= 0 (skip-chars-forward " \t"))
+ (unless (= 0 (skip-chars-forward " \t\n"))
(setq start (point)))
(cond
((not (char-after))) ; eob
end (1+ end)))
(rfc2047-encode start end)
(setq last-encoded t)))))
- (error (error "Invalid data for rfc2047 encoding: %s"
- (buffer-substring b e)))))))
+ (error
+ (message "Invalid data for rfc2047 encoding: %s"
+ (buffer-substring b e)))))))
(rfc2047-fold-region b (point))))
(defun rfc2047-encode-string (string)
"Encode words in STRING.
By default, the string is treated as containing addresses (see
-`rfc2047-special-chars')."
+`rfc2047-encoding-type')."
(with-temp-buffer
(insert string)
(rfc2047-encode-region (point-min) (point-max))
(defun rfc2047-encode (b e)
"Encode the word(s) in the region B to E.
By default, the region is treated as containing addresses (see
-`rfc2047-special-chars')."
+`rfc2047-encoding-type')."
(let* ((mime-charset (mm-find-mime-charset-region b e))
(cs (if (> (length mime-charset) 1)
;; Fixme: Instead of this, try to break region into
(let ((bol (save-restriction
(widen)
(rfc2047-point-at-bol)))
- (eol (rfc2047-point-at-eol))
- leading)
+ (eol (rfc2047-point-at-eol)))
(forward-line 1)
(while (not (eobp))
(if (and (looking-at "[ \t]")
(save-excursion
(save-restriction
(narrow-to-region (goto-char b) e)
- (let ((alist rfc2047-q-encoding-alist)
- (bol (save-restriction
+ (let ((bol (save-restriction
(widen)
(rfc2047-point-at-bol))))
- (while alist
- (when (looking-at (caar alist))
- (quoted-printable-encode-region b e nil (cdar alist))
- (subst-char-in-region (point-min) (point-max) ? ?_)
- (setq alist nil))
- (pop alist))
+ (quoted-printable-encode-region
+ b e nil
+ ;; = (\075), _ (\137), ? (\077) are used in the encoded word.
+ ;; Avoid using 8bit characters.
+ ;; This list excludes `especials' (see the RFC2047 syntax),
+ ;; meaning that some characters in non-structured fields will
+ ;; get encoded when they con't need to be. The following is
+ ;; what it used to be.
+;;; ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
+;;; "\010\012\014\040-\074\076\100-\136\140-\177")
+ "-\b\n\f !#-'*+0-9A-Z\\^`-~\d")
+ (subst-char-in-region (point-min) (point-max) ? ?_)
;; The size of QP encapsulation is about 20, so set limit to
;; 56=76-20.
(unless (< (- (point-max) (point-min)) 56)
;; Also check whether it needs to worry about delimiting fields like
;; encoding.
+;; In fact it's reported that (invalid) encoding of mailboxes in
+;; addr-specs is in use, so delimiting fields might help. Probably
+;; not decoding a word which isn't properly delimited is good enough
+;; and worthwhile (is it more correct or not?), e.g. something like
+;; `=?iso-8859-1?q?foo?=@'.
+
(defun rfc2047-decode-region (start end)
"Decode MIME-encoded words in region between START and END."
(interactive "r")
(when (and (eq cs 'ascii)
mail-parse-charset)
(setq cs mail-parse-charset))
- ;; Fixme: What's this for? The following comment makes no sense. -- fx
- (mm-with-unibyte-current-buffer
- ;; In Emacs Mule 4, decoding UTF-8 should be in unibyte mode.
- (mm-decode-coding-string
- (cond
- ((equal "B" encoding)
- (base64-decode-string
- (rfc2047-pad-base64 string)))
- ((equal "Q" encoding)
- (quoted-printable-decode-string
- (mm-replace-chars-in-string string ?_ ? )))
- (t (error "Invalid encoding: %s" encoding)))
- cs)))))
+ (mm-decode-coding-string
+ (cond
+ ((equal "B" encoding)
+ (base64-decode-string
+ (rfc2047-pad-base64 string)))
+ ((equal "Q" encoding)
+ (quoted-printable-decode-string
+ (mm-replace-chars-in-string string ?_ ? )))
+ (t (error "Invalid encoding: %s" encoding)))
+ cs))))
(provide 'rfc2047)
projects / gnus / blobdiff