(require 'utf7)
(require 'tls)
(require 'parse-time)
+(require 'nnmail)
+
+(eval-when-compile
+ (require 'gnus-sum))
(autoload 'auth-source-forget-user-or-password "auth-source")
(autoload 'auth-source-user-or-password "auth-source")
(defstruct nnimap
group process commands capabilities select-result newlinep server
- last-command-time greeting)
+ last-command-time greeting examined)
(defvar nnimap-object nil)
(with-current-buffer buffer
(when (and nnimap-object
(nnimap-last-command-time nnimap-object)
- (> (time-to-seconds
+ (> (gnus-float-time
(time-subtract
now
(nnimap-last-command-time nnimap-object)))
(* 5 60)))
(nnimap-send-command "NOOP")))))))
-(declare-function gnutls-negotiate "subr" (fn file &optional arglist fileonly))
+(declare-function gnutls-negotiate "gnutls"
+ (proc type &optional priority-string trustfiles keyfiles))
(defun nnimap-open-connection (buffer)
(unless nnimap-keepalive-timer
(setf (nnimap-greeting nnimap-object)
(buffer-substring (line-beginning-position)
(line-end-position)))
- ;; Store the capabilities.
- (setf (nnimap-capabilities nnimap-object)
- (mapcar
- #'upcase
- (nnimap-find-parameter
- "CAPABILITY" (cdr (nnimap-command "CAPABILITY")))))
+ (nnimap-get-capabilities)
(when nnimap-server-port
(push (format "%s" nnimap-server-port) ports))
;; If this is a STARTTLS-capable server, then sever the
(eq nnimap-stream 'starttls))
(fboundp 'open-gnutls-stream))
(nnimap-command "STARTTLS")
- (gnutls-negotiate (nnimap-process nnimap-object) nil))
+ (gnutls-negotiate (nnimap-process nnimap-object) nil)
+ ;; Get the capabilities again -- they may have changed
+ ;; after doing STARTTLS.
+ (nnimap-get-capabilities))
((and (eq nnimap-stream 'network)
(nnimap-capability "STARTTLS"))
(let ((nnimap-stream 'starttls))
(nnimap-command "ENABLE QRESYNC"))
(nnimap-process nnimap-object))))))))
+(defun nnimap-get-capabilities ()
+ (setf (nnimap-capabilities nnimap-object)
+ (mapcar
+ #'upcase
+ (nnimap-find-parameter
+ "CAPABILITY" (cdr (nnimap-command "CAPABILITY"))))))
+
(defun nnimap-quote-specials (string)
(with-temp-buffer
(insert string)
(let ((result (nnimap-possibly-change-group
;; Don't SELECT the group if we're going to select it
;; later, anyway.
- (if dont-check
+ (if (and dont-check
+ (assoc group nnimap-current-infos))
nil
group)
server))
1 group "SELECT")))))
(when (and info
marks)
- (nnimap-update-infos marks (list info)))
+ (nnimap-update-infos marks (list info))
+ (nnimap-store-info info (gnus-active (gnus-info-group info))))
(goto-char (point-max))
(let ((uidnext (nth 5 (car marks))))
(setq high (or (if uidnext
(deffoo nnimap-request-rename-group (group new-name &optional server)
(when (nnimap-possibly-change-group nil server)
(with-current-buffer (nnimap-buffer)
- ;; Make sure we don't have this group open read/write by asking
- ;; to examine a mailbox that doesn't exist. This seems to be
- ;; the only way that allows us to reliably go back to unselected
- ;; state on Courier.
- (nnimap-command "EXAMINE DOES.NOT.EXIST")
- (setf (nnimap-group nnimap-object) nil)
+ (nnimap-unselect-group)
(car (nnimap-command "RENAME %S %S"
(utf7-encode group t) (utf7-encode new-name t))))))
+(defun nnimap-unselect-group ()
+ ;; Make sure we don't have this group open read/write by asking
+ ;; to examine a mailbox that doesn't exist. This seems to be
+ ;; the only way that allows us to reliably go back to unselected
+ ;; state on Courier.
+ (nnimap-command "EXAMINE DOES.NOT.EXIST"))
+
(deffoo nnimap-request-expunge-group (group &optional server)
(when (nnimap-possibly-change-group group server)
(with-current-buffer (nnimap-buffer)
(if internal-move-group
(let ((result
(with-current-buffer (nnimap-buffer)
+ ;; Clear all flags before moving.
+ (nnimap-send-command "UID STORE %d FLAGS.SILENT ()"
+ article)
(nnimap-command "UID COPY %d %S"
article
(utf7-encode internal-move-group t)))))
(defun nnimap-find-article-by-message-id (group message-id)
(with-current-buffer (nnimap-buffer)
(erase-buffer)
- (setf (nnimap-group nnimap-object) nil)
- (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
+ (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)
(nnimap-add-cr)
(setq message (buffer-substring-no-properties (point-min) (point-max)))
(with-current-buffer (nnimap-buffer)
+ ;; If we have this group open read-only, then unselect it
+ ;; before appending to it.
+ (when (equal (nnimap-examined nnimap-object) group)
+ (nnimap-unselect-group))
(erase-buffer)
(setq sequence (nnimap-send-command
"APPEND %S {%d}" (utf7-encode group t)
(with-current-buffer (nnimap-buffer)
(setf (nnimap-group nnimap-object) nil)
(dolist (group groups)
+ (setf (nnimap-examined nnimap-object) group)
(push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t))
group)
sequences))
active (cdr (assq 'active params))
uidvalidity (cdr (assq 'uidvalidity params))
modseq (cdr (assq 'modseq params)))
+ (setf (nnimap-examined nnimap-object) group)
(if (and qresyncp
uidvalidity
modseq)
(not (gnus-active group)))
(gnus-set-active group
(cond
+ (active
+ (cons (min (or low (car active))
+ (car active))
+ (max (or high (cdr active))
+ (cdr active))))
((and low high)
(cons low high))
(uidnext
;; No articles in this group.
(cons uidnext (1- uidnext)))
- (active
- active)
(start-article
(cons start-article (1- start-article)))
(t
nil)
(deffoo nnimap-request-thread (id)
- (let* ((refs (split-string
- (or (mail-header-references (gnus-summary-article-header))
- "")))
- (cmd (let ((value
- (format
- "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
- id id)))
- (dolist (refid refs value)
- (setq value (format
- "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
- refid refid value)))))
- (result
- (with-current-buffer (nnimap-buffer)
- (nnimap-command "UID SEARCH %s" cmd))))
- (gnus-fetch-headers (and (car result)
- (delete 0 (mapcar #'string-to-number
- (cdr (assoc "SEARCH" (cdr result)))))))))
+ (let* ((refs (split-string
+ (or (mail-header-references (gnus-summary-article-header))
+ "")))
+ (cmd (let ((value
+ (format
+ "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
+ id id)))
+ (dolist (refid refs value)
+ (setq value (format
+ "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
+ refid refid value)))))
+ (result (with-current-buffer (nnimap-buffer)
+ (nnimap-command "UID SEARCH %s" cmd))))
+ (gnus-fetch-headers
+ (and (car result) (delete 0 (mapcar #'string-to-number
+ (cdr (assoc "SEARCH" (cdr result))))))
+ nil t)))
(defun nnimap-possibly-change-group (group server)
(let ((open-result t))
(nnimap-wait-for-response sequence)
(nnimap-parse-response))
-(defun nnimap-wait-for-connection (regexp)
+(defun nnimap-wait-for-connection (&optional regexp)
(unless regexp
(setq regexp "^[*.] .*\n"))
(let ((process (get-buffer-process (current-buffer))))
(split-string
(buffer-substring
(1+ (point))
- (1- (search-forward "]" (line-end-position) 'move)))))
+ (if (search-forward "]" (line-end-position) 'move)
+ (1- (point))
+ (point)))))
((eql char ?\()
(split-string
(buffer-substring
(1+ (point))
- (1- (search-forward ")" (line-end-position) 'move)))))
+ (if (search-forward ")" (line-end-position) 'move)
+ (1- (point))
+ (point)))))
((eql char ?\")
(forward-char 1)
(buffer-substring
projects / gnus / blobdiff