X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/3f715d17fef56ee78a3df7ebb00d4e8b1aec37de..6ec07c5ad9aa8b9292025e0f9ed820b678852896:/lisp/gnus/rfc2047.el diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index 89c10a99e0..8a7153969a 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -1,7 +1,7 @@ ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -31,7 +31,6 @@ (require 'cl)) (defvar message-posting-charset) -(require 'qp) (require 'mm-util) (require 'ietf-drums) ;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus. @@ -282,8 +281,8 @@ Should be called narrowed to the head of the message." (rfc2047-encode-region (point) (point-max)))) ((eq method 'default) (if (and (featurep 'mule) - (if (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters) + (if (boundp 'enable-multibyte-characters) + (default-value 'enable-multibyte-characters)) mail-parse-charset) (mm-encode-coding-region (point) (point-max) mail-parse-charset))) @@ -291,7 +290,7 @@ Should be called narrowed to the head of the message." ;; 8-bit names. The group name mail copy just got ;; unconditionally encoded. Previously, it would ask ;; whether to encode, which was quite confusing for the - ;; user. If the new behaviour is wrong, tell me. I have + ;; user. If the new behavior is wrong, tell me. I have ;; left the old code commented out below. ;; -- Per Abrahamsen Date: 2001-10-07. ;; Modified by Dave Love, with the commented-out code changed @@ -309,8 +308,8 @@ Should be called narrowed to the head of the message." ;;; (error "Cannot send unencoded text"))) ((mm-coding-system-p method) (if (or (and (featurep 'mule) - (if (boundp 'default-enable-multibyte-characters) - default-enable-multibyte-characters)) + (if (boundp 'enable-multibyte-characters) + (default-value 'enable-multibyte-characters))) (featurep 'file-coding)) (mm-encode-coding-region (point) (point-max) method))) ;; Hm. @@ -343,8 +342,8 @@ The buffer may be narrowed." (defconst rfc2047-syntax-table ;; (make-char-table 'syntax-table '(2)) only works in Emacs. (let ((table (make-syntax-table))) - ;; The following is done to work for setting all elements of the table - ;; in Emacs 21-23 and XEmacs; it appears to be the cleanest way. + ;; The following is done to work for setting all elements of the table; + ;; 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 @@ -428,7 +427,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." ;; since encoded words can't occur in quotes. (progn (goto-char end) - (delete-backward-char 1) + (delete-char -1) (goto-char start) (delete-char 1) (when last-encoded @@ -656,6 +655,9 @@ should not change this value.") Point moves to the end of the region." (let ((mime-charset (or (mm-find-mime-charset-region b e) (list 'us-ascii))) cs encoding tail crest eword) + ;; Use utf-8 as a last resort if determining charset of text fails. + (if (memq nil mime-charset) + (setq mime-charset (list 'utf-8))) (cond ((> (length mime-charset) 1) (error "Can't rfc2047-encode `%s'" (buffer-substring-no-properties b e))) @@ -827,6 +829,8 @@ Point moves to the end of the region." "Base64-encode the header contained in STRING." (base64-encode-string string t)) +(autoload 'quoted-printable-encode-region "qp") + (defun rfc2047-q-encode-string (string) "Quoted-printable-encode the header in STRING." (mm-with-unibyte-buffer @@ -847,18 +851,8 @@ Point moves to the end of the region." (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) -" +This is a substitution for the `rfc2231-encode-string' function, that +is the standard but many mailers don't support it." (let ((rfc2047-encoding-type 'mime) (rfc2047-encode-max-chars nil)) (rfc2045-encode-string param (rfc2047-encode-string value)))) @@ -896,15 +890,19 @@ them.") (goto-char beg) (while (search-forward "\\" nil 'move) (unless (memq (char-after) '(?\")) - (delete-backward-char 1)) + (delete-char -1)) (forward-char))) (forward-char)) (error (goto-char beg)))))))) -(defun rfc2047-charset-to-coding-system (charset) +(defun rfc2047-charset-to-coding-system (charset &optional allow-override) "Return coding-system corresponding to MIME CHARSET. -If your Emacs implementation can't decode CHARSET, return nil." +If your Emacs implementation can't decode CHARSET, return nil. + +If allow-override is given, use `mm-charset-override-alist' to +map undesired charset names to their replacement. This should +only be used for decoding, not for encoding." (when (stringp charset) (setq charset (intern (downcase charset)))) (when (or (not charset) @@ -912,7 +910,7 @@ If your Emacs implementation can't decode CHARSET, return nil." (memq 'gnus-all mail-parse-ignored-charsets) (memq charset mail-parse-ignored-charsets)) (setq charset mail-parse-charset)) - (let ((cs (mm-charset-to-coding-system charset))) + (let ((cs (mm-charset-to-coding-system charset nil allow-override))) (cond ((eq cs 'ascii) (setq cs (or (mm-charset-to-coding-system mail-parse-charset) 'raw-text))) @@ -925,6 +923,8 @@ If your Emacs implementation can't decode CHARSET, return nil." 'raw-text cs))) +(autoload 'quoted-printable-decode-string "qp") + (defun rfc2047-decode-encoded-words (words) "Decode successive encoded-words in WORDS and return a decoded string. Each element of WORDS looks like (CHARSET ENCODING ENCODED-TEXT @@ -933,7 +933,7 @@ ENCODED-WORD)." (while words (setq word (pop words)) (if (and (setq cs (rfc2047-charset-to-coding-system - (setq charset (car word)))) + (setq charset (car word)) t)) (condition-case code (cond ((char-equal ?B (nth 1 word)) (setq text (base64-decode-string @@ -1022,6 +1022,7 @@ other than `\"' and `\\' in quoted strings." ;; things essentially must not be there. (while (re-search-forward "[\n\r]+" nil t) (replace-match " ")) + (setq end (point-max)) ;; Quote decoded words if there are special characters ;; which might violate RFC2822. (when (and rfc2047-quote-decoded-words-containing-tspecials @@ -1031,17 +1032,22 @@ other than `\"' and `\\' in quoted strings." (when regexp (save-restriction (widen) - (beginning-of-line) - (while (and (memq (char-after) '(? ?\t)) - (zerop (forward-line -1)))) - (looking-at regexp))))) + (and + ;; Don't quote words if already quoted. + (not (and (eq (char-before e) ?\") + (eq (char-after end) ?\"))) + (progn + (beginning-of-line) + (while (and (memq (char-after) '(? ?\t)) + (zerop (forward-line -1)))) + (looking-at regexp))))))) (let (quoted) (goto-char e) (skip-chars-forward " \t") (setq start (point)) (setq quoted (eq (char-after) ?\")) (goto-char (point-max)) - (skip-chars-backward " \t") + (skip-chars-backward " \t" start) (if (setq quoted (and quoted (> (point) (1+ start)) (eq (char-before) ?\"))) @@ -1159,5 +1165,4 @@ strings are stripped." (provide 'rfc2047) -;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6 ;;; rfc2047.el ends here