'(("Newsgroups" . nil)
("Followup-To" . nil)
("Message-ID" . nil)
- ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\
+ ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\
\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime)
(t . mime))
"*Header/encoding method alist.
(rfc2047-narrow-to-field)
(if (not (rfc2047-encodable-p))
(prog1
- (if (and (eq (mm-body-7-or-8) '8bit)
- (mm-multibyte-p)
- (mm-coding-system-p
- (car message-posting-charset)))
- ;; 8 bit must be decoded.
- (mm-encode-coding-region
- (point-min) (point-max)
- (mm-charset-to-coding-system
- (car message-posting-charset))))
+ (if (and (eq (mm-body-7-or-8) '8bit)
+ (mm-multibyte-p)
+ (mm-coding-system-p
+ (car message-posting-charset)))
+ ;; 8 bit must be decoded.
+ (mm-encode-coding-region
+ (point-min) (point-max)
+ (mm-charset-to-coding-system
+ (car message-posting-charset))))
;; No encoding necessary, but folding is nice
- (rfc2047-fold-region
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward "^:")
- (when (looking-at ": ")
- (forward-char 2))
- (point))
- (point-max)))
+ (when nil
+ (rfc2047-fold-region
+ (save-excursion
+ (goto-char (point-min))
+ (skip-chars-forward "^:")
+ (when (looking-at ": ")
+ (forward-char 2))
+ (point))
+ (point-max))))
;; We found something that may perhaps be encoded.
(setq method nil
alist rfc2047-header-encoding-alist)
(eq (car elem) t))
(setq alist nil
method (cdr elem))))
- (goto-char (point-min))
(re-search-forward "^[^:]+: *" nil t)
(cond
((eq method 'address-mime)
table))))
(modify-syntax-entry ?\\ "\\" table)
(modify-syntax-entry ?\" "\"" table)
- (modify-syntax-entry ?\( "." table)
- (modify-syntax-entry ?\) "." table)
+ (modify-syntax-entry ?\( "(" table)
+ (modify-syntax-entry ?\) ")" table)
(modify-syntax-entry ?\< "." table)
(modify-syntax-entry ?\> "." table)
(modify-syntax-entry ?\[ "." table)
(save-restriction
(narrow-to-region b e)
(let ((encodable-regexp (if rfc2047-encode-encoded-words
- "[^\000-\177]\\|=\\?"
- "[^\000-\177]"))
+ "[^\000-\177]+\\|=\\?"
+ "[^\000-\177]+"))
start ; start of current token
- end ; end of current token
+ end begin csyntax
;; Whether there's an encoded word before the current token,
;; either immediately or separated by space.
- last-encoded)
+ last-encoded
+ (orig-text (buffer-substring-no-properties b e)))
(if (eq 'mime rfc2047-encoding-type)
;; Simple case. Continuous words in which all those contain
;; non-ASCII characters are encoded collectively. Encoding
;; `address-mime' case -- take care of quoted words, comments.
(with-syntax-table rfc2047-syntax-table
(goto-char (point-min))
- (condition-case nil ; in case of unbalanced quotes
+ (condition-case err ; in case of unbalanced quotes
;; Look for rfc2822-style: sequences of atoms, quoted
;; strings, specials, whitespace. (Specials mustn't be
;; encoded.)
(cond
((not (char-after))) ; eob
;; else token start
- ((eq ?\" (char-syntax (char-after)))
+ ((eq ?\" (setq csyntax (char-syntax (char-after))))
;; Quoted word.
(forward-sexp)
(setq end (point))
;; Does it need encoding?
(goto-char start)
- (skip-chars-forward "\000-\177" end)
- (if (= end (point))
- (setq last-encoded nil)
- ;; It needs encoding. Strip the quotes first,
- ;; since encoded words can't occur in quotes.
- (goto-char end)
- (delete-backward-char 1)
- (goto-char start)
- (delete-char 1)
- (when last-encoded
- ;; There was a preceding quoted word. We need
- ;; to include any separating whitespace in this
- ;; word to avoid it getting lost.
- (skip-chars-backward " \t")
- ;; A space is needed between the encoded words.
- (insert ? )
- (setq start (point)
- end (1+ end)))
- ;; Adjust the end position for the deleted quotes.
- (rfc2047-encode start (- end 2))
- (setq last-encoded t))) ; record that it was encoded
- ((eq ?. (char-syntax (char-after)))
+ (if (re-search-forward encodable-regexp end 'move)
+ ;; It needs encoding. Strip the quotes first,
+ ;; since encoded words can't occur in quotes.
+ (progn
+ (goto-char end)
+ (delete-backward-char 1)
+ (goto-char start)
+ (delete-char 1)
+ (when last-encoded
+ ;; There was a preceding quoted word. We need
+ ;; to include any separating whitespace in this
+ ;; word to avoid it getting lost.
+ (skip-chars-backward " \t")
+ ;; A space is needed between the encoded words.
+ (insert ? )
+ (setq start (point)
+ end (1+ end)))
+ ;; Adjust the end position for the deleted quotes.
+ (rfc2047-encode start (- end 2))
+ (setq last-encoded t)) ; record that it was encoded
+ (setq last-encoded nil)))
+ ((eq ?. csyntax)
;; Skip other delimiters, but record that they've
;; potentially separated quoted words.
(forward-char)
(setq last-encoded nil))
+ ((eq ?\) csyntax)
+ (error "Unbalanced parentheses"))
+ ((eq ?\( csyntax)
+ ;; Look for the end of parentheses.
+ (forward-list)
+ ;; Encode text as an unstructured field.
+ (let ((rfc2047-encoding-type 'mime))
+ (rfc2047-encode-region (1+ start) (1- (point))))
+ (skip-chars-forward ")"))
(t ; normal token/whitespace sequence
;; Find the end.
+ ;; Skip one ASCII word, or encode continuous words
+ ;; in which all those contain non-ASCII characters.
+ (setq end nil)
+ (while (not (or end (eobp)))
+ (when (looking-at "[\000-\177]+")
+ (setq begin (point)
+ end (match-end 0))
+ (when (progn
+ (while (and (or (re-search-forward
+ "[ \t\n]\\|\\Sw" end 'move)
+ (setq end nil))
+ (eq ?\\ (char-syntax (char-before))))
+ ;; Skip backslash-quoted characters.
+ (forward-char))
+ end)
+ (setq end (match-beginning 0))
+ (if rfc2047-encode-encoded-words
+ (progn
+ (goto-char begin)
+ (when (search-forward "=?" end 'move)
+ (goto-char (match-beginning 0))
+ (setq end nil)))
+ (goto-char end))))
+ ;; Where the value nil of `end' means there may be
+ ;; text to have to be encoded following the point.
+ ;; Otherwise, the point reached to the end of ASCII
+ ;; words separated by whitespace or a special char.
+ (unless end
+ (when (looking-at encodable-regexp)
+ (goto-char (setq begin (match-end 0)))
+ (while (and (looking-at "[ \t\n]+\\([^ \t\n]+\\)")
+ (setq end (match-end 0))
+ (progn
+ (while (re-search-forward
+ encodable-regexp end t))
+ (< begin (point)))
+ (goto-char begin)
+ (or (not (re-search-forward "\\Sw" end t))
+ (progn
+ (goto-char (match-beginning 0))
+ nil)))
+ (goto-char end))
+ (when (looking-at "[^ \t\n]+")
+ (setq end (match-end 0))
+ (if (re-search-forward "\\Sw+" end t)
+ ;; There are special characters better
+ ;; to be encoded so that MTAs may parse
+ ;; them safely.
+ (cond ((= end (point)))
+ ((looking-at (concat "\\sw*\\("
+ encodable-regexp
+ "\\)"))
+ (setq end nil))
+ (t
+ (goto-char (1- (match-end 0)))
+ (unless (= (point) (match-beginning 0))
+ ;; Separate encodable text and
+ ;; delimiter.
+ (insert " "))))
+ (goto-char end)
+ (skip-chars-forward " \t\n")
+ (if (and (looking-at "[^ \t\n]+")
+ (string-match encodable-regexp
+ (match-string 0)))
+ (setq end nil)
+ (goto-char end)))))))
(skip-chars-backward " \t\n")
- (if (and (eq (char-before) ?\()
- ;; Look for the end of parentheses.
- (let ((string (buffer-substring (point)
- (point-max)))
- (default-major-mode 'fundamental-mode))
- ;; Use `standard-syntax-table'.
- (with-temp-buffer
- (insert "(" string)
- (goto-char (point-min))
- (condition-case nil
- (progn
- (forward-list 1)
- (setq end (- (point) 3)))
- (error nil)))))
- ;; Encode text as an unstructured field.
- (let ((rfc2047-encoding-type 'mime))
- (rfc2047-encode-region start (+ (point) end))
- (forward-char))
- ;; Skip one ASCII word, or encode continuous words
- ;; in which all those contain non-ASCII characters.
- (skip-chars-forward " \t\n")
- (setq end nil)
- (while (not end)
- (when (looking-at "[\000-\177]+")
- (setq end (match-end 0))
- (if (re-search-forward "[ \t\n]\\|\\Sw" end t)
- (goto-char (match-beginning 0))
- (goto-char end)
- (setq end nil)))
- (unless end
- (setq end t)
- (when (looking-at "[^\000-\177]+")
- (goto-char (match-end 0))
- (while (and (looking-at "[ \t\n]+\\([^ \t\n]+\\)")
- (setq end (match-end 0))
- (string-match "[^\000-\177]"
- (match-string 1)))
- (goto-char end))
- (when (looking-at "[^ \t\n]+")
- (setq end (match-end 0))
- (if (re-search-forward "\\Sw+" end t)
- ;; There are special characters better
- ;; to be encoded so that MTAs may parse
- ;; them safely.
- (cond ((= end (point)))
- ((looking-at "[^\000-\177]")
- (setq end nil))
- (t
- (goto-char (1- (match-end 0)))
- (unless (= (point) (match-beginning 0))
- (insert " "))))
- (goto-char end)
- (skip-chars-forward " \t\n")
- (if (and (looking-at "[^ \t\n]+")
- (string-match "[^\000-\177]"
- (match-string 0)))
- (setq end nil)
- (goto-char end)))))))
- (skip-chars-backward " \t\n")
- (setq end (point))
- (goto-char start)
- (skip-chars-forward "\000-\177" end)
- (if (= end (point))
- (setq last-encoded nil)
- (rfc2047-encode start end)
- (setq last-encoded t))))))
+ (setq end (point))
+ (goto-char start)
+ (if (re-search-forward encodable-regexp end 'move)
+ (progn
+ (unless (memq (char-before start) '(nil ?\t ? ))
+ (if (progn
+ (goto-char start)
+ (skip-chars-backward "^ \t\n")
+ (and (looking-at "\\Sw+")
+ (= (match-end 0) start)))
+ ;; Also encode bogus delimiters.
+ (setq start (point))
+ ;; Separate encodable text and delimiter.
+ (goto-char start)
+ (insert " ")
+ (setq start (1+ start)
+ end (1+ end))))
+ (rfc2047-encode start end)
+ (setq last-encoded t))
+ (setq last-encoded nil)))))
(error
- (error "Invalid data for rfc2047 encoding: %s"
- (buffer-substring b e)))))))
- (rfc2047-fold-region b (point))))
+ (if (or debug-on-quit debug-on-error)
+ (signal (car err) (cdr err))
+ (error "Invalid data for rfc2047 encoding: %s"
+ (mm-replace-in-string orig-text "[ \t\n]+" " "))))))))
+ (rfc2047-fold-region b (point))
+ (goto-char (point-max))))
(defun rfc2047-encode-string (string)
"Encode words in STRING.
By default, the string is treated as containing addresses (see
`rfc2047-encoding-type')."
- (with-temp-buffer
+ (mm-with-multibyte-buffer
(insert string)
(rfc2047-encode-region (point-min) (point-max))
(buffer-string)))
-(defun rfc2047-encode-1 (column string cs encoder start space &optional eword)
+(defvar rfc2047-encode-max-chars 76
+ "Maximum characters of each header line that contain encoded-words.
+If it is nil, encoded-words will not be folded. Too small value may
+cause an error. Don't change this for no particular reason.")
+
+(defun rfc2047-encode-1 (column string cs encoder start crest tail
+ &optional eword)
"Subroutine used by `rfc2047-encode'."
(cond ((string-equal string "")
(or eword ""))
- ((>= column 76)
- (when (and eword
- (string-match "\n[ \t]+\\'" eword))
- ;; Reomove a superfluous empty line.
- (setq eword (substring eword 0 (match-beginning 0))))
- (rfc2047-encode-1 (length space) string cs encoder start " "
- (concat eword "\n" space)))
+ ((not rfc2047-encode-max-chars)
+ (concat start
+ (funcall encoder (if cs
+ (mm-encode-coding-string string cs)
+ string))
+ "?="))
+ ((>= column rfc2047-encode-max-chars)
+ (when eword
+ (cond ((string-match "\n[ \t]+\\'" eword)
+ ;; Reomove a superfluous empty line.
+ (setq eword (substring eword 0 (match-beginning 0))))
+ ((string-match "(+\\'" eword)
+ ;; Break the line before the open parenthesis.
+ (setq crest (concat crest (match-string 0 eword))
+ eword (substring eword 0 (match-beginning 0))))))
+ (rfc2047-encode-1 (length crest) string cs encoder start " " tail
+ (concat eword "\n" crest)))
(t
(let ((index 0)
(limit (1- (length string)))
(prev "")
- next)
+ next len)
(while (and prev
(<= index limit))
(setq next (concat start
(substring string 0 (1+ index))
cs)
(substring string 0 (1+ index))))
- "?="))
- (if (<= (+ column (length next)) 76)
- (setq prev next
- index (1+ index))
- (setq next prev
- prev nil)))
- (setq eword (concat eword next))
+ "?=")
+ len (+ column (length next)))
+ (if (> len rfc2047-encode-max-chars)
+ (setq next prev
+ prev nil)
+ (if (or (< index limit)
+ (<= (+ len (or (string-match "\n" tail)
+ (length tail)))
+ rfc2047-encode-max-chars))
+ (setq prev next
+ index (1+ index))
+ (if (string-match "\\`)+" tail)
+ ;; Break the line after the close parenthesis.
+ (setq tail (concat (substring tail 0 (match-end 0))
+ "\n "
+ (substring tail (match-end 0)))
+ prev next
+ index (1+ index))
+ (setq next prev
+ prev nil)))))
(if (> index limit)
- eword
+ (concat eword next tail)
+ (if (= 0 index)
+ (if (and eword
+ (string-match "(+\\'" eword))
+ (setq crest (concat crest (match-string 0 eword))
+ eword (substring eword 0 (match-beginning 0)))
+ (setq eword (concat eword next)))
+ (setq crest " "
+ eword (concat eword next)))
(when (string-match "\n[ \t]+\\'" eword)
;; Reomove a superfluous empty line.
(setq eword (substring eword 0 (match-beginning 0))))
- (rfc2047-encode-1 (length space) (substring string index)
- cs encoder start " "
- (concat eword "\n" space)))))))
+ (rfc2047-encode-1 (length crest) (substring string index)
+ cs encoder start " " tail
+ (concat eword "\n" crest)))))))
(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-encoding-type')."
+Point moves to the end of the region."
(let ((mime-charset (or (mm-find-mime-charset-region b e) (list 'us-ascii)))
- cs encoding space eword)
+ cs encoding tail crest eword)
(cond ((> (length mime-charset) 1)
(error "Can't rfc2047-encode `%s'"
(buffer-substring-no-properties b e)))
'B
'Q)))
(widen)
+ (goto-char e)
+ (skip-chars-forward "^ \t\n")
+ ;; `tail' may contain a close parenthesis.
+ (setq tail (buffer-substring-no-properties e (point)))
(goto-char b)
+ (setq b (point-marker)
+ e (set-marker (make-marker) e))
+ (rfc2047-fold-region (point-at-bol) b)
+ (goto-char b)
+ (skip-chars-backward "^ \t\n")
(unless (= 0 (skip-chars-backward " \t"))
- (setq space (buffer-substring-no-properties (point) b)))
+ ;; `crest' may contain whitespace and an open parenthesis.
+ (setq crest (buffer-substring-no-properties (point) b)))
(setq eword (rfc2047-encode-1
(- b (point-at-bol))
(mm-replace-in-string
'identity)
(concat "=?" (downcase (symbol-name mime-charset))
"?" (upcase (symbol-name encoding)) "?")
- (or space " ")))
+ (or crest " ")
+ tail))
(delete-region (if (eq (aref eword 0) ?\n)
- (point)
+ (if (bolp)
+ ;; The line was folded before encoding.
+ (1- (point))
+ (point))
(goto-char b))
- e)
+ (+ e (length tail)))
+ ;; `eword' contains `crest' and `tail'.
(insert eword)
- (unless (or (eolp)
+ (set-marker b nil)
+ (set-marker e nil)
+ (unless (or (/= 0 (length tail))
+ (eobp)
(looking-at "[ \t\n)]"))
(insert " "))))
(t
(goto-char (or break qword-break))
(setq break nil
qword-break nil)
- (if (looking-at "[ \t]")
- (insert ?\n)
- (insert "\n "))
+ (if (or (> 0 (skip-chars-backward " \t"))
+ (looking-at "[ \t]"))
+ (insert ?\n)
+ (insert "\n "))
(setq bol (1- (point)))
;; Don't break before the first non-LWSP characters.
(skip-chars-forward " \t")
(subst-char-in-region (point-min) (point-max) ? ?_)
(buffer-string)))
+(defun rfc2047-encode-parameter (param value)
+ "Return and PARAM=VALUE string encoded in the RFC2047-like style.
+This is a replacement for the `rfc2231-encode-string' function.
+
+When attaching files as MIME parts, we should use the RFC2231 encoding
+to specify the file names containing non-ASCII characters. However,
+many mail softwares don't support it in practice and recipients won't
+be able to extract files with correct names. Instead, the RFC2047-like
+encoding is acceptable generally. This function provides the very
+RFC2047-like encoding, resigning to such a regrettable trend. To use
+it, put the following line in your ~/.gnus.el file:
+
+\(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter)
+"
+ (let* ((rfc2047-encoding-type 'mime)
+ (rfc2047-encode-max-chars nil)
+ (string (rfc2047-encode-string value)))
+ (if (string-match "[][()<>@,;:\\\"/?=]" ;; tspecials
+ string)
+ (format "%s=%S" param string)
+ (concat param "=" string))))
+
;;;
;;; Functions for decoding RFC2047 messages
;;;
(memq 'gnus-unknown mail-parse-ignored-charsets))
(setq cs (mm-charset-to-coding-system mail-parse-charset)))
(when cs
- (when (and (eq cs 'ascii)
- mail-parse-charset)
- (setq cs mail-parse-charset))
+ (when (eq cs 'ascii)
+ (setq cs (or mail-parse-charset 'raw-text)))
(mm-decode-coding-string
(cond
((char-equal ?B encoding)
projects / gnus / blobdiff