* elmo-imap4.el (elmo-folder-list-subfolders): Check the return value
[elisp/wanderlust.git] / elmo / elmo-imap4.el
index 2b68689..81553d8 100644 (file)
@@ -716,43 +716,10 @@ Returns response value if selecting folder succeed. "
                "search %s") flag))
      'search)))
 
-(static-cond
- ((fboundp 'float)
-  ;; Emacs can parse dot symbol.
-  (defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
-  (defvar elmo-imap4-rfc822-text "RFC822\.TEXT")
-  (defvar elmo-imap4-rfc822-header "RFC822\.HEADER")
-  (defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
-  (defvar elmo-imap4-header-fields "HEADER\.FIELDS")
-  (defmacro elmo-imap4-replace-dot-symbols ()) ;; noop
-  (defalias 'elmo-imap4-fetch-read 'read)
-  )
- (t
-  ;;; For Nemacs.
-  ;; Cannot parse dot symbol.
-  (defvar elmo-imap4-rfc822-size "RFC822_SIZE")
-  (defvar elmo-imap4-header-fields "HEADER_FIELDS")
-  (defvar elmo-imap4-rfc822-size "RFC822_SIZE")
-  (defvar elmo-imap4-rfc822-text "RFC822_TEXT")
-  (defvar elmo-imap4-rfc822-header "RFC822_HEADER")
-  (defvar elmo-imap4-header-fields "HEADER_FIELDS")
-  (defun elmo-imap4-fetch-read (buffer)
-    (with-current-buffer buffer
-      (let ((beg (point))
-           token)
-       (when (re-search-forward "[[ ]" nil t)
-         (goto-char (match-beginning 0))
-         (setq token (buffer-substring beg (point)))
-         (cond ((string= token "RFC822.SIZE")
-                (intern elmo-imap4-rfc822-size))
-               ((string= token "RFC822.HEADER")
-                (intern elmo-imap4-rfc822-header))
-               ((string= token "RFC822.TEXT")
-                (intern elmo-imap4-rfc822-text))
-               ((string= token "HEADER\.FIELDS")
-                (intern elmo-imap4-header-fields))
-               (t (goto-char beg)
-                  (elmo-read (current-buffer))))))))))
+(defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
+(defvar elmo-imap4-rfc822-text "RFC822\.TEXT")
+(defvar elmo-imap4-rfc822-header "RFC822\.HEADER")
+(defvar elmo-imap4-header-fields "HEADER\.FIELDS")
 
 (defun elmo-imap4-make-number-set-list (msg-list &optional chop-length)
   "Make RFC2060's message set specifier from MSG-LIST.
@@ -792,18 +759,16 @@ If CHOP-LENGTH is not specified, message set is not chopped."
 
 ;;
 ;; app-data:
-;; cons of list
-;; 0: new-mark 1: already-mark 2: seen-mark 3: important-mark
-;; 4: seen-list
-;; and result of use-flag-p.
+;; cons of seen-list and result of use-flag-p.
 (defsubst elmo-imap4-fetch-callback-1-subr (entity flags app-data)
   "A msgdb entity callback function."
   (let* ((use-flag (cdr app-data))
         (app-data (car app-data))
-        (seen (member (car entity) (nth 4 app-data)))
+        (seen (member (car entity) app-data))
         mark)
     (if (member "\\Flagged" flags)
-       (elmo-msgdb-global-mark-set (car entity) (nth 3 app-data)))
+       (elmo-msgdb-global-mark-set (car entity)
+                                   elmo-msgdb-important-mark))
     (if (setq mark (elmo-msgdb-global-mark-get (car entity)))
        (unless (member "\\Seen" flags)
          (setq elmo-imap4-seen-messages
@@ -812,17 +777,22 @@ If CHOP-LENGTH is not specified, message set is not chopped."
                 elmo-imap4-seen-messages)))
       (setq mark (or (if (elmo-file-cache-status
                          (elmo-file-cache-get (car entity)))
+                        ;; cached.
+                        (if (member "\\Answered" flags)
+                            elmo-msgdb-answered-cached-mark
+                          (if (or seen
+                                  (and use-flag
+                                       (member "\\Seen" flags)))
+                              nil
+                            elmo-msgdb-unread-cached-mark))
+                      (if (member "\\Answered" flags)
+                          elmo-msgdb-answered-uncached-mark
                         (if (or seen
                                 (and use-flag
                                      (member "\\Seen" flags)))
-                            nil
-                          (nth 1 app-data))
-                      (if (or seen
-                              (and use-flag
-                                   (member "\\Seen" flags)))
-                          (if elmo-imap4-use-cache
-                              (nth 2 app-data))
-                        (nth 0 app-data))))))
+                            (if elmo-imap4-use-cache
+                                elmo-msgdb-read-uncached-mark)
+                          elmo-msgdb-new-mark))))))
     (setq elmo-imap4-current-msgdb
          (elmo-msgdb-append
           elmo-imap4-current-msgdb
@@ -852,7 +822,7 @@ If CHOP-LENGTH is not specified, message set is not chopped."
 
 (defun elmo-imap4-parse-capability (string)
   (if (string-match "^\\*\\(.*\\)$" string)
-      (elmo-read
+      (read
        (concat "(" (downcase (elmo-match-string 1 string)) ")"))))
 
 (defun elmo-imap4-clear-login (session)
@@ -1316,11 +1286,11 @@ Return nil if no complete line has arrived."
 (defun elmo-imap4-parse-response ()
   "Parse a IMAP command response."
   (let (token)
-    (case (setq token (elmo-read (current-buffer)))
+    (case (setq token (read (current-buffer)))
       (+ (progn
           (skip-chars-forward " ")
           (list 'continue-req (buffer-substring (point) (point-max)))))
-      (* (case (prog1 (setq token (elmo-read (current-buffer)))
+      (* (case (prog1 (setq token (read (current-buffer)))
                 (elmo-imap4-forward))
           (OK         (elmo-imap4-parse-resp-text-code))
           (NO         (elmo-imap4-parse-resp-text-code))
@@ -1332,19 +1302,19 @@ Return nil if no complete line has arrived."
           (LSUB       (list 'lsub (elmo-imap4-parse-data-list)))
           (SEARCH     (list
                        'search
-                       (elmo-read (concat "("
+                       (read (concat "("
                                      (buffer-substring (point) (point-max))
                                      ")"))))
           (STATUS     (elmo-imap4-parse-status))
           ;; Added
           (NAMESPACE  (elmo-imap4-parse-namespace))
           (CAPABILITY (list 'capability
-                            (elmo-read
+                            (read
                              (concat "(" (downcase (buffer-substring
                                                     (point) (point-max)))
                                      ")"))))
           (ACL (elmo-imap4-parse-acl))
-          (t       (case (prog1 (elmo-read (current-buffer))
+          (t       (case (prog1 (read (current-buffer))
                            (elmo-imap4-forward))
                      (EXISTS  (list 'exists token))
                      (RECENT  (list 'recent token))
@@ -1353,7 +1323,7 @@ Return nil if no complete line has arrived."
                      (t       (list 'garbage (buffer-string)))))))
       (t (if (not (string-match elmo-imap4-seq-prefix (symbol-name token)))
             (list 'garbage (buffer-string))
-          (case (prog1 (elmo-read (current-buffer))
+          (case (prog1 (read (current-buffer))
                   (elmo-imap4-forward))
             (OK  (progn
                    (setq elmo-imap4-parsing nil)
@@ -1412,9 +1382,9 @@ Return nil if no complete line has arrived."
     (cond ((search-forward "PERMANENTFLAGS " nil t)
           (list 'permanentflags (elmo-imap4-parse-flag-list)))
          ((search-forward "UIDNEXT " nil t)
-          (list 'uidnext (elmo-read (current-buffer))))
+          (list 'uidnext (read (current-buffer))))
          ((search-forward "UNSEEN " nil t)
-          (list 'unseen (elmo-read (current-buffer))))
+          (list 'unseen (read (current-buffer))))
          ((looking-at "UIDVALIDITY \\([0-9]+\\)")
           (list 'uidvalidity (match-string 1)))
          ((search-forward "READ-ONLY" nil t)
@@ -1478,12 +1448,12 @@ Return nil if no complete line has arrived."
     (let (element list)
       (while (not (eq (char-after (point)) ?\)))
        (elmo-imap4-forward)
-       (let ((token (elmo-imap4-fetch-read (current-buffer))))
+       (let ((token (read (current-buffer))))
          (elmo-imap4-forward)
          (setq element
                (cond ((eq token 'UID)
                       (list 'uid (condition-case nil
-                                     (elmo-read (current-buffer))
+                                     (read (current-buffer))
                                    (error nil))))
                      ((eq token 'FLAGS)
                       (list 'flags (elmo-imap4-parse-flag-list)))
@@ -1498,7 +1468,7 @@ Return nil if no complete line has arrived."
                      ((eq token (intern elmo-imap4-rfc822-text))
                       (list 'rfc822text (elmo-imap4-parse-nstring)))
                      ((eq token (intern elmo-imap4-rfc822-size))
-                      (list 'rfc822size (elmo-read (current-buffer))))
+                      (list 'rfc822size (read (current-buffer))))
                      ((eq token 'BODY)
                       (if (eq (char-before) ?\[)
                           (list
@@ -1528,19 +1498,19 @@ Return nil if no complete line has arrived."
       (while (not (eq (char-after (point)) ?\)))
        (setq status
              (cons
-              (let ((token (elmo-read (current-buffer))))
+              (let ((token (read (current-buffer))))
                 (cond ((eq token 'MESSAGES)
-                       (list 'messages (elmo-read (current-buffer))))
+                       (list 'messages (read (current-buffer))))
                       ((eq token 'RECENT)
-                       (list 'recent (elmo-read (current-buffer))))
+                       (list 'recent (read (current-buffer))))
                       ((eq token 'UIDNEXT)
-                       (list 'uidnext (elmo-read (current-buffer))))
+                       (list 'uidnext (read (current-buffer))))
                       ((eq token 'UIDVALIDITY)
                        (and (looking-at " \\([0-9]+\\)")
                             (prog1 (list 'uidvalidity (match-string 1))
                               (goto-char (match-end 1)))))
                       ((eq token 'UNSEEN)
-                       (list 'unseen (elmo-read (current-buffer))))
+                       (list 'unseen (read (current-buffer))))
                       (t
                        (message
                         "Unknown status data %s in mailbox %s ignored"
@@ -1567,9 +1537,9 @@ Return nil if no complete line has arrived."
        (nconc
         (copy-sequence elmo-imap4-extra-namespace-alist)
         (elmo-imap4-parse-namespace-subr
-         (elmo-read (concat "(" (buffer-substring
-                                 (point) (point-max))
-                            ")"))))))
+         (read (concat "(" (buffer-substring
+                            (point) (point-max))
+                       ")"))))))
 
 (defun elmo-imap4-parse-namespace-subr (ns)
   (let (prefix delim namespace-alist default-delim)
@@ -1883,6 +1853,16 @@ Return nil if no complete line has arrived."
   ((folder elmo-imap4-folder))
   (elmo-imap4-list folder "flagged"))
 
+(luna-define-method elmo-folder-list-answereds-plugged
+  ((folder elmo-imap4-folder))
+  (elmo-imap4-list folder "answered"))
+
+(defun elmo-imap4-folder-list-any-plugged (folder)
+  (elmo-imap4-list folder "or answered or unseen flagged"))
+
+(defun elmo-imap4-folder-list-digest-plugged (folder)
+  (elmo-imap4-list folder "or unseen flagged"))
+
 (luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder))
   (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
                     (elmo-imap4-folder-mailbox-internal folder))))
@@ -1892,15 +1872,16 @@ Return nil if no complete line has arrived."
   (let* ((root (elmo-imap4-folder-mailbox-internal folder))
         (session (elmo-imap4-get-session folder))
         (prefix (elmo-folder-prefix-internal folder))
-        (delim (or
-                (cdr
+        (namespace-assoc
                  (elmo-string-matched-assoc
                   root
                   (with-current-buffer (elmo-network-session-buffer session)
                     elmo-imap4-server-namespace)))
+        (delim (or (cdr namespace-assoc)
                 elmo-imap4-default-hierarchy-delimiter))
         ;; Append delimiter when root with namespace.
-        (root (if (and (match-end 1)
+        (root (if (and namespace-assoc
+                       (match-end 1)
                        (string= (substring root (match-end 1))
                                 ""))
                   (concat root delim)
@@ -2096,7 +2077,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
 (defun elmo-imap4-search-internal-primitive (folder session filter from-msgs)
   (let ((search-key (elmo-filter-key filter))
        (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"
-                           "larger" "smaller"))
+                           "larger" "smaller" "mark"))
        (total 0)
        (length (length from-msgs))
        charset set-list end results)
@@ -2114,6 +2095,18 @@ If optional argument REMOVE is non-nil, remove FLAG."
                           numbers)))
        (mapcar '(lambda (x) (delete x numbers)) rest)
        numbers))
+     ((string= "flag" search-key)
+      (cond
+       ((string= "unread" (elmo-filter-value filter))
+       (elmo-folder-list-unreads folder))
+       ((string= "important" (elmo-filter-value filter))
+       (elmo-folder-list-importants folder))
+       ((string= "answered" (elmo-filter-value filter))
+       (elmo-folder-list-answereds folder))
+       ((string= "digest" (elmo-filter-value filter))
+       (elmo-imap4-folder-list-digest-plugged folder))
+       ((string= "any" (elmo-filter-value filter))
+       (elmo-imap4-folder-list-any-plugged folder))))
      ((or (string= "since" search-key)
          (string= "before" search-key))
       (setq search-key (concat "sent" search-key)
@@ -2241,7 +2234,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
     (luna-call-next-method)))
 
 (luna-define-method elmo-folder-msgdb-create-plugged
-  ((folder elmo-imap4-folder) numbers &rest args)
+  ((folder elmo-imap4-folder) numbers seen-list)
   (when numbers
     (let ((session (elmo-imap4-get-session folder))
          (headers
@@ -2266,7 +2259,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
        (setq elmo-imap4-current-msgdb nil
              elmo-imap4-seen-messages nil
              elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
-             elmo-imap4-fetch-callback-data (cons args
+             elmo-imap4-fetch-callback-data (cons seen-list
                                                   (elmo-folder-use-flag-p
                                                    folder)))
        (while set-list
@@ -2306,6 +2299,14 @@ If optional argument REMOVE is non-nil, remove FLAG."
   ((folder elmo-imap4-folder) numbers)
   (elmo-imap4-set-flag folder numbers "\\Seen"))
 
+(luna-define-method elmo-folder-unmark-answered-plugged
+  ((folder elmo-imap4-folder) numbers)
+  (elmo-imap4-set-flag folder numbers "\\Answered" 'remove))
+
+(luna-define-method elmo-folder-mark-as-answered-plugged
+  ((folder elmo-imap4-folder) numbers)
+  (elmo-imap4-set-flag folder numbers "\\Answered"))
+
 (luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder)
                                              number)
   elmo-imap4-use-cache)
@@ -2514,8 +2515,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
                     (elmo-net-folder-user-internal (, folder2)))))))
 
 (luna-define-method elmo-folder-append-messages :around
-  ((folder elmo-imap4-folder) src-folder numbers unread-marks
-   &optional same-number)
+  ((folder elmo-imap4-folder) src-folder numbers &optional same-number)
   (if (and (eq (elmo-folder-type-internal src-folder) 'imap4)
           (elmo-imap4-identical-system-p folder src-folder)
           (elmo-folder-plugged-p folder))
@@ -2566,7 +2566,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
     (unless elmo-inhibit-display-retrieval-progress
       (elmo-display-progress 'elmo-imap4-display-literal-progress
                             "Retrieving..." 100)  ; remove progress bar.
-      (message "Retrieving...done."))
+      (message "Retrieving...done"))
     (if (setq response (elmo-imap4-response-bodydetail-text
                        (elmo-imap4-response-value-all
                         response 'fetch)))
@@ -2606,7 +2606,10 @@ If optional argument REMOVE is non-nil, remove FLAG."
       (goto-char (point-min))
       (std11-field-body (symbol-name field)))))
 
-
+(luna-define-method elmo-folder-search-requires-msgdb-p ((folder
+                                                         elmo-imap4-folder)
+                                                        condition)
+  nil)
 
 (require 'product)
 (product-provide (provide 'elmo-imap4) (require 'elmo-version))