;; Author: Simon Josefsson <jas@pdc.kth.se>
;;
+;;; Code:
(require 'elmo-vars)
(require 'elmo-util)
(require 'elmo-date)
(require 'elmo-net)
(require 'utf7)
(require 'elmo-mime)
+(require 'time-stamp)
-;;; Code:
(eval-when-compile (require 'cl))
(defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd
(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
(capability current-mailbox read-only flags))
(luna-define-internal-accessors 'elmo-imap4-session))
+(defmacro elmo-imap4-session-capable-p (session capability)
+ `(memq ,capability (elmo-imap4-session-capability-internal ,session)))
+
;;; MIME-ELMO-IMAP Location
(eval-and-compile
(luna-define-class mime-elmo-imap-location
;;; Debug
(defmacro elmo-imap4-debug (message &rest args)
- (` (if elmo-imap4-debug
- (elmo-imap4-debug-1 (, message) (,@ 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*")
(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
(defmacro elmo-imap4-response-continue-req-p (response)
"Returns non-nil if RESPONSE is '+' response."
- (` (assq 'continue-req (, response))))
+ `(assq 'continue-req ,response))
(defmacro elmo-imap4-response-ok-p (response)
"Returns non-nil if RESPONSE is an 'OK' response."
- (` (assq 'ok (, response))))
+ `(assq 'ok ,response))
(defmacro elmo-imap4-response-bye-p (response)
"Returns non-nil if RESPONSE is an 'BYE' response."
- (` (assq 'bye (, response))))
+ `(assq 'bye ,response))
(defmacro elmo-imap4-response-garbage-p (response)
"Returns non-nil if RESPONSE is an 'garbage' response."
- (` (assq 'garbage (, response))))
+ `(assq 'garbage ,response))
(defmacro elmo-imap4-response-value (response symbol)
"Get value of the SYMBOL from RESPONSE."
- (` (nth 1 (assq (, symbol) (, response)))))
+ `(nth 1 (assq ,symbol ,response)))
(defsubst elmo-imap4-response-value-all (response symbol)
"Get all value of the SYMBOL from RESPONSE."
(defmacro elmo-imap4-response-error-text (response)
"Returns text of NO, BAD, BYE response."
- (` (nth 1 (or (elmo-imap4-response-value (, response) 'no)
- (elmo-imap4-response-value (, response) 'bad)
- (elmo-imap4-response-value (, response) 'bye)))))
+ `(nth 1 (or (elmo-imap4-response-value ,response 'no)
+ (elmo-imap4-response-value ,response 'bad)
+ (elmo-imap4-response-value ,response 'bye))))
(defmacro elmo-imap4-response-bodydetail-text (response)
"Returns text of BODY[section]<partial>."
- (` (nth 3 (assq 'bodydetail (, response)))))
+ `(nth 3 (assq 'bodydetail ,response)))
;;; Session commands.
-; (defun elmo-imap4-send-command-wait (session command)
-; "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)))
+;;;(defun elmo-imap4-send-command-wait (session command)
+;;; "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)))
(defun elmo-imap4-send-command-wait (session command)
"Send COMMAND to the SESSION.
(number-to-string
(setq elmo-imap4-seqno (+ 1 elmo-imap4-seqno)))))
(setq cmdstr (concat tag " "))
- ;; (erase-buffer) No need.
+;;; No need.
+;;; (erase-buffer)
(goto-char (point-min))
(when (elmo-imap4-response-bye-p elmo-imap4-current-response)
(elmo-imap4-process-bye session))
session))
(message "Waiting for IMAP response...done"))
(setq elmo-imap4-parsing t)
- (elmo-imap4-debug "<-(%s)- %s" tag command)
(while (setq token (car command-args))
(cond ((stringp token) ; formatted
(setq cmdstr (concat cmdstr token)))
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 (elmo-imap4-session-capable-p session 'literal+)
+ ;; rfc2088
+ (progn
+ (setq cmdstr (concat cmdstr
+ (format "{%d+}" (nth 2 token))
+ "\r\n"))
+ (process-send-string process cmdstr)
+ (setq cmdstr nil))
+ (setq cmdstr (concat cmdstr
+ (format "{%d}" (nth 2 token))
+ "\r\n"))
+ (process-send-string process cmdstr)
+ (setq cmdstr nil)
+ (elmo-imap4-accept-continue-req session))
(cond ((stringp (nth 1 token))
(setq cmdstr (nth 1 token)))
((bufferp (nth 1 token))
(t
(error "Invalid argument")))
(setq command-args (cdr command-args)))
- (if cmdstr
- (process-send-string process cmdstr))
- (process-send-string process "\r\n")
+ (elmo-imap4-debug "[%s] <- %s" (format-time-string "%T") cmdstr)
+ (process-send-string process (concat cmdstr "\r\n"))
tag)))
(defun elmo-imap4-send-string (session string)
(elmo-network-session-process-internal session))
(setq elmo-imap4-current-response nil)
(goto-char (point-min))
- (elmo-imap4-debug "<-- %s" string)
+ (elmo-imap4-debug "[%s] <-- %s" (format-time-string "%T") string)
(process-send-string (elmo-network-session-process-internal session)
string)
(process-send-string (elmo-network-session-process-internal session)
'(open run))
(accept-process-output (elmo-network-session-process-internal session)
1)))
- (elmo-imap4-debug "=>%s" (prin1-to-string elmo-imap4-current-response))
+ (elmo-imap4-debug "[%s] => %s" (format-time-string "%T") (prin1-to-string elmo-imap4-current-response))
(setq elmo-imap4-parsing nil)
elmo-imap4-current-response))
(with-current-buffer (process-buffer process)
(while (not elmo-imap4-current-response)
(accept-process-output process 1))
- (elmo-imap4-debug "=>%s" (prin1-to-string elmo-imap4-current-response))
+ (elmo-imap4-debug "[%s] =>%s" (format-time-string "%T") (prin1-to-string elmo-imap4-current-response))
elmo-imap4-current-response))
(defun elmo-imap4-read-continue-req (session)
(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
((location mime-elmo-imap-location))
- (elmo-imap4-fetch-bodystructure
+ (elmo-message-fetch-bodystructure
(mime-elmo-imap-location-folder-internal location)
(mime-elmo-imap-location-number-internal location)
(mime-elmo-imap-location-strategy-internal location)))
(car (nth 1 entry))))
response)))
-(defun elmo-imap4-fetch-bodystructure (folder number strategy)
- "Fetch BODYSTRUCTURE for the message in the FOLDER with NUMBER using STRATEGY."
+(luna-define-method elmo-message-fetch-bodystructure ((folder
+ elmo-imap4-folder)
+ number strategy)
(if (elmo-fetch-strategy-use-cache strategy)
(elmo-object-load
(elmo-file-cache-expand-path
;;;(elmo-imap4-send-command-wait
;;;(elmo-imap4-get-session spec)
;;;(list "status "
-;;; (elmo-imap4-mailbox
-;;; (elmo-imap4-spec-mailbox spec))
-;;; " (uidvalidity)")))
+;;; (elmo-imap4-mailbox
+;;; (elmo-imap4-spec-mailbox spec))
+;;; " (uidvalidity)")))
)
(defun elmo-imap4-sync-validity (spec validity-file)
;; Not used.
)
+(defun elmo-imap4-elist (folder query tags)
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder))
+ (let ((answer (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session query) 'esearch))
+ tag result)
+ (while answer
+ (setq tag (intern (downcase (car answer))))
+ (cond ((eq tag 'uid)
+ nil)
+ ((memq tag tags)
+ (setq result
+ (append result
+ (if (eq tag 'all)
+ (sort
+ (elmo-number-set-to-number-list
+ (mapcar #'(lambda (x)
+ (let ((y (split-string x ":")))
+ (if (null (cdr y))
+ (string-to-number (car y))
+ (cons (string-to-number (car y))
+ (string-to-number (cadr y))))))
+ (split-string (cadr answer) "\,"))) '<)
+ (string-to-number (cadr answer))))))
+ (t nil))
+ (setq answer (cdr answer)))
+ result)))
+
(defun elmo-imap4-list (folder flag)
(let ((session (elmo-imap4-get-session folder)))
(elmo-imap4-session-select-mailbox
session
(elmo-imap4-folder-mailbox-internal folder))
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait
- session
- (format (if elmo-imap4-use-uid "uid search %s"
- "search %s") flag))
- 'search)))
+ (if (elmo-imap4-session-capable-p session 'esearch)
+ (elmo-imap4-elist folder
+ (concat (if elmo-imap4-use-uid "uid " "")
+ "search return (all) " flag) '(all))
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (format (if elmo-imap4-use-uid "uid search %s"
+ "search %s") flag))
+ 'search))))
(defun elmo-imap4-session-flag-available-p (session flag)
(case flag
"\\seen" (elmo-imap4-session-flags-internal session))
(elmo-string-member-ignore-case
"\\flagged" (elmo-imap4-session-flags-internal session))))
- (t (elmo-string-member-ignore-case
- (concat "\\" (symbol-name flag))
- (elmo-imap4-session-flags-internal session)))))
+ (answered
+ (elmo-string-member-ignore-case
+ (concat "\\" (symbol-name flag))
+ (elmo-imap4-session-flags-internal session)))
+ (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")
- (any "or answered or unseen flagged")
- (digest "or unseen flagged")
- (t (symbol-name flag)))))
+ (criteria (elmo-imap4-flag-to-imap-criteria flag)))
(if (elmo-imap4-session-flag-available-p session flag)
- (progn
- (elmo-imap4-session-select-mailbox
- session
- (elmo-imap4-folder-mailbox-internal folder))
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait
- session
- (format (if elmo-imap4-use-uid "uid search %s"
- "search %s") criteria))
- 'search))
+ (elmo-imap4-list folder criteria)
;; List flagged messages in the msgdb.
(elmo-msgdb-list-flagged (elmo-folder-msgdb folder) flag))))
(cond ((consp x)
(format "%s:%s" (car x) (cdr x)))
((integerp x)
- (int-to-string x))))
+ (number-to-string x))))
cont-list
","))
set-list)))
(flag-table (car app-data))
(msg-id (elmo-message-entity-field entity 'message-id))
saved-flags flag-list)
-;; (when (elmo-string-member-ignore-case "\\Flagged" flags)
-;; (elmo-msgdb-global-mark-set msg-id elmo-msgdb-important-mark))
+;;; (when (elmo-string-member-ignore-case "\\Flagged" flags)
+;;; (elmo-msgdb-global-mark-set msg-id elmo-msgdb-important-mark))
(setq saved-flags (elmo-flag-table-get flag-table msg-id)
flag-list
(if use-flag
(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)
:size (elmo-imap4-response-value element 'rfc822size)))
(elmo-imap4-response-value element 'flags)
- app-data)))
+ app-data)
+ (elmo-progress-notify 'elmo-folder-msgdb-create)))
(defun elmo-imap4-parse-capability (string)
(if (string-match "^\\*\\(.*\\)$" string)
(concat "(" (downcase (elmo-match-string 1 string)) ")"))))
(defun elmo-imap4-clear-login (session)
+ (when (elmo-imap4-session-capable-p session 'logindisabled)
+ (signal 'elmo-authenticate-error '(elmo-imap4-clear-login)))
(let ((elmo-imap4-debug-inhibit-logging t))
(or
(elmo-imap4-read-ok
elmo-network-initialize-session-buffer :after ((session
elmo-imap4-session) buffer)
(with-current-buffer buffer
- (mapcar 'make-variable-buffer-local elmo-imap4-local-variables)
+ (mapc 'make-variable-buffer-local elmo-imap4-local-variables)
(setq elmo-imap4-seqno 0)
(setq elmo-imap4-status 'initial)))
;; Skip garbage output from process before greeting.
(while (and (memq (process-status process) '(open run))
(goto-char (point-max))
- (forward-line -1)
- (not (elmo-imap4-parse-greeting)))
+ (or (/= (forward-line -1) 0)
+ (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))
+;;; (while (and (memq (process-status process) '(open run))
;;; (eq elmo-imap4-status 'initial))
;;; (message "Waiting for server response...")
;;; (accept-process-output process 1))
-;;; (message "")
+;;; (message "")
(unless (memq elmo-imap4-status '(nonauth auth))
(signal 'elmo-open-error
(list 'elmo-network-initialize-session)))
(when (eq (elmo-network-stream-type-symbol
(elmo-network-session-stream-type-internal session))
'starttls)
- (or (memq 'starttls
- (elmo-imap4-session-capability-internal session))
+ (or (elmo-imap4-session-capable-p session 'starttls)
(signal 'elmo-open-error
'(elmo-imap4-starttls-error)))
(elmo-imap4-send-command-wait session "starttls")
(sasl-mechanisms
(delq nil
(mapcar
- '(lambda (cap)
- (if (string-match "^auth=\\(.*\\)$"
- (symbol-name cap))
- (match-string 1 (upcase (symbol-name cap)))))
+ (lambda (cap)
+ (if (string-match "^auth=\\(.*\\)$"
+ (symbol-name cap))
+ (match-string 1 (upcase (symbol-name cap)))))
(elmo-imap4-session-capability-internal session))))
(mechanism
(sasl-find-mechanism
(delq nil
- (mapcar '(lambda (cap) (upcase (symbol-name cap)))
+ (mapcar (lambda (cap) (upcase (symbol-name cap)))
(if (listp auth)
auth
(list auth)))))) ;)
session
(intern (downcase name)))
(setq sasl-read-passphrase
- (function
- (lambda (prompt)
- (elmo-get-passwd
- (elmo-network-session-password-key session)))))
+ (lambda (prompt)
+ (elmo-get-passwd
+ (elmo-network-session-password-key session))))
(setq tag
(elmo-imap4-send-command
session
(luna-define-method elmo-network-setup-session ((session
elmo-imap4-session))
(with-current-buffer (elmo-network-session-buffer session)
- (when (memq 'namespace (elmo-imap4-session-capability-internal session))
+ (when (elmo-imap4-session-capable-p session 'namespace)
(setq elmo-imap4-server-namespace
(elmo-imap4-response-value
(elmo-imap4-send-command-wait session "namespace")
(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
(luna-define-method elmo-server-diff-async ((folder elmo-imap4-folder))
(let ((session (elmo-imap4-get-session folder)))
- ;; commit.
- ;; (elmo-imap4-commit spec)
+;;; ;; commit.
+;;; (elmo-imap4-commit spec)
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-status-callback
'elmo-imap4-server-diff-async-callback-1)
(defvar elmo-imap4-client-eol "\r\n"
"The EOL string we send to the server.")
-(defvar elmo-imap4-display-literal-progress nil)
+(defvar elmo-imap4-literal-progress-reporter nil)
(defun elmo-imap4-find-next-line ()
"Return point at end of current line, taking into account literals.
(if (match-string 1)
(if (< (point-max) (+ (point) (string-to-number (match-string 1))))
(progn
- (if (and elmo-imap4-display-literal-progress
- (> (string-to-number (match-string 1))
- (min elmo-display-retrieval-progress-threshold 100)))
- (elmo-display-progress
- 'elmo-imap4-display-literal-progress
- (format "Retrieving (%d/%d bytes)..."
- (- (point-max) (point))
- (string-to-number (match-string 1)))
- (/ (- (point-max) (point))
- (/ (string-to-number (match-string 1)) 100))))
+ (when elmo-imap4-literal-progress-reporter
+ (elmo-progress-notify
+ 'elmo-retrieve-message
+ :set (- (point-max) (point))
+ :total (string-to-number (match-string 1))))
nil)
(goto-char (+ (point) (string-to-number (match-string 1))))
(elmo-imap4-find-next-line))
"IMAP process filter."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
- (elmo-imap4-debug "-> %s" string)
(goto-char (point-max))
(insert string)
(let (end)
(delete-backward-char (length elmo-imap4-server-eol))
(goto-char (point-min))
(unwind-protect
- (cond ((eq elmo-imap4-status 'initial)
- (setq elmo-imap4-current-response
- (list
- (list 'greeting (elmo-imap4-parse-greeting)))))
- ((or (eq elmo-imap4-status 'auth)
- (eq elmo-imap4-status 'nonauth)
- (eq elmo-imap4-status 'selected)
- (eq elmo-imap4-status 'examine))
- (setq elmo-imap4-current-response
- (cons
- (elmo-imap4-parse-response)
- elmo-imap4-current-response)))
- (t
- (message "Unknown state %s in arrival filter"
- elmo-imap4-status))))
- (delete-region (point-min) (point-max))))))))
+ (case elmo-imap4-status
+ (initial
+ (setq elmo-imap4-current-response
+ (list
+ (list 'greeting (elmo-imap4-parse-greeting)))))
+ ((auth nonauth selected examine)
+ (setq elmo-imap4-current-response
+ (cons (elmo-imap4-parse-response)
+ elmo-imap4-current-response)))
+ (t
+ (message "Unknown state %s in arrival filter"
+ elmo-imap4-status)))
+ (delete-region (point-min) (point-max)))))))))
;; IMAP parser.
(elmo-imap4-forward)
(while (and (not (eq (char-after (point)) ?\)))
;; next line for MS Exchange bug
- (progn (and (eq (char-after (point)) ? ) (elmo-imap4-forward)) t)
+ (progn (and (eq (char-after (point)) (string-to-char " "))
+ (elmo-imap4-forward)) t)
(setq address (elmo-imap4-parse-address)))
(setq addresses (cons address addresses)))
(when (eq (char-after (point)) ?\))
(defun elmo-imap4-parse-response ()
"Parse a IMAP command response."
+ (elmo-imap4-debug "[%s] -> %s" (format-time-string "%T") (buffer-substring (point) (point-max)))
(let (token)
(case (setq token (read (current-buffer)))
(+ (progn
(read (concat "("
(buffer-substring (point) (point-max))
")"))))
+ (ESEARCH (list
+ 'esearch
+ (cddr (split-string (buffer-substring (point) (point-max)) " " "\,"))))
(STATUS (elmo-imap4-parse-status))
;; Added
(NAMESPACE (elmo-imap4-parse-namespace))
(1-
(progn (re-search-forward "[] ]" nil t)
(point))))))
- (if (eq (char-before) ? )
+ (if (eq (char-before) (string-to-char " "))
(prog1
(mapconcat 'identity
(cons section (elmo-imap4-parse-header-list)) " ")
(setq status
(cons
(let ((token (read (current-buffer))))
- (cond ((eq token 'MESSAGES)
- (list 'messages (read (current-buffer))))
- ((eq token 'RECENT)
- (list 'recent (read (current-buffer))))
- ((eq token 'UIDNEXT)
- (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 (read (current-buffer))))
- (t
- (message
- "Unknown status data %s in mailbox %s ignored"
- token mailbox))))
+ (case (intern (upcase (symbol-name token)))
+ (MESSAGES
+ (list 'messages (read (current-buffer))))
+ (RECENT
+ (list 'recent (read (current-buffer))))
+ (UIDNEXT
+ (list 'uidnext (read (current-buffer))))
+ (UIDVALIDITY
+ (and (looking-at " \\([0-9]+\\)")
+ (prog1 (list 'uidvalidity (match-string 1))
+ (goto-char (match-end 1)))))
+ (UNSEEN
+ (list 'unseen (read (current-buffer))))
+ (t
+ (message
+ "Unknown status data %s in mailbox %s ignored"
+ token mailbox))))
status))
(skip-chars-forward " ")))
(and elmo-imap4-status-callback
(defmacro elmo-imap4-value (value)
- (` (if (eq (, value) 'NIL) nil
- (, value))))
+ `(if (eq ,value 'NIL)
+ nil
+ ,value))
(defmacro elmo-imap4-nth (pos list)
- (` (let ((value (nth (, pos) (, list))))
- (elmo-imap4-value value))))
+ `(let ((value (nth ,pos ,list)))
+ (elmo-imap4-value value)))
(defun elmo-imap4-parse-namespace ()
(list 'namespace
(defun elmo-imap4-parse-acl ()
(let ((mailbox (elmo-imap4-parse-mailbox))
identifier rights acl)
- (while (eq (char-after (point)) ?\ )
+ (while (eq (char-after (point)) (string-to-char " "))
(elmo-imap4-forward)
(setq identifier (elmo-imap4-parse-astring))
(elmo-imap4-forward)
(let (b-e)
(elmo-imap4-forward)
(push (elmo-imap4-parse-body-extension) b-e)
- (while (eq (char-after (point)) ?\ )
+ (while (eq (char-after (point)) (string-to-char " "))
(elmo-imap4-forward)
(push (elmo-imap4-parse-body-extension) b-e))
(assert (eq (char-after (point)) ?\)))
(defsubst elmo-imap4-parse-body-ext ()
(let (ext)
- (when (eq (char-after (point)) ?\ );; body-fld-dsp
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-dsp
(elmo-imap4-forward)
(let (dsp)
(if (eq (char-after (point)) ?\()
(elmo-imap4-forward))
(assert (elmo-imap4-parse-nil)))
(push (nreverse dsp) ext))
- (when (eq (char-after (point)) ?\ );; body-fld-lang
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-lang
(elmo-imap4-forward)
(if (eq (char-after (point)) ?\()
(push (elmo-imap4-parse-string-list) ext)
(push (elmo-imap4-parse-nstring) ext))
- (while (eq (char-after (point)) ?\ );; body-extension
+ (while (eq (char-after (point)) (string-to-char " "));; body-extension
(elmo-imap4-forward)
(setq ext (append (elmo-imap4-parse-body-extension) ext)))))
ext))
(push subbody body))
(elmo-imap4-forward)
(push (elmo-imap4-parse-string) body);; media-subtype
- (when (eq (char-after (point)) ?\ );; body-ext-mpart:
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-mpart:
(elmo-imap4-forward)
(if (eq (char-after (point)) ?\();; body-fld-param
(push (elmo-imap4-parse-string-list) body)
(push (elmo-imap4-parse-string) body);; media-subtype
(elmo-imap4-forward)
;; next line for Sun SIMS bug
- (and (eq (char-after (point)) ? ) (elmo-imap4-forward))
+ (and (eq (char-after (point)) (string-to-char " "))
+ (elmo-imap4-forward))
(if (eq (char-after (point)) ?\();; body-fld-param
(push (elmo-imap4-parse-string-list) body)
(push (and (elmo-imap4-parse-nil) nil) body))
;; the problem is that the two first are in turn optionally followed
;; by the third. So we parse the first two here (if there are any)...
- (when (eq (char-after (point)) ?\ )
+ (when (eq (char-after (point)) (string-to-char " "))
(elmo-imap4-forward)
(let (lines)
(cond ((eq (char-after (point)) ?\();; body-type-msg:
;; ...and then parse the third one here...
- (when (eq (char-after (point)) ?\ );; body-ext-1part:
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-1part:
(elmo-imap4-forward)
(push (elmo-imap4-parse-nstring) body);; body-fld-md5
(setq body
(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
(elmo-msgdb-killed-list-length killed))
(elmo-imap4-response-value status 'messages)))))
+(defun elmo-imap4-folder-list-range (folder min max)
+ (elmo-imap4-list
+ folder
+ (concat
+ (let ((killed
+ (elmo-folder-killed-list-internal
+ folder)))
+ (if (and killed
+ (eq (length killed) 1)
+ (consp (car killed))
+ (eq (car (car killed)) 1))
+;; What about elmo-imap4-use-uid?
+ (format "uid %d:%s" (cdr (car killed)) max)
+ (format "uid %s:%s" min max)))
+ " undeleted")))
+
(luna-define-method elmo-folder-list-messages-plugged ((folder
- elmo-imap4-folder)
- &optional
- enable-killed)
- (elmo-imap4-list folder
- (let ((killed
- (elmo-folder-killed-list-internal
- folder)))
- (if (and killed
- (eq (length killed) 1)
- (consp (car killed))
- (eq (car (car killed)) 1))
- (format "uid %d:*" (cdr (car killed)))
- "all"))))
-
-(luna-define-method elmo-folder-list-flagged-unplugged
+ elmo-imap4-folder)
+ &optional
+ enable-killed)
+
+ (let* ((old (elmo-msgdb-list-messages (elmo-folder-msgdb folder)))
+ (new (elmo-imap4-folder-list-range folder
+ (1+ (or (elmo-folder-get-info-max folder) 0)) "*"))
+ (united-old-new (elmo-union old new)))
+ (if (= (length united-old-new) (or (elmo-folder-get-info-length folder) 0))
+ united-old-new
+ (elmo-union new
+ (elmo-imap4-folder-list-range
+ folder
+ 1 (1+ (or (elmo-folder-get-info-max folder) 0)))))))
+
+(luna-define-method elmo-folder-list-flagged-plugged
((folder elmo-imap4-folder) flag)
(elmo-imap4-folder-list-flagged folder flag))
(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
(elmo-net-folder-server-internal folder))))
(unless (eq (elmo-net-folder-port-internal folder) elmo-imap4-default-port)
(setq append-serv (concat append-serv ":"
- (int-to-string
+ (number-to-string
(elmo-net-folder-port-internal folder)))))
(setq type (elmo-net-folder-stream-type-internal folder))
(unless (eq (elmo-network-stream-type-symbol type)
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
+ (setq has-child-p
+ (when (string-match
+ (concat "^\\(" (regexp-quote root) "[^" re-delim "]" "+\\)"
+ re-delim)
+ folder)
+ (setq folder (match-string 1 folder))))
+ (setq result (delq
nil
(mapcar (lambda (fld)
(if (string-match
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))))
t)
(luna-define-method elmo-folder-delete ((folder elmo-imap4-folder))
- (let ((msgs (and (elmo-folder-exists-p folder)
- (elmo-folder-list-messages folder))))
+ (let* ((exists (elmo-folder-exists-p folder))
+ (msgs (and exists
+ (elmo-folder-list-messages folder))))
(when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
(if (> (length msgs) 0)
(format "%d msg(s) exists. " (length msgs))
(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))
- (elmo-imap4-send-command-wait session "close")
+ (when msgs (elmo-folder-delete-messages-internal folder msgs))
+ ;; close selected mailbox except one with \Noselect attribute
+ (when exists
+ (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 (or (elmo-string-member-ignore-case
flag
(elmo-imap4-session-flags-internal session))
+ (member "\\*" (elmo-imap4-session-flags-internal session))
(string= flag "\\Deleted")) ; XXX Humm..
(setq set-list (elmo-imap4-make-number-set-list
numbers
(luna-define-method elmo-folder-delete-messages-plugged
((folder elmo-imap4-folder) numbers)
- (let ((session (elmo-imap4-get-session folder)))
+ (let ((session (elmo-imap4-get-session folder))
+ (expunge
+ (or (null (elmo-imap4-list folder "deleted"))
+ (y-or-n-p
+ "There's hidden deleted messages, expunge anyway?"))))
(elmo-imap4-session-select-mailbox
session
(elmo-imap4-folder-mailbox-internal folder))
(unless (elmo-imap4-set-flag folder numbers "\\Deleted")
(error "Failed to set deleted flag"))
- (elmo-imap4-send-command session "expunge")))
+ (when expunge
+ (elmo-imap4-send-command session "expunge"))
+ t))
-(defmacro elmo-imap4-detect-search-charset (string)
- (` (with-temp-buffer
- (insert (, string))
- (detect-mime-charset-region (point-min) (point-max)))))
+(defun elmo-imap4-detect-search-charset (string)
+ (with-temp-buffer
+ (insert string)
+ (detect-mime-charset-region (point-min) (point-max))))
(defun elmo-imap4-search-internal-primitive (folder session filter from-msgs)
(let ((search-key (elmo-filter-key filter))
(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))))
(nthcdr (max (- (length numbers)
- (string-to-int (elmo-filter-value filter)))
+ (string-to-number (elmo-filter-value filter)))
0)
numbers)))
((string= "first" search-key)
(let* ((numbers (or from-msgs (elmo-folder-list-messages folder)))
- (rest (nthcdr (string-to-int (elmo-filter-value filter) )
+ (rest (nthcdr (string-to-number (elmo-filter-value filter) )
numbers)))
- (mapcar '(lambda (x) (delete x numbers)) rest)
+ (mapc (lambda (x) (delete x numbers)) rest)
numbers))
((string= "flag" search-key)
(elmo-imap4-folder-list-flagged
(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)
(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))))
condition &optional numbers)
(if (elmo-folder-plugged-p folder)
(save-excursion
- (let ((session (elmo-imap4-get-session folder)))
+ (let ((session (elmo-imap4-get-session folder))
+ ret)
+ (message "Searching...")
(elmo-imap4-session-select-mailbox
session
(elmo-imap4-folder-mailbox-internal folder))
- (elmo-imap4-search-internal folder session condition numbers)))
+ (setq ret (elmo-imap4-search-internal folder session condition numbers))
+ (message "Searching...done")
+ ret))
(luna-call-next-method)))
(luna-define-method elmo-folder-msgdb-create-plugged
(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
rfc2060 set-list)
- (setq rfc2060 (memq 'imap4rev1
- (elmo-imap4-session-capability-internal
- session)))
- (message "Getting overview...")
- (elmo-imap4-session-select-mailbox
- session (elmo-imap4-folder-mailbox-internal folder))
- (setq set-list (elmo-imap4-make-number-set-list
- numbers
- elmo-imap4-overview-fetch-chop-length))
- ;; Setup callback.
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-current-msgdb (elmo-make-msgdb)
- elmo-imap4-seen-messages nil
- elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
- elmo-imap4-fetch-callback-data (cons flag-table folder))
- (while set-list
- (elmo-imap4-send-command-wait
- session
- ;; get overview entity from IMAP4
- (format "%sfetch %s (%s rfc822.size flags)"
- (if elmo-imap4-use-uid "uid " "")
- (cdr (car set-list))
- (if rfc2060
- (format "body.peek[header.fields %s]" headers)
- (format "%s" headers))))
- (when (> length elmo-display-progress-threshold)
- (setq total (+ total (car (car set-list))))
- (elmo-display-progress
- 'elmo-imap4-msgdb-create "Getting overview..."
- (/ (* 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"))
- ;; cannot setup the global flag while retrieval.
- (dolist (number (elmo-msgdb-list-messages elmo-imap4-current-msgdb))
- (elmo-global-flags-set (elmo-msgdb-flags elmo-imap4-current-msgdb
- number)
- folder number
- (elmo-message-entity-field
- (elmo-msgdb-message-entity
- elmo-imap4-current-msgdb number)
- 'message-id)))
- elmo-imap4-current-msgdb))))
+ (setq rfc2060 (elmo-imap4-session-capable-p session 'imap4rev1))
+ (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
+ "Creating msgdb"
+ (elmo-imap4-session-select-mailbox
+ session (elmo-imap4-folder-mailbox-internal folder))
+ (setq set-list (elmo-imap4-make-number-set-list
+ numbers
+ elmo-imap4-overview-fetch-chop-length))
+ ;; Setup callback.
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-current-msgdb (elmo-make-msgdb)
+ elmo-imap4-seen-messages nil
+ elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
+ elmo-imap4-fetch-callback-data (cons flag-table folder))
+ (while set-list
+ (elmo-imap4-send-command-wait
+ session
+ ;; get overview entity from IMAP4
+ (format "%sfetch %s (%s rfc822.size flags)"
+ (if elmo-imap4-use-uid "uid " "")
+ (cdr (car set-list))
+ (if rfc2060
+ (format "body.peek[header.fields %s]" headers)
+ (format "%s" headers))))
+ (setq set-list (cdr set-list)))
+ (when elmo-imap4-seen-messages
+ (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
+ ;; cannot setup the global flag while retrieval.
+ (dolist (number (elmo-msgdb-list-messages elmo-imap4-current-msgdb))
+ (elmo-global-flags-set (elmo-msgdb-flags elmo-imap4-current-msgdb
+ number)
+ folder number
+ (elmo-message-entity-field
+ (elmo-msgdb-message-entity
+ elmo-imap4-current-msgdb number)
+ 'message-id)))
+ elmo-imap4-current-msgdb)))))
(luna-define-method elmo-folder-set-flag-plugged ((folder elmo-imap4-folder)
numbers flag)
(let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
- (when spec
- (elmo-imap4-set-flag folder numbers (car spec) (cdr spec)))))
+ (elmo-imap4-set-flag folder numbers (or (car spec)
+ (capitalize (symbol-name flag)))
+ (nth 1 spec))))
(luna-define-method elmo-folder-unset-flag-plugged ((folder elmo-imap4-folder)
numbers flag)
(let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
- (when spec
- (elmo-imap4-set-flag folder numbers (car spec) (not (cdr spec))))))
+ (elmo-imap4-set-flag folder numbers (or (car spec)
+ (capitalize (symbol-name flag)))
+ (not (nth 1 spec)))))
(luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder)
number)
(defsubst elmo-imap4-folder-diff-plugged (folder)
(let ((session (elmo-imap4-get-session folder))
messages new unread response killed uidnext)
-;;; (elmo-imap4-commit spec)
+;;; (elmo-imap4-commit spec)
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-status-callback nil)
(setq elmo-imap4-status-callback-data nil))
(setq response
(elmo-imap4-read-response session tag))))
(progn
+ (let ((exists (assq 'exists response))) ; update message count,
+ (when exists ; so merge update can go
+ (elmo-folder-set-info-hashtb folder nil (cadr exists))))
(elmo-imap4-session-set-current-mailbox-internal
session mailbox)
(elmo-imap4-session-set-read-only-internal
;; 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
(eval-when-compile
(defmacro elmo-imap4-identical-system-p (folder1 folder2)
"Return t if FOLDER1 and FOLDER2 are in the same IMAP4 system."
- (` (and (string= (elmo-net-folder-server-internal (, folder1))
- (elmo-net-folder-server-internal (, folder2)))
- (eq (elmo-net-folder-port-internal (, folder1))
- (elmo-net-folder-port-internal (, folder2)))
- (string= (elmo-net-folder-user-internal (, folder1))
- (elmo-net-folder-user-internal (, folder2)))))))
+ `(and (string= (elmo-net-folder-server-internal ,folder1)
+ (elmo-net-folder-server-internal ,folder2))
+ (eq (elmo-net-folder-port-internal ,folder1)
+ (elmo-net-folder-port-internal ,folder2))
+ (string= (elmo-net-folder-user-internal ,folder1)
+ (elmo-net-folder-user-internal ,folder2)))))
(luna-define-method elmo-folder-next-message-number-plugged
((folder elmo-imap4-folder))
response (elmo-imap4-response-value response 'status))
(elmo-imap4-response-value response 'uidnext)))
-(luna-define-method elmo-folder-append-messages :around
- ((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))
+(defun elmo-folder-append-messages-imap4-imap4 (dst-folder
+ src-folder
+ numbers
+ same-number)
+ (if (and (elmo-imap4-identical-system-p dst-folder src-folder)
+ (elmo-folder-plugged-p dst-folder))
;; Plugged
(prog1
- (elmo-imap4-copy-messages src-folder folder numbers)
+ (elmo-imap4-copy-messages src-folder dst-folder numbers)
(elmo-progress-notify 'elmo-folder-move-messages (length numbers)))
- (luna-call-next-method)))
+ (elmo-folder-append-messages dst-folder src-folder numbers same-number
+ 'elmo-folder-append-messages-imap4-imap4)))
(luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)
number)
(elmo-imap4-get-session folder)))
elmo-enable-disconnected-operation)) ; offline refile.
-;(luna-define-method elmo-message-fetch-unplugged
-; ((folder elmo-imap4-folder)
-; number strategy &optional section outbuf unseen)
-; (error "%d%s is not cached." number (if section
-; (format "(%s)" section)
-; "")))
+;;;(luna-define-method elmo-message-fetch-unplugged
+;;; ((folder elmo-imap4-folder)
+;;; number strategy &optional section outbuf unseen)
+;;; (error "%d%s is not cached." number (if section
+;;; (format "(%s)" section)
+;;; "")))
(defsubst elmo-imap4-message-fetch (folder number strategy
section outbuf unseen)
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-fetch-callback nil)
(setq elmo-imap4-fetch-callback-data nil))
- (unless elmo-inhibit-display-retrieval-progress
- (setq elmo-imap4-display-literal-progress t))
- (unwind-protect
- (setq response
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s body%s[%s]"
- "fetch %s body%s[%s]")
- number
- (if unseen ".peek" "")
- (or section "")
- )))
- (setq elmo-imap4-display-literal-progress nil))
- (unless elmo-inhibit-display-retrieval-progress
- (elmo-display-progress 'elmo-imap4-display-literal-progress
- "Retrieving..." 100) ; remove progress bar.
- (message "Retrieving...done"))
+ (elmo-with-progress-display (elmo-retrieve-message
+ (elmo-message-field folder number :size)
+ elmo-imap4-literal-progress-reporter)
+ "Retrieving"
+ (setq response
+ (elmo-imap4-send-command-wait session
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s body%s[%s]"
+ "fetch %s body%s[%s]")
+ number
+ (if unseen ".peek" "")
+ (or section "")))))
(if (setq response (elmo-imap4-response-bodydetail-text
(elmo-imap4-response-value-all
response 'fetch)))
(with-current-buffer outbuf
(erase-buffer)
(insert response)
+ (elmo-delete-cr-buffer)
t))))
(luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder)
nil)
(autoload 'elmo-global-flags-set "elmo-flag")
+(autoload 'elmo-get-global-flags "elmo-flag")
(require 'product)
(product-provide (provide 'elmo-imap4) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff