X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=eword-encode.el;h=6cee2d6c0c3942bbe90829d526b7c947267e0dc5;hb=a4139ca5c42e0eae82b2301d3f048dfaac4c216c;hp=b739498bf25ac03e6b1a1ef3afcb024217529161;hpb=1697de51199e83a0396ad7eb31e4c939d0e5917b;p=elisp%2Fflim.git

diff --git a/eword-encode.el b/eword-encode.el
index b739498..6cee2d6 100644
--- a/eword-encode.el
+++ b/eword-encode.el
@@ -46,6 +46,8 @@
     (iso-8859-7		. "Q")
     (iso-8859-8		. "Q")
     (iso-8859-9		. "Q")
+    (iso-8859-14	. "Q")
+    (iso-8859-15	. "Q")
     (iso-2022-jp	. "B")
     (iso-2022-jp-3	. "B")
     (iso-2022-kr	. "B")
@@ -61,6 +63,17 @@
 
 (defvar mime-header-default-charset-encoding "Q")
 
+(defvar mime-header-encode-method-alist
+  '((eword-encode-address-list
+     . (Reply-To
+	From Sender
+	Resent-Reply-To Resent-From
+	Resent-Sender To Resent-To
+	Cc Resent-Cc Bcc Resent-Bcc
+	Dcc))
+    (eword-encode-in-reply-to . (In-Reply-To))
+    (eword-encode-structured-field-body . (Mime-Version User-Agent))
+    (eword-encode-unstructured-field-body)))
 
 ;;; @ encoded-text encoder
 ;;;
@@ -71,7 +84,7 @@ CHARSET is a symbol to indicate MIME charset of the encoded-word.
 ENCODING allows \"B\" or \"Q\".
 MODE is allows `text', `comment', `phrase' or nil.  Default value is
 `phrase'."
-  (let ((text (encoded-text-encode-string string encoding)))
+  (let ((text (encoded-text-encode-string string encoding mode)))
     (if text
 	(concat "=?" (upcase (symbol-name charset)) "?"
 		encoding "?" text "?=")
@@ -166,6 +179,26 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
 		       (cons charset mime-header-default-charset-encoding)))))
 	(list charset encoding))))
 
+;; [tomo:2002-11-05] The following code is a quick-fix for emacsen
+;; which is not depended on the Mule model.  We should redesign
+;; `eword-encode-split-string' to avoid to depend on the Mule model.
+(if (featurep 'utf-2000)
+;; for CHISE Architecture
+(defun tm-eword::words-to-ruled-words (wl &optional mode)
+  (let (mcs)
+    (mapcar (function
+	     (lambda (word)
+	       (setq mcs (detect-mime-charset-string (cdr word)))
+	       (make-ew-rword
+		(cdr word)
+		mcs
+		(cdr (or (assq mcs mime-header-charset-encoding-alist)
+			 (cons mcs mime-header-default-charset-encoding)))
+		mode)
+	       ))
+	    wl)))
+
+;; for legacy Mule
 (defun tm-eword::words-to-ruled-words (wl &optional mode)
   (mapcar (function
 	   (lambda (word)
@@ -173,6 +206,7 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
 	       (make-ew-rword (cdr word) (car ret)(nth 1 ret) mode)
 	       )))
 	  wl))
+)
 
 (defun ew-space-process (seq)
   (let (prev a ac b c cc)
@@ -595,37 +629,32 @@ Optional argument COLUMN is start-position of the field."
 	(or column eword-encode-default-start-column)
 	(eword-encode-split-string string 'text))))
 
-(defun eword-encode-field-body (field-body field-name)
+;;;###autoload
+(defun mime-encode-field-body (field-body field-name)
   "Encode FIELD-BODY as FIELD-NAME, and return the result.
 A lexical token includes non-ASCII character is encoded as MIME
 encoded-word.  ASCII token is not encoded."
   (setq field-body (std11-unfold-string field-body))
   (if (string= field-body "")
       ""
-    (let (start)
+    (let ((method-alist mime-header-encode-method-alist)
+	  start ret)
       (if (symbolp field-name)
 	  (setq start (1+ (length (symbol-name field-name))))
 	(setq start (1+ (length field-name))
 	      field-name (intern (capitalize field-name))))
-      (cond ((memq field-name
-		   '(Reply-To
-		     From Sender
-		     Resent-Reply-To Resent-From
-		     Resent-Sender To Resent-To
-		     Cc Resent-Cc Bcc Resent-Bcc
-		     Dcc))
-	     (eword-encode-address-list field-body start)
-	     )
-	    ((eq field-name 'In-Reply-To)
-	     (eword-encode-in-reply-to field-body start)
-	     )
-	    ((memq field-name '(Mime-Version User-Agent))
-	     (eword-encode-structured-field-body field-body start)
-	     )
-	    (t
-	     (eword-encode-unstructured-field-body field-body start)
-	     ))
-      )))
+      (while (car method-alist)
+	(if (or (not (cdr (car method-alist)))
+		(memq field-name
+		      (cdr (car method-alist))))
+	    (progn
+	      (setq ret
+		    (apply (caar method-alist) (list field-body start)))
+	      (setq method-alist nil)))
+	(setq method-alist (cdr method-alist)))
+      ret)))
+(defalias 'eword-encode-field-body 'mime-encode-field-body)
+(make-obsolete 'eword-encode-field-body 'mime-encode-field-body)
 
 (defun eword-in-subject-p ()
   (let ((str (std11-field-body "Subject")))
@@ -660,21 +689,26 @@ It refer variable `mime-field-encoding-method-alist'."
       (goto-char (point-min))
       (let ((default-cs (mime-charset-to-coding-system default-mime-charset))
 	    bbeg end field-name)
-	(while (re-search-forward std11-field-head-regexp nil t)
+	(while (re-search-forward
+		(concat "\\(" std11-field-head-regexp "\\)" " ?")
+		nil t)
 	  (setq bbeg (match-end 0)
-		field-name (buffer-substring (match-beginning 0) (1- bbeg))
+		field-name (buffer-substring (match-beginning 0) (1- (match-end 1)))
 		end (std11-field-end))
 	  (and (delq 'ascii (find-charset-region bbeg end))
 	       (let ((method (eword-find-field-encoding-method
 			      (downcase field-name))))
 		 (cond ((eq method 'mime)
-			(let ((field-body
-			       (buffer-substring-no-properties bbeg end)
-			       ))
-			  (delete-region bbeg end)
-			  (insert (eword-encode-field-body field-body
-							   field-name))
-			  ))
+			(let* ((field-body
+				(buffer-substring-no-properties bbeg end))
+			       (encoded-body
+				(mime-encode-field-body
+				 field-body field-name)))
+			  (if (not encoded-body)
+			      (error "Cannot encode %s:%s"
+				     field-name field-body)
+			    (delete-region bbeg end)
+			    (insert encoded-body))))
 		       (code-conversion
 			(let ((cs
 			       (or (mime-charset-to-coding-system