From: yamaoka <yamaoka>
Date: Wed, 9 Jan 2002 10:23:38 +0000 (+0000)
Subject: * lpath.el: Fbind `coding-system-to-mime-charset' for Mule 2.
X-Git-Tag: t-gnus-6_15_5-01-quimby~7
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=75d2c9ee8a32fae9e64bbba889053488adbc3c6c;p=elisp%2Fgnus.git-

* lpath.el: Fbind `coding-system-to-mime-charset' for Mule 2.

* nnheader.el (std11-fold-region): New function copied from
 `rfc2047-fold-region'.
(std11-fold-field): Use it.
---

diff --git a/ChangeLog b/ChangeLog
index d5ede31..e773a2d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,13 @@
 2002-01-09  Katsumi Yamaoka <yamaoka@jpl.org>
 
+	* lisp/lpath.el: Fbind `coding-system-to-mime-charset' for Mule 2.
+
+	* lisp/nnheader.el (std11-fold-region): New function copied from
+	`rfc2047-fold-region'.
+	(std11-fold-field): Use it.
+
+2002-01-09  Katsumi Yamaoka <yamaoka@jpl.org>
+
 	* lisp/gnus.el: Don't autoload "gnus-bitmap".
 
 	* lisp/gnus-ems.el: Autoload "smiley-mule" if running Emacs
diff --git a/lisp/lpath.el b/lisp/lpath.el
index 625622d..604739d 100644
--- a/lisp/lpath.el
+++ b/lisp/lpath.el
@@ -122,7 +122,7 @@
 	 '((function-max-args smiley-encode-buffer)))
 	((boundp 'MULE)
 	 '((coding-system-get
-	    compose-mail file-name-extension
+	    coding-system-to-mime-charset compose-mail file-name-extension
 	    find-coding-systems-for-charsets find-coding-systems-region
 	    function-max-args get-charset-property shell-command-to-string
 	    smiley-encode-buffer)))
diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index 0f36e8f..9756937 100644
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -1248,15 +1248,77 @@ find-file-hooks, etc.
        (point-max)))
     (goto-char (point-min)))
 
+  (defun-maybe std11-fold-region (b e)
+    "Fold long lines in region B to E."
+    (save-restriction
+      (narrow-to-region b e)
+      (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))
+	    (goto-char (or break qword-break))
+	    (setq break nil
+		  qword-break nil)
+	    (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)))
+	  (cond
+	   ((eq (char-after) ?\n)
+	    (forward-char 1)
+	    (setq bol (point)
+		  break nil
+		  qword-break nil)
+	    (skip-chars-forward " \t")
+	    (unless (or (eobp) (eq (char-after) ?\n))
+	      (forward-char 1)))
+	   ((eq (char-after) ?\r)
+	    (forward-char 1))
+	   ((memq (char-after) '(?  ?\t))
+	    (skip-chars-forward " \t")
+	    (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) ?=)
+		    (forward-char 1)
+		  (skip-chars-forward "^ \t\n\r="))
+	      (setq qword-break (point))
+	      (skip-chars-forward "^ \t\n\r")))
+	   (t
+	    (skip-chars-forward "^ \t\n\r"))))
+	(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]")
+	      (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))))))
+
   (defun-maybe std11-fold-field ()
     "Fold the current line."
     (save-excursion
       (save-restriction
 	(std11-narrow-to-field)
-	(let ((str (std11-unfold-string
-		    (buffer-substring (point-min) (point-max)))))
-	  (delete-region (point-min) (point-max))
-	  (insert str)))))
+	(std11-fold-region (point-min) (point-max)))))
 
   (defalias 'mail-header-fold-field 'std11-fold-field)