X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=eword-decode.el;h=5280aeb5af0f778ed8687ddd0a1e7c54d68e06ec;hb=1740680720e06f70a43706857b6b56477d2c4419;hp=3b4ec0a97355031ae89cdfe2751b6b51d3bdad04;hpb=3b62aa46fcb51812779298c3cb3edc4bbe3f61ba;p=elisp%2Fflim.git

diff --git a/eword-decode.el b/eword-decode.el
index 3b4ec0a..5280aeb 100644
--- a/eword-decode.el
+++ b/eword-decode.el
@@ -31,7 +31,7 @@
 
 ;;; Code:
 
-(require 'std11-parse)
+(require 'std11)
 (require 'mel)
 (require 'mime-def)
 
@@ -84,11 +84,6 @@
 ;;; @@ Quoted-Printable
 ;;;
 
-(defconst quoted-printable-hex-chars "0123456789ABCDEF")
-(defconst quoted-printable-octet-regexp
-  (concat "=[" quoted-printable-hex-chars
-	  "][" quoted-printable-hex-chars "]"))
-
 (defconst eword-Q-encoded-text-regexp
   (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+"))
 ;; (defconst eword-Q-encoding-and-encoded-text-regexp
@@ -176,17 +171,17 @@ such as a version of Net$cape)."
 ;;;
 
 (defcustom eword-decode-ignored-field-list
-  '(newsgroups path lines nntp-posting-host message-id date)
+  '(Newsgroups Path Lines Nntp-Posting-Host Received Message-Id Date)
   "*List of field-names to be ignored when decoding.
 Each field name must be symbol."
   :group 'eword-decode
   :type '(repeat symbol))
 
 (defcustom eword-decode-structured-field-list
-  '(reply-to resent-reply-to from resent-from sender resent-sender
-	     to resent-to cc resent-cc bcc resent-bcc dcc
-	     mime-version content-type content-transfer-encoding
-	     content-disposition)
+  '(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender
+	     To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc
+	     Mime-Version Content-Type Content-Transfer-Encoding
+	     Content-Disposition)
   "*List of field-names to decode as structured field.
 Each field name must be symbol."
   :group 'eword-decode
@@ -216,7 +211,7 @@ If SEPARATOR is not nil, it is used as header separator."
 		      p (match-end 0)
 		      field-name (buffer-substring beg (1- p))
 		      len (string-width field-name)
-		      field-name (intern (downcase field-name))
+		      field-name (intern (capitalize field-name))
 		      end (std11-field-end))
 		(cond ((memq field-name eword-decode-ignored-field-list)
 		       ;; Don't decode
@@ -259,11 +254,99 @@ If SEPARATOR is not nil, it is used as header separator."
 	    ))
       )))
 
+(defun eword-visible-field-p (field-name visible-fields invisible-fields)
+  (or (catch 'found
+	(while visible-fields
+	  (let ((regexp (car visible-fields)))
+	    (if (string-match regexp field-name)
+		(throw 'found t)
+	      ))
+	  (setq visible-fields (cdr visible-fields))
+	  ))
+      (catch 'found
+	(while invisible-fields
+	  (let ((regexp (car invisible-fields)))
+	    (if (string-match regexp field-name)
+		(throw 'found nil)
+	      ))
+	  (setq invisible-fields (cdr invisible-fields))
+	  )
+	t)))
+		
+(defun mime-insert-decoded-header (entity
+				   &optional invisible-fields visible-fields
+				   code-conversion)
+  "Insert before point a decoded header of ENTITY."
+  (let ((default-charset
+	  (if code-conversion
+	      (if (mime-charset-to-coding-system code-conversion)
+		  code-conversion
+		default-mime-charset))))
+    (save-restriction
+      (narrow-to-region (point)(point))
+      (let ((the-buf (current-buffer))
+	    (src-buf (mime-entity-buffer entity))
+	    (h-end (mime-entity-header-end entity))
+	    beg p end field-name len field)
+	(save-excursion
+	  (set-buffer src-buf)
+	  (goto-char (mime-entity-header-start entity))
+	  (save-restriction
+	    (narrow-to-region (point) h-end)
+	    (while (re-search-forward std11-field-head-regexp nil t)
+	      (setq beg (match-beginning 0)
+		    p (match-end 0)
+		    field-name (buffer-substring beg (1- p))
+		    len (string-width field-name)
+		    end (std11-field-end))
+	      (when (eword-visible-field-p field-name
+					   visible-fields invisible-fields)
+		(setq field (intern (capitalize field-name)))
+		(save-excursion
+		  (set-buffer the-buf)
+		  (insert field-name)
+		  (insert ":")
+		  (cond ((memq field eword-decode-ignored-field-list)
+			 ;; Don't decode
+			 (insert-buffer-substring src-buf p end)
+			 )
+			((memq field eword-decode-structured-field-list)
+			 ;; Decode as structured field
+			 (let ((body (save-excursion
+				       (set-buffer src-buf)
+				       (buffer-substring p end)))
+			       (default-mime-charset default-charset))
+			   (insert (eword-decode-and-fold-structured-field
+				    body (1+ len)))
+			   ))
+			(t
+			 ;; Decode as unstructured field
+			 (let ((body (save-excursion
+				       (set-buffer src-buf)
+				       (buffer-substring p end)))
+			       (default-mime-charset default-charset))
+			   (insert (eword-decode-unstructured-field-body
+				    body (1+ len)))
+			   )))
+		  (insert "\n")
+		  )))))))))
+
 
 ;;; @ encoded-word decoder
 ;;;
 
-(defvar eword-warning-face nil "Face used for invalid encoded-word.")
+(defvar eword-decode-encoded-word-error-handler
+  'eword-decode-encoded-word-default-error-handler)
+
+(defvar eword-warning-face nil
+  "Face used for invalid encoded-word.")
+
+(defun eword-decode-encoded-word-default-error-handler (word signal)
+  (and (add-text-properties 0 (length word)
+			    (and eword-warning-face
+				 (list 'face eword-warning-face))
+			    word)
+       word))
 
 (defun eword-decode-encoded-word (word &optional must-unfold)
   "Decode WORD if it is an encoded-word.
@@ -288,12 +371,8 @@ as a version of Net$cape)."
             (condition-case err
                 (eword-decode-encoded-text charset encoding text must-unfold)
               (error
-               (and
-		(add-text-properties 0 (length word)
-				     (and eword-warning-face
-					  (list 'face eword-warning-face))
-				     word)
-		word)))
+	       (funcall eword-decode-encoded-word-error-handler word err)
+               ))
             ))
       word))