Function: gnus-agent-fetch-group-1
gnus-agent-fetch-group-1 is a byte-compiled function defined in
gnus-agent.el.gz.
Signature
(gnus-agent-fetch-group-1 GROUP METHOD)
Documentation
Fetch GROUP.
Source Code
;; Defined in /usr/src/emacs/lisp/gnus/gnus-agent.el.gz
(defun gnus-agent-fetch-group-1 (group method)
"Fetch GROUP."
(let ((gnus-command-method method)
(gnus-newsgroup-name group)
(gnus-newsgroup-dependencies gnus-newsgroup-dependencies)
(gnus-newsgroup-headers gnus-newsgroup-headers)
(gnus-newsgroup-scored gnus-newsgroup-scored)
(gnus-use-cache gnus-use-cache)
(gnus-summary-expunge-below gnus-summary-expunge-below)
(gnus-summary-mark-below gnus-summary-mark-below)
(gnus-orphan-score gnus-orphan-score)
;; Maybe some other gnus-summary local variables should also
;; be put here.
gnus-headers
gnus-score
articles
predicate info marks
)
(unless (gnus-check-group group)
(error "Can't open server for %s" group))
;; Fetch headers.
(when (or gnus-newsgroup-active
(gnus-active group)
(gnus-activate-group group))
(let ((marked-articles gnus-newsgroup-downloadable))
;; Identify the articles marked for download
(unless gnus-newsgroup-active
;; The variable gnus-newsgroup-active was selected as I need
;; a gnus-summary local variable that is NOT bound to any
;; value (its global value should default to nil).
(dolist (mark gnus-agent-download-marks)
(let ((arts (cdr (assq mark (gnus-info-marks
(setq info (gnus-get-info group)))))))
(when arts
(setq marked-articles (nconc (range-uncompress arts)
marked-articles))
))))
(setq marked-articles (sort marked-articles #'<))
;; Fetch any new articles from the server
(setq articles (gnus-agent-fetch-headers group))
;; Merge new articles with marked
(setq articles (sort (append marked-articles articles) #'<))
(when articles
;; Parse them and see which articles we want to fetch.
(setq gnus-newsgroup-dependencies
(or gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles))))
(setq gnus-newsgroup-headers
(or gnus-newsgroup-headers
(gnus-get-newsgroup-headers-xover articles nil nil
group)))
;; `gnus-agent-overview-buffer' may be killed for
;; timeout reason. If so, recreate it.
(gnus-agent-create-buffer)
(setq predicate
(gnus-get-predicate
(gnus-agent-find-parameter group 'agent-predicate)))
;; If the selection predicate requires scoring, score each header
(unless (memq predicate '(gnus-agent-true gnus-agent-false))
(let ((score-param
(gnus-agent-find-parameter group 'agent-score-file)))
;; Translate score-param into real one
(cond
((not score-param))
((eq score-param 'file)
(setq score-param (gnus-all-score-files group)))
((stringp (car score-param)))
(t
(setq score-param (list (list score-param)))))
(when score-param
(gnus-score-headers score-param))))
(unless (and (eq predicate 'gnus-agent-false)
(not marked-articles))
(let ((arts (list nil)))
(let ((arts-tail arts)
(alist (gnus-agent-load-alist group))
(marked-articles marked-articles)
(gnus-newsgroup-headers gnus-newsgroup-headers))
(while (setq gnus-headers (pop gnus-newsgroup-headers))
(let ((num (mail-header-number gnus-headers)))
;; Determine if this article is already in the cache
(while (and alist
(> num (caar alist)))
(setq alist (cdr alist)))
(unless (and (eq num (caar alist))
(cdar alist))
;; Determine if this article was marked for download.
(while (and marked-articles
(> num (car marked-articles)))
(setq marked-articles
(cdr marked-articles)))
;; When this article is marked, or selected by the
;; predicate, add it to the download list
(when (or (eq num (car marked-articles))
(let ((gnus-score
(or (cdr
(assq num gnus-newsgroup-scored))
gnus-summary-default-score))
(gnus-agent-long-article
(gnus-agent-find-parameter
group 'agent-long-article))
(gnus-agent-short-article
(gnus-agent-find-parameter
group 'agent-short-article))
(gnus-agent-low-score
(gnus-agent-find-parameter
group 'agent-low-score))
(gnus-agent-high-score
(gnus-agent-find-parameter
group 'agent-high-score))
(gnus-agent-expire-days
(gnus-agent-find-parameter
group 'agent-days-until-old)))
(funcall predicate)))
(gnus-agent-append-to-list arts-tail num))))))
(let (fetched-articles)
;; Fetch all selected articles
(setq gnus-newsgroup-undownloaded
(gnus-sorted-ndifference
gnus-newsgroup-undownloaded
(setq fetched-articles
(if (cdr arts)
(gnus-agent-fetch-articles group (cdr arts))
nil))))
(let ((unfetched-articles
(gnus-sorted-ndifference (cdr arts) fetched-articles)))
(if gnus-newsgroup-active
;; Update the summary buffer
(progn
(dolist (article marked-articles)
(gnus-summary-set-agent-mark article t))
(dolist (article fetched-articles)
(when gnus-agent-mark-unread-after-downloaded
(setq gnus-newsgroup-downloadable
(delq article gnus-newsgroup-downloadable))
(gnus-summary-mark-article
article gnus-unread-mark))
(when (gnus-summary-goto-subject article nil t)
(gnus-summary-update-download-mark article)))
(dolist (article unfetched-articles)
(gnus-summary-mark-article
article gnus-canceled-mark)))
;; Update the group buffer.
;; When some, or all, of the marked articles came
;; from the download mark. Remove that mark. I
;; didn't do this earlier as I only want to remove
;; the marks after the fetch is completed.
(dolist (mark gnus-agent-download-marks)
(when (eq mark 'download)
(let ((marked-arts
(assq mark (gnus-info-marks
(setq info (gnus-get-info group))))))
(when (cdr marked-arts)
;; FIXME: Use `cl-callf'?
(setq marks
(delq marked-arts (gnus-info-marks info)))
(setf (gnus-info-marks info) marks)))))
(let ((read (gnus-info-read
(or info (setq info (gnus-get-info group))))))
(setf (gnus-info-read info)
(range-add-list read unfetched-articles)))
(gnus-group-update-group group t)
(sit-for 0)
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string info)
")")
(concat "^(gnus-group-set-info '(\""
(regexp-quote group) "\""))))))))))))