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

diff --git a/eword-encode.el b/eword-encode.el
index c4cde05..6cee2d6 100644
--- a/eword-encode.el
+++ b/eword-encode.el
@@ -33,39 +33,9 @@
 ;;; @ variables
 ;;;
 
-(defgroup eword-encode nil
-  "Encoded-word encoding"
-  :group 'mime)
-
-(defcustom eword-field-encoding-method-alist
-  '(("X-Nsubject" . iso-2022-jp-2)
-    ("Newsgroups" . nil)
-    ("Message-ID" . nil)
-    (t            . mime)
-    )
-  "*Alist to specify field encoding method.
-Its key is field-name, value is encoding method.
-
-If method is `mime', this field will be encoded into MIME format.
-
-If method is a MIME-charset, this field will be encoded as the charset
-when it must be convert into network-code.
-
-If method is `default-mime-charset', this field will be encoded as
-variable `default-mime-charset' when it must be convert into
-network-code.
-
-If method is nil, this field will not be encoded."
-  :group 'eword-encode
-  :type '(repeat (cons (choice :tag "Field"
-			       (string :tag "Name")
-			       (const :tag "Default" t))
-		       (choice :tag "Method"
-			       (const :tag "MIME conversion" mime)
-			       (symbol :tag "non-MIME conversion")
-			       (const :tag "no-conversion" nil)))))
-
-(defvar eword-charset-encoding-alist
+;; User options are defined in mime-def.el.
+
+(defvar mime-header-charset-encoding-alist
   '((us-ascii		. nil)
     (iso-8859-1		. "Q")
     (iso-8859-2		. "Q")
@@ -76,6 +46,8 @@ If method is nil, this field will not be encoded."
     (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")
@@ -89,6 +61,19 @@ If method is nil, this field will not be encoded."
     (utf-8		. "B")
     ))
 
+(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
 ;;;
@@ -99,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 "?=")
@@ -189,11 +174,31 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
 (defun ew-find-charset-rule (charsets)
   (if charsets
       (let* ((charset (find-mime-charset-by-charsets charsets))
-	     (encoding (cdr (or (assq charset eword-charset-encoding-alist)
-				'(nil . "Q")))))
-	(list charset encoding)
-	)))
+	     (encoding
+	      (cdr (or (assq charset mime-header-charset-encoding-alist)
+		       (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)
@@ -201,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)
@@ -579,10 +585,8 @@ MODE is allows `text', `comment', `phrase' or nil.  Default value is
 ;;; @ application interfaces
 ;;;
 
-(defcustom eword-encode-default-start-column 10
-  "Default start column if it is omitted."
-  :group 'eword-encode
-  :type 'integer)
+(defvar eword-encode-default-start-column 10
+  "Default start column if it is omitted.")
 
 (defun eword-encode-string (string &optional column mode)
   "Encode STRING as encoded-words, and return the result.
@@ -625,46 +629,42 @@ 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")))
     (if (and str (string-match eword-encoded-word-regexp str))
 	str)))
+(make-obsolete 'eword-in-subject-p "Don't use it.")
 
 (defsubst eword-find-field-encoding-method (field-name)
   (setq field-name (downcase field-name))
-  (let ((alist eword-field-encoding-method-alist))
+  (let ((alist mime-field-encoding-method-alist))
     (catch 'found
       (while alist
 	(let* ((pair (car alist))
@@ -674,13 +674,14 @@ encoded-word.  ASCII token is not encoded."
 	      (throw 'found (cdr pair))
 	    ))
 	(setq alist (cdr alist)))
-      (cdr (assq t eword-field-encoding-method-alist))
+      (cdr (assq t mime-field-encoding-method-alist))
       )))
 
-(defun eword-encode-header (&optional code-conversion)
+;;;###autoload
+(defun mime-encode-header-in-buffer (&optional code-conversion)
   "Encode header fields to network representation, such as MIME encoded-word.
 
-It refer variable `eword-field-encoding-method-alist'."
+It refer variable `mime-field-encoding-method-alist'."
   (interactive "*")
   (save-excursion
     (save-restriction
@@ -688,21 +689,26 @@ It refer variable `eword-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
@@ -713,6 +719,8 @@ It refer variable `eword-field-encoding-method-alist'."
 		 ))
 	  ))
       )))
+(defalias 'eword-encode-header 'mime-encode-header-in-buffer)
+(make-obsolete 'eword-encode-header 'mime-encode-header-in-buffer)
 
 
 ;;; @ end