From 7e116860bbae843e00c29b08919e10fc37f7aaa2 Mon Sep 17 00:00:00 2001 From: Kenichi Handa Date: Mon, 29 Nov 2010 21:22:39 +0900 Subject: [PATCH] Implement rmail-search-mime-message-function. --- lisp/ChangeLog | 9 +++++ lisp/mail/rmailmm.el | 81 ++++++++++++++++++++++++++++++++------------ 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 + + * 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 * 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: -- 2.39.2