(require 'gnus)
(require 'nnoo)
(require 'netrc)
+(require 'utf7)
(require 'parse-time)
+(autoload 'auth-source-forget-user-or-password "auth-source")
+(autoload 'auth-source-user-or-password "auth-source")
+
(nnoo-declare nnimap)
(defvoo nnimap-address nil
(defvoo nnimap-stream 'ssl
"How nnimap will talk to the IMAP server.
-Values are `ssl' and `network'.")
+Values are `ssl', `network', `starttls' or `shell'.")
(defvoo nnimap-shell-program (if (boundp 'imap-shell-program)
(if (listp imap-shell-program)
(defvoo nnimap-inbox nil
"The mail box where incoming mail arrives and should be split out of.")
+(defvoo nnimap-split-methods nil
+ "How mail is split.
+Uses the same syntax as nnmail-split-methods")
+
+(make-obsolete-variable 'nnimap-split-rule "see `nnimap-split-methods'"
+ "Gnus 5.13")
+
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
Possible choices are nil (use default methods) or `anonymous'.")
-(defvoo nnimap-fetch-partial-articles nil
- "If non-nil, nnimap will fetch partial articles.
-If t, nnimap will fetch only the first part. If a string, it
-will fetch all parts that have types that match that string. A
-likely value would be \"text/\" to automatically fetch all
-textual parts.")
-
(defvoo nnimap-expunge t
"If non-nil, expunge articles after deleting them.
This is always done if the server supports UID EXPUNGE, but it's
not done by default on servers that doesn't support that command.")
+(defvoo nnimap-streaming t
+ "If non-nil, try to use streaming commands with IMAP servers.
+Switching this off will make nnimap slower, but it helps with
+some servers.")
(defvoo nnimap-connection-alist nil)
(defvoo nnimap-current-infos nil)
+(defvoo nnimap-fetch-partial-articles nil
+ "If non-nil, Gnus will fetch partial articles.
+If t, nnimap will fetch only the first part. If a string, it
+will fetch all parts that have types that match that string. A
+likely value would be \"text/\" to automatically fetch all
+textual parts.")
+
(defvar nnimap-process nil)
(defvar nnimap-status-string "")
(defvar nnimap-split-download-body-default nil
"Internal variable with default value for `nnimap-split-download-body'.")
+(defvar nnimap-keepalive-timer nil)
+(defvar nnimap-process-buffers nil)
+
(defstruct nnimap
- group process commands capabilities select-result newlinep server)
+ group process commands capabilities select-result newlinep server
+ last-command-time greeting)
(defvar nnimap-object nil)
(download "gnus-download")
(forward "gnus-forward")))
-(defvar nnimap-split-methods nil)
-
(defun nnimap-buffer ()
(nnimap-find-process-buffer nntp-server-buffer))
(erase-buffer)
(when (nnimap-possibly-change-group group server)
(with-current-buffer (nnimap-buffer)
- (nnimap-send-command "SELECT %S" (utf7-encode group t))
(erase-buffer)
(nnimap-wait-for-response
(nnimap-send-command
(nnimap-article-ranges (gnus-compress-sequence articles))
(format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
(format
- (if (member "IMAP4REV1"
- (nnimap-capabilities nnimap-object))
+ (if (nnimap-ver4-p)
"BODY.PEEK[HEADER.FIELDS %s]"
"RFC822.HEADER.LINES %s")
(append '(Subject From Date Message-Id
(nnimap-transform-headers))
(insert-buffer-substring
(nnimap-find-process-buffer (current-buffer))))
- t))
+ 'headers))
(defun nnimap-transform-headers ()
(goto-char (point-min))
- (let (article bytes lines size)
+ (let (article bytes lines size string)
(block nil
(while (not (eobp))
(while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)"))
(delete-region (point) (progn (forward-line 1) (point)))
(when (eobp)
(return)))
- (setq article (match-string 1)
- bytes (nnimap-get-length)
+ (setq article (match-string 1))
+ ;; Unfold quoted {number} strings.
+ (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n"
+ (1+ (line-end-position)) t)
+ (setq size (string-to-number (match-string 1)))
+ (delete-region (+ (match-beginning 0) 2) (point))
+ (setq string (delete-region (point) (+ (point) size)))
+ (insert (format "%S" string)))
+ (setq bytes (nnimap-get-length)
lines nil)
(beginning-of-line)
(setq size
(match-string 1)))
(beginning-of-line)
(when (search-forward "BODYSTRUCTURE" (line-end-position) t)
- (let ((structure (ignore-errors (read (current-buffer)))))
+ (let ((structure (ignore-errors
+ (read (current-buffer)))))
(while (and (consp structure)
(not (stringp (car structure))))
(setq structure (car structure)))
(set (make-local-variable 'nnimap-object)
(make-nnimap :server (nnoo-current-server 'nnimap)))
(push (list buffer (current-buffer)) nnimap-connection-alist)
+ (push (current-buffer) nnimap-process-buffers)
(current-buffer)))
(defun nnimap-open-shell-stream (name buffer host port)
?s host
?p port)))))
-(defun nnimap-credentials (address ports)
+(defun nnimap-credentials (address ports &optional inhibit-create)
(let (port credentials)
;; Request the credentials from all ports, but only query on the
;; last port if all the previous ones have failed.
(setq port (pop ports)))
(setq credentials
(auth-source-user-or-password
- '("login" "password") address port nil (null ports))))
+ '("login" "password") address port nil
+ (if inhibit-create
+ nil
+ (null ports)))))
credentials))
+(defun nnimap-keepalive ()
+ (let ((now (current-time)))
+ (dolist (buffer nnimap-process-buffers)
+ (when (buffer-name buffer)
+ (with-current-buffer buffer
+ (when (and nnimap-object
+ (nnimap-last-command-time nnimap-object)
+ (> (time-to-seconds
+ (time-subtract
+ now
+ (nnimap-last-command-time nnimap-object)))
+ ;; More than five minutes since the last command.
+ (* 5 60)))
+ (nnimap-send-command "NOOP")))))))
+
(defun nnimap-open-connection (buffer)
- (with-current-buffer (nnimap-make-process-buffer buffer)
- (let* ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (ports
- (cond
- ((eq nnimap-stream 'network)
- (open-network-stream
- "*nnimap*" (current-buffer) nnimap-address
- (or nnimap-server-port
- (if (netrc-find-service-number "imap")
- "imap"
- "143")))
- '("143" "imap"))
- ((eq nnimap-stream 'shell)
- (nnimap-open-shell-stream
- "*nnimap*" (current-buffer) nnimap-address
- (or nnimap-server-port "imap"))
- '("imap"))
- ((eq nnimap-stream 'ssl)
- (open-tls-stream
- "*nnimap*" (current-buffer) nnimap-address
- (or nnimap-server-port
- (if (netrc-find-service-number "imaps")
- "imaps"
- "993")))
- '("143" "993" "imap" "imaps"))))
- connection-result login-result credentials)
- (setf (nnimap-process nnimap-object)
- (get-buffer-process (current-buffer)))
- (when (and (nnimap-process nnimap-object)
- (memq (process-status (nnimap-process nnimap-object))
- '(open run)))
- (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil)
- (when (setq connection-result (nnimap-wait-for-connection))
- (unless (equal connection-result "PREAUTH")
- (if (not (setq credentials
- (if (eq nnimap-authenticator 'anonymous)
- (list "anonymous"
- (message-make-address))
- (nnimap-credentials
- nnimap-address
- (if nnimap-server-port
- (cons (format "%s" nnimap-server-port) ports)
- ports)))))
- (setq nnimap-object nil)
- (setq login-result (nnimap-command "LOGIN %S %S"
- (car credentials)
- (cadr credentials)))
- (unless (car login-result)
- (delete-process (nnimap-process nnimap-object))
- (setq nnimap-object nil))))
- (when nnimap-object
+ (unless nnimap-keepalive-timer
+ (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15)
+ 'nnimap-keepalive)))
+ (block nil
+ (with-current-buffer (nnimap-make-process-buffer buffer)
+ (let* ((coding-system-for-read 'binary)
+ (coding-system-for-write 'binary)
+ (port nil)
+ (ports
+ (cond
+ ((eq nnimap-stream 'network)
+ (open-network-stream
+ "*nnimap*" (current-buffer) nnimap-address
+ (setq port
+ (or nnimap-server-port
+ (if (netrc-find-service-number "imap")
+ "imap"
+ "143"))))
+ '("143" "imap"))
+ ((eq nnimap-stream 'shell)
+ (nnimap-open-shell-stream
+ "*nnimap*" (current-buffer) nnimap-address
+ (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")))
+ '("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"))))
+ connection-result login-result credentials)
+ (setf (nnimap-process nnimap-object)
+ (get-buffer-process (current-buffer)))
+ (if (not (and (nnimap-process nnimap-object)
+ (memq (process-status (nnimap-process nnimap-object))
+ '(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)
+ (if (not (setq connection-result (nnimap-wait-for-connection)))
+ (nnheader-report 'nnimap
+ "%s" (buffer-substring
+ (point) (line-end-position)))
+ ;; Store the greeting (for debugging purposes).
+ (setf (nnimap-greeting nnimap-object)
+ (buffer-substring (line-beginning-position)
+ (line-end-position)))
+ ;; Store the capabilities.
(setf (nnimap-capabilities nnimap-object)
(mapcar
#'upcase
- (or (nnimap-find-parameter "CAPABILITY" (cdr login-result))
- (nnimap-find-parameter
- "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
- (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
- (nnimap-command "ENABLE QRESYNC"))
- t))))))
+ (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))
+ (unless (equal connection-result "PREAUTH")
+ (if (not (setq credentials
+ (if (eq nnimap-authenticator 'anonymous)
+ (list "anonymous"
+ (message-make-address))
+ (or
+ ;; First look for the credentials based
+ ;; on the virtual server name.
+ (nnimap-credentials
+ (nnoo-current-server 'nnimap) ports t)
+ ;; Then look them up based on the
+ ;; physical address.
+ (nnimap-credentials nnimap-address ports)))))
+ (setq nnimap-object nil)
+ (setq login-result (nnimap-command "LOGIN %S %S"
+ (car credentials)
+ (cadr credentials)))
+ (unless (car login-result)
+ ;; If the login failed, then forget the credentials
+ ;; that are now possibly cached.
+ (dolist (host (list (nnoo-current-server 'nnimap)
+ nnimap-address))
+ (dolist (port ports)
+ (dolist (element '("login" "password"))
+ (auth-source-forget-user-or-password
+ element host port))))
+ (delete-process (nnimap-process nnimap-object))
+ (setq nnimap-object nil))))
+ (when nnimap-object
+ (when (member "QRESYNC" (nnimap-capabilities nnimap-object))
+ (nnimap-command "ENABLE QRESYNC"))
+ t)))))))
(defun nnimap-find-parameter (parameter elems)
(let (result)
(deffoo nnimap-request-article (article &optional group server to-buffer)
(with-current-buffer nntp-server-buffer
(let ((result (nnimap-possibly-change-group group server))
- parts)
+ parts structure)
(when (stringp article)
(setq article (nnimap-find-article-by-message-id group article)))
(when (and result
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(when nnimap-fetch-partial-articles
- (if (eq nnimap-fetch-partial-articles t)
- (setq parts '(1))
- (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
- (goto-char (point-min))
- (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
- (let ((structure (ignore-errors (read (current-buffer)))))
- (setq parts (nnimap-find-wanted-parts structure))))))
- (setq result
- (nnimap-command
- (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object))
- "UID FETCH %d BODY.PEEK[]"
- "UID FETCH %d RFC822.PEEK")
- article))
- ;; Check that we really got an article.
- (goto-char (point-min))
- (unless (looking-at "\\* [0-9]+ FETCH")
- (setq result nil)))
- (let ((buffer (nnimap-find-process-buffer (current-buffer))))
- (when (car result)
- (with-current-buffer (or to-buffer nntp-server-buffer)
- (insert-buffer-substring buffer)
- (goto-char (point-min))
- (let ((bytes (nnimap-get-length)))
- (delete-region (line-beginning-position)
- (progn (forward-line 1) (point)))
- (goto-char (+ (point) bytes))
- (delete-region (point) (point-max))
- (nnheader-ms-strip-cr))
- (cons group article))))))))
+ (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article)
+ (goto-char (point-min))
+ (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t)
+ (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)
+ (nnimap-get-whole-article article))
+ (let ((buffer (current-buffer)))
+ (with-current-buffer (or to-buffer nntp-server-buffer)
+ (erase-buffer)
+ (insert-buffer-substring buffer)
+ (nnheader-ms-strip-cr)
+ (cons group article)))))))))
+
+(defun nnimap-get-whole-article (article)
+ (let ((result
+ (nnimap-command
+ (if (nnimap-ver4-p)
+ "UID FETCH %d BODY.PEEK[]"
+ "UID FETCH %d RFC822.PEEK")
+ article)))
+ ;; Check that we really got an article.
+ (goto-char (point-min))
+ (unless (re-search-forward "\\* [0-9]+ FETCH" nil t)
+ (setq result nil))
+ (when result
+ ;; Remove any data that may have arrived before the FETCH data.
+ (beginning-of-line)
+ (unless (bobp)
+ (delete-region (point-min) (point)))
+ (let ((bytes (nnimap-get-length)))
+ (delete-region (line-beginning-position)
+ (progn (forward-line 1) (point)))
+ (goto-char (+ (point) bytes))
+ (delete-region (point) (point-max)))
+ t)))
+
+(defun nnimap-ver4-p ()
+ (member "IMAP4REV1" (nnimap-capabilities nnimap-object)))
+
+(defun nnimap-get-partial-article (article parts structure)
+ (let ((result
+ (nnimap-command
+ "UID FETCH %d (%s %s)"
+ article
+ (if (nnimap-ver4-p)
+ "BODY.PEEK[HEADER]"
+ "RFC822.HEADER")
+ (if (nnimap-ver4-p)
+ (mapconcat (lambda (part)
+ (format "BODY.PEEK[%s]" part))
+ parts " ")
+ (mapconcat (lambda (part)
+ (format "RFC822.PEEK[%s]" part))
+ parts " ")))))
+ (when result
+ (nnimap-convert-partial-article structure))))
+
+(defun nnimap-convert-partial-article (structure)
+ ;; First just skip past the headers.
+ (goto-char (point-min))
+ (let ((bytes (nnimap-get-length))
+ id parts)
+ ;; Delete "FETCH" line.
+ (delete-region (line-beginning-position)
+ (progn (forward-line 1) (point)))
+ (goto-char (+ (point) bytes))
+ ;; Collect all the body parts.
+ (while (looking-at ".*BODY\\[\\([.0-9]+\\)\\]")
+ (setq id (match-string 1)
+ bytes (nnimap-get-length))
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (push (list id (buffer-substring (point) (+ (point) bytes)))
+ parts)
+ (delete-region (point) (+ (point) bytes)))
+ ;; Delete trailing junk.
+ (delete-region (point) (point-max))
+ ;; Now insert all the parts again where they fit in the structure.
+ (nnimap-insert-partial-structure structure parts)
+ t))
+
+(defun nnimap-insert-partial-structure (structure parts &optional subp)
+ (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)))
+ (while (not (stringp (car structure)))
+ (insert "\n--" boundary "\n")
+ (if (consp (caar structure))
+ (nnimap-insert-partial-structure (pop structure) parts t)
+ (let ((bit (pop structure)))
+ (insert (format "Content-type: %s/%s"
+ (downcase (nth 0 bit))
+ (downcase (nth 1 bit))))
+ (if (member "CHARSET" (nth 2 bit))
+ (insert (format
+ "; charset=%S\n" (cadr (member "CHARSET" (nth 2 bit)))))
+ (insert "\n"))
+ (insert (format "Content-transfer-encoding: %s\n"
+ (nth 5 bit)))
+ (insert "\n")
+ (when (assoc (nth 9 bit) parts)
+ (insert (cadr (assoc (nth 9 bit) parts)))))))
+ (insert "\n--" boundary "--\n")))
(defun nnimap-find-wanted-parts (structure)
(message-flatten-list (nnimap-find-wanted-parts-1 structure "")))
(number-to-string num)
(format "%s.%s" prefix num)))
parts)
- (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub))))
- (when (string-match nnimap-fetch-partial-articles type)
- (push (if (string= prefix "")
+ (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub)))
+ (id (if (string= prefix "")
(number-to-string num)
- (format "%s.%s" prefix num))
- parts)))
- (incf num))))
+ (format "%s.%s" prefix num))))
+ (setcar (nthcdr 9 sub) id)
+ (when (if (eq nnimap-fetch-partial-articles t)
+ (equal id "1")
+ (string-match nnimap-fetch-partial-articles type))
+ (push id parts))))
+ (incf num)))
(nreverse parts)))
(deffoo nnimap-request-group (group &optional server dont-check info)
(when info
(nnimap-update-infos marks (list info)))
(goto-char (point-max))
- (cond
- (marks
- (setq high (nth 3 (car marks))
- low (nth 4 (car marks))))
- ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t)
- (setq high (1- (string-to-number (match-string 1)))
- low 1)))))
+ (let ((uidnext (nth 5 (car marks))))
+ (setq high (if uidnext
+ (1- uidnext)
+ (nth 3 (car marks)))
+ low (or (nth 4 (car marks)) uidnext)))))
(erase-buffer)
(insert
(format
articles)
((and force
(eq nnmail-expiry-target 'delete))
- (unless (nnimap-delete-article articles)
+ (unless (nnimap-delete-article (gnus-compress-sequence articles))
(message "Article marked for deletion, but not expunged."))
nil)
(t
(let ((deletable-articles
- (if force
+ (if (or force
+ (eq nnmail-expiry-wait 'immediate))
articles
(gnus-sorted-intersection
articles
(if (null deletable-articles)
articles
(if (eq nnmail-expiry-target 'delete)
- (nnimap-delete-article deletable-articles)
+ (nnimap-delete-article (gnus-compress-sequence deletable-articles))
(setq deletable-articles
(nnimap-process-expiry-targets
deletable-articles group server)))
;; Change back to the current group again.
(nnimap-possibly-change-group group server)
(setq deleted-articles (nreverse deleted-articles))
- (nnimap-delete-article deleted-articles)
+ (nnimap-delete-article (gnus-compress-sequence deleted-articles))
deleted-articles))
(defun nnimap-find-expired-articles (group)
(deffoo nnimap-request-scan (&optional group server)
(when (and (nnimap-possibly-change-group nil server)
- (equal group nnimap-inbox)
nnimap-inbox
nnimap-split-methods)
(message "nnimap %s splitting mail..." server)
(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)
+ (nnimap-add-cr)
(let ((message (buffer-string))
(message-id (message-field-value "message-id"))
sequence)
"\n"
"\r\n"))
(let ((result (nnimap-get-response sequence)))
- (when result
+ (if (not (car result))
+ (progn
+ (message "%s" (nnheader-get-report-string 'nnimap))
+ nil)
(cons group
(nnimap-find-article-by-message-id group message-id))))))))
(nnimap-send-command "UID FETCH %d:* FLAGS" start)
start
(car elem))
- sequences))))
+ sequences)))
+ ;; Some servers apparently can't have many outstanding
+ ;; commands, so throttle them.
+ (when (and (not nnimap-streaming)
+ (car sequences))
+ (nnimap-wait-for-response (caar sequences))))
sequences))))
(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
(nnimap-possibly-change-group nil server))
(with-current-buffer (nnimap-buffer)
;; Wait for the final data to trickle in.
- (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.
- (nnimap-update-infos (nnimap-flags-to-marks
- (nnimap-parse-flags
- (nreverse sequences)))
- infos)
- ;; Finally, just return something resembling an active file in
- ;; the nntp buffer, so that the agent can save the info, too.
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (dolist (info infos)
- (let* ((group (gnus-info-group info))
- (active (gnus-active group)))
- (when active
- (insert (format "%S %d %d y\n"
- (gnus-group-real-name group)
- (cdr active)
- (car active))))))))))
+ (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.
+ (nnimap-update-infos (nnimap-flags-to-marks
+ (nnimap-parse-flags
+ (nreverse sequences)))
+ infos)
+ ;; Finally, just return something resembling an active file in
+ ;; the nntp buffer, so that the agent can save the info, too.
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (dolist (info infos)
+ (let* ((group (gnus-info-group info))
+ (active (gnus-active group)))
+ (when active
+ (insert (format "%S %d %d y\n"
+ (gnus-group-real-name group)
+ (cdr active)
+ (car active)))))))))))
(defun nnimap-update-infos (flags infos)
(dolist (info infos)
(let ((group (gnus-info-group info))
(completep (and start-article
(= start-article 1))))
+ (when uidnext
+ (setq high (1- uidnext)))
;; First set the active ranges based on high/low.
(if (or completep
(not (gnus-active group)))
(gnus-set-active group
- (if high
- (cons low high)
+ (cond
+ ((and low high)
+ (cons low high))
+ (uidnext
;; No articles in this group.
- (cons (1- uidnext) uidnext)))
- (setcdr (gnus-active group) high))
+ (cons uidnext (1- uidnext)))
+ (start-article
+ (cons start-article (1- start-article)))
+ (t
+ ;; No articles and no uidnext.
+ nil)))
+ (gnus-set-active
+ group
+ (cons (car (gnus-active group))
+ (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
(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)
(setq mark (assoc flag marks))
(if (not mark)
(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)
- data))))
+ (setcdr mark (cons (car article) (cdr mark))))))
+ (push (list group existing marks high low uidnext start-article
+ permanent-flags)
+ data)))
data))
(defun nnimap-parse-flags (sequences)
(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))
+ (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))
(defun nnimap-command (&rest args)
(erase-buffer)
+ (setf (nnimap-last-command-time nnimap-object) (current-time))
(let* ((sequence (apply #'nnimap-send-command args))
(response (nnimap-get-response sequence)))
(if (equal (caar response) "OK")
(match-string 1))))
(defun nnimap-wait-for-response (sequence &optional messagep)
- (let ((process (get-buffer-process (current-buffer))))
+ (let ((process (get-buffer-process (current-buffer)))
+ openp)
(goto-char (point-max))
- (while (and (memq (process-status process)
- '(open run))
- (not (re-search-backward (format "^%d .*\n" sequence)
- (max (point-min) (- (point) 500))
- t)))
+ (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)))))
+ (goto-char (point-max)))
+ openp))
(defun nnimap-parse-response ()
(let ((lines (split-string (nnimap-last-response-string) "\r\n" t))
(cond
((eql char ?\[)
(split-string (buffer-substring
- (1+ (point)) (1- (search-forward "]")))))
+ (1+ (point))
+ (1- (search-forward "]" (line-end-position) 'move)))))
((eql char ?\()
(split-string (buffer-substring
- (1+ (point)) (1- (search-forward ")")))))
+ (1+ (point))
+ (1- (search-forward ")" (line-end-position) 'move)))))
((eql char ?\")
(forward-char 1)
- (buffer-substring (point) (1- (search-forward "\""))))
+ (buffer-substring
+ (point)
+ (1- (or (search-forward "\"" (line-end-position) 'move)
+ (point)))))
(t
(buffer-substring (point) (if (search-forward " " nil t)
(1- (point))
(nnimap-article-ranges articles)
(format "(UID %s%s)"
(format
- (if (member "IMAP4REV1"
- (nnimap-capabilities nnimap-object))
+ (if (nnimap-ver4-p)
"BODY.PEEK[HEADER] BODY.PEEK"
"RFC822.PEEK"))
(if nnimap-split-download-body-default
(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-inhibit-default-split-group t)
(groups (nnimap-get-groups))
new-articles)
;; And then mark the successful copy actions as deleted,
;; and possibly expunge them.
(nnimap-mark-and-expunge-incoming
- (nnimap-parse-copied-articles sequences))
- (nnimap-mark-and-expunge-incoming junk-articles))))))))
+ (nnimap-parse-copied-articles sequences)))
+ (nnimap-mark-and-expunge-incoming junk-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