Relicense "GPLv2 or later" files to "GPLv3 or later".

[gnus] / lisp / rfc2047.el

diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index 09de21a..4f63cae 100644 (file)
--- a/lisp/rfc2047.el
+++ b/lisp/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 Free Software Foundation, Inc.
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -9,7 +9,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -38,7 +38,7 @@
 (require 'ietf-drums)
 ;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus.
 (require 'mail-prsvr)
-(require 'base64)
+(require 'rfc2045) ;; rfc2045-encode-string
 (autoload 'mm-body-7-or-8 "mm-bodies")
 
 (defvar rfc2047-header-encoding-alist
@@ -146,37 +146,50 @@ This is either `base64' or `quoted-printable'."
                                                           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."
+matching ENCODABLE-REGEXP or it is within parentheses."
   (goto-char (point-min))
   (let ((tspecials (concat "[" ietf-drums-tspecials "]"))
+       (start (point))
        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))))))))
+      (while (not (eobp))
+       (if (ignore-errors
+             (forward-list 1)
+             (eq (char-before) ?\)))
+           (forward-list -1)
+         (goto-char (point-max)))
+       (save-restriction
+         (narrow-to-region start (point))
+         (goto-char start)
+         (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)))))
+         (goto-char (point-max)))
+       (forward-list 1)
+       (setq start (point))))))
 
 (defvar rfc2047-encoding-type 'address-mime
   "The type of encoding done by `rfc2047-encode-region'.
@@ -261,9 +274,10 @@ Should be called narrowed to the head of the message."
 ;;;              (rfc2047-encode-region (point-min) (point-max))
 ;;;            (error "Cannot send unencoded text")))
             ((mm-coding-system-p method)
-             (if (and (featurep 'mule)
-                      (if (boundp 'default-enable-multibyte-characters)
-                          default-enable-multibyte-characters))
+             (if (or (and (featurep 'mule)
+                          (if (boundp 'default-enable-multibyte-characters)
+                              default-enable-multibyte-characters))
+                     (featurep 'file-coding))
                  (mm-encode-coding-region (point) (point-max) method)))
             ;; Hm.
             (t)))
@@ -803,12 +817,9 @@ 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 (concat "[" ietf-drums-tspecials "]") string)
-       (format "%s=%S" param string)
-      (concat param "=" string))))
+  (let ((rfc2047-encoding-type 'mime)
+       (rfc2047-encode-max-chars nil))
+    (rfc2045-encode-string param (rfc2047-encode-string value))))
 
 ;;;
 ;;; Functions for decoding RFC2047 messages