From: hmurata Date: Fri, 25 Feb 2005 15:05:50 +0000 (+0000) Subject: * wl-vars.el (wl-message-use-header-narrowing): New user option. X-Git-Tag: wl-2_14-root~24 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=12f1baf26945a43185396ef6f3285eb8f71aa444;p=elisp%2Fwanderlust.git * wl-vars.el (wl-message-use-header-narrowing): New user option. * wl-summary.el (wl-summary-toggle-mime): Treat numeric prefix argument `5'. * wl-message.el (wl-message-display-no-merge-p): New function. (wl-message-buffer-display): Check whether the message is reassembled and follow the API change. * elmo-mime.el (elmo-mime-entity-reassembled-p): New method. (elmo-mime-entity-fragment-p): New function. (mime-elmo-buffer-entity): Added slot `reassembled'. (elmo-message-mime-entity): Added 4th argument `reassemble'. (elmo-message-mime-entity-internal): New function (renamed from `elmo-message-mime-entity'). (elmo-mime-inherit-field-list-from-enclosed): New constant. (elmo-mime-make-reassembled-mime-entity): New function. (elmo-message-reassembled-mime-entity): Ditto. (elmo-mime-collect-message/partial-pieces): Ditto. --- diff --git a/doc/wl-ja.texi b/doc/wl-ja.texi index 0b6d291..404f6ce 100644 --- a/doc/wl-ja.texi +++ b/doc/wl-ja.texi @@ -4497,6 +4497,12 @@ Non-nil ならヘッダの省略表示を有効にします。 @vindex wl-message-header-narrowing-string 初期設定は @samp{...}。 ヘッダの内容を省略した時に表示する文字列を指定します。 + +@item wl-message-auto-reassemble-message/partial +@vindex wl-message-auto-reassemble-message/partial +初期設定は @code{nil}。 +Non-nil なら MIME メディアタイプが message/partial のメッセージを表示する +際に、自動的に結合して表示します。 @end table diff --git a/doc/wl.texi b/doc/wl.texi index 9b5255d..4356d33 100644 --- a/doc/wl.texi +++ b/doc/wl.texi @@ -4493,6 +4493,12 @@ Each elements are regexp of field-name. @vindex wl-message-truncate-lines The initial value is the value of @code{default-truncate-lines}. If it is non-nil, truncate long lines in message buffer. + +@item wl-message-auto-reassemble-message/partial +@vindex wl-message-auto-reassemble-message/partial +The initial setting is @code{nil}. +If non-nil, automatically reassemble fragments of the message on +displaying when its MIME media type is message/partial. @end table @node Draft, Disconnected Operations, Message, Top diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 5a3728d..6116690 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,16 @@ +2005-02-25 Hiroya Murata + + * elmo-mime.el (elmo-mime-entity-reassembled-p): New method. + (elmo-mime-entity-fragment-p): New function. + (mime-elmo-buffer-entity): Added slot `reassembled'. + (elmo-message-mime-entity): Added 4th argument `reassemble'. + (elmo-message-mime-entity-internal): New function (renamed from + `elmo-message-mime-entity'). + (elmo-mime-inherit-field-list-from-enclosed): New constant. + (elmo-mime-make-reassembled-mime-entity): New function. + (elmo-message-reassembled-mime-entity): Ditto. + (elmo-mime-collect-message/partial-pieces): Ditto. + 2005-02-24 Hiroya Murata * elmo.el (elmo-message-fetch-string): Disable multibyte. diff --git a/elmo/elmo-mime.el b/elmo/elmo-mime.el index b21a134..c3ddca3 100644 --- a/elmo/elmo-mime.el +++ b/elmo/elmo-mime.el @@ -44,6 +44,9 @@ MIME-MODE is a symbol which is one of the following: `mime' (Can display each MIME part) `as-is' (Can display raw message)") +(luna-define-generic elmo-mime-entity-reassembled-p (entity) + "Return non-nil if ENTITY is reassembled message/partial pieces.") + (luna-define-generic elmo-mime-entity-display (entity preview-buffer &optional original-major-mode @@ -79,9 +82,16 @@ use for keymap of representation buffer.") keymap original-major-mode))) +(defun elmo-mime-entity-fragment-p (entity) + (and (not (elmo-mime-entity-reassembled-p entity)) + (eq (mime-entity-media-type entity) 'message) + (eq (mime-entity-media-subtype entity) 'partial))) + (eval-and-compile (luna-define-class mime-elmo-buffer-entity (mime-buffer-entity - elmo-mime-entity)) + elmo-mime-entity) + (reassembled)) + (luna-define-internal-accessors 'mime-elmo-buffer-entity) (luna-define-class mime-elmo-imap-entity (mime-imap-entity elmo-mime-entity))) @@ -238,6 +248,10 @@ value is used." ;; always return t. t) +(luna-define-method elmo-mime-entity-reassembled-p ((entity + mime-elmo-buffer-entity)) + (mime-elmo-buffer-entity-reassembled-internal entity)) + (luna-define-method elmo-mime-entity-display-as-is ((entity mime-elmo-buffer-entity) preview-buffer @@ -264,15 +278,45 @@ value is used." (error "Does not support this method")) -(defun elmo-message-mime-entity (folder number rawbuf +(defun elmo-message-mime-entity (folder number rawbuf reassemble &optional ignore-cache unread entire) "Return the mime-entity structure of the message in the FOLDER with NUMBER. RAWBUF is the output buffer for original message. +If REASSEMBLE is non-nil and MIME media type of the message is message/partial, +the mime-entity is reassembled partial message. If optional argument IGNORE-CACHE is non-nil, existing cache is ignored. If second optional argument UNREAD is non-nil, keep status of the message as unread. If third optional argument ENTIRE is non-nil, fetch entire message at once." + (let (id message entity content-type) + (or (and reassemble + (setq entity (elmo-message-entity folder number)) + (setq id (if (setq content-type (elmo-message-entity-field + entity 'content-type)) + (and (string-match "message/partial" content-type) + (mime-content-type-parameter + (mime-parse-Content-Type content-type) "id")) + (and (setq message (elmo-message-mime-entity-internal + folder number rawbuf + ignore-cache unread entire)) + (eq (mime-entity-media-type message) 'message) + (eq (mime-entity-media-subtype message) 'partial) + (mime-content-type-parameter + (mime-entity-content-type message) "id")))) + (elmo-message-reassembled-mime-entity + folder id rawbuf + (elmo-message-entity-field entity 'subject 'decode) + ignore-cache + unread)) + message + (elmo-message-mime-entity-internal + folder number rawbuf ignore-cache unread entire)))) + + +(defun elmo-message-mime-entity-internal (folder number rawbuf + &optional + ignore-cache unread entire) (let ((strategy (elmo-find-fetch-strategy folder number ignore-cache entire))) @@ -292,6 +336,120 @@ If third optional argument ENTIRE is non-nil, fetch entire message at once." (elmo-message-fetch folder number strategy unread))) (mime-open-entity 'elmo-buffer rawbuf))))) + +(defconst elmo-mime-inherit-field-list-from-enclosed + '("^Content-.*:" "^Message-Id:" "^Subject:" + "^Encrypted.*:" "^MIME-Version:")) + +(defsubst elmo-mime-make-reassembled-mime-entity (buffer) + (let ((entity (mime-open-entity 'elmo-buffer buffer))) + (mime-elmo-buffer-entity-set-reassembled-internal entity t) + entity)) + +(defun elmo-message-reassembled-mime-entity (folder id rawbuf subject + &optional + ignore-cache + unread) + (let ((cache (elmo-file-cache-get (concat "<" id ">"))) + pieces) + (if (and (not ignore-cache) + (eq (elmo-file-cache-status cache) 'entire)) + ;; use cache + (with-current-buffer rawbuf + (let (buffer-read-only) + (erase-buffer) + (elmo-file-cache-load (elmo-file-cache-path cache) nil)) + (elmo-mime-make-reassembled-mime-entity rawbuf)) + ;; reassemble fragment of the entity + (when (setq pieces (elmo-mime-collect-message/partial-pieces + folder id + (regexp-quote + (if (string-match "[0-9\n]+" subject) + (substring subject 0 (match-beginning 0)) + subject)) + ignore-cache unread)) + (with-current-buffer rawbuf + (let (buffer-read-only + (outer-header (car pieces)) + (pieces (sort (cdr pieces) (lambda (l r) (< (car l) (car r))))) + contents entity) + (erase-buffer) + (while pieces + (insert (cdr (car pieces))) + (setq pieces (cdr pieces))) + (let ((case-fold-search t)) + (save-restriction + (std11-narrow-to-header) + (goto-char (point-min)) + (while (re-search-forward std11-field-head-regexp nil t) + (let ((field-start (match-beginning 0))) + (unless (mime-visible-field-p + (buffer-substring field-start (match-end 0)) + elmo-mime-inherit-field-list-from-enclosed + '(".*")) + (delete-region field-start (1+ (std11-field-end)))))))) + (goto-char (point-min)) + (insert outer-header) + ;; save cache + (elmo-file-cache-save (elmo-file-cache-path cache) nil) + (elmo-mime-make-reassembled-mime-entity rawbuf))))))) + +(defun elmo-mime-collect-message/partial-pieces (folder id subject-regexp + &optional + ignore-cache + unread) + (catch 'complete + (with-temp-buffer + (set-buffer-multibyte nil) + (let (total header pieces) + (elmo-folder-do-each-message-entity (entity folder) + (when (string-match + subject-regexp + (elmo-message-entity-field entity 'subject 'decode)) + (erase-buffer) + (let* ((message (elmo-message-mime-entity-internal + folder + (elmo-message-entity-number entity) + (current-buffer) + ignore-cache + unread)) + (ct (mime-entity-content-type message)) + (the-id (or (mime-content-type-parameter ct "id") "")) + number) + (when (string= (downcase the-id) + (downcase id)) + (setq number (string-to-number + (mime-content-type-parameter ct "number"))) + (setq pieces (cons (cons number (mime-entity-body message)) + pieces)) + (when (= number 1) + (let ((case-fold-search t)) + (save-restriction + (std11-narrow-to-header) + (goto-char (point-min)) + (while (re-search-forward std11-field-head-regexp nil t) + (let ((field-start (match-beginning 0))) + (when (mime-visible-field-p + (buffer-substring field-start (match-end 0)) + nil + elmo-mime-inherit-field-list-from-enclosed) + (setq header (concat + header + (buffer-substring + field-start (std11-field-end)) + "\n")))))))) + (unless total + (setq total (ignore-errors + (string-to-number + (mime-content-type-parameter ct "total"))))) + (when (and total + (> total 0) + (>= (length pieces) total)) + (throw 'complete (cons header pieces))))))))) + ;; return value + nil)) + + ;; Replacement of mime-display-message. (defun elmo-mime-display-as-is-internal (message &optional preview-buffer diff --git a/wl/ChangeLog b/wl/ChangeLog index 359e06a..7f050b1 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,14 @@ +2005-02-25 Hiroya Murata + + * wl-vars.el (wl-message-use-header-narrowing): New user option. + + * wl-summary.el (wl-summary-toggle-mime): Treat numeric prefix + argument `5'. + + * wl-message.el (wl-message-display-no-merge-p): New function. + (wl-message-buffer-display): Check whether the message is + reassembled and follow the API change. + 2005-02-24 Hiroya Murata * wl-action.el (wl-summary-exec-action-resend-subr): Disable diff --git a/wl/wl-message.el b/wl/wl-message.el index 467845e..5c7f485 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -444,6 +444,9 @@ Returns non-nil if bottom of message." (defun wl-message-display-all-header-p (display-type) (eq (wl-message-display-type-property display-type :header) 'all)) +(defun wl-message-display-no-merge-p (display-type) + (eq (wl-message-display-type-property display-type :mime) 'no-merge)) + (defun wl-message-buffer-display-type (&optional message-buffer) (if message-buffer (with-current-buffer message-buffer @@ -562,11 +565,17 @@ Returns non-nil if bottom of message." entity (if (wl-message-mime-analysis-p display-type) 'mime - 'as-is)))) + 'as-is))) + (if (wl-message-display-no-merge-p display-type) + (elmo-mime-entity-reassembled-p entity) + (elmo-mime-entity-fragment-p entity))) (setq entity (elmo-message-mime-entity folder number (wl-message-get-original-buffer) + (and wl-message-auto-reassemble-message/partial + (not (wl-message-display-no-merge-p + display-type))) force-reload unread (not (wl-message-mime-analysis-p display-type))))) diff --git a/wl/wl-summary.el b/wl/wl-summary.el index dc066c9..476b6f7 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -4474,7 +4474,9 @@ If ARG is numeric number, decode message as following: (setq mime-mode (case arg (1 'mime) (2 'header-only) - (3 'as-is)))) + (3 'as-is) +;;; (4 'decode-only) + (5 'no-merge)))) (arg ;; Specify coding-system (doesn't change the MIME mode). (setq elmo-mime-display-as-is-coding-system diff --git a/wl/wl-vars.el b/wl/wl-vars.el index 6aea055..824bbc1 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -1646,6 +1646,11 @@ which appear just before @." :type 'boolean :group 'wl-pref) +(defcustom wl-message-auto-reassemble-message/partial nil + "*Reassemble message/partial messages automatically on show when non-nil." + :type 'boolean + :group 'wl-pref) + (defcustom wl-message-use-header-narrowing t "Use header narrowing when non-nil." :type 'boolean