From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/32188 Path: main.gmane.org!not-for-mail From: simon@josefsson.org Newsgroups: gmane.emacs.gnus.general Subject: Re: [patch] gnus agent Date: 14 Aug 2000 21:48:29 +0200 Sender: owner-ding@hpc.uh.edu Message-ID: References: NNTP-Posting-Host: coloc-standby.netfonds.no Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1035168499 18338 80.91.224.250 (21 Oct 2002 02:48:19 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 21 Oct 2002 02:48:19 +0000 (UTC) Return-Path: Original-Received: from spinoza.math.uh.edu (spinoza.math.uh.edu [129.7.128.18]) by mailhost.sclp.com (Postfix) with ESMTP id 3F318D051E for ; Mon, 14 Aug 2000 16:15:32 -0400 (EDT) Original-Received: from sina.hpc.uh.edu (lists@Sina.HPC.UH.EDU [129.7.3.5]) by spinoza.math.uh.edu (8.9.1/8.9.1) with ESMTP id PAC22496; Mon, 14 Aug 2000 15:15:26 -0500 (CDT) Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Mon, 14 Aug 2000 15:14:19 -0500 (CDT) Original-Received: from mailhost.sclp.com (postfix@66-209.196.61.interliant.com [209.196.61.66] (may be forged)) by sina.hpc.uh.edu (8.9.3/8.9.3) with ESMTP id PAA23070 for ; Mon, 14 Aug 2000 15:14:01 -0500 (CDT) Original-Received: from vic20.blipp.com (unknown [195.84.94.187]) by mailhost.sclp.com (Postfix) with ESMTP id 73DB8D051E for ; Mon, 14 Aug 2000 16:14:24 -0400 (EDT) Original-Received: from barbar.josefsson.org (IDENT:root@localhost [127.0.0.1]) by vic20.blipp.com (8.10.1/8.10.1) with SMTP id e7EKEG331535 for ; Mon, 14 Aug 2000 22:14:16 +0200 Original-To: ding@gnus.org In-Reply-To: Mail-Copies-To: nobody User-Agent: Gnus/5.0808 (Gnus v5.8.8) XEmacs/21.1 (Channel Islands) Original-Lines: 478 Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:32188 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:32188 Lars Magne Ingebrigtsen writes: > > This patch make all articles eligible for agent download, filtered > > only by predicates, instead of the hardcoded algorithm that choses > > what to download from unread articles only. > > Sounds like a good idea. Please do apply. It does have one problem though -- people that have configured agent predicates will have to revise them to get the "old" behaviour, since the patch make the default change. They would need to add `(and (not read) ...)' to get the same semantics. I'm not sure anyone would notice and/or care, but it is a change. (That's why I'm not sure it's good for the 5.8 series.) And changing predicates in existing Agent groups is troublesome -- articles that was rejected by the earlier predicate are NOT eligible for the new predicate. One have to manually remove the Agent cache. Many moons ago, I added a patch to solve that. It made the Agent look at ALL articles every time you synched the Agent ('J s') but it was taken out because it was simply too slow. There's a better solution though -- making Agent store what predicates is used when you synch the Agent and compare it the next time. If the predicate has changed, it clears the .agentview file. This makes the Agent go through ALL headers in the group, re-running the predicate on all articles. Since this would provoke a massive re-download of lots of articles too, modifying the Agent to see if article X exist locally before fetching it became necessery. The following patch implement that. (It's against CVS, so it includes the previous patch which I didn't commit yet) In addition, it does the following too: . postpones unplugged GCC's until you're plugged (so you can Gcc into a nnimap group, for example). . query the user at plugin-time if she want to synchronize flags (user customizable by `gnus-agent-synchronize-flags'). It only happens if the user actually modified remote flags, so it doesn't affect nntp users. . makes the agent somewhat more verbose Um, whad'ya'think? 2000-08-05 Simon Josefsson Make GCC to nnimap group work when disconnected. * gnus-draft.el (gnus-draft-send): Call `gnus-agent-restore-gcc'. * gnus-agent.el (gnus-agent-possibly-do-gcc): (gnus-agent-restore-gcc): (gnus-agent-possibly-save-gcc): New functions. * gnus-msg.el (gnus-inews-add-send-actions): Use `gnus-agent-possibly-do-gcc' if Agentized. (gnus-inews-add-send-actions): Add `gnus-agent-possibly-save-gcc' to `message-header-hook'. * gnus.el (gnus-agent-gcc-header): New variable. 2000-07-13 Simon Josefsson Asks the user to synch flags with server when you plug in. * gnus-agent.el (gnus-agent-synchronize-flags): New variable. (gnus-agent-possibly-synchronize-flags-server): New function, use it. (gnus-agent-toggle-plugged): Call it. (gnus-agent-synchronize-flags): Renamed from `gnus-agent-synchronize'. (gnus-agent-group-mode-map): `g-a-s' -> `g-a-s-flags'. (gnus-agent-possibly-synchronize-flags): New function. (gnus-agent-possibly-synchronize-flags-server): New function. 2000-07-13 Simon Josefsson Changing predicates for a group re-sync Gnus status on the group. * gnus-agent.el (gnus-agent-fetch-group-1): Clean agent overview if predicates chanted. (gnus-agent-load-predicate): New function. (gnus-agent-write-predicate): Ditto. Index: 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 --- gnus-agent.el 2000/07/13 17:19:05 5.55 +++ gnus-agent.el 2000/08/14 19:33:13 @@ -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) @@ -371,6 +380,27 @@ (while (search-backward "\n" nil t) (replace-match "\\n" t t)))) +(defun gnus-agent-restore-gcc () + "Restore GCC field from saved header." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward (concat gnus-agent-gcc-header ":") nil t) + (replace-match "Gcc:" 'fixedcase)))) + +(defun gnus-agent-possibly-save-gcc () + "Save GCC if Gnus is unplugged." + (unless gnus-plugged + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (re-search-forward "^gcc:" nil t) + (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase)))))) + +(defun gnus-agent-possibly-do-gcc () + "Do GCC if Gnus is plugged." + (when gnus-plugged + (gnus-inews-do-gcc))) + ;;; ;;; Group mode commands ;;; @@ -425,13 +455,26 @@ (setf (cadddr c) (delete group (cadddr c)))))) (gnus-category-write))) -(defun gnus-agent-synchronize () - "Synchronize local, unplugged, data with backend. -Currently sends flag setting requests, if any." +(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-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,8 +487,17 @@ (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 +605,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)) @@ -752,25 +803,37 @@ (defun gnus-agent-fetch-articles (group articles) "Fetch ARTICLES from GROUP and put them into the Agent." - (when articles - ;; Prune off articles that we have already fetched. + (let ((dir (concat (gnus-agent-directory) (gnus-agent-group-path group) "/")) + (date (time-to-days (current-time))) + (case-fold-search t) + pos crosses id elem exist) + ;; Prune off articles that we have already fetched, and notice + ;; articles that (for some reason) already exist locally. (while (and articles - (cdr (assq (car articles) gnus-agent-article-alist))) + (or (cdr (assq (car articles) gnus-agent-article-alist)) + (setq exist (file-readable-p + (expand-file-name + (int-to-string (car articles)) dir))))) + (when exist + (setcdr (assq (car articles) gnus-agent-article-alist) t) + (setq exist nil)) (pop articles)) (let ((arts articles)) (while (cdr arts) - (if (cdr (assq (cadr arts) gnus-agent-article-alist)) - (setcdr arts (cddr arts)) + (if (or (cdr (assq (cadr arts) gnus-agent-article-alist)) + (setq exist (file-readable-p + (expand-file-name + (int-to-string (cadr arts)) dir)))) + (progn + (when exist + (setcdr (assq (cadr arts) gnus-agent-article-alist) t) + (setq exist nil)) + (setcdr arts (cddr arts))) (setq arts (cdr arts))))) (when articles - (let ((dir (concat - (gnus-agent-directory) - (gnus-agent-group-path group) "/")) - (date (time-to-days (current-time))) - (case-fold-search t) - pos crosses id elem) (gnus-make-directory dir) - (gnus-message 7 "Fetching articles for %s..." group) + (gnus-message 7 "Fetching articles %s for %s..." + (gnus-compress-sequence articles) group) ;; Fetch the articles from the backend. (if (gnus-check-backend-function 'retrieve-articles group) (setq pos (gnus-retrieve-articles articles group)) @@ -820,8 +883,8 @@ (gnus-agent-enter-history id (or crosses (list (cons group (caar pos)))) date) (widen) - (pop pos))) - (gnus-agent-save-alist group))))) + (pop pos)))) + (gnus-agent-save-alist group))) (defun gnus-agent-crosspost (crosses article) (let (gnus-agent-article-alist group alist beg end) @@ -868,14 +931,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 +993,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 +1013,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 +1036,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)) @@ -1036,8 +1109,21 @@ ;; Maybe some other gnus-summary local variables should also ;; be put here. ) + (gnus-message 9 "Agent fetching group %s..." group) (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 detected for %s..." 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 +1141,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 8 "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 +1180,7 @@ score-method (list (list score-method))))))) (when score-param + (gnus-message 8 "Agent scores in group %s..." group) (gnus-score-headers score-param)) (setq arts nil) (while (setq gnus-headers (pop gnus-newsgroup-headers)) @@ -1104,16 +1188,20 @@ (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 (funcall predicate) + (push (mail-header-number gnus-headers) arts)))) + (gnus-message 8 "Agent predicate accepted %s..." + (gnus-compress-sequence arts))) ;; Fetch the articles. (when arts - (gnus-agent-fetch-articles group arts))) + (gnus-message 8 "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 8 "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 +1362,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 +1455,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 +1486,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." diff -w -u -r5.18 gnus-draft.el --- lisp/gnus-draft.el 2000/04/26 16:31:37 5.18 +++ lisp/gnus-draft.el 2000/08/14 19:42:09 @@ -143,6 +143,8 @@ (setq type (ignore-errors (read (current-buffer))) method (ignore-errors (read (current-buffer)))) (message-remove-header gnus-agent-meta-information-header))) + ;; Let Agent restore any GCC lines and h ave message perform them. + (gnus-agent-restore-gcc) ;; Then we send it. If we have no meta-information, we just send ;; it and let Message figure out how. (when (and (or (null method) diff -w -u -r5.66 gnus-msg.el --- lisp/gnus-msg.el 2000/06/25 16:49:30 5.66 +++ lisp/gnus-msg.el 2000/08/14 19:42:11 @@ -262,7 +262,11 @@ (defun gnus-inews-add-send-actions (winconf buffer article) (make-local-hook 'message-sent-hook) - (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) + (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc + 'gnus-inews-do-gcc) nil t) + (when gnus-agent + (make-local-hook 'message-header-hook) + (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) diff -w -u -r5.141 gnus.el --- lisp/gnus.el 2000/07/13 23:11:45 5.141 +++ lisp/gnus.el 2000/08/14 19:42:16 @@ -1478,6 +1478,7 @@ ;;; Internal variables (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information") +(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc") (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) (defvar gnus-original-article-buffer " *Original Article*") (defvar gnus-newsgroup-name nil)