;; 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.
+;; 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
(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
; "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.
"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.
;;
;; app-data:
-;; cons of list
-;; 0: new-mark 1: already-mark 2: seen-mark 3: important-mark
-;; 4: seen-list
-;; and result of use-flag-p.
+;; cons of seen-list and result of use-flag-p.
(defsubst elmo-imap4-fetch-callback-1-subr (entity flags app-data)
"A msgdb entity callback function."
(let* ((use-flag (cdr app-data))
(app-data (car app-data))
- (seen (member (car entity) (nth 4 app-data)))
+ (seen (member (car entity) app-data))
mark)
(if (member "\\Flagged" flags)
- (elmo-msgdb-global-mark-set (car entity) (nth 3 app-data)))
+ (elmo-msgdb-global-mark-set (car entity)
+ elmo-msgdb-important-mark))
(if (setq mark (elmo-msgdb-global-mark-get (car entity)))
(unless (member "\\Seen" flags)
(setq elmo-imap4-seen-messages
elmo-imap4-seen-messages)))
(setq mark (or (if (elmo-file-cache-status
(elmo-file-cache-get (car entity)))
+ ;; cached.
+ (if (member "\\Answered" flags)
+ elmo-msgdb-answered-cached-mark
+ (if (or seen
+ (and use-flag
+ (member "\\Seen" flags)))
+ nil
+ elmo-msgdb-unread-cached-mark))
+ (if (member "\\Answered" flags)
+ elmo-msgdb-answered-uncached-mark
(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
+ elmo-msgdb-read-uncached-mark)
+ elmo-msgdb-new-mark))))))
(setq elmo-imap4-current-msgdb
(elmo-msgdb-append
elmo-imap4-current-msgdb
(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)
(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-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))
(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))
(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)
(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)
(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)))
((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
(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
(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)
(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
((folder elmo-imap4-folder))
(elmo-imap4-list folder "flagged"))
+(luna-define-method elmo-folder-list-answereds-plugged
+ ((folder elmo-imap4-folder))
+ (elmo-imap4-list folder "answered"))
+
+(defun elmo-imap4-folder-list-any-plugged (folder)
+ (elmo-imap4-list folder "or answered or unseen flagged"))
+
+(defun elmo-imap4-folder-list-digest-plugged (folder)
+ (elmo-imap4-list folder "or unseen flagged"))
+
(luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder))
(not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
(elmo-imap4-folder-mailbox-internal 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 (match-end 1)
+ (root (if (and namespace-assoc
+ (match-end 1)
(string= (substring root (match-end 1))
""))
(concat root delim)
(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-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)
(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" "mark"))
(total 0)
(length (length from-msgs))
charset set-list end results)
numbers)))
(mapcar '(lambda (x) (delete x numbers)) rest)
numbers))
+ ((string= "flag" search-key)
+ (cond
+ ((string= "unread" (elmo-filter-value filter))
+ (elmo-folder-list-unreads folder))
+ ((string= "important" (elmo-filter-value filter))
+ (elmo-folder-list-importants folder))
+ ((string= "answered" (elmo-filter-value filter))
+ (elmo-folder-list-answereds folder))
+ ((string= "digest" (elmo-filter-value filter))
+ (elmo-imap4-folder-list-digest-plugged folder))
+ ((string= "any" (elmo-filter-value filter))
+ (elmo-imap4-folder-list-any-plugged folder))))
((or (string= "since" search-key)
(string= "before" search-key))
(setq search-key (concat "sent" search-key)
(luna-call-next-method)))
(luna-define-method elmo-folder-msgdb-create-plugged
- ((folder elmo-imap4-folder) numbers &rest args)
+ ((folder elmo-imap4-folder) numbers seen-list)
(when numbers
(let ((session (elmo-imap4-get-session folder))
(headers
(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-imap4-fetch-callback-data (cons seen-list
(elmo-folder-use-flag-p
folder)))
(while set-list
((folder elmo-imap4-folder) numbers)
(elmo-imap4-set-flag folder numbers "\\Seen"))
+(luna-define-method elmo-folder-unmark-answered-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Answered" 'remove))
+
+(luna-define-method elmo-folder-mark-as-answered-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Answered"))
+
(luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder)
number)
elmo-imap4-use-cache)
(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-net-folder-user-internal (, folder2)))))))
(luna-define-method elmo-folder-append-messages :around
- ((folder elmo-imap4-folder) src-folder numbers unread-marks
- &optional same-number)
+ ((folder elmo-imap4-folder) src-folder numbers &optional same-number)
(if (and (eq (elmo-folder-type-internal src-folder) 'imap4)
(elmo-imap4-identical-system-p folder src-folder)
(elmo-folder-plugged-p folder))
(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)))
(goto-char (point-min))
(std11-field-body (symbol-name field)))))
-
+(luna-define-method elmo-folder-search-requires-msgdb-p ((folder
+ elmo-imap4-folder)
+ condition)
+ nil)
(require 'product)
(product-provide (provide 'elmo-imap4) (require 'elmo-version))