* elmo.el (elmo-folder-list-unreads): Don't use msgdb API.
[elisp/wanderlust.git] / elmo / elmo-imap4.el
index 15df756..2827172 100644 (file)
@@ -53,7 +53,7 @@
 
 (defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd
   "Regexp to match IMAP4 mailbox names whose message flags on server should be ignored.
-(Except `\\Deleted' flag).")
+\(Except `\\Deleted' flag\).")
 
 (defvar elmo-imap4-overview-fetch-chop-length 200
   "*Number of overviews to fetch in one request.")
@@ -82,7 +82,7 @@
 
 (defvar elmo-imap4-use-select-to-update-status nil
   "*Some imapd have to send select command to update status.
-(ex. UW imapd 4.5-BETA?).  For these imapd, you must set this variable t.")
+\(ex. UW imapd 4.5-BETA?\).  For these imapd, you must set this variable t.")
 
 (defvar elmo-imap4-use-modified-utf7 nil
   "*Use mofidied UTF-7 (rfc2060) encoding for IMAP4 folder name.")
@@ -92,7 +92,7 @@
 
 (defvar elmo-imap4-extra-namespace-alist
   '(("^\\({.*/nntp}\\).*$" . ".")) ; Default is for UW's remote nntp mailbox...
-  "Extra namespace alist. 
+  "Extra namespace alist.
 A list of cons cell like: (REGEXP . DELIMITER).
 REGEXP should have a grouping for namespace prefix.")
 ;;
@@ -245,7 +245,7 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
     matched))
 
 (defmacro elmo-imap4-response-error-text (response)
-  "Returns text of NO, BAD, BYE, response."
+  "Returns text of NO, BAD, BYE response."
   (` (nth 1 (or (elmo-imap4-response-value (, response) 'no)
                (elmo-imap4-response-value (, response) 'bad)
                (elmo-imap4-response-value (, response) 'bye)))))
@@ -291,8 +291,11 @@ Returns a TAG string which is assigned to the COMMAND."
       (when (elmo-imap4-response-bye-p elmo-imap4-current-response)
        (elmo-imap4-process-bye session))
       (setq elmo-imap4-current-response nil)
-      (if elmo-imap4-parsing
-         (error "IMAP process is running. Please wait (or plug again)"))
+      (when elmo-imap4-parsing
+       (message "Waiting for IMAP response...")
+       (accept-process-output (elmo-network-session-process-internal
+                               session))
+       (message "Waiting for IMAP response...done"))
       (setq elmo-imap4-parsing t)
       (elmo-imap4-debug "<-(%s)- %s" tag command)
       (while (setq token (car command-args))
@@ -354,7 +357,7 @@ TAG is the tag of the command"
                    (elmo-imap4-response-bye-p elmo-imap4-current-response)
                    (when (elmo-imap4-response-garbage-p
                           elmo-imap4-current-response)
-                     (message "Garbage response: %s" 
+                     (message "Garbage response: %s"
                               (elmo-imap4-response-value
                                elmo-imap4-current-response
                                'garbage))
@@ -474,7 +477,7 @@ If response is not `OK' response, causes error with IMAP response text."
   (with-current-buffer (elmo-network-session-buffer session)
     (setq elmo-imap4-fetch-callback nil)
     (setq elmo-imap4-fetch-callback-data nil))
-  (elmo-imap4-send-command-wait session "check"))
+  (elmo-imap4-send-command session "check"))
 
 (defun elmo-imap4-atom-p (string)
   "Return t if STRING is an atom defined in rfc2060."
@@ -607,7 +610,7 @@ BUFFER must be a single-byte buffer."
        (mapcar
         (lambda (entry)
           (if (and (eq 'list (car entry))
-                   (not (member "\\NoSelect" (nth 1 (nth 1 entry)))))
+                   (not (elmo-string-member-ignore-case "\\Noselect" (nth 1 (nth 1 entry)))))
               (car (nth 1 entry))))
         response)))
 
@@ -696,9 +699,9 @@ Returns response value if selecting folder succeed. "
                   (elmo-imap4-response-bye-p response))
              (elmo-imap4-process-bye session)
            (unless no-error
-             (error (or
-                     (elmo-imap4-response-error-text response)
-                     (format "Select %s failed" mailbox)))))))
+             (error "%s"
+                    (or (elmo-imap4-response-error-text response)
+                        (format "Select %s failed" mailbox)))))))
       (and result response))))
 
 (defun elmo-imap4-check-validity (spec validity-file)
@@ -770,18 +773,17 @@ If CHOP-LENGTH is not specified, message set is not chopped."
 
 ;;
 ;; app-data:
-;; cons of seen-list and result of use-flag-p.
+;; cons of flag-table 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) app-data))
         mark)
