X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=aecd9f771c24a8e2ffa6de292c8f8c8b047fd32c;hb=0fb3ca6ec4c82ed8de7880a455c20e47e6017b3a;hp=7d8afef33581b95559789539aaef2ceb6495da2a;hpb=b7e45860debf48b59bb4b4afba22c6baffe53b77;p=gnus diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 7d8afef33..aecd9f771 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -128,6 +128,18 @@ If this is `ask' the hook will query the user." (const :tag "Ask" ask)) :group 'gnus-agent) +(defcustom gnus-agent-mark-unread-after-downloaded t + "Indicate whether to mark articles unread after downloaded." + :version "21.1" + :type 'boolean + :group 'gnus-agent) + +(defcustom gnus-agent-download-marks '(download) + "Marks for downloading." + :version "21.1" + :type '(repeat (symbol :tag "Mark")) + :group 'gnus-agent) + ;;; Internal variables (defvar gnus-agent-history-buffers nil) @@ -313,7 +325,7 @@ If this is `ask' the hook will query the user." ["Mark as downloadable" gnus-agent-mark-article t] ["Unmark as downloadable" gnus-agent-unmark-article t] ["Toggle mark" gnus-agent-toggle-mark t] - ["Fetch downloadable" gnus-aget-summary-fetch-group t] + ["Fetch downloadable" gnus-agent-summary-fetch-group t] ["Catchup undownloaded" gnus-agent-catchup t])))) (defvar gnus-agent-server-mode-map (make-sparse-keymap)) @@ -345,7 +357,7 @@ If this is `ask' the hook will query the user." (progn (setq gnus-plugged plugged) (gnus-run-hooks 'gnus-agent-plugged-hook) - (setcar (cdr gnus-agent-mode-status) + (setcar (cdr gnus-agent-mode-status) (gnus-agent-make-mode-line-string " Plugged" 'mouse-2 'gnus-agent-toggle-plugged)) @@ -354,7 +366,7 @@ If this is `ask' the hook will query the user." (gnus-agent-close-connections) (setq gnus-plugged plugged) (gnus-run-hooks 'gnus-agent-unplugged-hook) - (setcar (cdr gnus-agent-mode-status) + (setcar (cdr gnus-agent-mode-status) (gnus-agent-make-mode-line-string " Unplugged" 'mouse-2 'gnus-agent-toggle-plugged))) @@ -380,6 +392,13 @@ If this is `ask' the hook will query the user." (setq gnus-plugged t) (gnus)) +;;;###autoload +(defun gnus-slave-unplugged (&optional arg) + "Read news as a slave unplugged." + (interactive "P") + (setq gnus-plugged nil) + (gnus arg nil 'slave)) + ;;;###autoload (defun gnus-agentize () "Allow Gnus to be an offline newsreader. @@ -609,8 +628,12 @@ be a select method." (defun gnus-agent-read-servers () "Read the alist of covered servers." (setq gnus-agent-covered-methods - (gnus-agent-read-file - (nnheader-concat gnus-agent-directory "lib/servers")))) + (mapcar (lambda (m) + (gnus-server-get-method + nil + (or m "native"))) + (gnus-agent-read-file + (nnheader-concat gnus-agent-directory "lib/servers"))))) (defun gnus-agent-write-servers () "Write the alist of covered servers." @@ -618,7 +641,8 @@ be a select method." (let ((coding-system-for-write nnheader-file-coding-system) (file-name-coding-system nnmail-pathname-coding-system)) (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers") - (prin1 gnus-agent-covered-methods (current-buffer))))) + (prin1 (mapcar 'gnus-method-simplify gnus-agent-covered-methods) + (current-buffer))))) ;;; ;;; Summary commands @@ -671,7 +695,8 @@ the actual number of articles toggled is returned." (push article gnus-newsgroup-undownloaded)) (setq gnus-newsgroup-undownloaded (delq article gnus-newsgroup-undownloaded)) - (push article gnus-newsgroup-downloadable)) + (setq gnus-newsgroup-downloadable + (gnus-add-to-sorted-list gnus-newsgroup-downloadable article))) (gnus-summary-update-mark (if unmark gnus-undownloaded-mark gnus-downloadable-mark) 'unread))) @@ -732,7 +757,8 @@ the actual number of articles toggled is returned." (dolist (article articles) (setq gnus-newsgroup-downloadable (delq article gnus-newsgroup-downloadable)) - (gnus-summary-mark-article article gnus-unread-mark)))) + (if gnus-agent-mark-unread-after-downloaded + (gnus-summary-mark-article article gnus-unread-mark))))) (when (and (not state) gnus-plugged) (gnus-agent-toggle-plugged nil))))) @@ -800,7 +826,7 @@ the actual number of articles toggled is returned." (goto-char (point-min)) (when (re-search-forward (concat "^" (regexp-quote group) " ") nil t) - (save-excursion + (save-excursion (read (current-buffer)) ;; max (setq oactive-min (read (current-buffer)))) ;; min (gnus-delete-line)) @@ -960,7 +986,7 @@ the actual number of articles toggled is returned." (goto-char (match-end 0))) (gnus-agent-crosspost crosses (caar pos)))) (goto-char (point-min)) - (if (not (re-search-forward + (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t)) (setq id "No-Message-ID-in-article") (setq id (buffer-substring (match-beginning 1) (match-end 1)))) @@ -1033,9 +1059,9 @@ the actual number of articles toggled is returned." (setq articles (sort (gnus-uncompress-sequence articles) '<)) ;; Remove known articles. (when (gnus-agent-load-alist group) - (setq articles (gnus-sorted-intersection + (setq articles (gnus-list-range-intersection articles - (gnus-uncompress-range + (list (cons (1+ (caar (last gnus-agent-article-alist))) (cdr (gnus-active group))))))) ;; Fetch them. @@ -1044,11 +1070,11 @@ the actual number of articles toggled is returned." (when articles (gnus-message 7 "Fetching headers for %s..." group) (save-excursion - (set-buffer nntp-server-buffer) - (unless (eq 'nov (gnus-retrieve-headers articles group)) - (nnvirtual-convert-headers)) - ;; Save these headers for later processing. - (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) + (set-buffer nntp-server-buffer) + (unless (eq 'nov (gnus-retrieve-headers articles group)) + (nnvirtual-convert-headers)) + ;; Save these headers for later processing. + (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) (when (file-exists-p file) (gnus-agent-braid-nov group articles file)) (let ((coding-system-for-write @@ -1062,59 +1088,56 @@ the actual number of articles toggled is returned." articles)))) (defsubst gnus-agent-copy-nov-line (article) - (let (b e) + (let (art b e) (set-buffer gnus-agent-overview-buffer) - (unless (eobp) + (while (and (not (eobp)) + (< (setq art (read (current-buffer))) article)) + (forward-line 1)) + (beginning-of-line) + (if (or (eobp) + (not (eq article art))) + (set-buffer nntp-server-buffer) (setq b (point)) - (if (eq article (read (current-buffer))) - (setq e (progn (forward-line 1) (point))) - (progn - (beginning-of-line) - (setq e b))) + (setq e (progn (forward-line 1) (point))) (set-buffer nntp-server-buffer) (insert-buffer-substring gnus-agent-overview-buffer b e)))) (defun gnus-agent-braid-nov (group articles file) - (set-buffer gnus-agent-overview-buffer) - (goto-char (point-min)) - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-file-contents file) - (goto-char (point-max)) - (if (or (= (point-min) (point-max)) - (progn - (forward-line -1) - (< (read (current-buffer)) (car articles)))) - ;; We have only headers that are after the older headers, - ;; so we just append them. - (progn - (goto-char (point-max)) - (insert-buffer-substring gnus-agent-overview-buffer)) - ;; We do it the hard way. - (nnheader-find-nov-line (car articles)) - (gnus-agent-copy-nov-line (car articles)) - (pop articles) - (while (and articles - (not (eobp))) - (while (and (not (eobp)) - (< (read (current-buffer)) (car articles))) - (forward-line 1)) - (beginning-of-line) - (unless (eobp) - (gnus-agent-copy-nov-line (car articles)) - (setq articles (cdr articles)))) + (let (start last) + (set-buffer gnus-agent-overview-buffer) + (goto-char (point-min)) (set-buffer nntp-server-buffer) + (erase-buffer) + (nnheader-insert-file-contents file) + (goto-char (point-max)) + (unless (or (= (point-min) (point-max)) + (progn + (forward-line -1) + (< (setq last (read (current-buffer))) (car articles)))) + ;; We do it the hard way. + (nnheader-find-nov-line (car articles)) + (gnus-agent-copy-nov-line (pop articles)) + (while (and articles + (not (eobp))) + (while (and (not (eobp)) + (< (read (current-buffer)) (car articles))) + (forward-line 1)) + (beginning-of-line) + (unless (eobp) + (gnus-agent-copy-nov-line (pop articles))))) + ;; Copy the rest lines + (set-buffer nntp-server-buffer) + (goto-char (point-max)) (when articles - (let (b e) + (when last (set-buffer gnus-agent-overview-buffer) - (setq b (point) - e (point-max)) (while (and (not (eobp)) - (<= (read (current-buffer)) (car articles))) - (forward-line 1) - (setq b (point))) - (set-buffer nntp-server-buffer) - (insert-buffer-substring gnus-agent-overview-buffer b e))))) + (<= (read (current-buffer)) last)) + (forward-line 1)) + (beginning-of-line) + (setq start (point)) + (set-buffer nntp-server-buffer)) + (insert-buffer-substring gnus-agent-overview-buffer start)))) (defun gnus-agent-load-alist (group &optional dir) "Load the article-state alist for GROUP." @@ -1196,12 +1219,12 @@ the actual number of articles toggled is returned." (gnus-agent-fetch-group-1 group gnus-command-method)))))) (error (unless (funcall gnus-agent-confirmation-function - (format "Error (%s). Continue? " err)) + (format "Error (%s). Continue? " (cadr err))) (error "Cannot fetch articles into the Gnus agent"))) (quit (unless (funcall gnus-agent-confirmation-function (format "Quit fetching session (%s). Continue? " - err)) + (cadr err))) (signal 'quit "Cannot fetch articles into the Gnus agent")))) (pop methods)) (run-hooks 'gnus-agent-fetch-hook) @@ -1271,18 +1294,20 @@ the actual number of articles toggled is returned." (when arts (gnus-agent-fetch-articles group arts))) ;; Perhaps we have some additional articles to fetch. - (setq arts (assq 'download (gnus-info-marks - (setq info (gnus-get-info group))))) - (when (cdr arts) - (gnus-message 8 "Agent is downloading marked articles...") - (gnus-agent-fetch-articles - group (gnus-uncompress-range (cdr arts))) - (setq marks (delq arts (gnus-info-marks info))) - (gnus-info-set-marks info marks) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string info) - ")"))))) + (dolist (mark gnus-agent-download-marks) + (setq arts (assq mark (gnus-info-marks + (setq info (gnus-get-info group))))) + (when (cdr arts) + (gnus-message 8 "Agent is downloading marked articles...") + (gnus-agent-fetch-articles + group (gnus-uncompress-range (cdr arts))) + (when (eq mark 'download) + (setq marks (delq arts (gnus-info-marks info))) + (gnus-info-set-marks info marks) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string info) + ")"))))))) ;;; ;;; Agent Category Mode @@ -1606,9 +1631,11 @@ The following commands are available: (defun gnus-get-predicate (predicate) "Return the predicate for CATEGORY." (or (cdr (assoc predicate gnus-category-predicate-cache)) - (cdar (push (cons predicate - (gnus-category-make-function predicate)) - gnus-category-predicate-cache)))) + (let ((func (gnus-category-make-function predicate))) + (setq gnus-category-predicate-cache + (nconc gnus-category-predicate-cache + (list (cons predicate func)))) + func))) (defun gnus-group-category (group) "Return the category GROUP belongs to." @@ -1623,15 +1650,20 @@ The following commands are available: (or (gnus-gethash group gnus-category-group-cache) (assq 'default gnus-category-alist))) -(defun gnus-agent-expire () - "Expire all old articles." +(defun gnus-agent-expire (&optional articles group force) + "Expire all old articles. +If you want to force expiring of certain articles, this function can +take ARTICLES, GROUP and FORCE parameters as well. Setting ARTICLES +and GROUP without FORCE is not supported." (interactive) - (let ((methods gnus-agent-covered-methods) + (let ((methods (if group + (list (gnus-find-method-for-group group)) + gnus-agent-covered-methods)) (day (if (numberp gnus-agent-expire-days) (- (time-to-days (current-time)) gnus-agent-expire-days) nil)) (current-day (time-to-days (current-time))) - gnus-command-method sym group articles + gnus-command-method sym arts pos history overview file histories elem art nov-file low info unreads marked article orig lowest highest found days) (save-excursion @@ -1650,172 +1682,196 @@ The following commands are available: (setq gnus-agent-current-history (setq history (gnus-agent-history-buffer)))) (goto-char (point-min)) - (when (> (buffer-size) 1) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^\t") - (if (let ((fetch-date (read (current-buffer)))) - (if (numberp fetch-date) - ;; We now have the arrival day, so we see - ;; whether it's old enough to be expired. - (if (numberp day) - (> fetch-date day) - (skip-chars-forward "\t") - (setq found nil - days gnus-agent-expire-days) - (while (and (not found) - days) - (when (looking-at (caar days)) - (setq found (cadar days))) - (pop days)) - (> fetch-date (- current-day found))) - ;; History file is corrupted. - (gnus-message - 5 - (format "File %s is corrupted!" - (gnus-agent-lib-file "history"))) - (sit-for 1) - ;; Ignore it - t)) - ;; New article; we don't expire it. - (forward-line 1) - ;; Old article. Schedule it for possible nuking. - (while (not (eolp)) - (setq sym (let ((obarray expiry-hashtb) s) - (setq s (read (current-buffer))) - (if (stringp s) (intern s) s))) - (if (boundp sym) - (set sym (cons (cons (read (current-buffer)) (point)) - (symbol-value sym))) - (set sym (list (cons (read (current-buffer)) (point))))) - (skip-chars-forward " ")) - (forward-line 1))) - ;; We now have all articles that can possibly be expired. - (mapatoms - (lambda (sym) - (setq group (symbol-name sym) - articles (sort (symbol-value sym) 'car-less-than-car) - low (car (gnus-active group)) - info (gnus-get-info group) - unreads (ignore-errors - (gnus-list-of-unread-articles group)) - marked (nconc - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant - (gnus-info-marks info))))) - nov-file (gnus-agent-article-name ".overview" group) - lowest nil - highest nil) - (gnus-agent-load-alist group) - (gnus-message 5 "Expiring articles in %s" group) - (set-buffer overview) - (erase-buffer) - (when (file-exists-p nov-file) - (nnheader-insert-file-contents nov-file)) - (goto-char (point-min)) - (setq article 0) - (while (setq elem (pop articles)) - (setq article (car elem)) - (when (or (null low) - (< article low) - gnus-agent-expire-all - (and (not (memq article unreads)) - (not (memq article marked)))) - ;; Find and nuke the NOV line. - (while (and (not (eobp)) - (or (not (numberp - (setq art (read (current-buffer))))) - (< art article))) - (if (and (numberp art) - (file-exists-p - (gnus-agent-article-name - (number-to-string art) group))) - (progn - (unless lowest - (setq lowest art)) - (setq highest art) - (forward-line 1)) - ;; Remove old NOV lines that have no articles. - (gnus-delete-line))) - (if (or (eobp) - (/= art article)) - (beginning-of-line) - (gnus-delete-line)) - ;; Nuke the article. - (when (file-exists-p - (setq file (gnus-agent-article-name - (number-to-string article) - group))) - (delete-file file)) - ;; Schedule the history line for nuking. - (push (cdr elem) histories))) - (gnus-make-directory (file-name-directory nov-file)) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (write-region (point-min) (point-max) nov-file nil 'silent)) - ;; Delete the unwanted entries in the alist. - (setq gnus-agent-article-alist - (sort gnus-agent-article-alist 'car-less-than-car)) - (let* ((alist gnus-agent-article-alist) - (prev (cons nil alist)) - (first prev) - expired) - (while (and alist - (<= (caar alist) article)) - (if (or (not (cdar alist)) - (not (file-exists-p - (gnus-agent-article-name - (number-to-string - (caar alist)) - group)))) + (if (and articles group force) ;; point usless without art+group + (while (setq article (pop articles)) + ;; try to find history entries for articles + (goto-char (point-min)) + (if (re-search-forward + (concat "^[^\t]*\t[^\t]*\t\(.* ?\)" + (format "%S" (gnus-group-prefixed-name + group gnus-command-method)) + " " + (number-to-string article) + " $") + nil t) + (setq pos (point)) + (setq pos nil)) + (setq sym (let ((obarray expiry-hashtb) s) + (intern group))) + (if (boundp sym) + (set sym (cons (cons article pos) + (symbol-value sym))) + (set sym (list (cons article pos))))) + ;; go through history file to find eligble articles + (when (> (buffer-size) 1) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward "^\t") + (if (let ((fetch-date (read (current-buffer)))) + (if (numberp fetch-date) + ;; We now have the arrival day, so we see + ;; whether it's old enough to be expired. + (if (numberp day) + (> fetch-date day) + (skip-chars-forward "\t") + (setq found nil + days gnus-agent-expire-days) + (while (and (not found) + days) + (when (looking-at (caar days)) + (setq found (cadar days))) + (pop days)) + (> fetch-date (- current-day found))) + ;; History file is corrupted. + (gnus-message + 5 + (format "File %s is corrupted!" + (gnus-agent-lib-file "history"))) + (sit-for 1) + ;; Ignore it + t)) + ;; New article; we don't expire it. + (forward-line 1) + ;; Old article. Schedule it for possible nuking. + (while (not (eolp)) + (setq sym (let ((obarray expiry-hashtb) s) + (setq s (read (current-buffer))) + (if (stringp s) (intern s) s))) + (if (boundp sym) + (set sym (cons (cons (read (current-buffer)) (point)) + (symbol-value sym))) + (set sym (list (cons (read (current-buffer)) + (point))))) + (skip-chars-forward " ")) + (forward-line 1))))) + ;; We now have all articles that can possibly be expired. + (mapatoms + (lambda (sym) + (setq group (symbol-name sym) + arts (sort (symbol-value sym) 'car-less-than-car) + low (car (gnus-active group)) + info (gnus-get-info group) + unreads (ignore-errors + (gnus-list-of-unread-articles group)) + marked (nconc + (gnus-uncompress-range + (cdr (assq 'tick (gnus-info-marks info)))) + (gnus-uncompress-range + (cdr (assq 'dormant + (gnus-info-marks info))))) + nov-file (gnus-agent-article-name ".overview" group) + lowest nil + highest nil) + (gnus-agent-load-alist group) + (gnus-message 5 "Expiring articles in %s" group) + (set-buffer overview) + (erase-buffer) + (when (file-exists-p nov-file) + (nnheader-insert-file-contents nov-file)) + (goto-char (point-min)) + (setq article 0) + (while (setq elem (pop arts)) + (setq article (car elem)) + (when (or (null low) + (< article low) + gnus-agent-expire-all + (and (not (memq article unreads)) + (not (memq article marked))) + force) + ;; Find and nuke the NOV line. + (while (and (not (eobp)) + (or (not (numberp + (setq art (read (current-buffer))))) + (< art article))) + (if (and (numberp art) + (file-exists-p + (gnus-agent-article-name + (number-to-string art) group))) (progn - (push (caar alist) expired) - (setcdr prev (setq alist (cdr alist)))) - (setq prev alist - alist (cdr alist)))) - (setq gnus-agent-article-alist (cdr first)) - (gnus-agent-save-alist group) - ;; Mark all articles up to the first article - ;; in `gnus-article-alist' as read. - (when (and info (caar gnus-agent-article-alist)) - (setcar (nthcdr 2 info) - (gnus-range-add - (nth 2 info) - (cons 1 (- (caar gnus-agent-article-alist) 1))))) - ;; Maybe everything has been expired from - ;; `gnus-article-alist' and so the above marking as - ;; read could not be conducted, or there are - ;; expired article within the range of the alist. - (when (and info - expired - (or (not (caar gnus-agent-article-alist)) - (> (car expired) - (caar gnus-agent-article-alist)))) - (setcar (nthcdr 2 info) - (gnus-add-to-range - (nth 2 info) - (nreverse expired)))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string info) - ")"))) - (when lowest - (if (gnus-gethash group orig) - (setcar (gnus-gethash group orig) lowest) - (gnus-sethash group (cons lowest highest) orig)))) - expiry-hashtb) - (set-buffer history) - (setq histories (nreverse (sort histories '<))) - (while histories - (goto-char (pop histories)) - (gnus-delete-line)) - (gnus-agent-save-history) - (gnus-agent-close-history) - (gnus-write-active-file - (gnus-agent-lib-file "active") orig)) - (gnus-message 4 "Expiry...done"))))))) + (unless lowest + (setq lowest art)) + (setq highest art) + (forward-line 1)) + ;; Remove old NOV lines that have no articles. + (gnus-delete-line))) + (if (or (eobp) + (/= art article)) + (beginning-of-line) + (gnus-delete-line)) + ;; Nuke the article. + (when (file-exists-p + (setq file (gnus-agent-article-name + (number-to-string article) + group))) + (delete-file file)) + ;; Schedule the history line for nuking. + (if (cdr elem) + (push (cdr elem) histories)))) + (gnus-make-directory (file-name-directory nov-file)) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) nov-file nil 'silent)) + ;; Delete the unwanted entries in the alist. + (setq gnus-agent-article-alist + (sort gnus-agent-article-alist 'car-less-than-car)) + (let* ((alist gnus-agent-article-alist) + (prev (cons nil alist)) + (first prev) + expired) + (while (and alist + (<= (caar alist) article)) + (if (or (not (cdar alist)) + (not (file-exists-p + (gnus-agent-article-name + (number-to-string + (caar alist)) + group)))) + (progn + (push (caar alist) expired) + (setcdr prev (setq alist (cdr alist)))) + (setq prev alist + alist (cdr alist)))) + (setq gnus-agent-article-alist (cdr first)) + (gnus-agent-save-alist group) + ;; Mark all articles up to the first article + ;; in `gnus-agent-article-alist' as read. + (when (and info (caar gnus-agent-article-alist)) + (setcar (nthcdr 2 info) + (gnus-range-add + (nth 2 info) + (cons 1 (- (caar gnus-agent-article-alist) 1))))) + ;; Maybe everything has been expired from + ;; `gnus-agent-article-alist' and so the above marking as + ;; read could not be conducted, or there are + ;; expired article within the range of the alist. + (when (and info + expired + (or (not (caar gnus-agent-article-alist)) + (> (car expired) + (caar gnus-agent-article-alist)))) + (setcar (nthcdr 2 info) + (gnus-add-to-range + (nth 2 info) + (nreverse expired)))) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string info) + ")"))) + (when lowest + (if (gnus-gethash group orig) + (setcar (gnus-gethash group orig) lowest) + (gnus-sethash group (cons lowest highest) orig)))) + expiry-hashtb) + (set-buffer history) + (setq histories (nreverse (sort histories '<))) + (while histories + (goto-char (pop histories)) + (gnus-delete-line)) + (gnus-agent-save-history) + (gnus-agent-close-history) + (gnus-write-active-file + (gnus-agent-lib-file "active") orig)) + (gnus-message 4 "Expiry...done")))))) ;;;###autoload (defun gnus-agent-batch () @@ -1840,21 +1896,21 @@ The following commands are available: (erase-buffer) (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) - (nnheader-insert-file-contents file)) + (nnheader-insert-nov-file file (car articles))) (nnheader-find-nov-line (car articles)) (while (not (eobp)) (when (looking-at "[0-9]") (push (read (current-buffer)) cached-articles)) (forward-line 1)) (setq cached-articles (nreverse cached-articles)))) - (if (setq uncached-articles - (gnus-set-difference articles cached-articles)) + (if (setq uncached-articles + (gnus-sorted-difference articles cached-articles)) (progn (set-buffer nntp-server-buffer) (erase-buffer) (let (gnus-agent-cache) - (unless (eq 'nov - (gnus-retrieve-headers + (unless (eq 'nov + (gnus-retrieve-headers uncached-articles group fetch-old)) (nnvirtual-convert-headers))) (set-buffer gnus-agent-overview-buffer) @@ -1923,7 +1979,7 @@ The following commands are available: (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) (nnheader-insert-file-contents file))) - (goto-char (point-min)) + (goto-char (point-min)) (while (not (eobp)) (while (not (or (eobp) (looking-at "[0-9]"))) (setq point (point)) @@ -1936,7 +1992,7 @@ The following commands are available: (while (and arts (> n (car arts))) (message "Regenerating NOV %s %d..." group (car arts)) (mm-with-unibyte-buffer - (nnheader-insert-file-contents + (nnheader-insert-file-contents (concat dir (number-to-string (car arts)))) (goto-char (point-min)) (if (search-forward "\n\n" nil t) @@ -1961,15 +2017,15 @@ The following commands are available: (unless clean (gnus-agent-load-alist group)) (setq alist (sort alist 'car-less-than-car)) - (setq gnus-agent-article-alist (sort gnus-agent-article-alist + (setq gnus-agent-article-alist (sort gnus-agent-article-alist 'car-less-than-car)) (while (and alist gnus-agent-article-alist) - (cond + (cond ((< (caar alist) (caar gnus-agent-article-alist)) (push (pop alist) new-alist)) ((> (caar alist) (caar gnus-agent-article-alist)) (push (list (car (pop gnus-agent-article-alist))) new-alist)) - (t + (t (pop gnus-agent-article-alist) (while (and gnus-agent-article-alist (= (caar alist) (caar gnus-agent-article-alist))) @@ -1993,8 +2049,8 @@ The following commands are available: (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t)) (setq id "No-Message-ID-in-article") (setq id (buffer-substring (match-beginning 1) (match-end 1)))) - (gnus-agent-enter-history - id (list (cons group article)) + (gnus-agent-enter-history + id (list (cons group article)) (time-to-days (nth 5 (file-attributes file))))))) ;;;###autoload @@ -2005,7 +2061,7 @@ If CLEAN, don't read existing active and agentview files." (message "Regenerating Gnus agent files...") (dolist (gnus-command-method gnus-agent-covered-methods) (let ((active-file (gnus-agent-lib-file "active")) - history-hashtb active-hashtb active-changed + history-hashtb active-hashtb active-changed history-changed point) (gnus-make-directory (file-name-directory active-file)) (if clean @@ -2027,12 +2083,12 @@ If CLEAN, don't read existing active and agentview files." (goto-char (point-min)) (forward-line 1) (while (not (eobp)) - (if (looking-at + (if (looking-at "\\([^\t\n]+\\)\t[0-9]+\t\\([^ \n]+\\) \\([0-9]+\\)") (progn - (unless (string= (match-string 1) + (unless (string= (match-string 1) "last-header-fetched-for-session") - (gnus-sethash (match-string 2) + (gnus-sethash (match-string 2) (cons (string-to-number (match-string 3)) (gnus-gethash-safe (match-string 2) history-hashtb)) @@ -2063,14 +2119,14 @@ If CLEAN, don't read existing active and agentview files." n) (gnus-sethash group arts history-hashtb) (while (and arts gnus-agent-article-alist) - (cond + (cond ((> (car arts) (caar gnus-agent-article-alist)) (when (cdar gnus-agent-article-alist) - (gnus-agent-regenerate-history + (gnus-agent-regenerate-history group (caar gnus-agent-article-alist)) (setq history-changed t)) (setq n (car (pop gnus-agent-article-alist))) - (while (and gnus-agent-article-alist + (while (and gnus-agent-article-alist (= n (caar gnus-agent-article-alist))) (pop gnus-agent-article-alist))) ((< (car arts) (caar gnus-agent-article-alist)) @@ -2079,7 +2135,7 @@ If CLEAN, don't read existing active and agentview files." (pop arts))) (t (setq n (car (pop gnus-agent-article-alist))) - (while (and gnus-agent-article-alist + (while (and gnus-agent-article-alist (= n (caar gnus-agent-article-alist))) (pop gnus-agent-article-alist)) (setq n (pop arts)) @@ -2087,18 +2143,18 @@ If CLEAN, don't read existing active and agentview files." (pop arts))))) (while gnus-agent-article-alist (when (cdar gnus-agent-article-alist) - (gnus-agent-regenerate-history + (gnus-agent-regenerate-history group (caar gnus-agent-article-alist)) (setq history-changed t)) (pop gnus-agent-article-alist)))) (when history-changed - (message "Regenerate the history file of %s:%s" + (message "Regenerate the history file of %s:%s" (car gnus-command-method) (cadr gnus-command-method)) (gnus-agent-save-history)) (gnus-agent-close-history) (when active-changed - (message "Regenerate %s" active-file) + (message "Regenerate %s" active-file) (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system)) (gnus-write-active-file active-file active-hashtb))))) (message "Regenerating Gnus agent files...done")) @@ -2108,8 +2164,8 @@ If CLEAN, don't read existing active and agentview files." (interactive (list t)) (dolist (server gnus-opened-servers) (when (eq (nth 1 server) 'offline) - (if (if (eq force 'ask) - (gnus-y-or-n-p + (if (if (eq force 'ask) + (gnus-y-or-n-p (format "Switch %s:%s into online status? " (caar server) (cadar server))) force)