(defconst elmo-imap4-flag-specs '((important "\\Flagged")
(read "\\Seen")
(unread "\\Seen" 'remove)
- (answered "\\Answered")))
+ (answered "\\Answered")
+ ;; draft-melnikov-imap-keywords-03.txt
+ (forwarded "$Forwarded")
+ (work "$Work")
+ (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
(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
cmdstr
(elmo-imap4-format-quoted (nth 1 token)))))
((eq kind 'literal)
- (setq cmdstr (concat cmdstr
- (format "{%d}" (nth 2 token))))
- (process-send-string process cmdstr)
- (process-send-string process "\r\n")
- (setq cmdstr nil)
- (elmo-imap4-accept-continue-req session)
+ (if (memq 'literal+
+ (elmo-imap4-session-capability-internal
+ session))
+ ;; rfc2088
+ (progn
+ (setq cmdstr (concat cmdstr
+ (format "{%d+}" (nth 2 token))))
+ (process-send-string process cmdstr)
+ (process-send-string process "\r\n")
+ (setq cmdstr nil))
+ (setq cmdstr (concat cmdstr
+ (format "{%d}" (nth 2 token))))
+ (process-send-string process cmdstr)
+ (process-send-string process "\r\n")
+ (setq cmdstr nil)
+ (elmo-imap4-accept-continue-req session))
(cond ((stringp (nth 1 token))
(setq cmdstr (nth 1 token)))
((bufferp (nth 1 token))
(mime-elmo-imap-location-folder-internal location)
(mime-elmo-imap-location-number-internal location)
(mime-elmo-imap-location-strategy-internal location)
- section
- (current-buffer)
- 'unseen)
+ 'unseen
+ section)
(buffer-string))
- (elmo-message-fetch
+ (elmo-message-fetch-string
(mime-elmo-imap-location-folder-internal location)
(mime-elmo-imap-location-number-internal location)
(mime-elmo-imap-location-strategy-internal location)
- section
- nil 'unseen)))
+ 'unseen
+ section)))
(luna-define-method mime-imap-location-bodystructure
(t
(member "\\*" (elmo-imap4-session-flags-internal session)))))
+(defun elmo-imap4-flag-to-imap-search-key (flag)
+ (case flag
+ (read "seen")
+ (unread "unseen")
+ (important "flagged")
+ (answered "answered")
+ (new "new")
+ (t (concat
+ "keyword "
+ (or (car (cdr (assq flag elmo-imap4-flag-specs)))
+ (symbol-name flag))))))
+
+(defun elmo-imap4-flag-to-imap-criteria (flag)
+ (case flag
+ ((any digest)
+ (let ((criteria "flagged")
+ (global-flags (delq 'important (elmo-get-global-flags t t))))
+ (dolist (flag (delete 'new
+ (delete 'cached
+ (copy-sequence
+ (case flag
+ (any
+ elmo-preserved-flags)
+ (digest
+ elmo-digest-flags))))))
+ (setq criteria (concat "or "
+ (elmo-imap4-flag-to-imap-search-key flag)
+ " "
+ criteria)))
+ (while global-flags
+ (setq criteria (concat "or keyword "
+ (symbol-name (car global-flags))
+ " "
+ criteria))
+ (setq global-flags (cdr global-flags)))
+ criteria))
+ (t
+ (elmo-imap4-flag-to-imap-search-key flag))))
+
(defun elmo-imap4-folder-list-flagged (folder flag)
"List flagged message numbers in the FOLDER.
FLAG is one of the `unread', `read', `important', `answered', `any'."
(let ((session (elmo-imap4-get-session folder))
- (criteria (case flag
- (read "seen")
- (unread "unseen")
- (important "flagged")
- (answered "answered")
- (new "new")
- (any "or answered or unseen flagged")
- (digest "or unseen flagged")
- (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)))))
+ (criteria (elmo-imap4-flag-to-imap-criteria flag)))
(if (elmo-imap4-session-flag-available-p session flag)
(progn
(elmo-imap4-session-select-mailbox
(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)
(forward-line -1)
(not (elmo-imap4-parse-greeting)))
(accept-process-output process 1))
+ (erase-buffer)
(set-process-filter process 'elmo-imap4-arrival-filter)
(set-process-sentinel process 'elmo-imap4-sentinel)
;;; (while (and (memq (process-status process) '(open run))
(save-match-data
(set-buffer send-buf)
(erase-buffer)
- (elmo-set-buffer-multibyte nil)
+ (set-buffer-multibyte nil)
(if string
(insert string)
(with-current-buffer source-buf
(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)
(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
(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))
(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-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
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
(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))))
(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))
+ (when msgs (elmo-folder-delete-messages-internal 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-imap4-folder-mailbox-internal folder)))))
+ (elmo-imap4-session-set-current-mailbox-internal session nil))
(elmo-msgdb-delete-path folder)
t)))
(when numbers
(let ((session (elmo-imap4-get-session folder))
(headers
- (append
- '("Subject" "From" "To" "Cc" "Date"
- "Message-Id" "References" "In-Reply-To")
- elmo-msgdb-extra-fields))
+ (elmo-uniq-list
+ (append
+ '("Subject" "From" "To" "Cc" "Date"
+ "Message-Id" "References" "In-Reply-To")
+ (mapcar #'capitalize (elmo-msgdb-extra-fields 'non-virtual)))))
(total 0)
(length (length numbers))
print-length print-depth
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)))))
+ (capitalize (symbol-name flag)))
+ (nth 1 spec))))
(luna-define-method elmo-folder-unset-flag-plugged ((folder elmo-imap4-folder)
numbers flag)
;; elmo-folder-open-internal: do nothing.
-(luna-define-method elmo-find-fetch-strategy
- ((folder elmo-imap4-folder) entity &optional ignore-cache)
- (let ((number (elmo-message-entity-number entity))
- cache-file size message-id)
- (setq size (elmo-message-entity-field entity 'size))
- (setq message-id (elmo-message-entity-field entity 'message-id))
- (setq cache-file (elmo-file-cache-get message-id))
- (if (or ignore-cache
- (null (elmo-file-cache-status cache-file)))
- (if (and elmo-message-fetch-threshold
- (integerp size)
- (>= size elmo-message-fetch-threshold)
- (or (not elmo-message-fetch-confirm)
- (not (prog1 (y-or-n-p
+(luna-define-method elmo-find-fetch-strategy ((folder elmo-imap4-folder) number
+ &optional
+ ignore-cache
+ require-entireness)
+ (let ((entity (elmo-message-entity folder number)))
+ (if (null entity)
+ (elmo-make-fetch-strategy 'entire)
+ (let* ((size (elmo-message-entity-field entity 'size))
+ (message-id (elmo-message-entity-field entity 'message-id))
+ (cache-file (elmo-file-cache-get message-id))
+ (use-cache (and (not ignore-cache)
+ (elmo-message-use-cache-p folder number)
+ (if require-entireness
+ (eq (elmo-file-cache-status cache-file)
+ 'entire)
+ (elmo-file-cache-status cache-file)))))
+ (elmo-make-fetch-strategy
+ (if use-cache
+ (elmo-file-cache-status cache-file)
+ (if (and (not require-entireness)
+ elmo-message-fetch-threshold
+ (integerp size)
+ (>= size elmo-message-fetch-threshold)
+ (or (not elmo-message-fetch-confirm)
+ (not (prog1
+ (y-or-n-p
(format
"Fetch entire message at once? (%dbytes)"
size))
- (message "")))))
- ;; Fetch message as imap message.
- (elmo-make-fetch-strategy 'section
- nil
- (elmo-message-use-cache-p
- folder number)
- (elmo-file-cache-path
- cache-file))
- ;; Don't use existing cache and fetch entire message at once.
- (elmo-make-fetch-strategy 'entire nil
- (elmo-message-use-cache-p
- folder number)
- (elmo-file-cache-path cache-file)))
- ;; Cache found and use it.
- (if (not ignore-cache)
- (if (eq (elmo-file-cache-status cache-file) 'section)
- ;; Fetch message with imap message.
- (elmo-make-fetch-strategy 'section
- t
- (elmo-message-use-cache-p
- folder number)
- (elmo-file-cache-path
- cache-file))
- (elmo-make-fetch-strategy 'entire
- t
- (elmo-message-use-cache-p
- folder number)
- (elmo-file-cache-path
- cache-file)))))))
+ (message "")))))
+ 'section
+ 'entire))
+ use-cache
+ (elmo-message-use-cache-p folder number)
+ (elmo-file-cache-path cache-file))))))
(luna-define-method elmo-folder-create-plugged ((folder elmo-imap4-folder))
(elmo-imap4-send-command-wait
(elmo-imap4-mailbox
(elmo-imap4-folder-mailbox-internal folder)))))
+(defun elmo-imap4-flags-to-imap (flags)
+ "Convert FLAGS to the IMAP flag string."
+ (let ((imap-flag (if (not (memq 'unread flags)) "\\Seen")))
+ (dolist (flag flags)
+ (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
((folder elmo-imap4-folder) &optional flags number)
(if (elmo-folder-plugged-p folder)
(elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
folder))
(if (and flags (elmo-folder-use-flag-p folder))
- (concat " ("
- (mapconcat
- 'identity
- (append
- (and (memq 'important flags)
- '("\\Flagged"))
- (and (not (memq 'unread flags))
- '("\\Seen"))
- (and (memq 'answered flags)
- '("\\Answered")))
- " ")
- ") ")
+ (concat " (" (elmo-imap4-flags-to-imap 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