(require 'nnoo)
(require 'netrc)
(require 'utf7)
+(require 'tls)
(require 'parse-time)
(autoload 'auth-source-forget-user-or-password "auth-source")
"How mail is split.
Uses the same syntax as nnmail-split-methods")
+(defvoo nnimap-split-fancy nil
+ "Uses the same syntax as nnmail-split-fancy.")
+
+(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
+ "Emacs 24.1")
+
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
Possible choices are nil (use default methods) or `anonymous'.")
(port nil)
(ports
(cond
- ((eq nnimap-stream 'network)
+ ((or (eq nnimap-stream 'network)
+ (and (eq nnimap-stream 'starttls)
+ (fboundp 'open-gnutls-stream)))
(open-network-stream
"*nnimap*" (current-buffer) nnimap-address
(setq port
(setq port (or nnimap-server-port "imap")))
'("imap"))
((eq nnimap-stream 'starttls)
- (starttls-open-stream
- "*nnimap*" (current-buffer) nnimap-address
- (setq port (or nnimap-server-port "imap")))
+ (let ((tls-program (nnimap-extend-tls-programs)))
+ (open-tls-stream
+ "*nnimap*" (current-buffer) nnimap-address
+ (setq port (or nnimap-server-port "imap"))
+ 'starttls))
'("imap"))
- ((eq nnimap-stream 'ssl)
- (open-tls-stream
- "*nnimap*" (current-buffer) nnimap-address
- (setq port
- (or nnimap-server-port
- (if (netrc-find-service-number "imaps")
- "imaps"
- "993"))))
- '("143" "993" "imap" "imaps"))))
+ ((memq nnimap-stream '(ssl tls))
+ (funcall (if (fboundp 'open-gnutls-stream)
+ 'open-gnutls-stream
+ 'open-tls-stream)
+ "*nnimap*" (current-buffer) nnimap-address
+ (setq port
+ (or nnimap-server-port
+ (if (netrc-find-service-number "imaps")
+ "imaps"
+ "993"))))
+ '("143" "993" "imap" "imaps"))
+ (t
+ (error "Unknown stream type: %s" nnimap-stream))))
connection-result login-result credentials)
(setf (nnimap-process nnimap-object)
(get-buffer-process (current-buffer)))
'(open run))))
(nnheader-report 'nnimap "Unable to contact %s:%s via %s"
nnimap-address port nnimap-stream)
- (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
+ (gnus-set-process-query-on-exit-flag
+ (nnimap-process nnimap-object) nil)
(if (not (setq connection-result (nnimap-wait-for-connection)))
(nnheader-report 'nnimap
"%s" (buffer-substring
#'upcase
(nnimap-find-parameter
"CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
- (when (eq nnimap-stream 'starttls)
- (nnimap-command "STARTTLS")
- (starttls-negotiate (nnimap-process nnimap-object)))
+ (when nnimap-server-port
+ (push (format "%s" nnimap-server-port) ports))
;; If this is a STARTTLS-capable server, then sever the
;; connection and start a STARTTLS connection instead.
- (when (and (eq nnimap-stream 'network)
- (member "STARTTLS" (nnimap-capabilities nnimap-object)))
+ (cond
+ ((and (or (and (eq nnimap-stream 'network)
+ (member "STARTTLS"
+ (nnimap-capabilities nnimap-object)))
+ (eq nnimap-stream 'starttls))
+ (fboundp 'open-gnutls-stream))
+ (nnimap-command "STARTTLS")
+ (gnutls-negotiate (nnimap-process nnimap-object) nil))
+ ((and (eq nnimap-stream 'network)
+ (member "STARTTLS" (nnimap-capabilities nnimap-object)))
(let ((nnimap-stream 'starttls))
- (delete-process (nnimap-process nnimap-object))
- (kill-buffer (current-buffer))
- (return
- (nnimap-open-connection buffer))))
- (when nnimap-server-port
- (push (format "%s" nnimap-server-port) ports))
+ (let ((tls-process
+ (nnimap-open-connection buffer)))
+ ;; If the STARTTLS connection was successful, we
+ ;; kill our first non-encrypted connection. If it
+ ;; wasn't successful, we just use our unencrypted
+ ;; connection.
+ (when (memq (process-status tls-process) '(open run))
+ (delete-process (nnimap-process nnimap-object))
+ (kill-buffer (current-buffer))
+ (return tls-process))))))
(unless (equal connection-result "PREAUTH")
(if (not (setq credentials
(if (eq nnimap-authenticator 'anonymous)
(when nnimap-object
(when (member "QRESYNC" (nnimap-capabilities nnimap-object))
(nnimap-command "ENABLE QRESYNC"))
- t)))))))
+ (nnimap-process nnimap-object))))))))
+
+(defun nnimap-extend-tls-programs ()
+ (let ((programs tls-program)
+ result)
+ (unless (consp programs)
+ (setq programs (list programs)))
+ (dolist (program programs)
+ (when (assoc (car (split-string program)) tls-starttls-switches)
+ (push (if (not (string-match "%s" program))
+ (concat program " " "%s")
+ program)
+ result)))
+ (nreverse result)))
(defun nnimap-find-parameter (parameter elems)
(let (result)
result))
(deffoo nnimap-close-server (&optional server)
- t)
+ (when (nnoo-change-server 'nnimap server nil)
+ (ignore-errors
+ (delete-process (get-buffer-process (nnimap-buffer))))
+ t))
(deffoo nnimap-request-close ()
t)
(nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
(goto-char (point-min))
(when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
- (setq structure (ignore-errors (read (current-buffer)))
+ (setq structure (ignore-errors
+ (let ((start (point)))
+ (forward-sexp 1)
+ (downcase-region start (point))
+ (goto-char (point))
+ (read (current-buffer))))
parts (nnimap-find-wanted-parts structure))))
(when (if parts
(nnimap-get-partial-article article parts structure)
t))
(defun nnimap-insert-partial-structure (structure parts &optional subp)
- (let ((type (car (last structure 4)))
- (boundary (cadr (member "BOUNDARY" (car (last structure 3))))))
+ (let (type boundary)
+ (let ((bstruc structure))
+ (while (consp (car bstruc))
+ (pop bstruc))
+ (setq type (car bstruc))
+ (setq bstruc (car (cdr bstruc)))
+ (when (and (stringp (car bstruc))
+ (string= (downcase (car bstruc)) "boundary"))
+ (setq boundary (cadr bstruc))))
(when subp
(insert (format "Content-type: multipart/%s; boundary=%S\n\n"
(downcase type) boundary)))
(setq marks
(nnimap-flags-to-marks
(nnimap-parse-flags
- (list (list group-sequence flag-sequence 1 group)))))
- (when info
+ (list (list group-sequence flag-sequence
+ 1 group "SELECT")))))
+ (when (and info
+ marks)
(nnimap-update-infos marks (list info)))
(goto-char (point-max))
(let ((uidnext (nth 5 (car marks))))
- (setq high (if uidnext
- (1- uidnext)
- (nth 3 (car marks)))
- low (or (nth 4 (car marks)) uidnext)))))
+ (setq high (or (if uidnext
+ (1- uidnext)
+ (nth 3 (car marks)))
+ 0)
+ low (or (nth 4 (car marks)) uidnext 1)))))
(erase-buffer)
(insert
(format
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "DELETE %S" (utf7-encode group t))))))
+(deffoo nnimap-request-rename-group (group new-name &optional server)
+ (when (nnimap-possibly-change-group nil server)
+ (with-current-buffer (nnimap-buffer)
+ (car (nnimap-command "RENAME %S %S"
+ (utf7-encode group t) (utf7-encode new-name t))))))
+
(deffoo nnimap-request-expunge-group (group &optional server)
(when (nnimap-possibly-change-group group server)
(with-current-buffer (nnimap-buffer)
(defun nnimap-get-flags (spec)
(let ((articles nil)
- elems)
+ elems end)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(nnimap-wait-for-response (nnimap-send-command
"UID FETCH %s FLAGS" spec))
+ (setq end (point))
+ (subst-char-in-region (point-min) (point-max)
+ ?\\ ?% t)
(goto-char (point-min))
- (while (re-search-forward "^\\* [0-9]+ FETCH (\\(.*\\))" nil t)
- (setq elems (nnimap-parse-line (match-string 1)))
- (push (cons (string-to-number (cadr (member "UID" elems)))
- (cadr (member "FLAGS" elems)))
+ (while (search-forward " FETCH " end t)
+ (setq elems (read (current-buffer)))
+ (push (cons (cadr (memq 'UID elems))
+ (cadr (memq 'FLAGS elems)))
articles)))
(nreverse articles)))
(defun nnimap-find-article-by-message-id (group message-id)
- (when (nnimap-possibly-change-group group nil)
- (with-current-buffer (nnimap-buffer)
- (let ((result
- (nnimap-command "UID SEARCH HEADER Message-Id %S" message-id))
- article)
- (when (car result)
- ;; Select the last instance of the message in the group.
- (and (setq article
- (car (last (assoc "SEARCH" (cdr result)))))
- (string-to-number article)))))))
+ (with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (setf (nnimap-group nnimap-object) nil)
+ (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
+ (let ((sequence
+ (nnimap-send-command "UID SEARCH HEADER Message-Id %S" message-id))
+ article result)
+ (setq result (nnimap-wait-for-response sequence))
+ (when (and result
+ (car (setq result (nnimap-parse-response))))
+ ;; Select the last instance of the message in the group.
+ (and (setq article
+ (car (last (assoc "SEARCH" (cdr result)))))
+ (string-to-number article))))))
(defun nnimap-delete-article (articles)
(with-current-buffer (nnimap-buffer)
(when (nnimap-possibly-change-group group server)
(let (sequence)
(with-current-buffer (nnimap-buffer)
+ (erase-buffer)
;; Just send all the STORE commands without waiting for
;; response. If they're successful, they're successful.
(dolist (action actions)
(deffoo nnimap-request-accept-article (group &optional server last)
(when (nnimap-possibly-change-group nil server)
(nnmail-check-syntax)
- (let ((message (buffer-string))
- (message-id (message-field-value "message-id"))
- sequence)
+ (let ((message-id (message-field-value "message-id"))
+ sequence message)
+ (nnimap-add-cr)
+ (setq message (buffer-string))
(with-current-buffer (nnimap-buffer)
(setq sequence (nnimap-send-command
"APPEND %S {%d}" (utf7-encode group t)
(or highest exists)))))))))
t))))
+(deffoo nnimap-request-newgroups (date &optional server)
+ (nnimap-possibly-change-group nil server)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (dolist (group (with-current-buffer (nnimap-buffer)
+ (nnimap-get-groups)))
+ (unless (assoc group nnimap-current-infos)
+ ;; Insert dummy numbers here -- they don't matter.
+ (insert (format "%S 0 1 y\n" group))))
+ t))
+
(deffoo nnimap-retrieve-group-data-early (server infos)
(when (nnimap-possibly-change-group nil server)
(with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (setf (nnimap-group nnimap-object) nil)
;; QRESYNC handling isn't implemented.
- (let ((qresyncp (member "notQRESYNC" (nnimap-capabilities nnimap-object)))
- marks groups sequences)
+ (let ((qresyncp (member "QRESYNC" (nnimap-capabilities nnimap-object)))
+ params groups sequences active uidvalidity modseq group)
;; Go through the infos and gather the data needed to know
;; what and how to request the data.
(dolist (info infos)
- (setq marks (gnus-info-marks info))
- (push (list (gnus-group-real-name (gnus-info-group info))
- (cdr (assq 'active marks))
- (cdr (assq 'uid marks)))
- groups))
- ;; Then request the data.
- (erase-buffer)
- (setf (nnimap-group nnimap-object) nil)
- (dolist (elem groups)
+ (setq params (gnus-info-params info)
+ group (gnus-group-real-name (gnus-info-group info))
+ active (cdr (assq 'active params))
+ uidvalidity (cdr (assq 'uidvalidity params))
+ modseq (cdr (assq 'modseq params)))
(if (and qresyncp
- (nth 2 elem))
+ uidvalidity
+ modseq)
(push
- (list 'qresync
- (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
- (car elem)
- (car (nth 2 elem))
- (cdr (nth 2 elem)))
- nil
- (car elem))
+ (list (nnimap-send-command "EXAMINE %S (QRESYNC (%s %s))"
+ group uidvalidity modseq)
+ 'qresync
+ nil group 'qresync)
sequences)
(let ((start
- (if (nth 1 elem)
+ (if (and active uidvalidity)
;; Fetch the last 100 flags.
- (max 1 (- (cdr (nth 1 elem)) 100))
- 1)))
- (push (list (nnimap-send-command "EXAMINE %S" (car elem))
+ (max 1 (- (cdr active) 100))
+ 1))
+ (command
+ (if uidvalidity
+ "EXAMINE"
+ ;; If we don't have a UIDVALIDITY, then this is
+ ;; the first time we've seen the group, so we
+ ;; have to do a SELECT (which is slower than an
+ ;; examine), but will tell us whether the group
+ ;; is read-only or not.
+ "SELECT")))
+ (push (list (nnimap-send-command "%s %S" command group)
(nnimap-send-command "UID FETCH %d:* FLAGS" start)
- start
- (car elem))
+ start group command)
sequences)))
;; Some servers apparently can't have many outstanding
;; commands, so throttle them.
(nnimap-possibly-change-group nil server))
(with-current-buffer (nnimap-buffer)
;; Wait for the final data to trickle in.
- (when (nnimap-wait-for-response (cadar sequences))
- ;; Now we should have all the data we need, no matter whether
- ;; we're QRESYNCING, fetching all the flags from scratch, or
- ;; just fetching the last 100 flags per group.
+ (when (nnimap-wait-for-response (if (eq (cadar sequences) 'qresync)
+ (caar sequences)
+ (cadar sequences))
+ t)
+ ;; Now we should have most of the data we need, no matter
+ ;; whether we're QRESYNCING, fetching all the flags from
+ ;; scratch, or just fetching the last 100 flags per group.
(nnimap-update-infos (nnimap-flags-to-marks
(nnimap-parse-flags
(nreverse sequences)))
(defun nnimap-update-infos (flags infos)
(dolist (info infos)
- (let ((group (gnus-group-real-name (gnus-info-group info))))
- (nnimap-update-info info (cdr (assoc group flags))))))
+ (let* ((group (gnus-group-real-name (gnus-info-group info)))
+ (marks (cdr (assoc group flags))))
+ (when marks
+ (nnimap-update-info info marks)))))
(defun nnimap-update-info (info marks)
- (when marks
- (destructuring-bind (existing flags high low uidnext start-article
- permanent-flags) marks
- (let ((group (gnus-info-group info))
- (completep (and start-article
- (= start-article 1))))
+ (destructuring-bind (existing flags high low uidnext start-article
+ permanent-flags uidvalidity
+ vanished highestmodseq) marks
+ (cond
+ ;; Ignore groups with no UIDNEXT/marks. This happens for
+ ;; completely empty groups.
+ ((and (not existing)
+ (not uidnext))
+ (let ((active (cdr (assq 'active (gnus-info-params info)))))
+ (when active
+ (gnus-set-active (gnus-info-group info) active))))
+ ;; We have a mismatch between the old and new UIDVALIDITY
+ ;; identifiers, so we have to re-request the group info (the next
+ ;; time). This virtually never happens.
+ ((let ((old-uidvalidity
+ (cdr (assq 'uidvalidity (gnus-info-params info)))))
+ (and old-uidvalidity
+ (not (equal old-uidvalidity uidvalidity))
+ (> start-article 1)))
+ (gnus-group-remove-parameter info 'uidvalidity)
+ (gnus-group-remove-parameter info 'modseq))
+ ;; We have the data needed to update.
+ (t
+ (let* ((group (gnus-info-group info))
+ (completep (and start-article
+ (= start-article 1)))
+ (active (or (gnus-active group)
+ (cdr (assq 'active (gnus-info-params info))))))
(when uidnext
(setq high (1- uidnext)))
;; First set the active ranges based on high/low.
(uidnext
;; No articles in this group.
(cons uidnext (1- uidnext)))
+ (active
+ active)
(start-article
(cons start-article (1- start-article)))
(t
nil)))
(gnus-set-active
group
- (cons (car (gnus-active group))
+ (cons (car active)
(or high (1- uidnext)))))
- (when (and (not high)
- uidnext)
- (setq high (1- uidnext)))
- ;; Then update the list of read articles.
- (let* ((unread
- (gnus-compress-sequence
- (gnus-set-difference
- (gnus-set-difference
- existing
- (cdr (assoc '%Seen flags)))
- (cdr (assoc '%Flagged flags)))))
- (read (gnus-range-difference
- (cons start-article high) unread)))
- (when (> start-article 1)
- (setq read
- (gnus-range-nconcat
- (if (> start-article 1)
- (gnus-sorted-range-intersection
- (cons 1 (1- start-article))
- (gnus-info-read info))
- (gnus-info-read info))
- read)))
- (gnus-info-set-read info read)
- ;; Update the marks.
- (setq marks (gnus-info-marks info))
- ;; Note the active level for the next run-through.
- (let ((active (assq 'active marks)))
- (if active
- (setcdr active (gnus-active group))
- (push (cons 'active (gnus-active group)) marks)))
- (dolist (type (cdr nnimap-mark-alist))
- (let ((old-marks (assoc (car type) marks))
- (new-marks
- (gnus-compress-sequence
- (cdr (or (assoc (caddr type) flags) ; %Flagged
- (assoc (intern (cadr type) obarray) flags)
- (assoc (cadr type) flags)))))) ; "\Flagged"
- (setq marks (delq old-marks marks))
- (pop old-marks)
- (when (and old-marks
- (> start-article 1))
- (setq old-marks (gnus-range-difference
- old-marks
- (cons start-article high)))
- (setq new-marks (gnus-range-nconcat old-marks new-marks)))
- (when new-marks
- (push (cons (car type) new-marks) marks)))
- (gnus-info-set-marks info marks t)
- (nnimap-store-info info (gnus-active group))))))))
+ ;; See whether this is a read-only group.
+ (unless (eq permanent-flags 'not-scanned)
+ (gnus-group-set-parameter
+ info 'permanent-flags
+ (if (memq '%* permanent-flags)
+ t
+ nil)))
+ ;; Update marks and read articles if this isn't a
+ ;; read-only IMAP group.
+ (when (cdr (assq 'permanent-flags (gnus-info-params info)))
+ (if (and highestmodseq
+ (not start-article))
+ ;; We've gotten the data by QRESYNCing.
+ (nnimap-update-qresync-info
+ info existing (nnimap-imap-ranges-to-gnus-ranges vanished) flags)
+ ;; Do normal non-QRESYNC flag updates.
+ ;; Update the list of read articles.
+ (let* ((unread
+ (gnus-compress-sequence
+ (gnus-set-difference
+ (gnus-set-difference
+ existing
+ (cdr (assoc '%Seen flags)))
+ (cdr (assoc '%Flagged flags)))))
+ (read (gnus-range-difference
+ (cons start-article high) unread)))
+ (when (> start-article 1)
+ (setq read
+ (gnus-range-nconcat
+ (if (> start-article 1)
+ (gnus-sorted-range-intersection
+ (cons 1 (1- start-article))
+ (gnus-info-read info))
+ (gnus-info-read info))
+ read)))
+ (gnus-info-set-read info read)
+ ;; Update the marks.
+ (setq marks (gnus-info-marks info))
+ (dolist (type (cdr nnimap-mark-alist))
+ (let ((old-marks (assoc (car type) marks))
+ (new-marks
+ (gnus-compress-sequence
+ (cdr (or (assoc (caddr type) flags) ; %Flagged
+ (assoc (intern (cadr type) obarray) flags)
+ (assoc (cadr type) flags)))))) ; "\Flagged"
+ (setq marks (delq old-marks marks))
+ (pop old-marks)
+ (when (and old-marks
+ (> start-article 1))
+ (setq old-marks (gnus-range-difference
+ old-marks
+ (cons start-article high)))
+ (setq new-marks (gnus-range-nconcat old-marks new-marks)))
+ (when new-marks
+ (push (cons (car type) new-marks) marks)))
+ (gnus-info-set-marks info marks t)))))
+ ;; Note the active level for the next run-through.
+ (gnus-group-set-parameter info 'active (gnus-active group))
+ (gnus-group-set-parameter info 'uidvalidity uidvalidity)
+ (gnus-group-set-parameter info 'modseq highestmodseq)
+ (nnimap-store-info info (gnus-active group)))))))
+
+(defun nnimap-update-qresync-info (info existing vanished flags)
+ ;; Add all the vanished articles to the list of read articles.
+ (gnus-info-set-read
+ info
+ (gnus-range-add (gnus-info-read info)
+ vanished))
+ (let ((marks (gnus-info-marks info)))
+ (dolist (type (cdr nnimap-mark-alist))
+ (let ((ticks (assoc (car type) marks))
+ (new-marks
+ (cdr (or (assoc (caddr type) flags) ; %Flagged
+ (assoc (intern (cadr type) obarray) flags)
+ (assoc (cadr type) flags))))) ; "\Flagged"
+ (setq marks (delq ticks marks))
+ (pop ticks)
+ ;; Add the new marks we got.
+ (setq ticks (gnus-add-to-range ticks new-marks))
+ ;; Remove the marks from messages that don't have them.
+ (setq ticks (gnus-remove-from-range
+ ticks
+ (gnus-compress-sequence
+ (gnus-sorted-complement existing new-marks))))
+ (when ticks
+ (push (cons (car type) ticks) marks)))
+ (gnus-info-set-marks info marks t))))
+
+(defun nnimap-imap-ranges-to-gnus-ranges (irange)
+ (if (zerop (length irange))
+ nil
+ (let ((result nil))
+ (dolist (elem (split-string irange ","))
+ (push
+ (if (string-match ":" elem)
+ (let ((numbers (split-string elem ":")))
+ (cons (string-to-number (car numbers))
+ (string-to-number (cadr numbers))))
+ (string-to-number elem))
+ result))
+ (nreverse result))))
(defun nnimap-store-info (info active)
(let* ((group (gnus-group-real-name (gnus-info-group info)))
(push (list group info active) nnimap-current-infos))))
(defun nnimap-flags-to-marks (groups)
- (let (data group totalp uidnext articles start-article mark permanent-flags)
+ (let (data group totalp uidnext articles start-article mark permanent-flags
+ uidvalidity vanished highestmodseq)
(dolist (elem groups)
(setq group (car elem)
uidnext (nth 1 elem)
start-article (nth 2 elem)
permanent-flags (nth 3 elem)
- articles (nthcdr 4 elem))
+ uidvalidity (nth 4 elem)
+ vanished (nth 5 elem)
+ highestmodseq (nth 6 elem)
+ articles (nthcdr 7 elem))
(let ((high (caar articles))
marks low existing)
(dolist (article articles)
(push (list flag (car article)) marks)
(setcdr mark (cons (car article) (cdr mark))))))
(push (list group existing marks high low uidnext start-article
- permanent-flags)
+ permanent-flags uidvalidity vanished highestmodseq)
data)))
data))
;; Change \Delete etc to %Delete, so that the reader can read it.
(subst-char-in-region (point-min) (point-max)
?\\ ?% t)
- (let (start end articles groups uidnext elems permanent-flags)
+ (let (start end articles groups uidnext elems permanent-flags
+ uidvalidity vanished highestmodseq)
(dolist (elem sequences)
- (destructuring-bind (group-sequence flag-sequence totalp group) elem
+ (destructuring-bind (group-sequence flag-sequence totalp group command)
+ elem
(setq start (point))
- ;; The EXAMINE was successful.
- (when (and (search-forward (format "\n%d OK " group-sequence) nil t)
- (progn
- (forward-line 1)
- (setq end (point))
- (goto-char start)
- (setq permanent-flags
+ (when (and
+ ;; The EXAMINE was successful.
+ (search-forward (format "\n%d OK " group-sequence) nil t)
+ (progn
+ (forward-line 1)
+ (setq end (point))
+ (goto-char start)
+ (setq permanent-flags
+ (if (equal command "SELECT")
(and (search-forward "PERMANENTFLAGS "
- (or end (point-min)) t)
- (read (current-buffer))))
- (goto-char start)
- (setq uidnext
- (and (search-forward "UIDNEXT "
- (or end (point-min)) t)
- (read (current-buffer))))
- (goto-char end)
- (forward-line -1))
- ;; The UID FETCH FLAGS was successful.
- (search-forward (format "\n%d OK " flag-sequence) nil t))
- (setq start (point))
- (goto-char end)
+ (or end (point-min)) t)
+ (read (current-buffer)))
+ 'not-scanned))
+ (goto-char start)
+ (setq uidnext
+ (and (search-forward "UIDNEXT "
+ (or end (point-min)) t)
+ (read (current-buffer))))
+ (goto-char start)
+ (setq uidvalidity
+ (and (re-search-forward "UIDVALIDITY \\([0-9]+\\)"
+ (or end (point-min)) t)
+ ;; Store UIDVALIDITY as a string, as it's
+ ;; too big for 32-bit Emacsen, usually.
+ (match-string 1)))
+ (goto-char start)
+ (setq vanished
+ (and (eq flag-sequence 'qresync)
+ (re-search-forward "VANISHED.* \\([0-9:,]+\\)"
+ (or end (point-min)) t)
+ (match-string 1)))
+ (goto-char start)
+ (setq highestmodseq
+ (and (search-forward "HIGHESTMODSEQ "
+ (or end (point-min)) t)
+ (read (current-buffer))))
+ (goto-char end)
+ (forward-line -1))
+ ;; The UID FETCH FLAGS was successful.
+ (or (eq flag-sequence 'qresync)
+ (search-forward (format "\n%d OK " flag-sequence) nil t)))
+ (if (eq flag-sequence 'qresync)
+ (progn
+ (goto-char start)
+ (setq start end))
+ (setq start (point))
+ (goto-char end))
(while (search-forward " FETCH " start t)
(setq elems (read (current-buffer)))
(push (cons (cadr (memq 'UID elems))
(cadr (memq 'FLAGS elems)))
articles))
- (push (nconc (list group uidnext totalp permanent-flags) articles)
+ (push (nconc (list group uidnext totalp permanent-flags uidvalidity
+ vanished highestmodseq)
+ articles)
groups)
+ (goto-char end)
(setq articles nil))))
groups))
(goto-char (point-min))
(while (and (memq (process-status process)
'(open run))
- (not (re-search-forward "^\\* .*\n" nil t)))
+ (not (re-search-forward "^[*.] .*\n" nil t)))
(nnheader-accept-process-output process)
(goto-char (point-min)))
(forward-line -1)
- (and (looking-at "\\* \\([A-Z0-9]+\\)")
+ (and (looking-at "[*.] \\([A-Z0-9]+\\)")
(match-string 1))))
(defun nnimap-wait-for-response (sequence &optional messagep)
(let ((process (get-buffer-process (current-buffer)))
openp)
- (goto-char (point-max))
- (while (and (setq openp (memq (process-status process)
- '(open run)))
- (not (re-search-backward
- (format "^%d .*\n" sequence)
- (if nnimap-streaming
- (max (point-min) (- (point) 500))
- (point-min))
- t)))
- (when messagep
- (message "Read %dKB" (/ (buffer-size) 1000)))
- (nnheader-accept-process-output process)
- (goto-char (point-max)))
- openp))
+ (condition-case nil
+ (progn
+ (goto-char (point-max))
+ (while (and (setq openp (memq (process-status process)
+ '(open run)))
+ (not (re-search-backward
+ (format "^%d .*\n" sequence)
+ (if nnimap-streaming
+ (max (point-min) (- (point) 500))
+ (point-min))
+ t)))
+ (when messagep
+ (message "nnimap read %dk" (/ (buffer-size) 1000)))
+ (nnheader-accept-process-output process)
+ (goto-char (point-max)))
+ openp)
+ (quit
+ ;; The user hit C-g while we were waiting: kill the process, in case
+ ;; it's a gnutls-cli process that's stuck (tends to happen a lot behind
+ ;; NAT routers).
+ (delete-process process)
+ nil))))
(defun nnimap-parse-response ()
(let ((lines (split-string (nnimap-last-response-string) "\r\n" t))
(push
(cond
((eql char ?\[)
- (split-string (buffer-substring
- (1+ (point))
- (1- (search-forward "]" (line-end-position) 'move)))))
+ (split-string
+ (buffer-substring
+ (1+ (point))
+ (1- (search-forward "]" (line-end-position) 'move)))))
((eql char ?\()
- (split-string (buffer-substring
- (1+ (point))
- (1- (search-forward ")" (line-end-position) 'move)))))
+ (split-string
+ (buffer-substring
+ (1+ (point))
+ (1- (search-forward ")" (line-end-position) 'move)))))
((eql char ?\")
(forward-char 1)
(buffer-substring
(defun nnimap-split-incoming-mail ()
(with-current-buffer (nnimap-buffer)
(let ((nnimap-incoming-split-list nil)
- (nnmail-split-methods nnimap-split-methods)
+ (nnmail-split-methods (if (eq nnimap-split-methods 'default)
+ nnmail-split-methods
+ nnimap-split-methods))
+ (nnmail-split-fancy (or nnimap-split-fancy
+ nnmail-split-fancy))
(nnmail-inhibit-default-split-group t)
(groups (nnimap-get-groups))
new-articles)
(defun nnimap-mark-and-expunge-incoming (range)
(when range
(setq range (nnimap-article-ranges range))
+ (erase-buffer)
(let ((sequence
(nnimap-send-command
"UID STORE %s +FLAGS.SILENT (\\Deleted)" range)))
projects / gnus / blobdiff