Importing pgnus-0.79
[elisp/gnus.git-] / lisp / rfc2047.el
index ceb45c4..f11194c 100644 (file)
@@ -124,7 +124,8 @@ Should be called narrowed to the head of the message."
              (when method
                (cond
                 ((eq method 'mime)
-                 (rfc2047-encode-region (point-min) (point-max)))
+                 (rfc2047-encode-region (point-min) (point-max))
+                 (rfc2047-fold-region (point-min) (point-max)))
                 ;; Hm.
                 (t))))
            (goto-char (point-max)))))
@@ -134,9 +135,10 @@ Should be called narrowed to the head of the message."
 
 (defun rfc2047-encodable-p ()
   "Say whether the current (narrowed) buffer contains characters that need encoding."
-  (let ((charsets (mapcar
-                  'mm-mule-charset-to-mime-charset
-                  (mm-find-charset-region (point-min) (point-max))))
+  (let ((charsets
+        (mapcar
+         'mm-mime-charset
+         (mm-find-charset-region (point-min) (point-max))))
        (cs (list 'us-ascii mail-parse-charset))
        found)
     (while charsets
@@ -183,10 +185,9 @@ Should be called narrowed to the head of the message."
 
 (defun rfc2047-encode (b e charset)
   "Encode the word in the region with CHARSET."
-  (let* ((mime-charset
-         (mm-mime-charset charset b e))
+  (let* ((mime-charset (mm-mime-charset charset))
         (encoding (or (cdr (assq mime-charset
-                             rfc2047-charset-encoding-alist))
+                                 rfc2047-charset-encoding-alist))
                       'B))
         (start (concat
                 "=?" (downcase (symbol-name mime-charset)) "?"
@@ -207,6 +208,27 @@ Should be called narrowed to the head of the message."
        (insert "?=")
        (forward-line 1)))))
 
+(defun rfc2047-fold-region (b e)
+  "Fold the long lines in the region."
+  (save-restriction
+    (narrow-to-region b e)
+    (goto-char (point-min))
+    (let ((break nil))
+      (while (not (eobp))
+       (cond
+        ((memq (char-after) '(?  ?\t))
+         (setq break (point)))
+        ((and (not break)
+              (looking-at "=\\?"))
+         (setq break (point)))
+        ((and (looking-at "\\?=")
+              (> (- (point) (save-excursion (beginning-of-line) (point))) 76))
+         (goto-char break)
+         (insert "\n ")
+         (forward-line 1)))
+       (unless (eobp)
+         (forward-char 1))))))
+
 (defun rfc2047-b-encode-region (b e)
   "Encode the header contained in REGION with the B encoding."
   (base64-encode-region b e t)
@@ -266,7 +288,8 @@ Should be called narrowed to the head of the message."
                   (prog1
                       (match-string 0)
                     (delete-region (match-beginning 0) (match-end 0)))))
-         (when (and (mm-multibyte-p) mail-parse-charset)
+         (when (and (mm-multibyte-p)
+                    mail-parse-charset)
            (mm-decode-coding-region b e mail-parse-charset))
          (setq b (point)))
        (when (and (mm-multibyte-p)
@@ -284,7 +307,7 @@ Should be called narrowed to the head of the message."
       (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."