+ (let ((article article)
+ query)
+ (when (stringp article)
+ (setq gnus-override-method (gnus-server-to-method server))
+ (setq query
+ (list
+ (cons 'query (format "HEADER Message-ID %s" article))
+ (cons 'criteria "")
+ (cons 'shortcut t)))
+ (unless (and nnir-artlist (equal query nnir-memo-query)
+ (equal server nnir-memo-server))
+ (setq nnir-artlist (nnir-run-imap query server)
+ nnir-memo-query query
+ nnir-memo-server server))
+ (setq article 1))
+ (unless (zerop (nnir-artlist-length nnir-artlist))
+ (let ((artfullgroup (nnir-article-group article))
+ (artno (nnir-article-number article)))
+ (message "Requesting article %d from group %s"
+ artno artfullgroup)
+ (if to-buffer
+ (with-current-buffer to-buffer
+ (let ((gnus-article-decode-hook nil))
+ (gnus-request-article-this-buffer artno artfullgroup)))
+ (gnus-request-article artno artfullgroup))
+ (cons artfullgroup artno)))))))
+
+(deffoo nnir-request-move-article (article group server accept-form
+ &optional last internal-move-group)
+ (nnir-possibly-change-group group server)
+ (let* ((artfullgroup (nnir-article-group article))
+ (artno (nnir-article-number article))
+ (to-newsgroup (nth 1 accept-form))
+ (to-method (gnus-find-method-for-group to-newsgroup))
+ (from-method (gnus-find-method-for-group artfullgroup))
+ (move-is-internal (gnus-server-equal from-method to-method)))
+ (unless (gnus-check-backend-function
+ 'request-move-article artfullgroup)
+ (error "The group %s does not support article moving" artfullgroup))
+ (gnus-request-move-article
+ artno
+ artfullgroup
+ (nth 1 from-method)
+ accept-form
+ last
+ (and move-is-internal
+ to-newsgroup ; Not respooling
+ (gnus-group-real-name to-newsgroup)))))
+
+(deffoo nnir-request-expire-articles (articles group &optional server force)
+ (nnir-possibly-change-group group server)
+ (if force
+ (let ((articles-by-group (nnir-categorize
+ articles nnir-article-group nnir-article-ids))
+ not-deleted)
+ (while (not (null articles-by-group))
+ (let* ((group-articles (pop articles-by-group))
+ (artgroup (car group-articles))
+ (articleids (cadr group-articles))
+ (artlist (sort (mapcar 'cdr articleids) '<)))
+ (unless (gnus-check-backend-function 'request-expire-articles
+ artgroup)
+ (error "The group %s does not support article deletion" artgroup))
+ (unless (gnus-check-server (gnus-find-method-for-group artgroup))
+ (error "Couldn't open server for group %s" artgroup))
+ (push (gnus-request-expire-articles
+ artlist artgroup force)
+ not-deleted)))
+ (sort (delq nil not-deleted) '<))
+ articles))
+
+(deffoo nnir-warp-to-article ()
+ (nnir-possibly-change-group gnus-newsgroup-name)
+ (let* ((cur (if (> (gnus-summary-article-number) 0)
+ (gnus-summary-article-number)
+ (error "Can't warp to a pseudo-article")))
+ (backend-article-group (nnir-article-group cur))
+ (backend-article-number (nnir-article-number cur))
+ (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name)))
+
+ ;; what should we do here? we could leave all the buffers around
+ ;; and assume that we have to exit from them one by one. or we can
+ ;; try to clean up directly
+
+ ;;first exit from the nnir summary buffer.
+; (gnus-summary-exit)
+ ;; and if the nnir summary buffer in turn came from another
+ ;; summary buffer we have to clean that summary up too.
+ ; (when (not (eq (cdr quit-config) 'group))
+; (gnus-summary-exit))
+ (gnus-summary-read-group-1 backend-article-group t t nil
+ nil (list backend-article-number))))
+
+(deffoo nnir-request-update-mark (group article mark)
+ (let ((artgroup (nnir-article-group article))
+ (artnumber (nnir-article-number article)))
+ (when (and artgroup artnumber)
+ (gnus-request-update-mark artgroup artnumber mark))))
+
+(deffoo nnir-request-set-mark (group actions &optional server)
+ (nnir-possibly-change-group group server)
+ (let (mlist)
+ (dolist (action actions)
+ (destructuring-bind (range action marks) action
+ (let ((articles-by-group (nnir-categorize
+ (gnus-uncompress-range range)
+ nnir-article-group nnir-article-number)))
+ (dolist (artgroup articles-by-group)
+ (push (list
+ (car artgroup)
+ (list (gnus-compress-sequence
+ (sort (cadr artgroup) '<)) action marks)) mlist)))))
+ (dolist (request (nnir-categorize mlist car cadr))
+ (gnus-request-set-mark (car request) (cadr request)))))
+
+
+(deffoo nnir-request-update-info (group info &optional server)
+ (nnir-possibly-change-group group server)
+ ;; clear out all existing marks.
+ (gnus-info-set-marks info nil)
+ (gnus-info-set-read info nil)
+ (let ((group (gnus-group-guess-full-name-from-command-method group))
+ (articles-by-group
+ (nnir-categorize
+ (gnus-uncompress-range (cons 1 (nnir-artlist-length nnir-artlist)))
+ nnir-article-group nnir-article-ids)))
+ (gnus-set-active group
+ (cons 1 (nnir-artlist-length nnir-artlist)))
+ (while (not (null articles-by-group))
+ (let* ((group-articles (pop articles-by-group))
+ (articleids (reverse (cadr group-articles)))
+ (group-info (gnus-get-info (car group-articles)))
+ (marks (gnus-info-marks group-info))
+ (read (gnus-info-read group-info)))
+ (gnus-info-set-read
+ info
+ (gnus-add-to-range
+ (gnus-info-read info)
+ (delq nil
+ (mapcar
+ #'(lambda (art)
+ (when (gnus-member-of-range (cdr art) read) (car art)))
+ articleids))))
+ (dolist (mark marks)
+ (destructuring-bind (type . range) mark
+ (gnus-add-marked-articles
+ group type
+ (delq nil
+ (mapcar
+ #'(lambda (art)
+ (when (gnus-member-of-range (cdr art) range) (car art)))
+ articleids)))))))))
+
+
+(deffoo nnir-close-group (group &optional server)
+ (nnir-possibly-change-group group server)
+ (let ((pgroup (gnus-group-guess-full-name-from-command-method group)))
+ (when (and nnir-artlist (not (gnus-ephemeral-group-p pgroup)))
+ (gnus-group-set-parameter pgroup 'nnir-artlist nnir-artlist))
+ (setq nnir-artlist nil)
+ (when (gnus-ephemeral-group-p pgroup)
+ (gnus-kill-ephemeral-group pgroup)
+ (setq gnus-ephemeral-servers
+ (delq (assq 'nnir gnus-ephemeral-servers)
+ gnus-ephemeral-servers)))))
+;; (gnus-opened-servers-remove
+;; (car (assoc '(nnir "nnir-ephemeral" (nnir-address "nnir"))
+;; gnus-opened-servers))))