From: Kevin Greiner <kgreiner@xpediantsolutions.com>
Subject: Re: (Yet another stab at) Sharing ~/.newsrc.eld among multiple
Date: Thu, 06 Nov 2003 17:07:10 -0600 [thread overview]
Message-ID: <uk76dm6zl.fsf@xpediantsolutions.com> (raw)
In-Reply-To: <q67ptg52rju.fsf@raytheon.com>
[-- Attachment #1: Type: text/plain, Size: 2922 bytes --]
"Steven E. Harris" <seh@panix.com> writes:
> For the first time in a long time, I can now read the same news server
> from home and work. That means that I should be able to rsync
> .newsrc.eld and a bunch of score files around so that I can, say, read
> mail and news at work, continue at home over the weekend, and pick up
> again at work with consistent state along the way. I should be able
> to, but the agent gets in the way.
>
> Along with a primary news server, I read IMAP from three different
> hosts. At home, I just connect to these hosts directly, optionally
> with STARTTLS. At work, though, I have to reach these servers through
> SSH port forwarding to get through our firewall. The "server names"
> are identical in each case; it's the connection details that differ.¹
>
> My long-time solution to this difference is to split my .gnus file
> into a shared .gnus and a local .gnus-local.el, the latter included by
> the former. Any changes to .gnus apply regardless of
> location. Site-specific details (such as my three nnimap secondary
> select methods) go into .gnus-local.el. Again, all of this would work
> fine, except for the agent.
>
> My three nnimap groups are agentized. This forces the full select
> method definition of each into .newsrc.eld in the
> gnus-agent-covered-methods variable. If I use Gnus all week at work
> and try to take my .newsrc.eld home for the weekend, my .gnus-local.el
> at home will conflict with the gnus-agent-covered-methods variable
> stored in .newsrc.eld. (The agent seems to use a deep comparison to
> see if a given select method is agentized; all select method
> parameters must match, rather than just the name.) I'll have to
> re-agentize these groups, and the gnus-agent-covered-methods variable
> will continue to grow in my .newsrc.eld file.
>
> Why can't we just store, say, "nnimap+speakeasy" and "nnimap+panix" in
> .newsrc.eld, rather than cramming the full duplicated select method
> definitions in there? As previous threads mentioned², this duplication
> is dangerous, as the variables are also defined in the .gnus file. For
> my scenario, the duplication causes conflicts.
>
> I want to be able to refer to these servers by the minimal common
> name. They are going to be nnimap groups at home and work, and I'll
> call them "speakeasy" or "panix" regardless of where I am. Anything
> beyond that, though, becomes a site-specific detail.
>
> Has there been any progress since Gnus v5.10.2 that would help me
> overcome this conflict? If not, perhaps I can help make my Gnus dream
> come true.
Steven,
Here's the patch that should give you want you wanting. It will also
provide a couple of bonus features (fairly minor stuff) as I didn't
feel like stripping them out.
I'd appreciate your feedback.
You'll need the latest versions from CVS before applying the diffs.
Kevin Greiner
[-- Attachment #2: Patch to relax comparisons on gnus-agent-covered-methods. --]
[-- Type: text/plain, Size: 21373 bytes --]
diff -u lisp.cvs_ref/gnus-agent.el lisp/gnus-agent.el
--- lisp.cvs_ref/gnus-agent.el Thu Nov 6 16:42:37 2003
+++ lisp/gnus-agent.el Wed Oct 22 07:31:39 2003
@@ -69,12 +69,9 @@
:type 'integer)
(defcustom gnus-agent-expire-days 7
- "Read articles older than this will be expired.
-This can also be a list of regexp/day pairs. The regexps will be
-matched against group names."
+ "Read articles older than this will be expired."
:group 'gnus-agent
- :type '(choice (number :tag "days")
- (sexp :tag "List" nil)))
+ :type '(number :tag "days"))
(defcustom gnus-agent-expire-all nil
"If non-nil, also expire unread, ticked and dormant articles.
@@ -556,9 +553,11 @@
(defun gnus-agent-close-connections ()
"Close all methods covered by the Gnus agent."
- (let ((methods gnus-agent-covered-methods))
- (while methods
- (gnus-close-server (pop methods)))))
+
+ (mapcar (lambda (method)
+ (gnus-close-server method))
+ (gnus-agent-opened-methods)))
+
;;;###autoload
(defun gnus-unplugged ()
@@ -598,18 +597,19 @@
(unless gnus-agent-send-mail-function
(setq gnus-agent-send-mail-function
(or message-send-mail-real-function
- message-send-mail-function)
+ message-send-mail-function)
message-send-mail-real-function 'gnus-agent-send-mail))
(unless gnus-agent-covered-methods
- (mapcar
+ (mapc
(lambda (server)
- (if (memq (car (gnus-server-to-method server))
- gnus-agent-auto-agentize-methods)
- (setq gnus-agent-covered-methods
- (cons (gnus-server-to-method server)
- gnus-agent-covered-methods ))))
- (append (list gnus-select-method) gnus-secondary-select-methods))))
+ (let ((method (gnus-server-to-method server)))
+ (if (memq (car method)
+ gnus-agent-auto-agentize-methods)
+ (setq gnus-agent-covered-methods
+ (cons (gnus-agent-covered-method method)
+ gnus-agent-covered-methods)))))
+ (cons gnus-select-method gnus-secondary-select-methods))))
(defun gnus-agent-queue-setup (&optional group-name)
"Make sure the queue group exists.
@@ -747,7 +747,7 @@
"Synchronize unplugged flags with servers."
(interactive)
(save-excursion
- (dolist (gnus-command-method gnus-agent-covered-methods)
+ (dolist (gnus-command-method (gnus-agent-opened-methods))
(when (file-exists-p (gnus-agent-lib-file "flags"))
(gnus-agent-synchronize-flags-server gnus-command-method)))))
@@ -755,7 +755,7 @@
"Synchronize flags according to `gnus-agent-synchronize-flags'."
(interactive)
(save-excursion
- (dolist (gnus-command-method gnus-agent-covered-methods)
+ (dolist (gnus-command-method (gnus-agent-opened-methods))
(when (file-exists-p (gnus-agent-lib-file "flags"))
(gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
@@ -798,7 +798,7 @@
(let ((method (gnus-server-get-method nil (gnus-server-server-name))))
(when (gnus-agent-method-p method)
(error "Server already in the agent program"))
- (push method gnus-agent-covered-methods)
+ (push (gnus-agent-covered-method method) gnus-agent-covered-methods)
(gnus-server-update-server server)
(gnus-agent-write-servers)
(gnus-message 1 "Entered %s into the Agent" server)))
@@ -811,8 +811,11 @@
(let ((method (gnus-server-get-method nil (gnus-server-server-name))))
(unless (gnus-agent-method-p method)
(error "Server not in the agent program"))
- (setq gnus-agent-covered-methods
- (delete method gnus-agent-covered-methods))
+
+ (setq gnus-agent-covered-methods
+ (gnus-delete-if method gnus-agent-covered-methods
+ #'gnus-methods-equal-p))
+
(gnus-server-update-server server)
(gnus-agent-write-servers)
(gnus-message 1 "Removed %s from the agent" server)))
@@ -824,8 +827,8 @@
nil
(or m "native"))))
(if method
- (unless (member method gnus-agent-covered-methods)
- (push method gnus-agent-covered-methods))
+ (unless (gnus-agent-method-p method)
+ (push (gnus-agent-covered-method method) gnus-agent-covered-methods))
(gnus-message 1 "Ignoring disappeared server `%s'" m))))
(gnus-agent-read-file
(nnheader-concat gnus-agent-directory "lib/servers"))))
@@ -836,7 +839,7 @@
(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 (mapcar 'gnus-method-simplify gnus-agent-covered-methods)
+ (prin1 gnus-agent-covered-methods
(current-buffer)))))
;;;
@@ -1175,6 +1178,18 @@
(require 'nnagent)
'nnagent))
+(defun gnus-agent-opened-methods ()
+ "Return the subset of opened methods that are covered by the agent."
+
+ (let* ((opened-covered (cons nil nil))
+ (opened-covered-head opened-covered))
+ (mapc (lambda (method)
+ (setq method (car method))
+ (if (gnus-agent-method-p method)
+ (setq opened-covered (setcdr opened-covered (cons method nil)))))
+ gnus-opened-servers)
+ (cdr opened-covered-head)))
+
;;; History functions
(defun gnus-agent-history-buffer ()
@@ -1783,7 +1798,7 @@
(error "No servers are covered by the Gnus agent"))
(unless gnus-plugged
(error "Can't fetch articles while Gnus is unplugged"))
- (let ((methods gnus-agent-covered-methods)
+ (let ((methods (gnus-agent-opened-methods))
groups group gnus-command-method)
(save-excursion
(while methods
@@ -2004,6 +2019,36 @@
(gnus-prin1-to-string info)
")"))))))))))))
+(defun gnus-agent-unfetch-group (group articles)
+ "Remove ARTICLES for GROUP from the Agent."
+ (when articles
+ (gnus-agent-load-alist group)
+
+ (let ((dir (gnus-agent-group-pathname group))
+ (alist gnus-agent-article-alist)
+ (arts (sort articles #'<))
+ changed)
+
+ (while arts
+ (let ((art (pop arts)))
+ (while (let* ((entry (pop alist))
+ (artnum (car entry)))
+ (and artnum
+ (cond ((< artnum art)
+ t)
+ ((and (= artnum art)
+ (cdr entry))
+ (setq changed t)
+ (setcdr entry nil)
+
+ (ignore-errors
+ (delete-file (concat dir (number-to-string art))))
+ nil)))))))
+
+ (if changed
+ (let ((inhibit-quit t))
+ (gnus-agent-save-alist group))))))
+
;;;
;;; Agent Category Mode
;;;
@@ -2458,29 +2503,46 @@
(if (not group)
(gnus-agent-expire articles group force)
- (if (or (not (eq articles t))
- (yes-or-no-p
- (concat "Are you sure that you want to "
- "expire all articles in " group ".")))
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (overview (gnus-get-buffer-create " *expire overview*"))
- orig)
- (unwind-protect
- (let ((active-file (gnus-agent-lib-file "active")))
- (when (file-exists-p active-file)
- (with-temp-buffer
- (nnheader-insert-file-contents active-file)
- (gnus-active-to-gnus-format
- gnus-command-method
- (setq orig (gnus-make-hashtable
- (count-lines (point-min) (point-max))))))
- (save-excursion
- (gnus-agent-expire-group-1
- group overview (gnus-gethash-safe group orig)
- articles force))
- (gnus-agent-write-active active-file orig t)))
- (kill-buffer overview))))
- (gnus-message 4 "Expiry...done")))
+ (let ( ;; Bind gnus-agent-expire-stats to enable tracking of expiration statistics
+ (gnus-agent-expire-stats (list 0 0 0.0)))
+ (if (or (not (eq articles t))
+ (yes-or-no-p
+ (concat "Are you sure that you want to "
+ "expire all articles in " group ".")))
+ (let ((gnus-command-method (gnus-find-method-for-group group))
+ (overview (gnus-get-buffer-create " *expire overview*"))
+ orig)
+ (unwind-protect
+ (let ((active-file (gnus-agent-lib-file "active")))
+ (when (file-exists-p active-file)
+ (with-temp-buffer
+ (nnheader-insert-file-contents active-file)
+ (gnus-active-to-gnus-format
+ gnus-command-method
+ (setq orig (gnus-make-hashtable
+ (count-lines (point-min) (point-max))))))
+ (save-excursion
+ (gnus-agent-expire-group-1
+ group overview (gnus-gethash-safe group orig)
+ articles force))
+ (gnus-agent-write-active active-file orig t)))
+ (kill-buffer overview))))
+
+ (if (> gnus-verbose 4)
+ (let ((size (nth 2 gnus-agent-expire-stats))
+ (units '(B KB MB GB)))
+ (while (and (> size 1024.0)
+ (cdr units))
+ (setq size (/ size 1024.0)
+ units (cdr units)))
+
+ (gnus-message 5 "Expiry recovered %d NOV entries, deleted %d files,\
+ and freed %f %s."
+ (nth 0 gnus-agent-expire-stats)
+ (nth 1 gnus-agent-expire-stats)
+ size (car units)))
+ (gnus-message 4 "Expiry...done")
+ ))))
(defun gnus-agent-expire-group-1 (group overview active articles force)
;; Internal function - requires caller to have set
@@ -2499,7 +2561,10 @@
(gnus-message 5 "Expiry skipping over %s" group)
(gnus-message 5 "Expiring articles in %s" group)
(gnus-agent-load-alist group)
- (let* ((info (gnus-get-info group))
+ (let* ((stats (if (boundp 'gnus-agent-expire-stats)
+ (symbol-value 'gnus-agent-expire-stats)
+ (list 0 0 0.0)))
+ (info (gnus-get-info group))
(alist gnus-agent-article-alist)
(day (- (time-to-days (current-time))
(gnus-agent-find-parameter group 'agent-days-until-old)))
@@ -2539,7 +2604,7 @@
(cons (caar alist)
(caar (last alist))))
(sort articles '<)))))
- (marked ;; More articles that are exluded from the
+ (marked ;; More articles that are excluded from the
;; expiration process
(cond (gnus-agent-expire-all
;; All articles are unmarked by global decree
@@ -2691,8 +2756,8 @@
;; Kept articles are unread, marked, or special.
(keep
(gnus-agent-message 10
- "gnus-agent-expire: Article %d: Kept %s article."
- article-number keep)
+ "gnus-agent-expire: Article %d: Kept %s article%s."
+ article-number keep (if fetch-date " and file" ""))
(when fetch-date
(unless (file-exists-p
(concat dir (number-to-string
@@ -2736,8 +2801,11 @@
(let ((actions nil))
(when (memq type '(forced expired))
(ignore-errors ; Just being paranoid.
- (delete-file (concat dir (number-to-string
- article-number)))
+ (let ((file-name (concat dir (number-to-string
+ article-number))))
+ (incf (nth 2 stats) (nth 7 (file-attributes file-name)))
+ (incf (nth 1 stats))
+ (delete-file file-name))
(push "expired cached article" actions))
(setf (nth 1 entry) nil)
)
@@ -2745,7 +2813,13 @@
(when marker
(push "NOV entry removed" actions)
(goto-char marker)
- (gnus-delete-line))
+
+ (incf (nth 0 stats))
+
+ (let ((from (gnus-point-at-bol))
+ (to (progn (forward-line 1) (point))))
+ (incf (nth 2 stats) (- to from))
+ (delete-region from to)))
;; If considering all articles is set, I can only
;; expire article IDs that are no longer in the
@@ -2820,10 +2894,12 @@
(if (or (not (eq articles t))
(yes-or-no-p "Are you sure that you want to expire all \
articles in every agentized group."))
- (let ((methods gnus-agent-covered-methods)
+ (let ((methods (gnus-agent-opened-methods))
;; Bind gnus-agent-expire-current-dirs to enable tracking
;; of agent directories.
(gnus-agent-expire-current-dirs nil)
+ ;; Bind gnus-agent-expire-stats to enable tracking of expiration statistics
+ (gnus-agent-expire-stats (list 0 0 0.0))
gnus-command-method overview orig)
(setq overview (gnus-get-buffer-create " *expire overview*"))
(unwind-protect
@@ -2848,7 +2924,21 @@
(gnus-agent-write-active active-file orig t))))
(kill-buffer overview))
(gnus-agent-expire-unagentized-dirs)
- (gnus-message 4 "Expiry...done")))))
+ (if (> gnus-verbose 4)
+ (let ((size (nth 2 gnus-agent-expire-stats))
+ (units '(B KB MB GB)))
+ (while (and (> size 1024.0)
+ (cdr units))
+ (setq size (/ size 1024.0)
+ units (cdr units)))
+
+ (gnus-message 5 "Expiry recovered %d NOV entries, deleted %d files,\
+ and freed %f %s."
+ (nth 0 gnus-agent-expire-stats)
+ (nth 1 gnus-agent-expire-stats)
+ size (car units)))
+ (gnus-message 4 "Expiry...done")
+ )))))
(defun gnus-agent-expire-unagentized-dirs ()
(when (and gnus-agent-expire-unagentized-dirs
@@ -2945,9 +3035,9 @@
(gnus-agent-fetch-session)))
(defun gnus-agent-unread-articles (group)
- (let* ((read (gnus-info-read (gnus-get-info group)))
- (known (gnus-agent-load-alist group))
- (unread (list nil))
+ (let* ((read (gnus-info-read (gnus-get-info group)))
+ (known (gnus-agent-load-alist group))
+ (unread (list nil))
(tail-unread unread))
(while (and known read)
(let ((candidate (car (pop known))))
@@ -2959,7 +3049,12 @@
(gnus-agent-append-to-list tail-unread candidate)
nil)
((> candidate max)
- (setq read (cdr read))))))))
+ (setq read (cdr read))
+ ;; return t so that I always loop one more
+ ;; time. If I just iterated off the end of
+ ;; read, min will become nil and the current
+ ;; candidate will be added to the unread list.
+ t))))))
(while known
(gnus-agent-append-to-list tail-unread (car (pop known))))
(cdr unread)))
@@ -3164,9 +3259,17 @@
def)
def
select)))
- (intern-soft
- (read-string
- "Reread (nil)? (t=>all, nil=>none, some=>all downloaded): "))))
+ (catch 'mark
+ (while (let ((c (read-char-exclusive "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n)")))
+ (cond ((or (eq c ?\r) (eq c ?n) (eq c ?N))
+ (throw 'mark nil))
+ ((or (eq c ?a) (eq c ?A))
+ (throw 'mark t))
+ ((or (eq c ?d) (eq c ?D))
+ (throw 'mark 'some)))
+ (message "Unexpected input")
+ (sit-for 1)
+ t)))))
(gnus-message 5 "Regenerating in %s" group)
(let* ((gnus-command-method (or gnus-command-method
(gnus-find-method-for-group group)))
@@ -3351,7 +3454,7 @@
(interactive "P")
(let (regenerated)
(gnus-message 4 "Regenerating Gnus agent files...")
- (dolist (gnus-command-method gnus-agent-covered-methods)
+ (dolist (gnus-command-method (gnus-agent-opened-methods))
(let ((active-file (gnus-agent-lib-file "active"))
active-hashtb active-changed
point)
@@ -3422,8 +3525,18 @@
(if (eq status 'offline) 'online 'offline))))
(defun gnus-agent-group-covered-p (group)
- (member (gnus-group-method group)
- gnus-agent-covered-methods))
+ (gnus-agent-method-p (gnus-group-method group)))
+
+(defun gnus-agent-covered-method (method)
+ "When given a full select method, truncate it to the minimal method
+stored in gnus-agent-covered-methods."
+
+ (let ((select (nth 0 method)))
+ (if (memq 'address
+ (assoc (symbol-name select)
+ gnus-valid-select-methods))
+ (list select (nth 1 method))
+ (list select))))
(add-hook 'gnus-group-prepare-hook
(lambda ()
diff -u lisp.cvs_ref/gnus-srvr.el lisp/gnus-srvr.el
--- lisp.cvs_ref/gnus-srvr.el Thu Nov 6 16:42:39 2003
+++ lisp/gnus-srvr.el Sun Oct 19 22:16:03 2003
@@ -281,8 +281,7 @@
"(closed)")
((error) "(error)")))))
(gnus-tmp-agent (if (and gnus-agent
- (member method
- gnus-agent-covered-methods))
+ (gnus-agent-method-p method))
" (agent)"
"")))
(beginning-of-line)
diff -u lisp.cvs_ref/gnus-start.el lisp/gnus-start.el
--- lisp.cvs_ref/gnus-start.el Thu Nov 6 16:42:39 2003
+++ lisp/gnus-start.el Mon Oct 20 00:48:52 2003
@@ -658,6 +658,7 @@
;; Clear other internal variables.
(setq gnus-list-of-killed-groups nil
gnus-have-read-active-file nil
+ gnus-agent-covered-methods nil
gnus-newsrc-alist nil
gnus-newsrc-hashtb nil
gnus-killed-list nil
diff -u lisp.cvs_ref/gnus-util.el lisp/gnus-util.el
--- lisp.cvs_ref/gnus-util.el Thu Nov 6 16:42:40 2003
+++ lisp/gnus-util.el Thu Nov 6 16:50:37 2003
@@ -160,6 +160,22 @@
`(delete-region (gnus-point-at-bol)
(progn (forward-line ,(or n 1)) (point))))
+(defun gnus-delete-if (elt list &optional func)
+ (setq func (or func #'equal))
+
+ (let* ((root (cons nil list))
+ (at root))
+ (while (cond ((not (cdr at))
+ nil)
+ ((funcall func elt (cadr at))
+ (setcdr at (cddr at))
+ t)
+ (t
+ (setq at (cdr at))
+ t)))
+ (cdr root)))
+
+
(defun gnus-byte-code (func)
"Return a form that can be `eval'ed based on FUNC."
(let ((fval (indirect-function func)))
diff -u lisp.cvs_ref/gnus.el lisp/gnus.el
--- lisp.cvs_ref/gnus.el Thu Nov 6 16:42:40 2003
+++ lisp/gnus.el Thu Nov 6 16:48:19 2003
@@ -2236,7 +2236,11 @@
(defvar gnus-agent-fetching nil
"Whether Gnus agent is in fetching mode.")
-(defvar gnus-agent-covered-methods nil)
+(defvar gnus-agent-covered-methods nil
+ "A list of abbreviated select methods. In this list, the
+abbreviated select methods identify the back end to use (e.g. `nntp',
+`nnimap', etc.) and the \"server name\". All other back end elements
+removed.")
(defvar gnus-command-method nil
"Dynamically bound variable that says what the current back end is.")
@@ -2348,7 +2352,7 @@
gnus-newsrc-alist gnus-server-alist
gnus-killed-list gnus-zombie-list
gnus-topic-topology gnus-topic-alist
- gnus-agent-covered-methods gnus-format-specs)
+ gnus-format-specs)
"Gnus variables saved in the quick startup file.")
(defvar gnus-newsrc-alist nil
@@ -3799,7 +3803,18 @@
(defun gnus-agent-method-p (method)
"Say whether METHOD is covered by the agent."
- (member method gnus-agent-covered-methods))
+ (catch 'found-match
+ (let ((covered-methods gnus-agent-covered-methods))
+ (while covered-methods
+ (let* ((covered-method (pop covered-methods))
+ (covered-method-select (nth 0 covered-method))
+ (covered-method-name (nth 1 covered-method))
+ (method-select (nth 0 method))
+ (method-name (nth 1 method)))
+ (if (and (eq covered-method-select method-select)
+ (or (not covered-method-name)
+ (equal covered-method-name method-name)))
+ (throw 'found-match t)))))))
(defun gnus-online (method)
(not
next prev parent reply other threads:[~2003-11-06 23:07 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2003-11-06 20:03 (Yet another stab at) Sharing ~/.newsrc.eld among multiple machines Steven E. Harris
2003-11-06 22:24 ` (Yet another stab at) Sharing ~/.newsrc.eld among multiple Simon Josefsson
2003-11-06 22:43 ` Steven E. Harris
2003-11-06 23:49 ` Simon Josefsson
2003-11-06 23:07 ` Kevin Greiner [this message]
2003-11-07 1:22 ` Steven E. Harris
2003-11-07 3:22 ` Kevin Greiner
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=uk76dm6zl.fsf@xpediantsolutions.com \
--to=kgreiner@xpediantsolutions.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).