* 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.

diff --git a/elmo/ChangeLog b/elmo/ChangeLog
index 76bdfa1..795316c 100644 (file)
--- a/elmo/ChangeLog
+++ b/elmo/ChangeLog
@@ -1,3 +1,20 @@
+2001-09-10  Yuuichi Teranishi  <teranisi@gohome.org>
+
+       * 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  <teranisi@gohome.org>
 
        * 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,3 +1,8 @@
+2001-09-10  Yuuichi Teranishi  <teranisi@gohome.org>
+
+       * wl-address.el (wl-address-specials-regexp): Eliminated.
+       (wl-address-quote-specials): Rewrite.
+
 2001-09-05  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * 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 (file)
--- 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)