projects / elisp / wanderlust.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Fix "Operating...done" to follow the Emacs Lisp Coding Conventions.
[elisp/wanderlust.git] / elmo / elmo-imap4.el
diff --git a/elmo/elmo-imap4.el b/elmo/elmo-imap4.el
index d7c129e..438cc37 100644 (file)
--- a/elmo/elmo-imap4.el
+++ b/elmo/elmo-imap4.el
@@ -192,13 +192,16 @@ Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
   (luna-define-internal-accessors 'mime-elmo-imap-location))
 
 ;;; Debug
-(defsubst elmo-imap4-debug (message &rest args)
-  (if elmo-imap4-debug
-      (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
-       (goto-char (point-max))
-       (if elmo-imap4-debug-inhibit-logging
-           (insert "NO LOGGING\n")
-         (insert (apply 'format message args) "\n")))))
+(defmacro elmo-imap4-debug (message &rest args)
+  (` (if elmo-imap4-debug
+        (elmo-imap4-debug-1 (, message) (,@ args)))))
+
+(defun elmo-imap4-debug-1 (message &rest args)
+  (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
+    (goto-char (point-max))
+    (if elmo-imap4-debug-inhibit-logging
+       (insert "NO LOGGING\n")
+      (insert (apply 'format message args) "\n"))))
 
 (defsubst elmo-imap4-decode-folder-string (string)
   (if elmo-imap4-use-modified-utf7
@@ -713,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.
@@ -849,7 +819,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)
@@ -925,7 +895,12 @@ If CHOP-LENGTH is not specified, message set is not chopped."
            (signal 'elmo-open-error
                    '(elmo-imap4-starttls-error)))
        (elmo-imap4-send-command-wait session "starttls")
-       (starttls-negotiate process)))))
+       (starttls-negotiate process)
+       (elmo-imap4-session-set-capability-internal
+        session
+        (elmo-imap4-response-value
+         (elmo-imap4-send-command-wait session "capability")
+         'capability))))))
 
 (luna-define-method elmo-network-authenticate-session ((session
                                                        elmo-imap4-session))
@@ -1308,11 +1283,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))
@@ -1324,19 +1299,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))
@@ -1345,7 +1320,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)
@@ -1404,9 +1379,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)
@@ -1470,12 +1445,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)))
@@ -1490,7 +1465,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
@@ -1520,24 +1495,25 @@ 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"
                         token mailbox))))
-              status))))
+              status))
+       (skip-chars-forward " ")))
     (and elmo-imap4-status-callback
         (funcall elmo-imap4-status-callback
                  status
@@ -1558,9 +1534,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)
@@ -1784,9 +1760,7 @@ Return nil if no complete line has arrived."
     (setq parse (elmo-parse-token name ":"))
     (elmo-imap4-folder-set-mailbox-internal folder
                                            (elmo-imap4-encode-folder-string
-                                            (if (eq (length (car parse)) 0)
-                                                elmo-imap4-default-mailbox
-                                              (car parse))))
+                                            (car parse)))
     ;; user
     (setq parse (elmo-parse-prefixed-element ?: (cdr parse) "/"))
     (elmo-net-folder-set-user-internal folder
@@ -1903,8 +1877,10 @@ Return nil if no complete line has arrived."
                  (elmo-imap4-send-command-wait
                   session
                   (list "list " (elmo-imap4-mailbox root) " *"))))
-    (unless (string= (elmo-net-folder-user-internal folder)
-                    elmo-imap4-default-user)
+    (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))))
     (unless (eq (elmo-net-folder-auth-internal folder)
                (or elmo-imap4-default-authenticate-type 'clear))
@@ -1979,6 +1955,9 @@ Return nil if no complete line has arrived."
        (elmo-imap4-folder-mailbox-internal folder)
        'force 'notify-bye))))
 
+(luna-define-method elmo-folder-creatable-p ((folder elmo-imap4-folder))
+  t)
+
 (luna-define-method elmo-folder-writable-p ((folder elmo-imap4-folder))
   t)
 
@@ -2083,7 +2062,8 @@ 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"))
+       (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"
+                           "larger" "smaller"))
        (total 0)
        (length (length from-msgs))
        charset set-list end results)
@@ -2357,7 +2337,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
 (luna-define-method elmo-folder-open :around ((folder elmo-imap4-folder)
                                              &optional load-msgdb)
   (if (elmo-folder-plugged-p folder)
-      (let (session mailbox msgdb response tag)
+      (let (session mailbox msgdb result response tag)
        (condition-case err
            (progn
              (setq session (elmo-imap4-get-session folder)
@@ -2366,30 +2346,46 @@ If optional argument REMOVE is non-nil, remove FLAG."
                                                 (list "select "
                                                       (elmo-imap4-mailbox
                                                        mailbox))))
+             (message "Selecting %s..."
+                      (elmo-folder-name-internal folder))
              (if load-msgdb
-                 (setq msgdb (elmo-msgdb-load folder)))
+                 (setq msgdb (elmo-msgdb-load folder 'silent)))
              (elmo-folder-set-killed-list-internal
               folder
               (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
-             (setq response (elmo-imap4-read-response session tag)))
+             (if (setq result (elmo-imap4-response-ok-p
+                               (setq response
+                                     (elmo-imap4-read-response session tag))))
+                 (progn
+                   (elmo-imap4-session-set-current-mailbox-internal
+                    session mailbox)
+                   (elmo-imap4-session-set-read-only-internal
+                    session
+                    (nth 1 (assq 'read-only (assq 'ok response)))))
+               (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)))))
+             (message "Selecting %s...done"
+                      (elmo-folder-name-internal folder))
+             (elmo-folder-set-msgdb-internal
+              folder msgdb))
          (quit
-          (if response
+          (if (elmo-imap4-response-ok-p response)
               (elmo-imap4-session-set-current-mailbox-internal
                session mailbox)
             (and session
                  (elmo-imap4-session-set-current-mailbox-internal
                   session nil))))
          (error
-          (if response
+          (if (elmo-imap4-response-ok-p response)
               (elmo-imap4-session-set-current-mailbox-internal
                session mailbox)
             (and session
                  (elmo-imap4-session-set-current-mailbox-internal
-                  session nil)))))
-       (if load-msgdb
-           (elmo-folder-set-msgdb-internal
-            folder
-            (or msgdb (elmo-msgdb-load folder)))))
+                  session nil))))))
     (luna-call-next-method)))
 
 ;; elmo-folder-open-internal: do nothing.
@@ -2441,7 +2437,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
                                      (elmo-file-cache-path
                                       cache-file)))))))
 
-(luna-define-method elmo-folder-create ((folder elmo-imap4-folder))
+(luna-define-method elmo-folder-create-plugged ((folder elmo-imap4-folder))
   (elmo-imap4-send-command-wait
    (elmo-imap4-get-session folder)
    (list "create "
@@ -2465,7 +2461,7 @@ If optional argument REMOVE is non-nil, remove FLAG."
                    "append "
                    (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
                                         folder))
-                   (if unread " " " (\\Seen) ")
+                   (if unread " () " " (\\Seen) ")
                    (elmo-imap4-buffer-literal send-buffer))))
          (kill-buffer send-buffer))
        result)
@@ -2537,7 +2533,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)))