;;; Code:
+(eval-when-compile (require 'cl))
(eval-and-compile
(eval
'(unless (fboundp 'base64-decode-string)
(defvar rfc2047-header-encoding-alist
'(("Newsgroups" . nil)
("Message-ID" . nil)
+ ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
+ "-A-Za-z0-9!*+/=_")
(t . mime))
"*Header/encoding method alist.
The list is traversed sequentially. The keys can either be
2) `mime', in which case the header will be encoded according to RFC2047;
3) a charset, in which case it will be encoded as that charset;
4) `default', in which case the field will be encoded as the rest
- of the article.")
+ of the article.
+5) a string, like `mime', expect for using it as word-chars.")
(defvar rfc2047-charset-encoding-alist
'((us-ascii . nil)
"Alist of RFC2047 encodings to encoding functions.")
(defvar rfc2047-q-encoding-alist
- '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/")
+ '(("\\(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. Some versions of Emacs has bug!
;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
(setq alist nil
method (cdr elem))))
(cond
+ ((stringp method)
+ (rfc2047-encode-region (point-min) (point-max) method))
((eq method 'mime)
(rfc2047-encode-region (point-min) (point-max)))
((eq method 'default)
mail-parse-charset)
(mm-encode-coding-region (point-min) (point-max)
mail-parse-charset)))
+ ((null method)
+ (and (delq 'ascii
+ (mm-find-charset-region (point-min)
+ (point-max)))
+ (if (or (message-options-get
+ 'rfc2047-encode-message-header-encode-any)
+ (message-options-set
+ 'rfc2047-encode-message-header-encode-any
+ (y-or-n-p
+ "Some texts are not encoded. Encode anyway?")))
+ (rfc2047-encode-region (point-min) (point-max))
+ (error "Cannot send unencoded text."))))
((mm-coding-system-p method)
(if (featurep 'mule)
(mm-encode-coding-region (point-min) (point-max) method)))
(setq found t)))
found))
-(defun rfc2047-dissect-region (b e)
+(defun rfc2047-dissect-region (b e &optional word-chars)
"Dissect the region between B and E into words."
- (let ((word-chars "-A-Za-z0-9!*+/")
- ;; Not using ietf-drums-specials-token makes life simple.
- mail-parse-mule-charset
+ (unless word-chars
+ ;; Anything except most CTLs, WSP
+ (setq word-chars "\010\012\014\041-\177"))
+ (let (mail-parse-mule-charset
words point current
result word)
(save-restriction
(setq word (pop words))))
result))
-(defun rfc2047-encode-region (b e)
+(defun rfc2047-encode-region (b e &optional word-chars)
"Encode all encodable words in REGION."
- (let ((words (rfc2047-dissect-region b e)) word)
+ (let ((words (rfc2047-dissect-region b e word-chars)) word)
(save-restriction
(narrow-to-region b e)
(delete-region (point-min) (point-max))
(cdr word))))
(rfc2047-fold-region (point-min) (point-max)))))
-(defun rfc2047-encode-string (string)
+(defun rfc2047-encode-string (string &optional word-chars)
"Encode words in STRING."
(with-temp-buffer
(insert string)
- (rfc2047-encode-region (point-min) (point-max))
+ (rfc2047-encode-region (point-min) (point-max) word-chars)
(buffer-string)))
(defun rfc2047-encode (b e charset)
(narrow-to-region b e)
(goto-char (point-min))
(let ((break nil)
+ (qword-break nil)
(bol (save-restriction
(widen)
(gnus-point-at-bol))))
(while (not (eobp))
- (when (and break (> (- (point) bol) 76))
- (goto-char break)
- (setq break nil)
+ (when (and (or break qword-break) (> (- (point) bol) 76))
+ (goto-char (or break qword-break))
+ (setq break nil
+ qword-break nil)
(insert "\n ")
(setq bol (1- (point)))
;; Don't break before the first non-LWSP characters.
((eq (char-after) ?\n)
(forward-char 1)
(setq bol (point)
- break nil)
+ break nil
+ qword-break nil)
(skip-chars-forward " \t")
(unless (or (eobp) (eq (char-after) ?\n))
(forward-char 1)))
(skip-chars-forward " \t")
(setq break (1- (point))))
((not break)
- (if (not (looking-at "=\\?"))
+ (if (not (looking-at "=\\?[^=]"))
(if (eq (char-after) ?=)
(forward-char 1)
(skip-chars-forward "^ \t\n\r="))
- (setq break (point))
+ (setq qword-break (point))
(skip-chars-forward "^ \t\n\r")))
(t
(skip-chars-forward "^ \t\n\r"))))
- (when (and break (> (- (point) bol) 76))
- (goto-char break)
- (setq break nil)
+ (when (and (or break qword-break) (> (- (point) bol) 76))
+ (goto-char (or break qword-break))
+ (setq break nil
+ qword-break nil)
(insert "\n ")
(setq bol (1- (point)))
;; Don't break before the first non-LWSP characters.
(save-excursion
(save-restriction
(narrow-to-region (goto-char b) e)
- (let ((alist rfc2047-q-encoding-alist))
+ (let ((alist rfc2047-q-encoding-alist)
+ (bol (save-restriction
+ (widen)
+ (gnus-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))
- (goto-char (1+ (point-min)))
- (while (and (not (bobp)) (not (eobp)))
- (goto-char (min (point-max) (save-restriction
- (widen)
- ;; THe QP encapsulation is about 20.
- (+ 56 (gnus-point-at-bol)))))
- (search-backward "=" (- (point) 2) t)
- (unless (or (bobp) (eobp))
- (insert "\n")))))))
+ ;; The size of QP encapsulation is about 20, so set limit to
+ ;; 56=76-20.
+ (unless (< (- (point-max) (point-min)) 56)
+ ;; Don't break if it could fit in one line.
+ ;; Let rfc2047-encode-region break it later.
+ (goto-char (1+ (point-min)))
+ (while (and (not (bobp)) (not (eobp)))
+ (goto-char (min (point-max) (+ 56 bol)))
+ (search-backward "=" (- (point) 2) t)
+ (unless (or (bobp) (eobp))
+ (insert "\n")
+ (setq bol (point)))))))))
;;;
;;; Functions for decoding RFC2047 messages
;;;
(defvar rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=")
+ "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]*\\)\\?=")
(defun rfc2047-decode-region (start end)
"Decode MIME-encoded words in region between START and END."
(error word))
word)))
+(defun rfc2047-pad-base64 (string)
+ "Pad STRING to quartets."
+ ;; Be more liberal to accept buggy base64 strings. If
+ ;; base64-decode-string accepts buggy strings, this function could
+ ;; be aliased to identity.
+ (case (mod (length string) 4)
+ (0 string)
+ (1 string) ;; Error, don't pad it.
+ (2 (concat string "=="))
+ (3 (concat string "="))))
+
(defun rfc2047-decode (charset encoding string)
"Decode STRING that uses CHARSET with ENCODING.
Valid ENCODINGs are \"B\" and \"Q\".
(when (and (eq cs 'ascii)
mail-parse-charset)
(setq cs mail-parse-charset))
- (mm-with-unibyte-current-buffer
+ (mm-with-unibyte-current-buffer-mule4
;; In Emacs Mule 4, decoding UTF-8 should be in unibyte mode.
(mm-decode-coding-string
(cond
((equal "B" encoding)
- (base64-decode-string string))
+ (base64-decode-string
+ (rfc2047-pad-base64 string)))
((equal "Q" encoding)
(quoted-printable-decode-string
(mm-replace-chars-in-string string ?_ ? )))
projects / elisp / gnus.git- / blobdiff