From 023fb657509dc1198ffb97596647dd5e7faf6caf Mon Sep 17 00:00:00 2001 From: teranisi Date: Mon, 10 Sep 2001 09:09:42 +0000 Subject: [PATCH] * wl-address.el (wl-address-specials-regexp): Eliminated. (wl-address-quote-specials): Rewrite. * mmimap.el (mime-imap-entity::requested): New slot. (mime-imap-location-fetch-entity-p): New generic function. (mime-decode-parameters): Define using `defun-maybe'. (mmimap-make-mime-entity): Use `make-mime-content-type' to make content-type structure. (mime-entity-body): Return empty body if `mime-imap-location-fetch-entity-p' returns nil in the first request. * elmo.el (elmo-message-displaying): New variable. * elmo-mime.el (elmo-mime-message-display): Bind elmo-message-displaying as t. * elmo-imap4.el (mime-imap-location-fetch-entity-p): Define. --- elmo/ChangeLog | 17 ++++++++++++ elmo/elmo-imap4.el | 13 +++++++++ elmo/elmo-mime.el | 1 + elmo/elmo.el | 3 +++ elmo/mmimap.el | 74 +++++++++++++++++++++++++--------------------------- wl/ChangeLog | 5 ++++ wl/wl-address.el | 10 +++---- 7 files changed, 79 insertions(+), 44 deletions(-) diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 76bdfa1..795316c 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,20 @@ +2001-09-10 Yuuichi Teranishi + + * mmimap.el (mime-imap-entity::requested): New slot. + (mime-imap-location-fetch-entity-p): New generic function. + (mime-decode-parameters): Define using `defun-maybe'. + (mmimap-make-mime-entity): Use `make-mime-content-type' to make + content-type structure. + (mime-entity-body): Return empty body if + `mime-imap-location-fetch-entity-p' returns nil in the first request. + + * elmo.el (elmo-message-displaying): New variable. + + * elmo-mime.el (elmo-mime-message-display): Bind + elmo-message-displaying as t. + + * elmo-imap4.el (mime-imap-location-fetch-entity-p): Define. + 2001-08-31 Yuuichi Teranishi * acap.el (acap-open): erase buffer before starting network process. diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el index 2952397..30b2f7a 100644 --- a/elmo/elmo-imap4.el +++ b/elmo/elmo-imap4.el @@ -415,6 +415,19 @@ If response is not `OK' response, causes error with IMAP response text." (mime-elmo-imap-location-number-internal location) (mime-elmo-imap-location-strategy-internal location))) +(luna-define-method mime-imap-location-fetch-entity-p + ((location mime-elmo-imap-location) entity) + (or (not elmo-message-displaying) ; Fetching entity to save or force display. + ;; cache exists + (file-exists-p + (expand-file-name + (mmimap-entity-section (mime-entity-node-id-internal entity)) + (elmo-fetch-strategy-cache-path + (mime-elmo-imap-location-strategy-internal location)))) + ;; not too large to fetch. + (> elmo-message-fetch-threshold + (or (mime-imap-entity-size-internal entity) 0)))) + ;;; (defun elmo-imap4-session-check (session) diff --git a/elmo/elmo-mime.el b/elmo/elmo-mime.el index b88cd10..037513b 100644 --- a/elmo/elmo-mime.el +++ b/elmo/elmo-mime.el @@ -214,6 +214,7 @@ If second optional argument UNREAD is specified, message is displayed but keep it as unread. Return non-nil if not entire message was fetched." (let (mime-display-header-hook ; Do nothing. + (elmo-message-displaying t) entity strategy) (setq entity (elmo-msgdb-overview-get-entity number (elmo-folder-msgdb diff --git a/elmo/elmo.el b/elmo/elmo.el index 65b517d..48d597f 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -66,6 +66,9 @@ Otherwise, entire fetching of the message is aborted without confirmation." :type 'boolean :group 'elmo) +(defvar elmo-message-displaying nil + "A global switch to indicate message is displaying or not.") + ;;; internal (defvar elmo-folder-type-alist nil) diff --git a/elmo/mmimap.el b/elmo/mmimap.el index 54a5faf..bec308b 100644 --- a/elmo/mmimap.el +++ b/elmo/mmimap.el @@ -36,7 +36,7 @@ (eval-and-compile (luna-define-class mime-imap-entity (mime-entity) - (size header-string body-string new)) + (size header-string body-string new requested)) (luna-define-internal-accessors 'mime-imap-entity)) ;;; @ MIME IMAP location @@ -52,6 +52,9 @@ SECTION is a section string which is defined in RFC2060.") "Return a parsed bodystructure of LOCATION. `NIL' should be converted to nil, `astring' should be converted to a string.") +(luna-define-generic mime-imap-location-fetch-entity-p (location entity) + "Return non-nil when LOCATION may fetch the ENTITY.") + ;;; @ Subroutines ;; @@ -66,10 +69,8 @@ SECTION is a section string which is defined in RFC2060.") (reverse node-id) ".")))) -(static-if (fboundp 'mime-decode-parameters) - (defalias 'mmimap-parse-parameters-from-list 'mime-decode-parameters) - (defun mmimap-parse-parameters-from-list (attrlist) - "Parse parameters from ATTRLIST." +(eval-and-compile + (defun-maybe mime-decode-parameters (attrlist) (let (ret-val) (while attrlist (setq ret-val (append ret-val @@ -94,8 +95,7 @@ CLASS, LOCATION, NODE-ID, PARENT are set to the returned entity." :location location :node-id (if (eq number 0) node-id - (nconc (list number) node-id)) - )) + (nconc (list number) node-id)))) (while (and (setq curp (car bodystructure)) (listp curp)) (setq children @@ -111,34 +111,17 @@ CLASS, LOCATION, NODE-ID, PARENT are set to the returned entity." (setq num (+ num 1)) (setq bodystructure (cdr bodystructure))) (mime-entity-set-children-internal entity children) - (setq content-type (list (cons 'type 'multipart))) - (if (car bodystructure) - (setq content-type (nconc content-type - (list (cons 'subtype - (intern - (downcase - (car - bodystructure)))))))) - (setq content-type (append content-type - (mmimap-parse-parameters-from-list - (nth 1 bodystructure)))) - (mime-entity-set-content-type-internal entity content-type) + (mime-entity-set-content-type-internal + entity + (make-mime-content-type 'multipart + (if (car bodystructure) + (intern (downcase + (car bodystructure)))) + (mime-decode-parameters + (nth 1 bodystructure)))) entity)) (t ; singlepart (let (content-type entity) - (setq content-type - (list (cons 'type (intern (downcase (car bodystructure)))))) - (if (nth 1 bodystructure) - (setq content-type (append content-type - (list - (cons 'subtype - (intern - (downcase - (nth 1 bodystructure)))))))) - (if (nth 2 bodystructure) - (setq content-type (append content-type - (mmimap-parse-parameters-from-list - (nth 2 bodystructure))))) (setq node-id (nconc (list number) node-id)) (setq entity (luna-make-entity @@ -149,7 +132,14 @@ CLASS, LOCATION, NODE-ID, PARENT are set to the returned entity." :location location :parent parent :node-id node-id)) - (mime-entity-set-content-type-internal entity content-type) + (mime-entity-set-content-type-internal + entity + (make-mime-content-type (intern (downcase (car bodystructure))) + (if (nth 1 bodystructure) + (intern (downcase + (nth 1 bodystructure)))) + (mime-decode-parameters + (nth 2 bodystructure)))) (mime-entity-set-encoding-internal entity (and (nth 5 bodystructure) (downcase @@ -200,12 +190,18 @@ CLASS, LOCATION, NODE-ID, PARENT are set to the returned entity." (luna-define-method mime-entity-body ((entity mime-imap-entity)) (or (mime-imap-entity-body-string-internal entity) - (mime-imap-entity-set-body-string-internal - entity - (mime-imap-location-section-body - (mime-entity-location-internal entity) - (mmimap-entity-section - (mime-entity-node-id-internal entity)))))) + (if (or (mime-imap-entity-requested-internal entity) ; second time. + (mime-imap-location-fetch-entity-p + (mime-entity-location-internal entity) + entity)) + (mime-imap-entity-set-body-string-internal + entity + (mime-imap-location-section-body + (mime-entity-location-internal entity) + (mmimap-entity-section + (mime-entity-node-id-internal entity)))) + (mime-imap-entity-set-requested-internal entity t) + ""))) (luna-define-method mime-insert-entity-body ((entity mime-imap-entity)) (insert (mime-entity-body entity))) diff --git a/wl/ChangeLog b/wl/ChangeLog index 5180e52..a42747a 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,8 @@ +2001-09-10 Yuuichi Teranishi + + * wl-address.el (wl-address-specials-regexp): Eliminated. + (wl-address-quote-specials): Rewrite. + 2001-09-05 Katsumi Yamaoka * wl-xmas.el (wl-highlight-folder-current-line): Use Perl style diff --git a/wl/wl-address.el b/wl/wl-address.el index 19dcb26..3e540c6 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -280,13 +280,13 @@ Matched address lists are append to CL." (completing-read "To: " cl) (read-string "To: ")))) -(defconst wl-address-specials-regexp "[]\"(),.:;<>@[\\]") - (defun wl-address-quote-specials (word) "Make quoted string of WORD if needed." - (if (string-match wl-address-specials-regexp word) - (prin1-to-string word) - word)) + (let ((lal (std11-lexical-analyze word))) + (if (or (assq 'specials lal) + (assq 'domain-literal lal)) + (prin1-to-string word) + word))) (defun wl-address-make-completion-list (address-list) (let (addr-tuple cl) -- 1.7.10.4