* wl.el (wl-save-status, wl-init): Remove last period in
[elisp/wanderlust.git] / wl / wl-mime.el
index f1fb91b..506dcb7 100644 (file)
@@ -4,7 +4,6 @@
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 ;; Keywords: mail, net news
-;; Time-stamp: <2000-03-23 15:53:53 teranisi>
 
 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
 
 (require 'mmelmo)
 
 (eval-when-compile
-  (defun-maybe Meadow-version ())
-  (mapcar
-   (function
-    (lambda (symbol)
-      (unless (boundp symbol)
-       (set (make-local-variable symbol) nil))))
-   '(xemacs-betaname
-     xemacs-codename
-     enable-multibyte-characters
-     mule-version)))
+  (defalias-maybe 'Meadow-version 'ignore))
+
+(defvar xemacs-betaname)
+(defvar xemacs-codename)
+(defvar enable-multibyte-characters)
+(defvar mule-version)
 
 ;;; Draft
 
 (defalias 'wl-draft-editor-mode 'mime-edit-mode)
 
-(defalias 'wl-draft-decode-message-in-buffer 
+(defalias 'wl-draft-decode-message-in-buffer
   'mime-edit-decode-message-in-buffer)
 
 (defun wl-draft-yank-current-message-entity ()
-  "Yank currently displayed message entity. 
+  "Yank currently displayed message entity.
 By setting following-method as yank-content."
   (let ((wl-draft-buffer (current-buffer))
-       (mime-view-following-method-alist 
-        (list (cons 'mmelmo-original-mode 
+       (mime-view-following-method-alist
+        (list (cons 'mmelmo-original-mode
                     (function wl-draft-yank-to-draft-buffer))))
-       (mime-preview-following-method-alist 
+       (mime-preview-following-method-alist
         (list (cons 'mmelmo-original-mode
                     (function wl-draft-yank-to-draft-buffer)))))
     (if (get-buffer (wl-current-message-buffer))
@@ -74,12 +69,12 @@ By setting following-method as yank-content."
 (defalias 'wl-draft-enclose-digest-region 'mime-edit-enclose-digest-region)
 
 ;; SEMI 1.13.5 or later.
-;; (mime-display-message 
-;;  MESSAGE &optional 
+;; (mime-display-message
+;;  MESSAGE &optional
 ;;  PREVIEW-BUFFER MOTHER DEFAULT-KEYMAP-OR-FUNCTION ORIGINAL-MAJOR-MODE)
 ;; SEMI 1.13.4 or earlier.
-;; (mime-display-message 
-;;  MESSAGE &optional 
+;; (mime-display-message
+;;  MESSAGE &optional
 ;;  PREVIEW-BUFFER MOTHER DEFAULT-KEYMAP-OR-FUNCTION)
 (static-if (or (and mime-user-interface-product
                    (eq (nth 0 (aref mime-user-interface-product 1)) 1)
@@ -98,9 +93,9 @@ By setting following-method as yank-content."
                             (, default-keymap-or-function))))
   ;; User agent field of XEmacs has problem on SEMI 1.13.4 or earlier.
   (setq mime-edit-user-agent-value
-       (concat 
+       (concat
         (mime-product-name mime-user-interface-product) "/"
-        (mapconcat 
+        (mapconcat
          #'number-to-string
          (mime-product-version mime-user-interface-product) ".")
         " (" (mime-product-code-name mime-user-interface-product)
@@ -109,7 +104,7 @@ By setting following-method as yank-content."
                        (mime-product-version mime-library-product) ".")
         " (" (mime-product-code-name mime-library-product) ") "
         (if (featurep 'xemacs)
-            (concat 
+            (concat
              (if (featurep 'mule) "MULE")
              " XEmacs"
              (if (string-match "\\s +\\((\\|\\\"\\)" emacs-version)
@@ -162,7 +157,7 @@ By setting following-method as yank-content."
                                          mime-edit-translate-buffer-hook)))
     (mime-edit-preview-message)
     (let ((buffer-read-only nil))
-      (when wl-highlight-body-too 
+      (when wl-highlight-body-too
        (wl-highlight-body))
       (run-hooks 'wl-draft-preview-message-hook))))
 
@@ -192,9 +187,9 @@ By setting following-method as yank-content."
        (if (setq mime-out-win (get-buffer-window mime-out-buf))
            (delete-window mime-out-win)))))
 
-(defun wl-message-request-partial (folder number msgdb)
+(defun wl-message-request-partial (folder number)
   (elmo-set-work-buf
-   (elmo-read-msg-no-cache folder number (current-buffer) msgdb)
+   (elmo-read-msg-no-cache folder number (current-buffer))
    (mime-parse-buffer nil))); 'mime-buffer-entity)))
 
 (defalias 'wl-message-read            'mime-preview-scroll-up-entity)
@@ -203,19 +198,40 @@ By setting following-method as yank-content."
 (defalias 'wl-message-play-content    'mime-preview-play-current-entity)
 (defalias 'wl-message-extract-content 'mime-preview-extract-current-entity)
 (defalias 'wl-message-quit            'mime-preview-quit)
-(defalias 'wl-message-button-dispatcher 'mime-button-dispatcher)
+(defalias 'wl-message-button-dispatcher-internal
+  'mime-button-dispatcher)
 
 ;;; Summary
+(defun wl-summary-burst-subr (children target number)
+  ;; returns new number.
+  (let (content-type message-entity granch)
+    (while children
+      (setq content-type (mime-entity-content-type (car children)))
+      (if (eq (cdr (assq 'type content-type)) 'multipart)
+          (setq number (wl-summary-burst-subr
+                       (mime-entity-children (car children))
+                       target
+                       number))
+        (when (and (eq (cdr (assq 'type content-type)) 'message)
+                   (eq (cdr (assq 'subtype content-type)) 'rfc822))
+          (message (format "Bursting...%s" (setq number (+ 1 number))))
+          (setq message-entity
+                (car (mime-entity-children (car children))))
+         (elmo-append-msg target
+                          (mime-entity-body (car children))
+                          (mime-entity-fetch-field message-entity
+                                                   "Message-ID"))))
+      (setq children (cdr children)))
+    number))
+
 (defun wl-summary-burst ()
   (interactive)
   (let ((raw-buf (wl-message-get-original-buffer))
-       (i 0)
-       target 
-       children message-entity content-type)
+       children message-entity content-type target)
     (save-excursion
       (setq target wl-summary-buffer-folder-name)
       (while (not (elmo-folder-writable-p target))
-       (setq target 
+       (setq target
              (wl-summary-read-folder wl-default-folder "to extract to")))
       (wl-summary-set-message-buffer-or-redisplay)
       (save-excursion
@@ -223,34 +239,20 @@ By setting following-method as yank-content."
        (setq message-entity (get-text-property (point-min) 'mime-view-entity)))
       (set-buffer raw-buf)
       (setq children (mime-entity-children message-entity))
-      (message "Bursting...")
-      (while children
-       (setq content-type (mime-entity-content-type (car children)))
-       (when (and (eq (cdr (assq 'type content-type)) 'message)
-                  (eq (cdr (assq 'subtype content-type)) 'rfc822))
-         (message (format "Bursting...%s" (setq i (+ 1 i))))
-         (setq message-entity
-               (car (mime-entity-children (car children))))
-         (save-restriction
-           (narrow-to-region (mime-entity-point-min message-entity)
-                             (mime-entity-point-max message-entity))
-           (elmo-append-msg target
-                            ;;(mime-entity-content (car children))))
-                            (buffer-substring (point-min) (point-max))
-                            (std11-field-body "Message-ID"))))
-       (setq children (cdr children)))
-      (message "Bursting...done."))
-    (if (elmo-folder-plugged-p target)
-       (elmo-commit target))
+      (when children
+       (message "Bursting...")
+       (wl-summary-burst-subr children target 0)
+       (message "Bursting...done"))
+      (if (elmo-folder-plugged-p target)
+         (elmo-commit target)))
     (wl-summary-sync-update3)))
 
-
 ;; internal variable.
 (defvar wl-mime-save-dir nil "Last saved directory.")
 ;;; Yet another save method.
 (defun wl-mime-save-content (entity situation)
   (let ((filename (read-file-name "Save to file: "
-                                 (expand-file-name 
+                                 (expand-file-name
                                   (or (mime-entity-safe-filename entity)
                                       ".")
                                   (or wl-mime-save-dir
@@ -269,7 +271,7 @@ By setting following-method as yank-content."
   "Internal method for wl to combine message/partial messages
 automatically."
   (interactive)
-  (let* ((msgdb (save-excursion 
+  (let* ((msgdb (save-excursion
                  (set-buffer wl-message-buffer-cur-summary-buffer)
                  wl-summary-buffer-msgdb))
         (mime-display-header-hook 'wl-highlight-headers)
@@ -287,9 +289,9 @@ automatically."
            (not (y-or-n-p "Merge partials?")))
        (with-current-buffer mother
          (mime-store-message/partial-piece entity situation))
-      (setq subject-id 
+      (setq subject-id
            (eword-decode-string
-            (decode-mime-charset-string 
+            (decode-mime-charset-string
              (wl-mime-entity-read-field entity 'Subject)
              wl-summary-buffer-mime-charset)))
       (if (string-match "[0-9\n]+" subject-id)
@@ -304,11 +306,10 @@ automatically."
                    ;; request message at the cursor in Subject buffer.
                    (wl-message-request-partial
                     folder
-                    (elmo-msgdb-overview-entity-get-number (car overviews))
-                    msgdb))
+                    (elmo-msgdb-overview-entity-get-number (car overviews))))
                   (situation (mime-entity-situation message))
                   (the-id (or (cdr (assoc "id" situation)) "")))
-             (when (string= (downcase the-id) 
+             (when (string= (downcase the-id)
                             (downcase id))
                (with-current-buffer mother
                  (mime-store-message/partial-piece message situation))
@@ -317,13 +318,20 @@ automatically."
          (setq overviews (cdr overviews)))
        (message "Not all partials found.")))))
 
+(defun wl-mime-header-presentation-method (entity situation)
+  (let ((mmelmo-sort-field-list wl-message-sort-field-list))
+    (mime-insert-header entity
+                       wl-message-ignored-field-list
+                       wl-message-visible-field-list)
+    (wl-highlight-headers)))
+
 ;;; Setup methods.
 (defun wl-mime-setup ()
   (set-alist 'mime-preview-quitting-method-alist
             'mmelmo-original-mode 'wl-message-exit)
   (set-alist 'mime-view-over-to-previous-method-alist
             'mmelmo-original-mode 'wl-message-exit)
-  (set-alist 'mime-view-over-to-next-method-alist 
+  (set-alist 'mime-view-over-to-next-method-alist
             'mmelmo-original-mode 'wl-message-exit)
   (set-alist 'mime-preview-over-to-previous-method-alist
             'mmelmo-original-mode 'wl-message-exit)
@@ -343,10 +351,10 @@ automatically."
    '((mode . "extract")
      (major-mode . mmelmo-original-mode)
      (method . wl-mime-save-content)))
-  (set-alist 'mime-preview-following-method-alist 
+  (set-alist 'mime-preview-following-method-alist
             'mmelmo-original-mode
             (function wl-message-follow-current-entity))
-  (set-alist 'mime-view-following-method-alist 
+  (set-alist 'mime-view-following-method-alist
             'mmelmo-original-mode
             (function wl-message-follow-current-entity))
   (set-alist 'mime-edit-message-inserter-alist
@@ -354,16 +362,24 @@ automatically."
   (set-alist 'mime-edit-mail-inserter-alist
             'wl-draft-mode (function wl-draft-insert-get-message))
   (set-alist 'mime-edit-split-message-sender-alist
-            'wl-draft-mode 
+            'wl-draft-mode
             (cdr (assq 'mail-mode mime-edit-split-message-sender-alist)))
   (set-alist 'mime-raw-representation-type-alist
             'mmelmo-original-mode 'binary)
   ;; Sort and highlight header fields.
-  (setq mmelmo-sort-field-list wl-message-sort-field-list)
-  (add-hook 'mmelmo-header-inserted-hook 'wl-highlight-headers)
+  (or wl-message-ignored-field-list
+      (setq wl-message-ignored-field-list
+           mime-view-ignored-field-list))
+  (or wl-message-visible-field-list
+      (setq wl-message-visible-field-list
+           mime-view-visible-field-list))
+  (set-alist 'mime-header-presentation-method-alist
+            'mmelmo-original-mode
+            (function wl-mime-header-presentation-method))
   (add-hook 'mmelmo-entity-content-inserted-hook 'wl-highlight-body))
   
 
-(provide 'wl-mime)
+(require 'product)
+(product-provide (provide 'wl-mime) (require 'wl-version))
 
 ;;; wl-mime.el ends here