Importing Oort Gnus v0.04.
[elisp/gnus.git-] / lisp / rfc2047.el
index 7d04a83..10eff84 100644 (file)
@@ -116,6 +116,14 @@ Valid encodings are nil, `Q' and `B'.")
        (point-max))))
   (goto-char (point-min)))
 
+(defun rfc2047-field-value ()
+  "Return the value of the field at point."
+  (save-excursion
+    (save-restriction
+      (rfc2047-narrow-to-field)
+      (re-search-forward ":[ \t\n]*" nil t)
+      (buffer-substring (point) (point-max)))))
+
 (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."
@@ -127,15 +135,26 @@ Should be called narrowed to the head of the message."
        (save-restriction
          (rfc2047-narrow-to-field)
          (if (not (rfc2047-encodable-p))
-             (if (and (eq (mm-body-7-or-8) '8bit)
-                      (mm-multibyte-p)
-                      (mm-coding-system-p
-                       (car message-posting-charset)))
-                      ;; 8 bit must be decoded.
-                      ;; Is message-posting-charset a coding system?
-                      (mm-encode-coding-region
-                       (point-min) (point-max)
-                       (car message-posting-charset)))
+             (prog1
+               (if (and (eq (mm-body-7-or-8) '8bit)
+                        (mm-multibyte-p)
+                        (mm-coding-system-p
+                         (car message-posting-charset)))
+                   ;; 8 bit must be decoded.
+                   ;; Is message-posting-charset a coding system?
+                   (mm-encode-coding-region
+                    (point-min) (point-max)
+                    (car message-posting-charset))
+                 nil)
+               ;; No encoding necessary, but folding is nice
+               (rfc2047-fold-region
+                (save-excursion
+                  (goto-char (point-min))
+                  (skip-chars-forward "^:")
+                  (when (looking-at ": ")
+                    (forward-char 2))
+                  (point))
+                (point-max)))
            ;; We found something that may perhaps be encoded.
            (setq method nil
                  alist rfc2047-header-encoding-alist)
@@ -157,18 +176,29 @@ Should be called narrowed to the head of the message."
                       mail-parse-charset)
                  (mm-encode-coding-region (point-min) (point-max)
                                           mail-parse-charset)))
+            ;; We get this when CC'ing messsages to newsgroups with
+            ;; 8-bit names.  The group name mail copy just get
+            ;; unconditionally encoded.  Previously, it would ask
+            ;; whether to encode, which was quite confusing for the
+            ;; user.  If the new behaviour is wrong, tell me. I have
+            ;; left the old code commented out below.
+            ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
             ((null method)
-             (and (delq 'ascii
-                        (mm-find-charset-region (point-min)
-                                                (point-max)))
-                  (if (or (message-options-get
-                           'rfc2047-encode-message-header-encode-any)
-                          (message-options-set
-                           'rfc2047-encode-message-header-encode-any
-                           (y-or-n-p
-                            "Some texts are not encoded. Encode anyway?")))
-                      (rfc2047-encode-region (point-min) (point-max))
-                    (error "Cannot send unencoded text."))))
+             (when (delq 'ascii 
+                         (mm-find-charset-region (point-min) (point-max)))
+               (rfc2047-encode-region (point-min) (point-max))))
+;;;         ((null method)
+;;;          (and (delq 'ascii
+;;;                     (mm-find-charset-region (point-min)
+;;;                                             (point-max)))
+;;;               (if (or (message-options-get
+;;;                        'rfc2047-encode-message-header-encode-any)
+;;;                       (message-options-set
+;;;                        'rfc2047-encode-message-header-encode-any
+;;;                        (y-or-n-p
+;;;                         "Some texts are not encoded. Encode anyway?")))
+;;;                   (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)
@@ -316,6 +346,13 @@ The buffer may be narrowed."
        (insert "?=")
        (forward-line 1)))))
 
+(defun rfc2047-fold-field ()
+  "Fold the current line."
+  (save-excursion
+    (save-restriction
+      (rfc2047-narrow-to-field)
+      (rfc2047-fold-region (point-min) (point-max)))))
+
 (defun rfc2047-fold-region (b e)
   "Fold long lines in region B to E."
   (save-restriction
@@ -323,21 +360,24 @@ The buffer may be narrowed."
     (goto-char (point-min))
     (let ((break nil)
          (qword-break nil)
+         (first t)
          (bol (save-restriction
                 (widen)
                 (gnus-point-at-bol))))
       (while (not (eobp))
-       (when (and (or break qword-break) (> (- (point) bol) 76))
+       (when (and (or break qword-break)
+                  (> (- (point) bol) 76))
          (goto-char (or break qword-break))
          (setq break nil
                qword-break nil)
-         (if (looking-at " \t")
+         (if (looking-at "[ \t]")
              (insert "\n")
            (insert "\n "))
          (setq bol (1- (point)))
          ;; Don't break before the first non-LWSP characters.
          (skip-chars-forward " \t")
-         (unless (eobp) (forward-char 1)))
+         (unless (eobp)
+           (forward-char 1)))
        (cond
         ((eq (char-after) ?\n)
          (forward-char 1)
@@ -351,7 +391,10 @@ The buffer may be narrowed."
          (forward-char 1))
         ((memq (char-after) '(?  ?\t))
          (skip-chars-forward " \t")
-         (setq break (1- (point))))
+         (if first
+             ;; Don't break just after the header name.
+             (setq first nil)
+           (setq break (1- (point)))))
         ((not break)
          (if (not (looking-at "=\\?[^=]"))
              (if (eq (char-after) ?=)
@@ -361,17 +404,26 @@ The buffer may be narrowed."
            (skip-chars-forward "^ \t\n\r")))
         (t
          (skip-chars-forward "^ \t\n\r"))))
-      (when (and (or break qword-break) (> (- (point) bol) 76))
+      (when (and (or break qword-break)
+                (> (- (point) bol) 76))
        (goto-char (or break qword-break))
        (setq break nil
              qword-break nil)
-         (if (looking-at " \t")
+         (if (looking-at "[ \t]")
              (insert "\n")
            (insert "\n "))
        (setq bol (1- (point)))
        ;; Don't break before the first non-LWSP characters.
        (skip-chars-forward " \t")
-       (unless (eobp) (forward-char 1))))))
+       (unless (eobp)
+         (forward-char 1))))))
+
+(defun rfc2047-unfold-field ()
+  "Fold the current line."
+  (save-excursion
+    (save-restriction
+      (rfc2047-narrow-to-field)
+      (rfc2047-unfold-region (point-min) (point-max)))))
 
 (defun rfc2047-unfold-region (b e)
   "Unfold lines in region B to E."
@@ -419,7 +471,7 @@ The buffer may be narrowed."
        (while alist
          (when (looking-at (caar alist))
            (mm-with-unibyte-current-buffer-mule4
-             (quoted-printable-encode-region 
+             (quoted-printable-encode-region
               (point-min) (point-max) nil (cdar alist)))
            (subst-char-in-region (point-min) (point-max) ?  ?_)
            (setq alist nil))