* elmo-util.el (elmo-collect-separators): New function.

[elisp/wanderlust.git] / elmo / elmo-imap4.el

diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el
index 07ea83c..6f87018 100644 (file)
--- a/elmo/elmo-imap4.el
+++ b/elmo/elmo-imap4.el
@@ -174,6 +174,11 @@ REGEXP should have a grouping for namespace prefix.")
                                  (personal "$Personal")
                                  (shouldreply "$ShouldReply")))
 
+(defconst elmo-imap4-folder-name-syntax
+  `(mailbox
+    (?: [user "^[A-Za-z]"] (?/ [auth ".+"]))
+    ,@elmo-net-folder-name-syntax))
+
 ;; For debugging.
 (defvar elmo-imap4-debug nil
   "Non-nil forces IMAP4 folder as debug mode.
@@ -214,12 +219,12 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
 
 (defsubst elmo-imap4-decode-folder-string (string)
   (if elmo-imap4-use-modified-utf7
-      (utf7-decode-string string 'imap)
+      (utf7-decode string 'imap)
     string))
 
 (defsubst elmo-imap4-encode-folder-string (string)
   (if elmo-imap4-use-modified-utf7
-      (utf7-encode-string string 'imap)
+      (utf7-encode string 'imap)
     string))
 
 ;;; Response
@@ -1836,9 +1841,7 @@ Return nil if no complete line has arrived."
        (elmo-imap4-forward)
        (nreverse body)))))
 
-(luna-define-method elmo-folder-initialize :around ((folder
-                                                    elmo-imap4-folder)
-                                                   name)
+(luna-define-method elmo-folder-initialize ((folder elmo-imap4-folder) name)
   (let ((default-user  elmo-imap4-default-user)
        (default-server elmo-imap4-default-server)
        (default-port   elmo-imap4-default-port)
@@ -1847,39 +1850,38 @@ Return nil if no complete line has arrived."
             (append elmo-imap4-stream-type-alist
                     elmo-network-stream-type-alist)
           elmo-network-stream-type-alist))
-       parse)
+       tokens)
     (when (string-match "\\(.*\\)@\\(.*\\)" default-server)
       ;; case: imap4-default-server is specified like
       ;; "hoge%imap.server@gateway".
       (setq default-user (elmo-match-string 1 default-server))
       (setq default-server (elmo-match-string 2 default-server)))
-    (setq name (luna-call-next-method))
+    (setq tokens (car (elmo-parse-separated-tokens
+                      name
+                      elmo-imap4-folder-name-syntax)))
     ;; mailbox
-    (setq parse (elmo-parse-token name ":"))
     (elmo-imap4-folder-set-mailbox-internal folder
                                            (elmo-imap4-encode-folder-string
-                                            (car parse)))
+                                            (cdr (assq 'mailbox tokens))))
     ;; user
-    (setq parse (elmo-parse-prefixed-element ?: (cdr parse) "/"))
     (elmo-net-folder-set-user-internal folder
-                                      (if (eq (length (car parse)) 0)
-                                          default-user
-                                        (car parse)))
+                                      (or (cdr (assq 'user tokens))
+                                          default-user))
     ;; auth
-    (setq parse (elmo-parse-prefixed-element ?/ (cdr parse)))
     (elmo-net-folder-set-auth-internal
      folder
-     (if (eq (length (car parse)) 0)
-        (or elmo-imap4-default-authenticate-type 'clear)
-       (intern (car parse))))
-    (unless (elmo-net-folder-server-internal folder)
-      (elmo-net-folder-set-server-internal folder default-server))
-    (unless (elmo-net-folder-port-internal folder)
-      (elmo-net-folder-set-port-internal folder default-port))
-    (unless (elmo-net-folder-stream-type-internal folder)
-      (elmo-net-folder-set-stream-type-internal
-       folder
-       (elmo-get-network-stream-type elmo-imap4-default-stream-type)))
+     (let ((auth (cdr (assq 'auth tokens))))
+       (or (and auth (intern auth))
+          elmo-imap4-default-authenticate-type
+          'clear)))
+    ;; network
+    (elmo-net-folder-set-parameters
+     folder
+     tokens
+     (list :server     default-server
+          :port        default-port
+          :stream-type
+          (elmo-get-network-stream-type elmo-imap4-default-stream-type)))
     folder))
 
 ;;; ELMO IMAP4 folder
@@ -1966,6 +1968,7 @@ Return nil if no complete line has arrived."
         (delim (or (cdr namespace-assoc)
                 elmo-imap4-default-hierarchy-delimiter))
         ;; Append delimiter when root with namespace.
+        (root-nodelim root)
         (root (if (and namespace-assoc
                        (match-end 1)
                        (string= (substring root (match-end 1))
@@ -1984,12 +1987,16 @@ Return nil if no complete line has arrived."
                    (elmo-imap4-response-get-selectable-mailbox-list
                     (elmo-imap4-send-command-wait
                      session
-                     (list "list \"\" " (elmo-imap4-mailbox root)))))))
+                     (list "list \"\" " (elmo-imap4-mailbox
+                                         root-nodelim)))))))
     (when (or (not (string= (elmo-net-folder-user-internal folder)
                            elmo-imap4-default-user))
              (not (eq (elmo-net-folder-auth-internal folder)
                       (or elmo-imap4-default-authenticate-type 'clear))))
-      (setq append-serv (concat ":" (elmo-net-folder-user-internal folder))))
+      (setq append-serv (concat ":"
+                               (elmo-quote-syntactical-element
+                                (elmo-net-folder-user-internal folder)
+                                'user elmo-imap4-folder-name-syntax))))
     (unless (eq (elmo-net-folder-auth-internal folder)
                (or elmo-imap4-default-authenticate-type 'clear))
       (setq append-serv
@@ -2039,7 +2046,9 @@ Return nil if no complete line has arrived."
                                      fld))
                                  (cdr result)))
                  folder (concat prefix
-                                (elmo-imap4-decode-folder-string folder)
+                                (elmo-quote-syntactical-element
+                                 (elmo-imap4-decode-folder-string folder)
+                                 'mailbox elmo-imap4-folder-name-syntax)
                                 (and append-serv
                                      (eval append-serv)))
                  ret (append ret (if has-child-p
@@ -2047,7 +2056,10 @@ Return nil if no complete line has arrived."
                                    (list folder)))))
          ret)
       (mapcar (lambda (fld)
-               (concat prefix (elmo-imap4-decode-folder-string fld)
+               (concat prefix
+                       (elmo-quote-syntactical-element
+                        (elmo-imap4-decode-folder-string fld)
+                        'mailbox elmo-imap4-folder-name-syntax)
                        (and append-serv
                             (eval append-serv))))
              result))))
@@ -2580,13 +2592,14 @@ If optional argument REMOVE is non-nil, remove FLAG."
 
 (defun elmo-imap4-flags-to-imap (flags)
   "Convert FLAGS to the IMAP flag string."
-  (let ((imap-flag (if (not (memq 'unread flags)) "\\Seen"))
-       (flags (delq 'read (delq 'cached (delq 'unread flags))))
-       spec)
+  (let ((imap-flag (if (not (memq 'unread flags)) "\\Seen")))
     (dolist (flag flags)
-      (setq imap-flag (concat imap-flag (if imap-flag " ")
-                             (or (car (cdr (assq flag elmo-imap4-flag-specs)))
-                                 (capitalize (symbol-name flag))))))
+      (unless (memq flag '(new read unread cached))
+       (setq imap-flag
+             (concat imap-flag
+                     (if imap-flag " ")
+                     (or (car (cdr (assq flag elmo-imap4-flag-specs)))
+                         (capitalize (symbol-name flag)))))))
     imap-flag))
 
 (luna-define-method elmo-folder-append-buffer