(nnimap-find-process-buffer nntp-server-buffer))
(defun nnimap-header-parameters ()
- (format "(UID RFC822.SIZE BODYSTRUCTURE %s)"
- (format
+ (let (params)
+ (push "UID" params)
+ (push "RFC822.SIZE" params)
+ (when (nnimap-capability "X-GM-EXT-1")
+ (push "X-GM-LABELS" params))
+ (push "BODYSTRUCTURE" params)
+ (push (format
(if (nnimap-ver4-p)
"BODY.PEEK[HEADER.FIELDS %s]"
"RFC822.HEADER.LINES %s")
(append '(Subject From Date Message-Id
References In-Reply-To Xref)
- nnmail-extra-headers))))
+ nnmail-extra-headers))
+ params)
+ (format "%s" (nreverse params))))
(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
(when group
(nnimap-article-ranges (gnus-compress-sequence articles))
(nnimap-header-parameters))
t)
+ (unless (process-live-p (get-buffer-process (current-buffer)))
+ (error "Server closed connection"))
(nnimap-transform-headers)
(nnheader-remove-cr-followed-by-lf))
(insert-buffer-substring
(defun nnimap-transform-headers ()
(goto-char (point-min))
- (let (article lines size string)
+ (let (article lines size string labels)
(block nil
(while (not (eobp))
(while (not (looking-at "\\* [0-9]+ FETCH"))
t)
(match-string 1)))
(beginning-of-line)
+ (when (search-forward "X-GM-LABELS" (line-end-position) t)
+ (setq labels (ignore-errors (read (current-buffer)))))
+ (beginning-of-line)
(when (search-forward "BODYSTRUCTURE" (line-end-position) t)
(let ((structure (ignore-errors
(read (current-buffer)))))
(insert (format "Chars: %s\n" size)))
(when lines
(insert (format "Lines: %s\n" lines)))
+ (when labels
+ (insert (format "X-GM-LABELS: %s\n" labels)))
;; Most servers have a blank line after the headers, but
;; Davmail doesn't.
(unless (re-search-forward "^\r$\\|^)\r?$" nil t)
nil
group)
server))
- articles active marks high low)
+ active)
(with-current-buffer nntp-server-buffer
(when result
(when (or (not dont-check)
(nnimap-finish-retrieve-group-infos server (list info) sequences
t)
(setq active (nth 2 (assoc group nnimap-current-infos)))))
+ (erase-buffer)
(insert (format "211 %d %d %d %S\n"
(- (cdr active) (car active))
(car active)
group))
t))))
-(deffoo nnimap-request-scan-group (group &optional server info)
+(deffoo nnimap-request-group-scan (group &optional server info)
(setq group (nnimap-decode-gnus-group group))
- (let (marks high low)
- (with-current-buffer (nnimap-buffer)
- (erase-buffer)
- (let ((group-sequence
- (nnimap-send-command "SELECT %S" (utf7-encode group t)))
- (flag-sequence
- (nnimap-send-command "UID FETCH 1:* FLAGS")))
- (setf (nnimap-group nnimap-object) group)
- (nnimap-wait-for-response flag-sequence)
- (setq marks
- (nnimap-flags-to-marks
- (nnimap-parse-flags
- (list (list group-sequence flag-sequence
- 1 group "SELECT")))))
- (when (and info
- marks)
- (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
- (1- uidnext)
- (nth 3 (car marks)))
- 0)
- low (or (nth 4 (car marks)) uidnext 1)))))
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (insert
- (format
- "211 %d %d %d %S\n" (1+ (- high low)) low high group))
- t)))
+ (when (nnimap-change-group nil server)
+ (let (marks high low)
+ (with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (let ((group-sequence
+ (nnimap-send-command "SELECT %S" (utf7-encode group t)))
+ (flag-sequence
+ (nnimap-send-command "UID FETCH 1:* FLAGS")))
+ (setf (nnimap-group nnimap-object) group)
+ (nnimap-wait-for-response flag-sequence)
+ (setq marks
+ (nnimap-flags-to-marks
+ (nnimap-parse-flags
+ (list (list group-sequence flag-sequence
+ 1 group "SELECT")))))
+ (when (and info
+ marks)
+ (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
+ (1- uidnext)
+ (nth 3 (car marks)))
+ 0)
+ low (or (nth 4 (car marks)) uidnext 1)))))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert
+ (format
+ "211 %d %d %d %S\n" (1+ (- high low)) low high group))
+ t))))
(deffoo nnimap-request-create-group (group &optional server args)
(setq group (nnimap-decode-gnus-group group))
(defun nnimap-find-expired-articles (group)
(let ((cutoff (nnmail-expired-article-p group nil nil)))
- (with-current-buffer (nnimap-buffer)
- (let ((result
- (nnimap-command
- "UID SEARCH SENTBEFORE %s"
- (format-time-string
- (format "%%d-%s-%%Y"
- (upcase
- (car (rassoc (nth 4 (decode-time cutoff))
- parse-time-months))))
- cutoff))))
- (and (car result)
- (delete 0 (mapcar #'string-to-number
- (cdr (assoc "SEARCH" (cdr result))))))))))
-
+ (when cutoff
+ (with-current-buffer (nnimap-buffer)
+ (let ((result
+ (nnimap-command
+ "UID SEARCH SENTBEFORE %s"
+ (format-time-string
+ (format "%%d-%s-%%Y"
+ (upcase
+ (car (rassoc (nth 4 (decode-time cutoff))
+ parse-time-months))))
+ cutoff))))
+ (and (car result)
+ (delete 0 (mapcar #'string-to-number
+ (cdr (assoc "SEARCH" (cdr result)))))))))))
(defun nnimap-find-article-by-message-id (group server message-id
&optional limit)
(while (search-forward "* LIST " nil t)
(let ((flags (read (current-buffer)))
(separator (read (current-buffer)))
- (group (read (current-buffer))))
+ (group (buffer-substring-no-properties
+ (progn (skip-chars-forward " \"")
+ (point))
+ (progn (end-of-line)
+ (skip-chars-backward " \r\"")
+ (point)))))
(unless (member '%NoSelect flags)
(push (utf7-decode (if (stringp group)
group
(ranges (cdr spec)))
(if (eq group 'junk)
(setq junk-articles ranges)
- (push (list (nnimap-send-command
- "UID COPY %s %S"
- (nnimap-article-ranges ranges)
- (utf7-encode group t))
- ranges)
- sequences))))
+ ;; Don't copy if the message is already in its
+ ;; target group.
+ (unless (string= group nnimap-inbox)
+ (push (list (nnimap-send-command
+ "UID COPY %s %S"
+ (nnimap-article-ranges ranges)
+ (utf7-encode group t))
+ ranges)
+ sequences)))))
;; Wait for the last COPY response...
(when sequences
(nnimap-wait-for-response (caar sequences))
projects / gnus / blobdiff