[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
agent work
My previous patch adding a new `read' agent predicate turned out quite
well, I've been using (a slightly modified) version for a week or so
and all that can be expected to work, work nicely.
In private mail folders I use the `true' predicate and in mailing list
groups the default `(and short (not read))'.
This patch contain the modifications I've made:
. add a new `read' agent predicate
. wipe out .agentview when predicates is modified for a group
. flag synchronization when you plug in, by quering user
by default (`gnus-agent-synchronize-flags')
. make sure all articles are subject to predicate handling
. more `message' about what the Agent is doing -- like what
articles are accepted/rejected by predicates
I'm unsure about commiting this to Gnus CVS -- this is "alpha" stuff.
I'd like if a new development series would start..
I'm now concentrating on getting unplugged "Gcc" (and possibly
unplugged copy/move) to work.
Index: lisp/gnus-agent.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus-agent.el,v
retrieving revision 5.55
diff -w -u -r5.55 gnus-agent.el
--- lisp/gnus-agent.el 2000/07/13 17:19:05 5.55
+++ lisp/gnus-agent.el 2000/07/13 21:48:36
@@ -83,6 +83,14 @@
:group 'gnus-agent
:type 'function)
+(defcustom gnus-agent-synchronize-flags 'ask
+ "Indicate if flags are synchronized when you plug in.
+If this is `ask' the hook will query the user."
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Ask" ask))
+ :group 'gnus-agent)
+
;;; Internal variables
(defvar gnus-agent-history-buffers nil)
@@ -233,7 +241,7 @@
"Jc" gnus-enter-category-buffer
"Jj" gnus-agent-toggle-plugged
"Js" gnus-agent-fetch-session
- "JY" gnus-agent-synchronize
+ "JY" gnus-agent-synchronize-flags
"JS" gnus-group-send-drafts
"Ja" gnus-agent-add-group
"Jr" gnus-agent-remove-group)
@@ -290,6 +298,7 @@
(if plugged
(progn
(setq gnus-plugged plugged)
+ (gnus-agent-possibly-synchronize-flags)
(gnus-run-hooks 'gnus-agent-plugged-hook)
(setcar (cdr gnus-agent-mode-status) " Plugged"))
(gnus-agent-close-connections)
@@ -424,14 +433,27 @@
(when (cadddr (setq c (gnus-group-category group)))
(setf (cadddr c) (delete group (cadddr c))))))
(gnus-category-write)))
+
+(defun gnus-agent-synchronize-flags ()
+ "Synchronize unplugged flags with servers."
+ (interactive)
+ (save-excursion
+ (dolist (gnus-command-method gnus-agent-covered-methods)
+ (when (file-exists-p (gnus-agent-lib-file "flags"))
+ (gnus-agent-synchronize-flags-server gnus-command-method)))))
-(defun gnus-agent-synchronize ()
- "Synchronize local, unplugged, data with backend.
-Currently sends flag setting requests, if any."
+(defun gnus-agent-possibly-synchronize-flags ()
+ "Synchronize flags according to `gnus-agent-synchronize-flags'."
(interactive)
(save-excursion
(dolist (gnus-command-method gnus-agent-covered-methods)
(when (file-exists-p (gnus-agent-lib-file "flags"))
+ (gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
+
+(defun gnus-agent-synchronize-flags-server (method)
+ "Synchronize flags set when unplugged for server."
+ (let ((gnus-command-method method))
+ (when (file-exists-p (gnus-agent-lib-file "flags"))
(set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
(erase-buffer)
(nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
@@ -444,9 +466,18 @@
(write-file (gnus-agent-lib-file "flags"))
(error "Couldn't set flags from file %s"
(gnus-agent-lib-file "flags"))))
- (write-file (gnus-agent-lib-file "flags")))
- (kill-buffer nil)))))
+ (delete-file (gnus-agent-lib-file "flags")))
+ (kill-buffer nil))))
+(defun gnus-agent-possibly-synchronize-flags-server (method)
+ "Synchronize flags for server according to `gnus-agent-synchronize-flags'."
+ (when (or (and gnus-agent-synchronize-flags
+ (not (eq gnus-agent-synchronize-flags 'ask)))
+ (and (eq gnus-agent-synchronize-flags 'ask)
+ (gnus-y-or-n-p (format "Synchronize flags on server `%s'? "
+ (cadr method)))))
+ (gnus-agent-synchronize-flags-server method)))
+
;;;
;;; Server mode commands
;;;
@@ -553,9 +584,8 @@
(gnus-agent-method-p gnus-command-method))
(gnus-agent-load-alist gnus-newsgroup-name)
;; First mark all undownloaded articles as undownloaded.
- (let ((articles (append gnus-newsgroup-unreads
- gnus-newsgroup-marked
- gnus-newsgroup-dormant))
+ (let ((articles (gnus-uncompress-sequence
+ (gnus-active gnus-newsgroup-name)))
article)
(while (setq article (pop articles))
(unless (or (cdr (assq article gnus-agent-article-alist))
@@ -868,14 +898,9 @@
(pop gnus-agent-group-alist))))
(defun gnus-agent-fetch-headers (group &optional force)
- (let ((articles (gnus-list-of-unread-articles group))
+ (let ((articles (gnus-uncompress-range (gnus-active group)))
(gnus-decode-encoded-word-function 'identity)
(file (gnus-agent-article-name ".overview" group)))
- ;; Add article with marks to list of article headers we want to fetch.
- (dolist (arts (gnus-info-marks (gnus-get-info group)))
- (setq articles (union (gnus-uncompress-sequence (cdr arts))
- articles)))
- (setq articles (sort articles '<))
;; Remove known articles.
(when (gnus-agent-load-alist group)
(setq articles (gnus-sorted-intersection
@@ -935,8 +960,8 @@
(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))
+ (and (nnheader-find-nov-line (car articles))
+ (gnus-agent-copy-nov-line (car articles)))
(pop articles)
(while (and articles
(not (eobp)))
@@ -955,6 +980,19 @@
(set-buffer nntp-server-buffer)
(insert-buffer-substring gnus-agent-overview-buffer b e)))))
+(defun gnus-agent-load-predicate (group)
+ "Return the predicate used to generate .agentview file for GROUP."
+ (gnus-agent-read-file (gnus-agent-article-name ".predicate" group)))
+
+(defun gnus-agent-write-predicate (group predicate)
+ "Write the predicate used to generate .agentview file for GROUP."
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (file (gnus-agent-article-name ".predicate" group)))
+ (gnus-make-directory (file-name-directory file))
+ (with-temp-file file
+ (princ predicate (current-buffer))
+ (insert "\n"))))
+
(defun gnus-agent-load-alist (group &optional dir)
"Load the article-state alist for GROUP."
(setq gnus-agent-article-alist
@@ -965,10 +1003,12 @@
(defun gnus-agent-save-alist (group &optional articles state dir)
"Save the article-state alist for GROUP."
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (with-temp-file (if dir
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (file (if dir
(concat dir ".agentview")
- (gnus-agent-article-name ".agentview" group))
+ (gnus-agent-article-name ".agentview" group))))
+ (gnus-make-directory (file-name-directory file))
+ (with-temp-file file
(princ (setq gnus-agent-article-alist
(nconc gnus-agent-article-alist
(mapcar (lambda (article) (cons article state))
@@ -1038,6 +1078,19 @@
)
(unless (gnus-check-group group)
(error "Can't open server for %s" group))
+ ;; Check if predicates have changed
+ (setq category (gnus-group-category group))
+ (setq predicate
+ (gnus-get-predicate
+ (or (gnus-group-find-parameter group 'agent-predicate t)
+ (cadr category))))
+ (unless (equal predicate (gnus-agent-load-predicate group))
+ (when (gnus-agent-load-alist group)
+ (gnus-message 5 "Agent predicate change for group %s...cache removed"
+ group))
+ (let (gnus-agent-article-alist)
+ (gnus-agent-save-alist group))
+ (gnus-agent-write-predicate group predicate))
;; Fetch headers.
(when (and (or (gnus-active group) (gnus-activate-group group))
(setq articles (gnus-agent-fetch-headers group))
@@ -1055,11 +1108,8 @@
;; `gnus-agent-overview-buffer' may be killed for
;; timeout reason. If so, recreate it.
(gnus-agent-create-buffer)))
- (setq category (gnus-group-category group))
- (setq predicate
- (gnus-get-predicate
- (or (gnus-group-find-parameter group 'agent-predicate t)
- (cadr category))))
+ (gnus-message 9 "Agent looking in %s at articles %s..."
+ group (gnus-compress-sequence articles))
;; Do we want to download everything, or nothing?
(if (or (eq (caaddr predicate) 'gnus-agent-true)
(eq (caaddr predicate) 'gnus-agent-false))
@@ -1097,6 +1147,7 @@
score-method
(list (list score-method)))))))
(when score-param
+ (gnus-message 9 "Agent scores in group %s..." group)
(gnus-score-headers score-param))
(setq arts nil)
(while (setq gnus-headers (pop gnus-newsgroup-headers))
@@ -1104,16 +1155,22 @@
(or (cdr (assq (mail-header-number gnus-headers)
gnus-newsgroup-scored))
gnus-summary-default-score))
- (when (funcall predicate)
- (push (mail-header-number gnus-headers)
- arts))))
+ (if (not (funcall predicate))
+ (gnus-message 10 "Article %s rejected by predicate..."
+ (mail-header-number gnus-headers))
+ (gnus-message 10 "Article %s accepted by predicate..."
+ (mail-header-number gnus-headers))
+ (push (mail-header-number gnus-headers) arts))))
;; Fetch the articles.
(when arts
+ (gnus-message 9 "Agent fetching articles %s..."
+ (gnus-compress-sequence 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 9 "Agent is downloading marked articles...")
(gnus-agent-fetch-articles
group (gnus-uncompress-range (cdr arts)))
(setq marks (delq arts (gnus-info-marks info)))
@@ -1274,7 +1331,7 @@
(setq gnus-category-alist
(or (gnus-agent-read-file
(nnheader-concat gnus-agent-directory "lib/categories"))
- (list (list 'default 'short nil nil)))))
+ (list (list 'default '(and short (not read)) nil nil)))))
(defun gnus-category-write ()
"Write the category alist."
@@ -1367,6 +1424,7 @@
(long . gnus-agent-long-p)
(low . gnus-agent-low-scored-p)
(high . gnus-agent-high-scored-p)
+ (read . gnus-agent-read-p)
(true . gnus-agent-true)
(false . gnus-agent-false))
"Mapping from short score predicate symbols to predicate functions.")
@@ -1397,6 +1455,11 @@
(defun gnus-agent-high-scored-p ()
"Say whether an article has a high score or not."
(> gnus-score gnus-agent-high-score))
+
+(defun gnus-agent-read-p ()
+ "Say whether an article is read or not."
+ (gnus-member-of-range (mail-header-number gnus-headers)
+ (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
(defun gnus-category-make-function (cat)
"Make a function from category CAT."