-    (if (member "\\Flagged" flags)
+    (if (elmo-string-member-ignore-case "\\Flagged" flags)
        (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)
+       (unless (elmo-string-member-ignore-case "\\Seen" flags)
          (setq elmo-imap4-seen-messages
                (cons
                 (elmo-msgdb-overview-entity-get-number entity)
@@ -789,18 +791,18 @@ If CHOP-LENGTH is not specified, message set is not chopped."
       (setq mark (or (if (elmo-file-cache-status
                          (elmo-file-cache-get (car entity)))
                         ;; cached.
-                        (if (member "\\Answered" flags)
+                        (if (elmo-string-member-ignore-case
+                             "\\Answered" flags)
                             elmo-msgdb-answered-cached-mark
-                          (if (or seen
-                                  (and use-flag
-                                       (member "\\Seen" flags)))
+                          (if (and use-flag
+                                   (member "\\Seen" flags))
                               nil
                             elmo-msgdb-unread-cached-mark))
-                      (if (member "\\Answered" flags)
+                      (if (elmo-string-member-ignore-case "\\Answered" flags)
                           elmo-msgdb-answered-uncached-mark
-                        (if (or seen
-                                (and use-flag
-                                     (member "\\Seen" flags)))
+                        (if (and use-flag
+                                 (elmo-string-member-ignore-case
+                                  "\\Seen" flags))
                             (if elmo-imap4-use-cache
                                 elmo-msgdb-read-uncached-mark)
                           elmo-msgdb-new-mark))))))
@@ -1807,15 +1809,16 @@ Return nil if no complete line has arrived."
         (setq mailbox "inbox"))
      (if (eq (string-to-char mailbox) ?/)
         (setq mailbox (substring mailbox 1 (length mailbox))))
-     (expand-file-name
-      mailbox
+     ;; don't use expand-file-name (e.g. %~/something)
+     (concat
       (expand-file-name
        (or (elmo-net-folder-user-internal folder) "nobody")
        (expand-file-name (or (elmo-net-folder-server-internal folder)
                             "nowhere")
                         (expand-file-name
                          "imap"
-                         elmo-msgdb-directory)))))))
+                         elmo-msgdb-directory)))
+      "/" mailbox))))
 
 (luna-define-method elmo-folder-status-plugged ((folder
                                                 elmo-imap4-folder))
@@ -1986,18 +1989,25 @@ Return nil if no complete line has arrived."
 (luna-define-method elmo-folder-writable-p ((folder elmo-imap4-folder))
   t)
 
-(luna-define-method elmo-folder-delete :before ((folder elmo-imap4-folder))
-  (let ((session (elmo-imap4-get-session folder))
-       msgs)
-    (when (elmo-imap4-folder-mailbox-internal folder)
-      (when (setq msgs (elmo-folder-list-messages folder))
-       (elmo-folder-delete-messages folder msgs))
-      (elmo-imap4-send-command-wait session "close")
-      (elmo-imap4-send-command-wait
-       session
-       (list "delete "
-            (elmo-imap4-mailbox
-             (elmo-imap4-folder-mailbox-internal folder)))))))
+(luna-define-method elmo-folder-delete ((folder elmo-imap4-folder))
+  (let ((msgs (and (elmo-folder-exists-p folder)
+                  (elmo-folder-list-messages folder))))
+    (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
+                              (if (> (length msgs) 0)
+                                  (format "%d msg(s) exists. " (length msgs))
+                                "")
+                              (elmo-folder-name-internal folder)))
+      (let ((session (elmo-imap4-get-session folder)))
+       (when (elmo-imap4-folder-mailbox-internal folder)
+         (when msgs (elmo-folder-delete-messages folder msgs))
+         (elmo-imap4-send-command-wait session "close")
+         (elmo-imap4-send-command-wait
+          session
+          (list "delete "
+                (elmo-imap4-mailbox
+                 (elmo-imap4-folder-mailbox-internal folder))))))
+      (elmo-msgdb-delete-path folder)
+      t)))
 
 (luna-define-method elmo-folder-rename-internal ((folder elmo-imap4-folder)
                                                 new-folder)
@@ -2077,8 +2087,12 @@ If optional argument REMOVE is non-nil, remove FLAG."
 (luna-define-method elmo-folder-delete-messages-plugged
   ((folder elmo-imap4-folder) numbers)
   (let ((session (elmo-imap4-get-session folder)))
-    (elmo-imap4-set-flag folder numbers "\\Deleted")
-    (elmo-imap4-send-command-wait session "expunge")))
+    (elmo-imap4-session-select-mailbox
+     session
+     (elmo-imap4-folder-mailbox-internal folder))
+    (unless (elmo-imap4-set-flag folder numbers "\\Deleted")
+      (error "Failed to set deleted flag"))
+    (elmo-imap4-send-command session "expunge")))
 
 (defmacro elmo-imap4-detect-search-charset (string)
   (` (with-temp-buffer
@@ -2245,7 +2259,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 seen-list)
+  ((folder elmo-imap4-folder) numbers flag-table)
   (when numbers
     (let ((session (elmo-imap4-get-session folder))
          (headers
@@ -2255,6 +2269,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
            elmo-msgdb-extra-fields))
          (total 0)
          (length (length numbers))
+         print-length print-depth
          rfc2060 set-list)
       (setq rfc2060 (memq 'imap4rev1
                          (elmo-imap4-session-capability-internal
@@ -2270,7 +2285,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 seen-list
+             elmo-imap4-fetch-callback-data (cons flag-table
                                                   (elmo-folder-use-flag-p
                                                    folder)))
        (while set-list
@@ -2410,9 +2425,9 @@ If optional argument REMOVE is non-nil, remove FLAG."
                (elmo-imap4-session-set-current-mailbox-internal session nil)
                (if (elmo-imap4-response-bye-p response)
                    (elmo-imap4-process-bye session)
-                 (error (or
-                         (elmo-imap4-response-error-text response)
-                         (format "Select %s failed" mailbox)))))
+                 (error "%s"
+                        (or (elmo-imap4-response-error-text response)
+                            (format "Select %s failed" mailbox)))))
              (message "Selecting %s...done"
                       (elmo-folder-name-internal folder))
              (elmo-folder-set-msgdb-internal
@@ -2490,7 +2505,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
          (elmo-imap4-folder-mailbox-internal folder)))))
 
 (luna-define-method elmo-folder-append-buffer
-  ((folder elmo-imap4-folder) unread &optional number)
+  ((folder elmo-imap4-folder) &optional flag number)
   (if (elmo-folder-plugged-p folder)
       (let ((session (elmo-imap4-get-session folder))
            send-buffer result)
@@ -2506,13 +2521,16 @@ If optional argument REMOVE is non-nil, remove FLAG."
                    "append "
                    (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
                                         folder))
-                   (if unread " () " " (\\Seen) ")
+                   (cond 
+                    ((eq flag 'read) " (\\Seen) ")
+                    ((eq flag 'answered) " (\\Answered)")
+                    (t " () "))
                    (elmo-imap4-buffer-literal send-buffer))))
          (kill-buffer send-buffer))
        result)
     ;; Unplugged
     (if elmo-enable-disconnected-operation
-       (elmo-folder-append-buffer-dop folder unread number)
+       (elmo-folder-append-buffer-dop folder flag number)
       (error "Unplugged"))))
 
 (eval-when-compile