Importing pgnus-0.69
[elisp/gnus.git-] / lisp / rfc2047.el
index c96aeb2..84204e5 100644 (file)
 ;;; Code:
 
 (eval-and-compile
-  (if (not (fboundp 'base64-encode-string))
-      (require 'base64)))
+  (eval
+   '(unless (fboundp 'base64-decode-string)
+      (require 'base64))))
+
 (require 'qp)
 (require 'mm-util)
+(require 'ietf-drums)
 
 (defvar rfc2047-default-charset 'iso-8859-1
   "Default MIME charset -- does not need encoding.")
@@ -56,7 +59,7 @@ The values can be:
     (iso-8859-3 . Q)
     (iso-8859-4 . Q)
     (iso-8859-5 . B)
-    (koi8-r . Q)
+    (koi8-r . B)
     (iso-8859-7 . Q)
     (iso-8859-8 . Q)
     (iso-8859-9 . Q)
@@ -100,13 +103,13 @@ Valid encodings are nil, `Q' and `B'.")
        (point-max))))
   (goto-char (point-min)))
 
-;;;###autoload
 (defun rfc2047-encode-message-header ()
   "Encode the message header according to `rfc2047-header-encoding-alist'.
 Should be called narrowed to the head of the message."
   (interactive "*")
   (when (featurep 'mule)
     (save-excursion
+      (goto-char (point-min))
       (let ((alist rfc2047-header-encoding-alist)
            elem method)
        (while (not (eobp))
@@ -126,13 +129,16 @@ Should be called narrowed to the head of the message."
                  (rfc2047-encode-region (point-min) (point-max)))
                 ;; Hm.
                 (t))))
-           (goto-char (point-max))))))))
+           (goto-char (point-max)))))
+      (when rfc2047-default-charset
+       (encode-coding-region (point-min) (point-max)
+                             rfc2047-default-charset)))))
 
 (defun rfc2047-encodable-p ()
   "Say whether the current (narrowed) buffer contains characters that need encoding."
   (let ((charsets (mapcar
                   'mm-mule-charset-to-mime-charset
-                  (find-charset-region (point-min) (point-max))))
+                  (mm-find-charset-region (point-min) (point-max))))
        (cs (list 'us-ascii rfc2047-default-charset))
        found)
     (while charsets
@@ -141,18 +147,17 @@ Should be called narrowed to the head of the message."
     found))
 
 (defun rfc2047-dissect-region (b e)
-  "Dissect the region between B and E."
+  "Dissect the region between B and E into words."
   (let (words)
     (save-restriction
       (narrow-to-region b e)
       (goto-char (point-min))
-      (while (re-search-forward "[^ \t\n]+" nil t)
+      (while (re-search-forward
+             (concat "[^" ietf-drums-tspecials " \t\n]+") nil t)
        (push
         (list (match-beginning 0) (match-end 0)
-              (car
-               (delq 'ascii
-                     (find-charset-region (match-beginning 0)
-                                          (match-end 0)))))
+              (car (delq 'ascii (mm-find-charset-region
+                                 (match-beginning 0) (match-end 0)))))
         words))
       words)))
 
