Fix typo (falgs => flags).
[elisp/wanderlust.git] / elmo / elmo-imap4.el
index f2dda4b..e1b7e39 100644 (file)
@@ -51,6 +51,9 @@
 ;;; Code:
 (eval-when-compile (require 'cl))
 
+(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 (For STATUS command).")
+
 (defvar elmo-imap4-overview-fetch-chop-length 200
   "*Number of overviews to fetch in one request.")
 
@@ -161,6 +164,11 @@ REGEXP should have a grouping for namespace prefix.")
 (defconst elmo-imap4-literal-threshold 1024
  "Limitation of characters that can be used in a quoted string.")
 
+(defconst elmo-imap4-flag-specs '((important "\\Flagged")
+                                 (read "\\Seen")
+                                 (unread "\\Seen" 'remove)
+                                 (answered "\\Answered")))
+
 ;; For debugging.
 (defvar elmo-imap4-debug nil
   "Non-nil forces IMAP4 folder as debug mode.
@@ -449,7 +457,7 @@ If response is not `OK' response, causes error with IMAP response text."
 
 (luna-define-method mime-imap-location-bodystructure
   ((location mime-elmo-imap-location))
-  (elmo-imap4-fetch-bodystructure
+  (elmo-message-fetch-bodystructure
    (mime-elmo-imap-location-folder-internal location)
    (mime-elmo-imap-location-number-internal location)
    (mime-elmo-imap-location-strategy-internal location)))
@@ -610,8 +618,9 @@ BUFFER must be a single-byte buffer."
               (car (nth 1 entry))))
         response)))
 
-(defun elmo-imap4-fetch-bodystructure (folder number strategy)
-  "Fetch BODYSTRUCTURE for the message in the FOLDER with NUMBER using STRATEGY."
+(luna-define-method elmo-message-fetch-bodystructure ((folder
+                                                      elmo-imap4-folder)
+                                                     number strategy)
   (if (elmo-fetch-strategy-use-cache strategy)
       (elmo-object-load
        (elmo-file-cache-expand-path
@@ -742,9 +751,12 @@ Returns response value if selecting folder succeed. "
          "\\seen" (elmo-imap4-session-flags-internal session))
         (elmo-string-member-ignore-case
          "\\flagged" (elmo-imap4-session-flags-internal session))))
-    (t (elmo-string-member-ignore-case
-       (concat "\\" (symbol-name flag))
-       (elmo-imap4-session-flags-internal session)))))
+    (answered
+     (elmo-string-member-ignore-case
+      (concat "\\" (symbol-name flag))
+      (elmo-imap4-session-flags-internal session)))
+    (t
+     (member "\\*" (elmo-imap4-session-flags-internal session)))))
 
 (defun elmo-imap4-folder-list-flagged (folder flag)
   "List flagged message numbers in the FOLDER.
@@ -754,9 +766,20 @@ FLAG is one of the `unread', `read', `important', `answered', `any'."
                    (read "seen")
                    (unread "unseen")
                    (important "flagged")
+                   (answered "answered")
+                   (new "new")
                    (any "or answered or unseen flagged")
                    (digest "or unseen flagged")
-                   (t (symbol-name flag)))))
+                   (t (concat "keyword " (capitalize (symbol-name flag)))))))
+    ;; Add search keywords
+    (when (or (eq flag 'digest)(eq flag 'any))
+      (let ((flags (delq 'important (elmo-get-global-flags t t))))
+       (while flags
+         (setq criteria (concat "or keyword "
+                                (symbol-name (car flags))
+                                " "
+                                criteria))
+         (setq flags (cdr flags)))))
     (if (elmo-imap4-session-flag-available-p session flag)
        (progn
          (elmo-imap4-session-select-mailbox
@@ -827,7 +850,8 @@ If CHOP-LENGTH is not specified, message set is not chopped."
          flag-list
          (if use-flag
              (append
-              (and (elmo-string-member-ignore-case "\\Recent" flags)
+              (and (memq 'new saved-flags)
+                   (not (elmo-string-member-ignore-case "\\Seen" flags))
                    '(new))
               (and (elmo-string-member-ignore-case "\\Flagged" flags)
                    '(important))
@@ -855,10 +879,8 @@ If CHOP-LENGTH is not specified, message set is not chopped."
      (with-temp-buffer
        (insert (or (elmo-imap4-response-bodydetail-text element)
                   ""))
-       ;; Delete CR.
-       (goto-char (point-min))
-       (while (search-forward "\r\n" nil t)
-        (replace-match "\n"))
+       ;; Replace all CRLF with LF.
+       (elmo-delete-cr-buffer)
        (elmo-msgdb-create-message-entity-from-buffer
        handler
        (elmo-imap4-response-value element 'uid)
@@ -1896,20 +1918,13 @@ Return nil if no complete line has arrived."
                         (format "uid %d:*" (cdr (car killed)))
                       "all"))))
 
-(luna-define-method elmo-folder-list-unreads-plugged
-  ((folder elmo-imap4-folder))
-  (elmo-imap4-folder-list-flagged folder 'unread))
-
-(luna-define-method elmo-folder-list-importants-plugged
-  ((folder elmo-imap4-folder))
-  (elmo-imap4-folder-list-flagged folder 'important))
-
-(luna-define-method elmo-folder-list-answereds-plugged
-  ((folder elmo-imap4-folder))
-  (elmo-imap4-folder-list-flagged folder 'answered))
+(luna-define-method elmo-folder-list-flagged-plugged
+  ((folder elmo-imap4-folder) flag)
+  (elmo-imap4-folder-list-flagged folder flag))
 
 (luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder))
-  t)
+  (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
+                    (elmo-imap4-folder-mailbox-internal folder))))
 
 (luna-define-method elmo-folder-list-subfolders ((folder elmo-imap4-folder)
                                                 &optional one-level)
@@ -1935,6 +1950,14 @@ Return nil if no complete line has arrived."
                  (elmo-imap4-send-command-wait
                   session
                   (list "list " (elmo-imap4-mailbox root) " *"))))
+    ;; The response of Courier-imap doesn't contain a specified folder itself.
+    (unless (member root result)
+      (setq result
+           (append result
+                   (elmo-imap4-response-get-selectable-mailbox-list
+                    (elmo-imap4-send-command-wait
+                     session
+                     (list "list \"\" " (elmo-imap4-mailbox root)))))))
     (when (or (not (string= (elmo-net-folder-user-internal folder)
                            elmo-imap4-default-user))
              (not (eq (elmo-net-folder-auth-internal folder)
@@ -2096,6 +2119,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
     (when (or (elmo-string-member-ignore-case
               flag
               (elmo-imap4-session-flags-internal session))
+             (member "\\*" (elmo-imap4-session-flags-internal session))
              (string= flag "\\Deleted")) ; XXX Humm..
       (setq set-list (elmo-imap4-make-number-set-list
                      numbers
@@ -2341,29 +2365,19 @@ If optional argument REMOVE is non-nil, remove FLAG."
                                  'message-id)))
        elmo-imap4-current-msgdb))))
 
-(luna-define-method elmo-folder-unflag-important-plugged
-  ((folder elmo-imap4-folder) numbers)
-  (elmo-imap4-set-flag folder numbers "\\Flagged" 'remove))
-
-(luna-define-method elmo-folder-flag-as-important-plugged
-  ((folder elmo-imap4-folder) numbers)
-  (elmo-imap4-set-flag folder numbers "\\Flagged"))
-
-(luna-define-method elmo-folder-unflag-read-plugged
-  ((folder elmo-imap4-folder) numbers)
-  (elmo-imap4-set-flag folder numbers "\\Seen" 'remove))
+(luna-define-method elmo-folder-set-flag-plugged ((folder elmo-imap4-folder)
+                                                 numbers flag)
+  (let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
+    (elmo-imap4-set-flag folder numbers (or (car spec)
+                                           (capitalize (symbol-name flag)))
+                        (nth 1 spec))))
 
-(luna-define-method elmo-folder-flag-as-read-plugged
-  ((folder elmo-imap4-folder) numbers)
-  (elmo-imap4-set-flag folder numbers "\\Seen"))
-
-(luna-define-method elmo-folder-unflag-answered-plugged
-  ((folder elmo-imap4-folder) numbers)
-  (elmo-imap4-set-flag folder numbers "\\Answered" 'remove))
-
-(luna-define-method elmo-folder-flag-as-answered-plugged
-  ((folder elmo-imap4-folder) numbers)
-  (elmo-imap4-set-flag folder numbers "\\Answered"))
+(luna-define-method elmo-folder-unset-flag-plugged ((folder elmo-imap4-folder)
+                                                   numbers flag)
+  (let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
+    (elmo-imap4-set-flag folder numbers (or (car spec)
+                                           (capitalize (symbol-name flag)))
+                        (not (nth 1 spec)))))
 
 (luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder)
                                              number)
@@ -2411,7 +2425,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
     (setq messages (elmo-imap4-response-value response 'messages))
     (setq uidnext (elmo-imap4-response-value response 'uidnext))
     (setq killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
-    ;; 
+    ;;
     (when killed
       (when (and (consp (car killed))
                 (eq (car (car killed)) 1))
@@ -2576,10 +2590,14 @@ If optional argument REMOVE is non-nil, remove FLAG."
                                  (and (memq 'answered flags)
                                       '("\\Answered")))
                                 " ")
+                               ;; XX KEYWORD flags
                                ") ")
                      " () ")
                    (elmo-imap4-buffer-literal send-buffer))))
          (kill-buffer send-buffer))
+       (when result
+         (elmo-folder-preserve-flags
+          folder (elmo-msgdb-get-message-id-from-buffer) flags))
        result)
     ;; Unplugged
     (if elmo-enable-disconnected-operation
@@ -2677,6 +2695,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
        (with-current-buffer outbuf
          (erase-buffer)
          (insert response)
+         (elmo-delete-cr-buffer)
          t))))
 
 (luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder)
@@ -2716,6 +2735,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
   nil)
 
 (autoload 'elmo-global-flags-set "elmo-flag")
+(autoload 'elmo-get-global-flags "elmo-flag")
 
 (require 'product)
 (product-provide (provide 'elmo-imap4) (require 'elmo-version))