(defvoo nnimap-inbox nil
"The mail box where incoming mail arrives and should be split out of.
-For example, \"INBOX\".")
+This can be a string or a list of strings
+For example, \"INBOX\" or (\"INBOX\" \"SENT\").")
(defvoo nnimap-split-methods nil
"How mail is split.
(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
+If t, Gnus 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.")
+(defgroup nnimap nil
+ "IMAP for Gnus."
+ :group 'gnus)
+
+(defcustom nnimap-request-articles-find-limit nil
+ "Limit the number of articles to look for after moving an article."
+ :type 'integer
+ :version "24.3"
+ :group 'nnimap)
+
(defvar nnimap-process nil)
(defvar nnimap-status-string "")
(setq group (nnimap-decode-gnus-group group)))
(with-current-buffer nntp-server-buffer
(erase-buffer)
- (when (nnimap-possibly-change-group group server)
+ (when (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(nnimap-wait-for-response
(while (re-search-forward
"[^]][ (]{\\([0-9]+\\)}\r?\n"
(save-excursion
- (or (re-search-forward "\\* [0-9]+ FETCH" nil t)
+ ;; Start of the header section.
+ (or (re-search-forward "] {[0-9]+}\r?\n" nil t)
+ ;; Start of the next FETCH.
+ (re-search-forward "\\* [0-9]+ FETCH" nil t)
(point-max)))
t)
(setq size (string-to-number (match-string 1)))
(defun nnimap-make-process-buffer (buffer)
(with-current-buffer
- (generate-new-buffer (format "*nnimap %s %s %s*"
+ (generate-new-buffer (format " *nnimap %s %s %s*"
nnimap-address nnimap-server-port
(gnus-buffer-exists-p buffer)))
(mm-disable-multibyte)
(when nnimap-object
(when (nnimap-capability "QRESYNC")
(nnimap-command "ENABLE QRESYNC"))
+ (nnheader-message 7 "Opening connection to %s...done"
+ nnimap-address)
(nnimap-process nnimap-object))))))))
(autoload 'rfc2104-hash "rfc2104")
(when group
(setq group (nnimap-decode-gnus-group group)))
(with-current-buffer nntp-server-buffer
- (let ((result (nnimap-possibly-change-group group server))
+ (let ((result (nnimap-change-group group server))
parts structure)
(when (stringp article)
- (setq article (nnimap-find-article-by-message-id group article)))
+ (setq article (nnimap-find-article-by-message-id group server article)))
(when (and result
article)
(erase-buffer)
(deffoo nnimap-request-head (article &optional group server to-buffer)
(when group
(setq group (nnimap-decode-gnus-group group)))
- (when (nnimap-possibly-change-group group server)
+ (when (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer)
(when (stringp article)
- (setq article (nnimap-find-article-by-message-id group article)))
+ (setq article (nnimap-find-article-by-message-id group server article)))
(if (null article)
nil
(nnimap-get-whole-article
(deffoo nnimap-request-group (group &optional server dont-check info)
(setq group (nnimap-decode-gnus-group group))
- (let ((result (nnimap-possibly-change-group
+ (let ((result (nnimap-change-group
;; Don't SELECT the group if we're going to select it
;; later, anyway.
(if (and (not dont-check)
(deffoo nnimap-request-create-group (group &optional server args)
(setq group (nnimap-decode-gnus-group group))
- (when (nnimap-possibly-change-group nil server)
+ (when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "CREATE %S" (utf7-encode group t))))))
(deffoo nnimap-request-delete-group (group &optional force server)
(setq group (nnimap-decode-gnus-group group))
- (when (nnimap-possibly-change-group nil server)
+ (when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "DELETE %S" (utf7-encode group t))))))
(deffoo nnimap-request-rename-group (group new-name &optional server)
(setq group (nnimap-decode-gnus-group group))
- (when (nnimap-possibly-change-group nil server)
+ (when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
(nnimap-unselect-group)
(car (nnimap-command "RENAME %S %S"
(deffoo nnimap-request-expunge-group (group &optional server)
(setq group (nnimap-decode-gnus-group group))
- (when (nnimap-possibly-change-group group server)
+ (when (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "EXPUNGE")))))
(deffoo nnimap-request-move-article (article group server accept-form
&optional last internal-move-group)
(setq group (nnimap-decode-gnus-group group))
+ (when internal-move-group
+ (setq internal-move-group (nnimap-decode-gnus-group internal-move-group)))
(with-temp-buffer
(mm-disable-multibyte)
(when (funcall (if internal-move-group
(cons internal-move-group
(or (nnimap-find-uid-response "COPYUID" (cadr result))
(nnimap-find-article-by-message-id
- internal-move-group message-id)))))
+ internal-move-group server message-id
+ nnimap-request-articles-find-limit)))))
;; Move the article to a different method.
(let ((result (eval accept-form)))
(when result
+ (nnimap-change-group group server)
(nnimap-delete-article article)
result)))))))
(cond
((null articles)
nil)
- ((not (nnimap-possibly-change-group group server))
+ ((not (nnimap-change-group group server))
articles)
((and force
(eq nnmail-expiry-target 'delete))
(gnus-server-equal (gnus-group-method nnmail-expiry-target)
(gnus-server-to-method
(format "nnimap:%s" server))))
- (and (nnimap-possibly-change-group group server)
+ (and (nnimap-change-group group server)
(with-current-buffer (nnimap-buffer)
(nnheader-message 7 "Expiring articles from %s: %s" group articles)
(nnimap-command
(when target
(push article deleted-articles))))))))
;; Change back to the current group again.
- (nnimap-possibly-change-group group server)
+ (nnimap-change-group group server)
(setq deleted-articles (nreverse deleted-articles))
(nnimap-delete-article (gnus-compress-sequence deleted-articles))
deleted-articles))
(cdr (assoc "SEARCH" (cdr result))))))))))
-(defun nnimap-find-article-by-message-id (group message-id)
+(defun nnimap-find-article-by-message-id (group server message-id
+ &optional limit)
+ "Search for message with MESSAGE-ID in GROUP from SERVER.
+If LIMIT, first try to limit the search to the N last articles."
(with-current-buffer (nnimap-buffer)
(erase-buffer)
- (unless (equal group (nnimap-group nnimap-object))
- (setf (nnimap-group nnimap-object) nil)
- (setf (nnimap-examined nnimap-object) group)
- (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 (cdr (assoc "SEARCH" (cdr result))))))
- (string-to-number article))))))
+ (let* ((change-group-result (nnimap-change-group group server nil t))
+ (number-of-article
+ (and (listp change-group-result)
+ (catch 'found
+ (dolist (result (cdr change-group-result))
+ (when (equal "EXISTS" (cadr result))
+ (throw 'found (car result)))))))
+ (sequence
+ (nnimap-send-command
+ "UID SEARCH%s HEADER Message-Id %S"
+ (if (and limit number-of-article)
+ ;; The -1 is because IMAP message
+ ;; numbers are one-based rather than
+ ;; zero-based.
+ (format " %s:*" (- (string-to-number number-of-article)
+ limit -1))
+ "")
+ message-id)))
+ (when (nnimap-wait-for-response sequence)
+ (let ((article (car (last (cdr (assoc "SEARCH"
+ (nnimap-parse-response)))))))
+ (if article
+ (string-to-number article)
+ (when (and limit number-of-article)
+ (nnimap-find-article-by-message-id group server message-id))))))))
(defun nnimap-delete-article (articles)
(with-current-buffer (nnimap-buffer)
(deffoo nnimap-request-scan (&optional group server)
(when group
(setq group (nnimap-decode-gnus-group group)))
- (when (and (nnimap-possibly-change-group nil server)
+ (when (and (nnimap-change-group nil server)
nnimap-inbox
nnimap-split-methods)
(nnheader-message 7 "nnimap %s splitting mail..." server)
- (nnimap-split-incoming-mail)
+ (if (listp nnimap-inbox)
+ (dolist (nnimap-inbox nnimap-inbox)
+ (nnimap-split-incoming-mail))
+ (nnimap-split-incoming-mail))
(nnheader-message 7 "nnimap %s splitting mail...done" server)))
(defun nnimap-marks-to-flags (marks)
(deffoo nnimap-request-update-group-status (group status &optional server)
(setq group (nnimap-decode-gnus-group group))
- (when (nnimap-possibly-change-group nil server)
+ (when (nnimap-change-group nil server)
(let ((command (assoc
status
'((subscribe "SUBSCRIBE")
(deffoo nnimap-request-set-mark (group actions &optional server)
(setq group (nnimap-decode-gnus-group group))
- (when (nnimap-possibly-change-group group server)
+ (when (nnimap-change-group group server)
(let (sequence)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(deffoo nnimap-request-accept-article (group &optional server last)
(setq group (nnimap-decode-gnus-group group))
- (when (nnimap-possibly-change-group nil server)
+ (when (nnimap-change-group nil server)
(nnmail-check-syntax)
(let ((message-id (message-field-value "message-id"))
sequence message)
(cons group
(or (nnimap-find-uid-response "APPENDUID" (car result))
(nnimap-find-article-by-message-id
- group message-id))))))))))
+ group server message-id
+ nnimap-request-articles-find-limit))))))))))
(defun nnimap-process-quirk (greeting-match type data)
(when (and (nnimap-greeting nnimap-object)
(deffoo nnimap-request-replace-article (article group buffer)
(setq group (nnimap-decode-gnus-group group))
(let (group-art)
- (when (and (nnimap-possibly-change-group group nil)
+ (when (and (nnimap-change-group group)
;; Put the article into the group.
(with-current-buffer buffer
(setq group-art
groups))))
(nreverse groups)))
+(defun nnimap-get-responses (sequences)
+ (let (responses)
+ (dolist (sequence sequences)
+ (goto-char (point-min))
+ (when (re-search-forward (format "^%d " sequence) nil t)
+ (push (list sequence (nnimap-parse-response))
+ responses)))
+ responses))
+
(deffoo nnimap-request-list (&optional server)
- (when (nnimap-possibly-change-group nil server)
+ (when (nnimap-change-group nil server)
(with-current-buffer nntp-server-buffer
(erase-buffer)
(let ((groups
(dolist (response responses)
(let* ((sequence (car response))
(response (cadr response))
- (group (cadr (assoc sequence sequences))))
+ (group (cadr (assoc sequence sequences)))
+ (egroup (encode-coding-string group 'utf-8)))
(when (and group
(equal (caar response) "OK"))
(let ((uidnext (nnimap-find-parameter "UIDNEXT" response))
(setq highest (1- (string-to-number (car uidnext)))))
(cond
((null highest)
- (insert (format "%S 0 1 y\n" (utf7-decode group t))))
+ (insert (format "%S 0 1 y\n" egroup)))
((zerop exists)
;; Empty group.
- (insert (format "%S %d %d y\n"
- (utf7-decode group t)
+ (insert (format "%S %d %d y\n" egroup
highest (1+ highest))))
(t
;; Return the widest possible range.
- (insert (format "%S %d 1 y\n" (utf7-decode group t)
+ (insert (format "%S %d 1 y\n" egroup
(or highest exists)))))))))
t)))))
(deffoo nnimap-request-newgroups (date &optional server)
- (when (nnimap-possibly-change-group nil server)
+ (when (nnimap-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" (utf7-encode group)))))
+ (insert (format "%S 0 1 y\n" (encode-coding-string group 'utf-8)))))
t)))
(deffoo nnimap-retrieve-group-data-early (server infos)
- (when (and (nnimap-possibly-change-group nil server)
+ (when (and (nnimap-change-group nil server)
infos)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(deffoo nnimap-finish-retrieve-group-infos (server infos sequences)
(when (and sequences
- (nnimap-possibly-change-group nil server t)
+ (nnimap-change-group nil server t)
;; Check that the process is still alive.
(get-buffer-process (nnimap-buffer))
(memq (process-status (get-buffer-process (nnimap-buffer)))
(push (cons (car type) new-marks) marks)))))
;; Keep track of non-existing articles.
(let* ((old-unexists (assq 'unexist marks))
+ (active (gnus-active group))
(unexists
(if completep
(gnus-range-difference
- (gnus-active group)
+ active
(gnus-compress-sequence existing))
(gnus-add-to-range
(cdr old-unexists)
(gnus-list-range-difference
existing (gnus-active group))))))
+ (when (> (car active) 1)
+ (setq unexists (gnus-range-add
+ (cons 1 (1- (car active)))
+ unexists)))
(if old-unexists
(setcdr old-unexists unexists)
(push (cons 'unexist unexists) marks)))
(setq nnimap-status-string "Read-only server")
nil)
+(defvar gnus-refer-thread-use-nnir) ;; gnus-sum.el
(declare-function gnus-fetch-headers "gnus-sum"
(articles &optional limit force-new dependencies))
(setq group (nnimap-decode-gnus-group group)))
(if gnus-refer-thread-use-nnir
(nnir-search-thread header)
- (when (nnimap-possibly-change-group group server)
+ (when (nnimap-change-group group server)
(let* ((cmd (nnimap-make-thread-query header))
(result (with-current-buffer (nnimap-buffer)
(nnimap-command "UID SEARCH %s" cmd))))
(cdr (assoc "SEARCH" (cdr result))))))
nil t))))))
-(defun nnimap-possibly-change-group (group server &optional no-reconnect)
+(defun nnimap-change-group (group &optional server no-reconnect read-only)
+ "Change group to GROUP if non-nil.
+If SERVER is set, check that server is connected, otherwise retry
+to reconnect, unless NO-RECONNECT is set to t. Return nil if
+unsuccessful in connecting.
+If GROUP is nil, return t.
+If READ-ONLY is set, send EXAMINE rather than SELECT to the server.
+Return the server's response to the SELECT or EXAMINE command."
(let ((open-result t))
(when (and server
(not (nnimap-server-opened server)))
t)
(t
(with-current-buffer (nnimap-buffer)
- (if (equal group (nnimap-group nnimap-object))
- t
- (let ((result (nnimap-command "SELECT %S" (utf7-encode group t))))
- (when (car result)
- (setf (nnimap-group nnimap-object) group
- (nnimap-select-result nnimap-object) result)
- result))))))))
+ (let ((result (nnimap-command "%s %S"
+ (if read-only
+ "EXAMINE"
+ "SELECT")
+ (utf7-encode group t))))
+ (when (car result)
+ (setf (nnimap-group nnimap-object) group
+ (nnimap-select-result nnimap-object) result)
+ result)))))))
(defun nnimap-find-connection (buffer)
"Find the connection delivering to BUFFER."
(nnimap-wait-for-response nnimap-sequence))
nnimap-sequence)
+(defvar nnimap-record-commands nil
+ "If non-nil, log commands to the \"*imap log*\" buffer.")
+
+(defun nnimap-log-buffer ()
+ (let ((name "*imap log*"))
+ (or (get-buffer name)
+ (with-current-buffer (get-buffer-create name)
+ (when (boundp 'window-point-insertion-type)
+ (make-local-variable 'window-point-insertion-type)
+ (setq window-point-insertion-type t))
+ (current-buffer)))))
+
(defun nnimap-log-command (command)
- (with-current-buffer (get-buffer-create "*imap log*")
- (goto-char (point-max))
- (insert (format-time-string "%H:%M:%S") " "
- (if nnimap-inhibit-logging
- "(inhibited)\n"
- command)))
+ (when nnimap-record-commands
+ (with-current-buffer (nnimap-log-buffer)
+ (goto-char (point-max))
+ (insert (format-time-string "%H:%M:%S")
+ " [" nnimap-address "] "
+ (if nnimap-inhibit-logging
+ "(inhibited)\n"
+ command))))
command)
(defun nnimap-command (&rest args)
(forward-line 1)))
(buffer-substring (point) end))))
-(defun nnimap-get-responses (sequences)
- (let (responses)
- (dolist (sequence sequences)
- (goto-char (point-min))
- (when (re-search-forward (format "^%d " sequence) nil t)
- (push (list sequence (nnimap-parse-response))
- responses)))
- responses))
-
(defvar nnimap-incoming-split-list nil)
(defun nnimap-fetch-inbox (articles)
projects / gnus / blobdiff