Synch with the flim-1_14 branch.

[elisp/flim.git] / mmgeneric.el

diff --git a/mmgeneric.el b/mmgeneric.el
index 02dcfd2..5bd9686 100644 (file)
--- a/mmgeneric.el
+++ b/mmgeneric.el
@@ -32,23 +32,26 @@
 
 (autoload 'mime-entity-content-type "mime")
 (autoload 'mime-parse-multipart "mime-parse")
-(autoload 'mime-parse-encapsulated "mime-parse")
-(autoload 'mime-parse-external "mime-parse")
+(autoload 'mime-parse-message "mime-parse")
+;; (autoload 'mime-parse-encapsulated "mime-parse")
+;; (autoload 'mime-parse-external "mime-parse")
 (autoload 'mime-entity-content "mime")
 
-(luna-define-class mime-entity ()
-                  (location
-                   content-type children parent
-                   node-id
-                   content-disposition encoding
-                   ;; for other fields
-                   original-header parsed-header))
+(eval-and-compile
+  (luna-define-class mime-entity ()
+                    (location
+                     content-type children parent
+                     node-id
+                     content-disposition encoding
+                     ;; for other fields
+                     original-header parsed-header))
+
+  (luna-define-internal-accessors 'mime-entity)
+  )
 
 (defalias 'mime-entity-representation-type-internal 'luna-class-name)
 (defalias 'mime-entity-set-representation-type-internal 'luna-set-class-name)
 
-(luna-define-internal-accessors 'mime-entity)
-
 (luna-define-method mime-entity-fetch-field ((entity mime-entity)
                                             field-name)
   (or (symbolp field-name)
@@ -56,22 +59,6 @@
   (cdr (assq field-name
             (mime-entity-original-header-internal entity))))
 
-(luna-define-method mime-entity-children ((entity mime-entity))
-  (let* ((content-type (mime-entity-content-type entity))
-        (primary-type (mime-content-type-primary-type content-type))
-        sub-type)
-    (cond ((eq primary-type 'multipart)
-          (mime-parse-multipart entity))
-         ((eq primary-type 'message)
-          (setq sub-type (mime-content-type-subtype content-type))
-          (cond ((eq sub-type 'external-body)
-                 (mime-parse-external entity))
-                ((memq sub-type '(rfc822 news))
-                 (mime-parse-encapsulated entity)
-                 ;; [tomo] Should we make a variable to specify
-                 ;; encapsulated media-types?
-                 ))))))
-
 (luna-define-method mime-insert-text-content ((entity mime-entity))
   (insert
    (decode-mime-charset-string (mime-entity-content entity)
@@ -119,6 +106,66 @@
           def-body))
 
 
+;;; @ header filter
+;;;
+
+;; [tomo] We should think about specification of better filtering
+;; mechanism.  Please discuss in the emacs-mime mailing lists.
+
+(defun mime-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-header-from-buffer (buffer start end
+                                             &optional invisible-fields
+                                             visible-fields)
+  (let ((the-buf (current-buffer))
+       (mode-obj (mime-find-field-presentation-method 'wide))
+       field-decoder
+       f-b p f-e field-name len field field-body)
+    (save-excursion
+      (set-buffer buffer)
+      (save-restriction
+       (narrow-to-region start end)
+       (goto-char start)
+       (while (re-search-forward std11-field-head-regexp nil t)
+         (setq f-b (match-beginning 0)
+               p (match-end 0)
+               field-name (buffer-substring f-b p)
+               len (string-width field-name)
+               f-e (std11-field-end))
+         (when (mime-visible-field-p field-name
+                                     visible-fields invisible-fields)
+           (setq field (intern
+                        (capitalize (buffer-substring f-b (1- p))))
+                 field-body (buffer-substring p f-e)
+                 field-decoder (inline (mime-find-field-decoder-internal
+                                        field mode-obj)))
+           (with-current-buffer the-buf
+             (insert field-name)
+             (insert (if field-decoder
+                         (funcall field-decoder field-body len)
+                       ;; Don't decode
+                       field-body))
+             (insert "\n")
+             )))))))
+
+
 ;;; @ end
 ;;;