X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Frfc2047.el;h=74705daa5740f9a073d001fac953f76f64939d19;hb=e4cd2c48b6a75de831dbe75d76ea3107c7062ba6;hp=81a3d17805705ee496a080870bacb6b7c22a4439;hpb=0f02de60a02d0ca6ba8987750a764106ad91424b;p=gnus

diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index 81a3d1780..74705daa5 100644
--- a/lisp/rfc2047.el
+++ b/lisp/rfc2047.el
@@ -133,13 +133,13 @@ Should be called narrowed to the head of the message."
 	(encode-coding-region (point-min) (point-max)
 			      mail-parse-charset)))))
 
-(defun rfc2047-encodable-p ()
-  "Say whether the current (narrowed) buffer contains characters that need encoding."
+(defun rfc2047-encodable-p (&optional header)
+  "Say whether the current (narrowed) buffer contains characters that need encoding in headers."
   (let ((charsets
 	 (mapcar
 	  'mm-mime-charset
 	  (mm-find-charset-region (point-min) (point-max))))
-	(cs (list 'us-ascii mail-parse-charset))
+	(cs (list 'us-ascii (car message-posting-charset)))
 	found)
     (while charsets
       (unless (memq (pop charsets) cs)
@@ -148,18 +148,58 @@ Should be called narrowed to the head of the message."
 
 (defun rfc2047-dissect-region (b e)
   "Dissect the region between B and E into words."
-  (let (words)
+  (let ((all-specials (concat ietf-drums-tspecials " \t\n\r"))
+	(special-list (mapcar 'identity ietf-drums-tspecials))
+	(blank-list '(?  ?\t ?\n ?\r))
+	words current cs state mail-parse-mule-charset)
     (save-restriction
       (narrow-to-region b e)
       (goto-char (point-min))
-      (while (re-search-forward
-	      (concat "[^" ietf-drums-tspecials " \t\n]+") nil t)
-	(push
-	 (list (match-beginning 0) (match-end 0)
-	       (car (delq 'ascii (mm-find-charset-region
-				  (match-beginning 0) (match-end 0)))))
-	 words))
-      words)))
+      (skip-chars-forward all-specials)
+      (setq b (point))
+      (while (not (eobp))
+	(cond
+	 ((not state)
+	  (if (memq (char-after) blank-list)
+	      (setq state 'blank)
+	    (setq state 'word)
+	    (if (not (eq (setq cs (mm-charset-after)) 'ascii))
+		(setq current cs)))
+	  (setq b (point)))
+	 ((eq state 'blank)
+	  (cond 
+	   ((memq (char-after) special-list)
+	    (setq state nil))
+	   ((memq (char-after) blank-list))
+	   (t
+	    (setq state 'word)
+	    (if (not (eq (setq cs (mm-charset-after)) 'ascii))
+		(setq current cs)))))
+	 ((eq state 'word)
+	  (cond 
+	   ((memq (char-after) special-list)
+	    (setq state nil)
+	    (push (list b (point) current) words)
+	    (setq current nil))
+	   ((memq (char-after) blank-list)
+	    (setq state 'blank)
+	    (push (list b (point) current) words)
+	    (setq current nil)
+	    (setq b (point)))
+	   ((or (eq (setq cs (mm-charset-after)) 'ascii)
+		(if current
+		    (eq current cs)
+		  (setq current cs))))
+	   (t
+	    (push (list b (point) current) words)
+	    (setq current cs)
+	    (setq b (point))))))
+	(if state
+	    (forward-char)
+	  (skip-chars-forward all-specials)))
+      (if (eq state 'word)
+	  (push (list b (point) current) words)))
+    words))
 
 (defun rfc2047-encode-region (b e)
   "Encode all encodable words in REGION."
@@ -231,8 +271,8 @@ Should be called narrowed to the head of the message."
 	 ((and (looking-at "\\?=")
 	       (> (- (point) (save-excursion (beginning-of-line) (point))) 76))
 	  (goto-char break)
-	  (insert "\n ")
-	  (forward-line 1)))
+	  (setq break nil)
+	  (insert "\n ")))
 	(unless (eobp)
 	  (forward-char 1))))))