-;;; elmo-imap4.el -- IMAP4 Interface for ELMO.
+;;; elmo-imap4.el --- IMAP4 Interface for ELMO.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
(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 in imap4.")
+ "*Number of overviews to fetch in one request.")
+
+;; c.f. rfc2683 3.2.1.5 Long Command Lines
+;;
+;; "A client should limit the length of the command lines it generates
+;; to approximately 1000 octets (including all quoted strings but not
+;; including literals). If the client is unable to group things into
+;; ranges so that the command line is within that length, it should
+;; split the request into multiple commands. The client should use
+;; literals instead of long quoted strings, in order to keep the command
+;; length down.
+;; For its part, a server should allow for a command line of at least
+;; 8000 octets. This provides plenty of leeway for accepting reasonable
+;; length commands from clients. The server should send a BAD response
+;; to a command that does not end within the server's maximum accepted
+;; command length. "
+
+;; To limit command line length, chop number set.
+(defvar elmo-imap4-number-set-chop-length 1000
+ "*Number of messages to specify as a number-set argument for one request.")
(defvar elmo-imap4-force-login nil
"*Non-nil forces to try 'login' if there is no 'auth' capability in imapd.")
(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.")
"Use cache in imap4 folder.")
(defvar elmo-imap4-extra-namespace-alist
- '(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox...
- "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER).")
+ '(("^\\({.*/nntp}\\).*$" . ".")) ; Default is for UW's remote nntp mailbox...
+ "Extra namespace alist.
+A list of cons cell like: (REGEXP . DELIMITER).
+REGEXP should have a grouping for namespace prefix.")
;;
;;; internal variables
;;
;;; XXX Temporal implementation
(defvar elmo-imap4-current-msgdb nil)
+(defvar elmo-imap4-seen-messages nil)
(defvar elmo-imap4-local-variables
'(elmo-imap4-status
elmo-imap4-fetch-callback-data
elmo-imap4-status-callback
elmo-imap4-status-callback-data
- elmo-imap4-current-msgdb))
+ elmo-imap4-current-msgdb
+ elmo-imap4-seen-messages))
;;;;
(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
"Returns non-nil if RESPONSE is an 'BYE' response."
(` (assq 'bye (, response))))
+(defmacro elmo-imap4-response-garbage-p (response)
+ "Returns non-nil if RESPONSE is an 'garbage' response."
+ (` (assq 'garbage (, response))))
+
(defmacro elmo-imap4-response-value (response symbol)
"Get value of the SYMBOL from RESPONSE."
(` (nth 1 (assq (, symbol) (, response)))))
; "Send COMMAND to the SESSION and wait for response.
; Returns RESPONSE (parsed lisp object) of IMAP session."
; (elmo-imap4-read-response session
-; (elmo-imap4-send-command
-; session
-; command)))
+; (elmo-imap4-send-command
+; session
+; command)))
(defun elmo-imap4-send-command-wait (session command)
"Send COMMAND to the SESSION.
(defun elmo-imap4-send-command (session command)
"Send COMMAND to the SESSION.
-Returns a TAG string which is assigned to the COMAND."
+Returns a TAG string which is assigned to the COMMAND."
(let* ((command-args (if (listp command)
command
(list command)))
(setq cmdstr (concat tag " "))
;; (erase-buffer) No need.
(goto-char (point-min))
- (if (elmo-imap4-response-bye-p elmo-imap4-current-response)
- (signal 'elmo-imap4-bye-error
- (list (elmo-imap4-response-error-text
- elmo-imap4-current-response))))
+ (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.)"))
+ (error "IMAP process is running. Please wait (or plug again)"))
(setq elmo-imap4-parsing t)
(elmo-imap4-debug "<-(%s)- %s" tag command)
(while (setq token (car command-args))
(with-current-buffer (process-buffer
(elmo-network-session-process-internal session))
(while (not (or (string= tag elmo-imap4-reached-tag)
- (elmo-imap4-response-bye-p elmo-imap4-current-response)))
+ (elmo-imap4-response-bye-p elmo-imap4-current-response)
+ (when (elmo-imap4-response-garbage-p
+ elmo-imap4-current-response)
+ (message "Garbage response: %s"
+ (elmo-imap4-response-value
+ elmo-imap4-current-response
+ 'garbage))
+ t)))
(when (memq (process-status
(elmo-network-session-process-internal session))
'(open run))
(elmo-network-session-process-internal session))
'continue-req))
+(defun elmo-imap4-process-bye (session)
+ (with-current-buffer (elmo-network-session-buffer session)
+ (let ((r elmo-imap4-current-response))
+ (setq elmo-imap4-current-response nil)
+ (elmo-network-close-session session)
+ (signal 'elmo-imap4-bye-error
+ (list (concat (elmo-imap4-response-error-text r))
+ "Try Again")))))
+
(defun elmo-imap4-accept-continue-req (session)
"Returns non-nil if `+' (continue-req) response is arrived in SESSION.
If response is not `+' response, cause an error."
(if (elmo-imap4-response-ok-p response)
response
(if (elmo-imap4-response-bye-p response)
- (signal 'elmo-imap4-bye-error
- (list (elmo-imap4-response-error-text response)))
+ (elmo-imap4-process-bye session)
(error "IMAP error: %s"
(or (elmo-imap4-response-error-text response)
"No `OK' response from server."))))))
-
-
;;; MIME-ELMO-IMAP Location
(luna-define-method mime-imap-location-section-body ((location
mime-elmo-imap-location)
(elmo-imap4-folder-mailbox-internal folder)))))
(defun elmo-imap4-get-session (folder &optional if-exists)
- (elmo-network-get-session 'elmo-imap4-session "IMAP" folder if-exists))
+ (elmo-network-get-session 'elmo-imap4-session
+ (concat
+ (if (elmo-folder-biff-internal folder)
+ "BIFF-")
+ "IMAP")
+ folder if-exists))
(defun elmo-imap4-session-select-mailbox (session mailbox
&optional force no-error)
is same as MAILBOX.
If second optional argument NO-ERROR is non-nil, don't cause an error when
selecting folder was failed.
+If NO-ERROR is 'notify-bye, only BYE response is reported as error.
Returns response value if selecting folder succeed. "
(when (or force
(not (string=
session
(nth 1 (assq 'read-only (assq 'ok response)))))
(elmo-imap4-session-set-current-mailbox-internal session nil)
- (unless no-error
- (error (or
- (elmo-imap4-response-error-text response)
- (format "Select %s failed" mailbox))))))
+ (if (and (eq no-error 'notify-bye)
+ (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)))))))
(and result response))))
(defun elmo-imap4-check-validity (spec validity-file)
mark)
(if (member "\\Flagged" flags)
(elmo-msgdb-global-mark-set (car entity) (nth 3 app-data)))
- (setq mark (or (elmo-msgdb-global-mark-get (car entity))
- (if (elmo-file-cache-status
- (elmo-file-cache-get (car entity)))
+ (if (setq mark (elmo-msgdb-global-mark-get (car entity)))
+ (unless (member "\\Seen" flags)
+ (setq elmo-imap4-seen-messages
+ (cons
+ (elmo-msgdb-overview-entity-get-number entity)
+ elmo-imap4-seen-messages)))
+ (setq mark (or (if (elmo-file-cache-status
+ (elmo-file-cache-get (car entity)))
+ (if (or seen
+ (and use-flag
+ (member "\\Seen" flags)))
+ nil
+ (nth 1 app-data))
(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
+ (nth 2 app-data))
+ (nth 0 app-data))))))
(setq elmo-imap4-current-msgdb
(elmo-msgdb-append
elmo-imap4-current-msgdb
(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))
(defun elmo-imap4-server-diff-async-callback-1 (status data)
(funcall elmo-imap4-server-diff-async-callback
- (cons (elmo-imap4-response-value status 'unseen)
+ (list (elmo-imap4-response-value status 'recent)
+ (elmo-imap4-response-value status 'unseen)
(elmo-imap4-response-value status 'messages))
data))
"status "
(elmo-imap4-mailbox
(elmo-imap4-folder-mailbox-internal folder))
- " (unseen messages)"))))
+ " (recent unseen messages)"))))
(luna-define-method elmo-server-diff-async ((folder elmo-imap4-folder))
(let ((session (elmo-imap4-get-session folder)))
"status "
(elmo-imap4-mailbox
(elmo-imap4-folder-mailbox-internal folder))
- " (unseen messages)"))))
+ " (recent unseen messages)"))))
;;; IMAP parser.
(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
(if (eq (length prefix) 0)
(progn (setq default-delim delim) nil)
(cons
- (concat "^"
+ (concat "^\\("
(if (string= (downcase prefix) "inbox")
"[Ii][Nn][Bb][Oo][Xx]"
(regexp-quote prefix))
- ".*$")
+ "\\).*$")
delim)))
(elmo-imap4-nth i ns))))))
(if default-delim
(luna-define-method elmo-folder-initialize :around ((folder
elmo-imap4-folder)
name)
- (let ((default-user elmo-imap4-default-user)
- (default-server elmo-imap4-default-server)
- (default-port elmo-imap4-default-port)
+ (let ((default-user elmo-imap4-default-user)
+ (default-server elmo-imap4-default-server)
+ (default-port elmo-imap4-default-port)
(elmo-network-stream-type-alist
(if elmo-imap4-stream-type-alist
(append elmo-imap4-stream-type-alist
elmo-network-stream-type-alist)
- elmo-network-stream-type-alist)))
+ elmo-network-stream-type-alist))
+ parse)
(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))
- (when (string-match
- "^\\([^:@!]*\\)\\(:[^/!]+\\)?\\(/[^/:@!]+\\)?"
- name)
- (progn
- (if (match-beginning 1)
- (progn
- (elmo-imap4-folder-set-mailbox-internal
- folder
- (elmo-match-string 1 name))
- (if (eq (length (elmo-imap4-folder-mailbox-internal folder))
- 0)
- ;; No information is specified other than folder type.
- (elmo-imap4-folder-set-mailbox-internal
- folder
- elmo-imap4-default-mailbox)))
- (elmo-imap4-folder-set-mailbox-internal
- folder
- elmo-imap4-default-mailbox))
- ;; Setup slots for elmo-net-folder.
- (elmo-net-folder-set-user-internal
- folder
- (if (match-beginning 2)
- (elmo-match-substring 2 name 1)
- default-user))
- (elmo-net-folder-set-auth-internal
- folder
- (if (match-beginning 3)
- (intern (elmo-match-substring 3 name 1))
- (or elmo-imap4-default-authenticate-type 'clear)))
- (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)))
- folder))))
+ ;; mailbox
+ (setq parse (elmo-parse-token name ":"))
+ (elmo-imap4-folder-set-mailbox-internal folder
+ (elmo-imap4-encode-folder-string
+ (car parse)))
+ ;; 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)))
+ ;; 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)))
+ folder))
;;; ELMO IMAP4 folder
(luna-define-method elmo-folder-expand-msgdb-path ((folder
"nowhere")
(expand-file-name
"imap"
- elmo-msgdb-dir)))))))
+ elmo-msgdb-directory)))))))
(luna-define-method elmo-folder-status-plugged ((folder
elmo-imap4-folder))
(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 namespace-assoc
+ (match-end 1)
+ (string= (substring root (match-end 1))
+ ""))
+ (concat root delim)
+ root))
result append-serv type)
- ;; Append delimiter
- (if (and root
- (not (string= root ""))
- (not (string-match (concat "\\(.*\\)"
- (regexp-quote delim)
- "\\'")
- root)))
- (setq root (concat root delim)))
(setq result (elmo-imap4-response-get-selectable-mailbox-list
(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))
(elmo-network-stream-type-spec-string
type)))))
(if one-level
- (let (folder folders ret)
- (while (setq folders (car result))
- (if (prog1
- (string-match
- (concat "^\\(" root "[^" delim "]" "+\\)" delim)
- folders)
- (setq folder (match-string 1 folders)))
- (progn
- (setq ret
- (append ret
- (list
- (list
- (concat
- prefix
- (elmo-imap4-decode-folder-string folder)
- (and append-serv
- (eval append-serv)))))))
- (setq result
- (delq
- nil
- (mapcar '(lambda (fld)
- (unless
- (string-match
- (concat "^" (regexp-quote folder) delim)
+ (let ((re-delim (regexp-quote delim))
+ (case-fold-search nil)
+ folder ret has-child-p)
+ ;; Append delimiter
+ (when (and root
+ (not (string= root ""))
+ (not (string-match
+ (concat "\\(.*\\)" re-delim "\\'")
+ root)))
+ (setq root (concat root delim)))
+ (while (setq folder (car result))
+ (when (string-match
+ (concat "^\\(" (regexp-quote root) "[^" re-delim "]" "+\\)"
+ re-delim)
+ folder)
+ (setq folder (match-string 1 folder)))
+ (setq has-child-p nil
+ result (delq
+ nil
+ (mapcar (lambda (fld)
+ (if (string-match
+ (concat "^" (regexp-quote folder)
+ "\\(" re-delim "\\|\\'\\)")
fld)
+ (progn (setq has-child-p t) nil)
fld))
- result))))
- (setq ret (append
- ret
- (list
- (concat prefix
- (elmo-imap4-decode-folder-string folders)
- (and append-serv
- (eval append-serv))))))
- (setq result (cdr result))))
+ (cdr result)))
+ folder (concat prefix
+ (elmo-imap4-decode-folder-string folder)
+ (and append-serv
+ (eval append-serv)))
+ ret (append ret (if has-child-p
+ (list (list folder))
+ (list folder)))))
ret)
(mapcar (lambda (fld)
(concat prefix (elmo-imap4-decode-folder-string fld)
(elmo-imap4-session-select-mailbox
session
(elmo-imap4-folder-mailbox-internal folder)
- 'force 'no-error))))
+ '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)
-(luna-define-method elmo-folder-delete ((folder elmo-imap4-folder))
+(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)
(elmo-imap4-folder-mailbox-internal folder))
" "
(elmo-imap4-mailbox
- (elmo-imap4-folder-mailbox-internal new-folder))))))
+ (elmo-imap4-folder-mailbox-internal new-folder))))
+ (elmo-imap4-session-set-current-mailbox-internal
+ session (elmo-imap4-folder-mailbox-internal new-folder))))
(defun elmo-imap4-copy-messages (src-folder dst-folder numbers)
(let ((session (elmo-imap4-get-session src-folder))
- (set-list (elmo-imap4-make-number-set-list numbers)))
+ (set-list (elmo-imap4-make-number-set-list
+ numbers
+ elmo-imap4-number-set-chop-length))
+ succeeds)
(elmo-imap4-session-select-mailbox session
(elmo-imap4-folder-mailbox-internal
src-folder))
- (when set-list
+ (while set-list
(if (elmo-imap4-send-command-wait session
(list
(format
(elmo-imap4-mailbox
(elmo-imap4-folder-mailbox-internal
dst-folder))))
- numbers))))
+ (setq succeeds (append succeeds numbers)))
+ (setq set-list (cdr set-list)))
+ succeeds))
(defun elmo-imap4-set-flag (folder numbers flag &optional remove)
"Set flag on messages.
FLAG is the flag name.
If optional argument REMOVE is non-nil, remove FLAG."
(let ((session (elmo-imap4-get-session folder))
- set-list)
+ response set-list)
(elmo-imap4-session-select-mailbox session
(elmo-imap4-folder-mailbox-internal
folder))
- (setq set-list (elmo-imap4-make-number-set-list numbers))
- (when set-list
+ (setq set-list (elmo-imap4-make-number-set-list
+ numbers
+ elmo-imap4-number-set-chop-length))
+ (while set-list
(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
- (format
- (if elmo-imap4-use-uid
- "uid store %s %sflags.silent (%s)"
- "store %s %sflags.silent (%s)")
- (cdr (car set-list))
- (if remove "-" "+")
- flag)))))
+ (unless (elmo-imap4-response-ok-p
+ (elmo-imap4-send-command-wait
+ session
+ (format
+ (if elmo-imap4-use-uid
+ "uid store %s %sflags.silent (%s)"
+ "store %s %sflags.silent (%s)")
+ (cdr (car set-list))
+ (if remove "-" "+")
+ flag)))
+ (setq response 'fail))
+ (setq set-list (cdr set-list)))
+ (not (eq response 'fail))))
(luna-define-method elmo-folder-delete-messages-plugged
((folder elmo-imap4-folder) numbers)
(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"))
- charset)
+ (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"
+ "larger" "smaller"))
+ (total 0)
+ (length (length from-msgs))
+ charset set-list end results)
+ (message "Searching...")
(cond
((string= "last" search-key)
(let ((numbers (or from-msgs (elmo-folder-list-messages folder))))
numbers))
((or (string= "since" search-key)
(string= "before" search-key))
- (setq search-key (concat "sent" search-key))
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid search %s%s%s %s"
- "search %s%s%s %s")
- (if from-msgs
- (concat
- (if elmo-imap4-use-uid "uid ")
- (cdr
- (car
- (elmo-imap4-make-number-set-list
- from-msgs)))
- " ")
- "")
- (if (eq (elmo-filter-type filter)
- 'unmatch)
- "not " "")
- search-key
- (elmo-date-get-description
- (elmo-date-get-datevec
- (elmo-filter-value filter)))))
- 'search))
+ (setq search-key (concat "sent" search-key)
+ set-list (elmo-imap4-make-number-set-list
+ from-msgs
+ elmo-imap4-number-set-chop-length)
+ end nil)
+ (while (not end)
+ (setq results
+ (append
+ results
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (format
+ (if elmo-imap4-use-uid
+ "uid search %s%s%s %s"
+ "search %s%s%s %s")
+ (if from-msgs
+ (concat
+ (if elmo-imap4-use-uid "uid ")
+ (cdr (car set-list))
+ " ")
+ "")
+ (if (eq (elmo-filter-type filter)
+ 'unmatch)
+ "not " "")
+ search-key
+ (elmo-date-get-description
+ (elmo-date-get-datevec
+ (elmo-filter-value filter)))))
+ 'search)))
+ (when (> length elmo-display-progress-threshold)
+ (setq total (+ total (car (car set-list))))
+ (elmo-display-progress
+ 'elmo-imap4-search "Searching..."
+ (/ (* total 100) length)))
+ (setq set-list (cdr set-list)
+ end (null set-list)))
+ results)
(t
(setq charset
(if (eq (length (elmo-filter-value filter)) 0)
(setq charset 'us-ascii)
(elmo-imap4-detect-search-charset
- (elmo-filter-value filter))))
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait session
- (list
- (if elmo-imap4-use-uid "uid ")
- "search "
- "CHARSET "
- (elmo-imap4-astring
- (symbol-name charset))
- " "
- (if from-msgs
- (concat
- (if elmo-imap4-use-uid "uid ")
- (cdr
- (car
- (elmo-imap4-make-number-set-list
- from-msgs)))
- " ")
- "")
- (if (eq (elmo-filter-type filter)
- 'unmatch)
- "not " "")
- (format "%s%s "
- (if (member
- (elmo-filter-key filter)
- imap-search-keys)
- ""
- "header ")
- (elmo-filter-key filter))
- (elmo-imap4-astring
- (encode-mime-charset-string
- (elmo-filter-value filter) charset))))
- 'search)))))
+ (elmo-filter-value filter)))
+ set-list (elmo-imap4-make-number-set-list
+ from-msgs
+ elmo-imap4-number-set-chop-length)
+ end nil)
+ (while (not end)
+ (setq results
+ (append
+ results
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (list
+ (if elmo-imap4-use-uid "uid ")
+ "search "
+ "CHARSET "
+ (elmo-imap4-astring
+ (symbol-name charset))
+ " "
+ (if from-msgs
+ (concat
+ (if elmo-imap4-use-uid "uid ")
+ (cdr (car set-list))
+ " ")
+ "")
+ (if (eq (elmo-filter-type filter)
+ 'unmatch)
+ "not " "")
+ (format "%s%s "
+ (if (member
+ (elmo-filter-key filter)
+ imap-search-keys)
+ ""
+ "header ")
+ (elmo-filter-key filter))
+ (elmo-imap4-astring
+ (encode-mime-charset-string
+ (elmo-filter-value filter) charset))))
+ 'search)))
+ (when (> length elmo-display-progress-threshold)
+ (setq total (+ total (car (car set-list))))
+ (elmo-display-progress
+ 'elmo-imap4-search "Searching..."
+ (/ (* total 100) length)))
+ (setq set-list (cdr set-list)
+ end (null set-list)))
+ results))))
(defun elmo-imap4-search-internal (folder session condition from-msgs)
(let (result)
folder session (nth 2 condition) from-msgs)))
result (sort result '<))))))
-(luna-define-method elmo-folder-search ((folder elmo-imap4-folder)
- condition &optional numbers)
- (save-excursion
- (let ((session (elmo-imap4-get-session folder)))
- (elmo-imap4-session-select-mailbox
- session
- (elmo-imap4-folder-mailbox-internal folder))
- (elmo-imap4-search-internal folder session condition numbers))))
+(luna-define-method elmo-folder-search :around ((folder elmo-imap4-folder)
+ condition &optional numbers)
+ (if (elmo-folder-plugged-p folder)
+ (save-excursion
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder))
+ (elmo-imap4-search-internal folder session condition numbers)))
+ (luna-call-next-method)))
(luna-define-method elmo-folder-msgdb-create-plugged
((folder elmo-imap4-folder) numbers &rest args)
;; Setup callback.
(with-current-buffer (elmo-network-session-buffer session)
(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-folder-use-flag-p
(/ (* total 100) length)))
(setq set-list (cdr set-list)))
(message "Getting overview...done")
+ (when elmo-imap4-seen-messages
+ (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
elmo-imap4-current-msgdb))))
(luna-define-method elmo-folder-unmark-important-plugged
(defsubst elmo-imap4-folder-diff-plugged (folder)
(let ((session (elmo-imap4-get-session folder))
- messages
- response killed)
+ messages new unread response killed)
;;; (elmo-imap4-commit spec)
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-status-callback nil)
(elmo-imap4-mailbox
(elmo-imap4-folder-mailbox-internal
folder))
- " (unseen messages)")))
+ " (recent unseen messages)")))
(setq response (elmo-imap4-response-value response 'status))
(setq messages (elmo-imap4-response-value response 'messages))
(setq killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
(setq messages (- messages
(elmo-msgdb-killed-list-length
killed))))
- (cons (elmo-imap4-response-value response 'unseen)
- messages)))
+ (setq new (elmo-imap4-response-value response 'recent)
+ unread (elmo-imap4-response-value response 'unseen))
+ (if (< unread new) (setq new unread))
+ (list new unread messages)))
(luna-define-method elmo-folder-diff-plugged ((folder elmo-imap4-folder))
(elmo-imap4-folder-diff-plugged folder))
(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)
(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.
(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 "
"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)
(elmo-imap4-identical-system-p folder src-folder)
(elmo-folder-plugged-p folder))
;; Plugged
- (elmo-imap4-copy-messages src-folder folder numbers)
+ (prog1
+ (elmo-imap4-copy-messages src-folder folder numbers)
+ (elmo-progress-notify 'elmo-folder-move-messages (length numbers)))
(luna-call-next-method)))
(luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)
(setq elmo-imap4-display-literal-progress nil))
(unless elmo-inhibit-display-retrieval-progress
(elmo-display-progress 'elmo-imap4-display-literal-progress
- "" 100) ; remove progress bar.
- (message "Retrieving...done."))
+ "Retrieving..." 100) ; remove progress bar.
+ (message "Retrieving...done"))
(if (setq response (elmo-imap4-response-bodydetail-text
(elmo-imap4-response-value-all
response 'fetch)))
(with-current-buffer outbuf
(erase-buffer)
- (insert response)))))
+ (insert response)
+ t))))
(luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder)
number strategy
projects / elisp / wanderlust.git / blobdiff