(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
cmdstr
(elmo-imap4-format-quoted (nth 1 token)))))
((eq kind 'literal)
- (if (memq 'literal+
- (elmo-imap4-session-capability-internal
- session))
+ (if (elmo-imap4-session-capable-p session 'literal+)
;; rfc2088
(progn
(setq cmdstr (concat cmdstr
(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
;; 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)
(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")
(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")
(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))
(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.
(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))))
(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
"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)
(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)))
projects / elisp / wanderlust.git / blobdiff