@@ -187,28 +192,31 @@ Should be called narrowed to the head of the message."
                       'B))
         (start (concat
                 "=?" (downcase (symbol-name mime-charset)) "?"
-                (downcase (symbol-name encoding)) "?")))
+                (downcase (symbol-name encoding)) "?"))
+        (first t))
     (save-restriction
       (narrow-to-region b e)
       (mm-encode-coding-region b e mime-charset)
       (funcall (cdr (assq encoding rfc2047-encoding-function-alist))
               (point-min) (point-max))
       (goto-char (point-min))
-      (insert start)
-      (goto-char (point-max))
-      (insert "?=")
-      ;; Encoded words can't be more than 75 chars long, so we have to
-      ;; split the long ones up.
-      (end-of-line)
-      (while (> (current-column) 74)
-       (beginning-of-line)
-       (forward-char 73)
-       (insert "?=\n " start)
-       (end-of-line)))))
+      (while (not (eobp))
+       (unless first
+         (insert " "))
+       (setq first nil)
+       (insert start)
+       (end-of-line)
+       (insert "?=")
+       (forward-line 1)))))
 
 (defun rfc2047-b-encode-region (b e)
   "Encode the header contained in REGION with the B encoding."
-  (base64-encode-region b e t))
+  (base64-encode-region b e t)
+  (goto-char (point-min))
+  (while (not (eobp))
+    (goto-char (min (point-max) (+ 64 (point))))
+    (unless (eobp)
+      (insert "\n"))))
 
 (defun rfc2047-q-encode-region (b e)
   "Encode the header contained in REGION with the Q encoding."
@@ -219,17 +227,23 @@ Should be called narrowed to the head of the message."
        (while alist
          (when (looking-at (caar alist))
            (quoted-printable-encode-region b e nil (cdar alist))
-           (subst-char-in-region (point-min) (point-max) ?  ?_))
-         (pop alist))))))
+           (subst-char-in-region (point-min) (point-max) ?  ?_)
+           (setq alist nil))
+         (pop alist))
+       (goto-char (point-min))
+       (while (not (eobp))
+         (goto-char (min (point-max) (+ 64 (point))))
+         (search-backward "=" (- (point) 2) t)
+         (unless (eobp)
+           (insert "\n")))))))
 
 ;;;
 ;;; Functions for decoding RFC2047 messages
 ;;;
 
 (defvar rfc2047-encoded-word-regexp
-  "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ ]+\\)\\?=")
+  "=\\?\\([^][\000-\040()<>@,\;:\\\"/?.=]+\\)\\?\\(B\\|Q\\)\\?\\([!->@-~ +]+\\)\\?=")
 
-;;;###autoload
 (defun rfc2047-decode-region (start end)
   "Decode MIME-encoded words in region between START and END."
   (interactive "r")
@@ -254,20 +268,25 @@ Should be called narrowed to the head of the message."
                   (prog1
                       (match-string 0)
                     (delete-region (match-beginning 0) (match-end 0)))))
-         (mm-decode-coding-region b e rfc2047-default-charset)
+         (when (and (mm-multibyte-p) rfc2047-default-charset)
+           (mm-decode-coding-region b e rfc2047-default-charset))
          (setq b (point)))
-       (mm-decode-coding-region b (point-max) rfc2047-default-charset)))))
+       (when (and (mm-multibyte-p)
+                  rfc2047-default-charset
+                  (not (eq rfc2047-default-charset 'us-ascii)))
+         (mm-decode-coding-region b (point-max) rfc2047-default-charset))))))
 
-;;;###autoload
 (defun rfc2047-decode-string (string)
- "Decode the quoted-printable-encoded STRING and return the results."
- (with-temp-buffer
-   (mm-enable-multibyte)
-   (insert string)
-   (inline
-     (rfc2047-decode-region (point-min) (point-max)))
-   (buffer-string)))
-
+  "Decode the quoted-printable-encoded STRING and return the results."
+  (let ((m (mm-multibyte-p)))
+    (with-temp-buffer
+      (when m
+       (mm-enable-multibyte))
+      (insert string)
+      (inline
+       (rfc2047-decode-region (point-min) (point-max)))
+      (buffer-string))))
 (defun rfc2047-parse-and-decode (word)
   "Decode WORD and return it if it is an encoded word.
 Return WORD if not."
@@ -286,14 +305,15 @@ Return WORD if not."
   "Decode STRING that uses CHARSET with ENCODING.
 Valid ENCODINGs are \"B\" and \"Q\".
 If your Emacs implementation can't decode CHARSET, it returns nil."
-  (let ((cs (mm-charset-to-coding-system charset)))
+  (let ((cs (let ((mm-default-charset rfc2047-default-charset))
+             (mm-charset-to-coding-system charset))))
     (when cs
+      (when (eq cs 'ascii)
+       (setq cs rfc2047-default-charset))
       (mm-decode-coding-string
        (cond
        ((equal "B" encoding)
-        (if (fboundp 'base64-decode-string)
-            (base64-decode-string string)
-          (base64-decode string)))
+        (base64-decode-string string))
        ((equal "Q" encoding)
         (quoted-printable-decode-string
          (mm-replace-chars-in-string string ?_ ? )))