Changeset 4161 for trunk/lisp/gnus/rfc2047.el

Timestamp:

09/09/06 16:30:10 (2 years ago)

Author:

miyoshi

Message:

Sync up with Emacs CVS HEAD.

Files:

• trunk/lisp/gnus/rfc2047.el (modified) (10 diffs)

trunk/lisp/gnus/rfc2047.el

@@ -172 +172 @@
-      (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)
+    (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)
+                  (unless (and encodable-regexp
+                               (re-search-forward encodable-regexp nil t))
+                    (while (re-search-forward tspecials nil 'move)
+                      (unless (and (eq (char-before) ?\\) ;; Already quoted.
+                                   (looking-at tspecials))
+                        (goto-char (match-beginning 0))
+                        (unless (or (eq (char-before) ?\\)
+                                    (and rfc2047-encode-encoded-words
+                                         (eq (char-after) ??)
+                                         (eq (char-before) ?=)))
+                          (insert "\\")))
+                      (forward-char)))))
+            (error
+             (goto-char beg))))))))
+
-(defvar rfc2047-encoding-type 'address-mime
-  "The type of encoding done by `rfc2047-encode-region'.
@@ -188 +222 @@
-        (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))
-
+
+
+
-                  (if (and (eq (mm-body-7-or-8) '8bit)
-                           (mm-multibyte-p)
@@ -210 +254 @@
-                   (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
@@ -348 +384 @@
-                (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))
@@ -822 +859 @@
-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.
@@ -899 +959 @@
-;; `=?iso-8859-1?q?foo?=@'.
-
-
-
+
+
+
+
-  (interactive "r")
-  (let ((case-fold-search t)
@@ -911 +973 @@
-      (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.
@@ -996 +1060 @@
-          (mm-decode-coding-region b (point-max) mail-parse-charset))))))
-
-
-
+
+
+
+
+
+
+
+
+
+
-  (let ((m (mm-multibyte-p)))
-    (if (string-match "=\\?" string)
@@ -1011 +1083 @@
-          (insert string)
-          (inline
-
+ 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
@@ -1034 +1114 @@
-        (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."