diff options
author | Karoly Lorentey <lorentey@elte.hu> | 2006-10-14 17:36:28 +0000 |
---|---|---|
committer | Karoly Lorentey <lorentey@elte.hu> | 2006-10-14 17:36:28 +0000 |
commit | 12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a (patch) | |
tree | 1775f9fd1c92defd8b61304a08ec00da95bc4539 /lisp/gnus/rfc2047.el | |
parent | 3f87f67ee215ffeecbd2f53bd7f342cdf03f47df (diff) | |
parent | f763da8d0808af7c80d72bc586bf4fcf50b37ddd (diff) | |
download | emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.tar.gz emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.tar.bz2 emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.zip |
Merged from emacs@sv.gnu.org
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-413
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-414
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-415
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-416
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-417
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-418
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-419
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-420
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-421
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-422
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-423
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-424
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-425
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-426
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-427
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-428
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-429
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-430
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-431
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-432
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-433
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-434
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-435
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-436
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-437
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-438
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-439
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-440
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-441
lisp/url/url-methods.el: Fix format error when http_proxy is empty string
* emacs@sv.gnu.org/emacs--devo--0--patch-442
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-443
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-444
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-445
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-446
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-447
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-448
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-449
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-450
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-451
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-452
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-453
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-454
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-455
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-456
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-457
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-458
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-459
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-460
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-461
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-462
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-463
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-464
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-465
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-466
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-467
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-468
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-469
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-470
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-471
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-472
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-473
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-128
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-129
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-130
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-131
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-132
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-133
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-134
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-135
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-136
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-137
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-138
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-139
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-140
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-141
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-142
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-143
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-144
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-145
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-146
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-147
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-148
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-149
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-582
Diffstat (limited to 'lisp/gnus/rfc2047.el')
-rw-r--r-- | lisp/gnus/rfc2047.el | 116 |
1 files changed, 102 insertions, 14 deletions
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index aa30d9ba783..40b10c07eb4 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -171,6 +171,42 @@ This is either `base64' or `quoted-printable'." (re-search-forward ":[ \t\n]*" nil t) (buffer-substring-no-properties (point) (point-max))))) +(defun rfc2047-quote-special-characters-in-quoted-strings (&optional + encodable-regexp) + "Quote special characters with `\\'s in quoted strings. +Quoting will not be done in a quoted string if it contains characters +matching ENCODABLE-REGEXP." + (goto-char (point-min)) + (let ((tspecials (concat "[" ietf-drums-tspecials "]")) + beg end) + (with-syntax-table (standard-syntax-table) + (while (search-forward "\"" nil t) + (setq beg (match-beginning 0)) + (unless (eq (char-before beg) ?\\) + (goto-char beg) + (setq beg (1+ beg)) + (condition-case nil + (progn + (forward-sexp) + (setq end (1- (point))) + (goto-char beg) + (if (and encodable-regexp + (re-search-forward encodable-regexp end t)) + (goto-char (1+ end)) + (save-restriction + (narrow-to-region beg end) + (while (re-search-forward tspecials nil 'move) + (if (eq (char-before) ?\\) + (if (looking-at tspecials) ;; Already quoted. + (forward-char) + (insert "\\")) + (goto-char (match-beginning 0)) + (insert "\\") + (forward-char)))) + (forward-char))) + (error + (goto-char beg)))))))) + (defvar rfc2047-encoding-type 'address-mime "The type of encoding done by `rfc2047-encode-region'. This should be dynamically bound around calls to @@ -187,8 +223,18 @@ Should be called narrowed to the head of the message." (while (not (eobp)) (save-restriction (rfc2047-narrow-to-field) + (setq method nil + alist rfc2047-header-encoding-alist) + (while (setq elem (pop alist)) + (when (or (and (stringp (car elem)) + (looking-at (car elem))) + (eq (car elem) t)) + (setq alist nil + method (cdr elem)))) (if (not (rfc2047-encodable-p)) - (prog1 + (prog2 + (when (eq method 'address-mime) + (rfc2047-quote-special-characters-in-quoted-strings)) (if (and (eq (mm-body-7-or-8) '8bit) (mm-multibyte-p) (mm-coding-system-p @@ -209,14 +255,6 @@ Should be called narrowed to the head of the message." (point)) (point-max)))) ;; We found something that may perhaps be encoded. - (setq method nil - alist rfc2047-header-encoding-alist) - (while (setq elem (pop alist)) - (when (or (and (stringp (car elem)) - (looking-at (car elem))) - (eq (car elem) t)) - (setq alist nil - method (cdr elem)))) (re-search-forward "^[^:]+: *" nil t) (cond ((eq method 'address-mime) @@ -347,6 +385,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." (rfc2047-encode start (point)) (goto-char end)))) ;; `address-mime' case -- take care of quoted words, comments. + (rfc2047-quote-special-characters-in-quoted-strings encodable-regexp) (with-syntax-table rfc2047-syntax-table (goto-char (point-min)) (condition-case err ; in case of unbalanced quotes @@ -821,6 +860,29 @@ encoded-word, concatenate them, and decode it by charset. Otherwise, the decoder will fully decode each encoded-word before concatenating them.") +(defun rfc2047-strip-backslashes-in-quoted-strings () + "Strip backslashes in quoted strings. `\\\"' remains." + (goto-char (point-min)) + (let (beg) + (with-syntax-table (standard-syntax-table) + (while (search-forward "\"" nil t) + (unless (eq (char-before) ?\\) + (setq beg (match-end 0)) + (goto-char (match-beginning 0)) + (condition-case nil + (progn + (forward-sexp) + (save-restriction + (narrow-to-region beg (1- (point))) + (goto-char beg) + (while (search-forward "\\" nil 'move) + (unless (memq (char-after) '(?\")) + (delete-backward-char 1)) + (forward-char))) + (forward-char)) + (error + (goto-char beg)))))))) + (defun rfc2047-charset-to-coding-system (charset) "Return coding-system corresponding to MIME CHARSET. If your Emacs implementation can't decode CHARSET, return nil." @@ -898,8 +960,10 @@ ENCODED-WORD)." ;; 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." +(defun rfc2047-decode-region (start end &optional address-mime) + "Decode MIME-encoded words in region between START and END. +If ADDRESS-MIME is non-nil, strip backslashes which precede characters +other than `\"' and `\\' in quoted strings." (interactive "r") (let ((case-fold-search t) (eword-regexp (eval-when-compile @@ -910,6 +974,8 @@ ENCODED-WORD)." (save-excursion (save-restriction (narrow-to-region start end) + (when address-mime + (rfc2047-strip-backslashes-in-quoted-strings)) (goto-char (setq b start)) ;; Look for the encoded-words. (while (setq match (re-search-forward eword-regexp nil t)) @@ -995,8 +1061,16 @@ ENCODED-WORD)." (not (eq mail-parse-charset 'gnus-decoded))) (mm-decode-coding-region b (point-max) mail-parse-charset)))))) -(defun rfc2047-decode-string (string) - "Decode the quoted-printable-encoded STRING and return the results." +(defun rfc2047-decode-address-region (start end) + "Decode MIME-encoded words in region between START and END. +Backslashes which precede characters other than `\"' and `\\' in quoted +strings are stripped." + (rfc2047-decode-region start end t)) + +(defun rfc2047-decode-string (string &optional address-mime) + "Decode MIME-encoded STRING and return the result. +If ADDRESS-MIME is non-nil, strip backslashes which precede characters +other than `\"' and `\\' in quoted strings." (let ((m (mm-multibyte-p))) (if (string-match "=\\?" string) (with-temp-buffer @@ -1010,8 +1084,16 @@ ENCODED-WORD)." (mm-enable-multibyte)) (insert string) (inline - (rfc2047-decode-region (point-min) (point-max))) + (rfc2047-decode-region (point-min) (point-max) address-mime)) (buffer-string)) + (when address-mime + (setq string + (with-temp-buffer + (when (mm-multibyte-string-p string) + (mm-enable-multibyte)) + (insert string) + (rfc2047-strip-backslashes-in-quoted-strings) + (buffer-string)))) ;; Fixme: As above, `m' here is inappropriate. (if (and m mail-parse-charset @@ -1033,6 +1115,12 @@ ENCODED-WORD)." (mm-decode-coding-string string mail-parse-charset)) (mm-string-as-multibyte string))))) +(defun rfc2047-decode-address-string (string) + "Decode MIME-encoded STRING and return the result. +Backslashes which precede characters other than `\"' and `\\' in quoted +strings are stripped." + (rfc2047-decode-string string t)) + (defun rfc2047-pad-base64 (string) "Pad STRING to quartets." ;; Be more liberal to accept buggy base64 strings. If |