Implement rmail-search-mime-message-function.

2 files changed, 69 insertions, 21 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1b35c13377c..c09e7a7a441 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2010-11-29  Kenichi Handa  <handa@m17n.org>
+
+        * mail/rmailmm.el (rmail-mime-parse): Call rmail-mime-process
+        within condition-case.
+        (rmail-show-mime): Don't use condition-case.
+        (rmail-search-mime-message): New function.
+        (rmail-search-mime-message-function): Set to
+        rmail-search-mime-message.
+
 2010-11-26  Kenichi Handa  <handa@m17n.org>
 
         * mail/rmailmm.el (rmail-mime-insert-multipart): For unsupported
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 2c1269ee3f1..1cd765cbf9f 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -690,7 +690,9 @@ modified."
 The value is a MIME-entiy object (see `rmail-mime-enty-new')."
   (save-excursion
     (goto-char (point-min))
-    (rmail-mime-process nil t)))
+    (condition-case nil
+        (rmail-mime-process nil t)
+      (error nil))))
 
 (defun rmail-mime-insert (entity &optional content-type disposition)
   "Insert a MIME-entity ENTITY in the current buffer.
@@ -743,30 +745,31 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
          message type disposition encoding))
 
 (defun rmail-show-mime ()
-  (let ((mbox-buf rmail-buffer))
-    (condition-case nil
-        (let ((entity (rmail-mime-parse)))
-          (with-current-buffer rmail-view-buffer
-            (let ((inhibit-read-only t)
-                  (rmail-buffer mbox-buf))
-              (erase-buffer)
-              (rmail-mime-insert entity))))
-      (error
-       ;; Decoding failed.  Insert the original message body as is.
-       (let ((region (with-current-buffer mbox-buf
-                       (goto-char (point-min))
-                       (re-search-forward "^$" nil t)
-                       (forward-line 1)
-                       (cons (point) (point-max)))))
-         (with-current-buffer rmail-view-buffer
-           (let ((inhibit-read-only t))
-             (erase-buffer)
-             (insert-buffer-substring mbox-buf (car region) (cdr region))))
-         (message "MIME decoding failed"))))))
+  "Function to set in `rmail-show-mime-function' (which see)."
+  (let ((mbox-buf rmail-buffer)
+        (entity (rmail-mime-parse)))
+    (if entity
+        (with-current-buffer rmail-view-buffer
+          (let ((inhibit-read-only t)
+                (rmail-buffer mbox-buf))
+            (erase-buffer)
+            (rmail-mime-insert entity)))
+      ;; Decoding failed.  Insert the original message body as is.
+      (let ((region (with-current-buffer mbox-buf
+                      (goto-char (point-min))
+                      (re-search-forward "^$" nil t)
+                      (forward-line 1)
+                      (cons (point) (point-max)))))
+        (with-current-buffer rmail-view-buffer
+          (let ((inhibit-read-only t))
+            (erase-buffer)
+            (insert-buffer-substring mbox-buf (car region) (cdr region))))
+        (message "MIME decoding failed")))))
 
 (setq rmail-show-mime-function 'rmail-show-mime)
 
 (defun rmail-insert-mime-forwarded-message (forward-buffer)
+  "Function to set in `rmail-insert-mime-forwarded-message-function' (which see)."
   (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer)))
     (save-restriction
       (narrow-to-region (point) (point))
@@ -776,6 +779,7 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
       'rmail-insert-mime-forwarded-message)
 
 (defun rmail-insert-mime-resent-message (forward-buffer)
+  "Function to set in `rmail-insert-mime-resent-message-function' (which see)."
   (insert-buffer-substring
    (with-current-buffer forward-buffer rmail-view-buffer))
   (goto-char (point-min))
@@ -786,6 +790,41 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
 (setq rmail-insert-mime-resent-message-function
       'rmail-insert-mime-resent-message)
 
+(defun rmail-search-mime-message (msg regexp)
+  "Function to set in `rmail-search-mime-message-function' (which see)."
+  (save-restriction
+    (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg))
+    (let ((mbox-buf (current-buffer))
+          (header-end (save-excursion
+                        (re-search-forward "^$" nil 'move) (point)))
+          (body-end (point-max))
+          (entity (rmail-mime-parse)))
+      (or 
+       ;; At first, just search the headers.
+       (with-temp-buffer
+         (insert-buffer-substring mbox-buf nil header-end)
+         (rfc2047-decode-region (point-min) (point))
+         (goto-char (point-min))
+         (re-search-forward regexp nil t))
+       ;; Next, search the body.
+       (if (and entity
+                (let* ((content-type (rmail-mime-entity-type entity))
+                       (charset (cdr (assq 'charset (cdr content-type)))))
+                  (or (not (string-match "text/.*" (car content-type))) 
+                      (and charset
+                           (not (string= (downcase charset) "us-ascii"))))))
+           ;; Search the decoded MIME message.
+           (with-temp-buffer
+             (let ((rmail-buffer mbox-buf))
+               (rmail-mime-insert entity))
+             (goto-char (point-min))
+             (re-search-forward regexp nil t))
+         ;; Search the body without decoding.
+         (goto-char header-end)
+         (re-search-forward regexp nil t))))))
+
+(setq rmail-search-mime-message-function 'rmail-search-mime-message)
+
 (provide 'rmailmm)
 
 ;; Local Variables: