(defmacro gnus-agent-with-fetch (&rest forms)
"Do FORMS safely."
`(unwind-protect
- (progn
+ (let ((gnus-agent-fetching t))
(gnus-agent-start-fetch)
,@forms)
(gnus-agent-stop-fetch)))
(while (re-search-forward (concat gnus-agent-gcc-header ":") nil t)
(replace-match "Gcc:" 'fixedcase))))
+(defun gnus-agent-any-covered-gcc ()
+ (save-restriction
+ (message-narrow-to-headers)
+ (let* ((gcc (mail-fetch-field "gcc" nil t))
+ (methods (and gcc
+ (mapcar 'gnus-inews-group-method
+ (message-unquote-tokens
+ (message-tokenize-header
+ gcc " ,")))))
+ covered)
+ (while (and (not covered) methods)
+ (setq covered
+ (member (car methods) gnus-agent-covered-methods)
+ methods (cdr methods)))
+ covered)))
+
(defun gnus-agent-possibly-save-gcc ()
"Save GCC if Gnus is unplugged."
- (unless gnus-plugged
+ (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t))
(defun gnus-agent-possibly-do-gcc ()
"Do GCC if Gnus is plugged."
- (when gnus-plugged
+ (when (or gnus-plugged (not (gnus-agent-any-covered-gcc)))
(gnus-inews-do-gcc)))
;;;
(insert "\n"))
(pop gnus-agent-group-alist))))
-(defun gnus-agent-union (l1 l2)
- "Set union of lists L1 and L2."
- (cond ((null l1) l2)
- ((null l2) l1)
- ((equal l1 l2) l1)
- (t
- (or (>= (length l1) (length l2))
- (setq l1 (prog1 l2 (setq l2 l1))))
- (while l2
- (or (memq (car l2) l1)
- (push (car l2) l1))
- (pop l2))
- l1)))
-
(defun gnus-agent-fetch-headers (group &optional force)
(let* ((articles (gnus-list-of-unread-articles group))
(len (length articles))
(setq articles (nthcdr i articles))))
;; add article with marks to list of article headers we want to fetch.
(dolist (arts (gnus-info-marks (gnus-get-info group)))
- (setq articles (gnus-agent-union (gnus-uncompress-sequence (cdr arts))
- articles)))
+ (setq articles (gnus-union (gnus-uncompress-sequence (cdr arts))
+ articles)))
(setq articles (sort articles '<))
;; Remove known articles.
(when (gnus-agent-load-alist group)
(error
(unless (funcall gnus-agent-confirmation-function
(format "Error (%s). Continue? " err))
- (error "Cannot fetch articles into the Gnus agent."))))
+ (error "Cannot fetch articles into the Gnus agent.")))
+ (quit
+ (unless (funcall gnus-agent-confirmation-function
+ (format "Quit (%s). Continue? " err))
+ (signal 'quit "Cannot fetch articles into the Gnus agent."))))
(pop methods))
(gnus-message 6 "Finished fetching articles into the Gnus agent"))))
(caddr category)))
;; 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)))
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward "^\t")
- (if (> (read (current-buffer)) day)
+ (if (let ((fetch-date (read (current-buffer))))
+ (if (numberp fetch-date)
+ (> fetch-date day)
+ ;; 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.
(gnus-group-send-drafts)
(gnus-agent-fetch-session))
-;;;
-;;; Advice
-;;;
-
-(defadvice gnus-group-get-new-news (after gnus-agent-advice
- activate preactivate)
- "Update modeline."
- (unless (interactive-p)
- (gnus-agent-toggle-plugged gnus-plugged)))
-
(provide 'gnus-agent)
;;; gnus-agent.el ends here