;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'timer))
(require 'cl))
-(eval-and-compile
- (autoload 'gnus-server-update-server "gnus-srvr")
- (autoload 'gnus-agent-customize-category "gnus-cus")
-)
+(autoload 'gnus-server-update-server "gnus-srvr")
+(autoload 'gnus-agent-customize-category "gnus-cus")
(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
"Where the Gnus agent will store its files."
:type 'boolean
:group 'gnus-agent)
-(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap)
+(defcustom gnus-agent-auto-agentize-methods nil
"Initially, all servers from these methods are agentized.
The user may remove or add servers using the Server buffer.
See Info node `(gnus)Server Buffer'."
`(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body)
(when (and gnus-agent-need-update-total-fetched-for
(not gnus-agent-inhibit-update-total-fetched-for))
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(setq gnus-agent-need-update-total-fetched-for nil)
(gnus-group-update-group ,group t)))))
(defun gnus-agent-stop-fetch ()
"Save all data structures and clean up."
(setq gnus-agent-spam-hashtb nil)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(widen)))
(defmacro gnus-agent-with-fetch (&rest forms)
(gnus-agent-make-mode-line-string " Plugged"
'mouse-2
'gnus-agent-toggle-plugged))
- (gnus-agent-go-online gnus-agent-go-online)
- (gnus-agent-possibly-synchronize-flags))
+ (gnus-agent-go-online gnus-agent-go-online))
(t
(gnus-agent-close-connections)
(setq gnus-plugged set-to)
(interactive)
(save-excursion
(dolist (gnus-command-method (gnus-agent-covered-methods))
- (when (and (file-exists-p (gnus-agent-lib-file "flags"))
- (eq (gnus-server-status gnus-command-method) 'ok))
+ (when (eq (gnus-server-status gnus-command-method) 'ok)
(gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
(defun gnus-agent-synchronize-flags-server (method)
(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)))))
+ (when (and (file-exists-p (gnus-agent-lib-file "flags"))
+ (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)))
;;;###autoload
(setq selected-sets (nreverse selected-sets))
(gnus-make-directory dir)
- (gnus-message 7 "Fetching articles for %s..." group)
+ (gnus-message 7 "Fetching articles for %s..."
+ (gnus-agent-decoded-group-name group))
(unwind-protect
(while (setq articles (pop selected-sets))
(let (article)
(while (setq article (pop articles))
(gnus-message 10 "Fetching article %s for %s..."
- article group)
+ article
+ (gnus-agent-decoded-group-name group))
(when (or
(gnus-backlog-request-article group article
nntp-server-buffer)
nntp-server-buffer (point-min) (point-max))
(setq pos (nreverse pos)))))
;; Then save these articles into the Agent.
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(while pos
(narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
(goto-char (point-min))
(setq date (or date t))
(let (gnus-agent-article-alist group alist beg end)
- (save-excursion
- (set-buffer gnus-agent-overview-buffer)
+ (with-current-buffer gnus-agent-overview-buffer
(when (nnheader-find-nov-line article)
(forward-word 1)
(setq beg (point))
(push (setq alist (list group (gnus-agent-load-alist (caar crosses))))
gnus-agent-group-alist))
(setcdr alist (cons (cons (cdar crosses) date) (cdr alist)))
- (save-excursion
- (set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
- group)))
+ (with-current-buffer (gnus-get-buffer-create
+ (format " *Gnus agent overview %s*"group))
(when (= (point-max) (point-min))
(push (cons group (current-buffer)) gnus-agent-buffer-alist)
(ignore-errors
(while alist
(let ((entry (pop alist)))
(when (gnus-methods-equal-p gnus-command-method (gnus-info-method entry))
- (gnus-agent-flush-group (gnus-info-group entry)))))))
+ (gnus-agent-flush-group (gnus-info-group entry)))))))
(defun gnus-agent-flush-group (group)
"Flush the agent's index files such that the GROUP no longer
article files, is then deleted using gnus-agent-expire-group. The
gnus-agent-regenerate-group method provides an undo mechanism by
reconstructing the index files from the article files."
+ (interactive)
(save-excursion
(let ((file-name-coding-system nnmail-pathname-coding-system))
(while gnus-agent-buffer-alist
10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
(gnus-compress-sequence articles t))
- (save-excursion
- (set-buffer nntp-server-buffer)
-
+ (with-current-buffer nntp-server-buffer
(if articles
(progn
- (gnus-message 7 "Fetching headers for %s..." group)
+ (gnus-message 7 "Fetching headers for %s..."
+ (gnus-agent-decoded-group-name group))
;; Fetch them.
(gnus-make-directory (nnheader-translate-file-chars
;; Keeps the compiler from warning about the free variable in
;; gnus-agent-read-agentview.
-(eval-when-compile
- (defvar gnus-agent-read-agentview))
+(defvar gnus-agent-read-agentview)
(defun gnus-agent-load-alist (group)
"Load the article-state alist for GROUP."
;; Bind free variable that's used in `gnus-agent-read-agentview'.
- (let ((gnus-agent-read-agentview group)
- (file-name-coding-system nnmail-pathname-coding-system))
+ (let* ((gnus-agent-read-agentview group)
+ (file-name-coding-system nnmail-pathname-coding-system)
+ (agentview (gnus-agent-article-name ".agentview" group)))
(setq gnus-agent-article-alist
- (gnus-cache-file-contents
- (gnus-agent-article-name ".agentview" group)
- 'gnus-agent-file-loading-cache
- 'gnus-agent-read-agentview))))
+ (and (file-exists-p agentview)
+ (gnus-cache-file-contents
+ agentview
+ 'gnus-agent-file-loading-cache
+ 'gnus-agent-read-agentview)))))
(defun gnus-agent-read-agentview (file)
"Load FILE and do a `read' there."
((= version 1)
(setq changed-version (not (= 1 gnus-agent-article-alist-save-format))))
((= version 2)
- (let (uncomp)
- (mapcar
- (lambda (comp-list)
- (let ((state (car comp-list))
- (sequence (inline
- (gnus-uncompress-range
- (cdr comp-list)))))
- (mapcar (lambda (article-id)
- (setq uncomp (cons (cons article-id state) uncomp)))
- sequence)))
- alist)
+ (let (state sequence uncomp)
+ (while alist
+ (setq state (caar alist)
+ sequence (inline (gnus-uncompress-range (cdar alist)))
+ alist (cdr alist))
+ (while sequence
+ (push (cons (pop sequence) state) uncomp)))
(setq alist (sort uncomp 'car-less-than-car)))
(setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
(when changed-version
(gnus-agent-save-alist gnus-agent-read-agentview)))
alist))
((end-of-file file-error)
- ;; The agentview file is missing.
+ ;; The agentview file is missing.
(condition-case nil
;; If the agent directory exists, attempt to perform a brute-force
;; reconstruction of its contents.
(let* (alist
(file-name-coding-system nnmail-pathname-coding-system)
- (file-attributes (directory-files-and-attributes
+ (file-attributes (directory-files-and-attributes
(gnus-agent-article-name ""
gnus-agent-read-agentview) nil "^[0-9]+$" t)))
(while file-attributes
(cond ((eq gnus-agent-article-alist-save-format 1)
(princ gnus-agent-article-alist (current-buffer)))
((eq gnus-agent-article-alist-save-format 2)
- (let ((compressed nil))
- (mapcar (lambda (pair)
- (let* ((article-id (car pair))
- (day-of-download (cdr pair))
- (comp-list (assq day-of-download compressed)))
- (if comp-list
- (setcdr comp-list
- (cons article-id (cdr comp-list)))
- (setq compressed
- (cons (list day-of-download article-id)
- compressed)))
- nil)) gnus-agent-article-alist)
- (mapcar (lambda (comp-list)
- (setcdr comp-list
- (gnus-compress-sequence
- (nreverse (cdr comp-list)))))
- compressed)
+ (let ((alist gnus-agent-article-alist)
+ article-id day-of-download comp-list compressed)
+ (while alist
+ (setq article-id (caar alist)
+ day-of-download (cdar alist)
+ comp-list (assq day-of-download compressed)
+ alist (cdr alist))
+ (if comp-list
+ (setcdr comp-list (cons article-id (cdr comp-list)))
+ (push (list day-of-download article-id) compressed)))
+ (setq alist compressed)
+ (while alist
+ (setq comp-list (pop alist))
+ (setcdr comp-list
+ (gnus-compress-sequence (nreverse (cdr comp-list)))))
(princ compressed (current-buffer)))))
(insert "\n")
(princ gnus-agent-article-alist-save-format (current-buffer))
(gnus-agent-update-view-total-fetched-for group nil)))
(defvar gnus-agent-article-local nil)
+(defvar gnus-agent-article-local-times nil)
(defvar gnus-agent-file-loading-local nil)
(defun gnus-agent-load-local (&optional method)
"Load the METHOD'S local file. The local file contains min/max
article counts for each of the method's subscribed groups."
(let ((gnus-command-method (or method gnus-command-method)))
- (setq gnus-agent-article-local
- (gnus-cache-file-contents
- (gnus-agent-lib-file "local")
- 'gnus-agent-file-loading-local
- 'gnus-agent-read-and-cache-local))))
+ (when (or (null gnus-agent-article-local-times)
+ (zerop gnus-agent-article-local-times))
+ (setq gnus-agent-article-local
+ (gnus-cache-file-contents
+ (gnus-agent-lib-file "local")
+ 'gnus-agent-file-loading-local
+ 'gnus-agent-read-and-cache-local))
+ (when gnus-agent-article-local-times
+ (incf gnus-agent-article-local-times)))
+ gnus-agent-article-local))
(defun gnus-agent-read-and-cache-local (file)
"Load and read FILE then bind its contents to
gnus-agent-article-local. If that variable had `dirty' (also known as
modified) original contents, they are first saved to their own file."
-
(if (and gnus-agent-article-local
(symbol-value (intern "+dirty" gnus-agent-article-local)))
(gnus-agent-save-local))
(local (or local (gnus-agent-load-local)))
(symb (intern gmane local))
(minmax (and (boundp symb) (symbol-value symb))))
-
(if (cond ((and minmax
(or (not (eq min (car minmax)))
(not (eq max (cdr minmax))))
(defun gnus-agent-batch-confirmation (msg)
"Show error message and return t."
- (gnus-message 1 msg)
+ (gnus-message 1 "%s" msg)
t)
;;;###autoload
(defvar gnus-agent-predicate 'false
"The selection predicate used when no other source is available.")
-(defvar gnus-agent-short-article 100
+(defvar gnus-agent-short-article 500
"Articles that have fewer lines than this are short.")
-(defvar gnus-agent-long-article 200
+(defvar gnus-agent-long-article 1000
"Articles that have more lines than this are long.")
(defvar gnus-agent-low-score 0
(defun gnus-category-setup-buffer ()
(unless (get-buffer gnus-category-buffer)
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-category-buffer))
+ (with-current-buffer (gnus-get-buffer-create gnus-category-buffer)
(gnus-category-mode))))
(defun gnus-category-prepare ()
group overview (gnus-gethash-safe group orig)
articles force))))
(kill-buffer overview))))
- (gnus-message 4 (gnus-agent-expire-done-message)))))
+ (gnus-message 4 "%s" (gnus-agent-expire-done-message)))))
(defun gnus-agent-expire-group-1 (group overview active articles force)
;; Internal function - requires caller to have set
(gnus-message 7 "gnus-agent-expire: Loading overview...")
(nnheader-insert-file-contents nov-file)
(goto-char (point-min))
-
+
(let (p)
(while (< (setq p (point)) (point-max))
(condition-case nil
;; Check the order of the entry positions. They should be in
;; ascending order. If they aren't, the positions must be
;; converted to markers.
- (when (let ((dlist dlist)
- (prev-pos -1)
- pos)
- (while dlist
- (if (setq pos (nth 3 (pop dlist)))
- (if (< pos prev-pos)
- (throw 'sort-results 'unsorted)
- (setq prev-pos pos)))))
+ (when (catch 'sort-results
+ (let ((dlist dlist)
+ (prev-pos -1)
+ pos)
+ (while dlist
+ (if (setq pos (nth 3 (pop dlist)))
+ (if (< pos prev-pos)
+ (throw 'sort-results 'unsorted)
+ (setq prev-pos pos))))))
(gnus-message 7 "gnus-agent-expire: Unsorted overview; inserting markers to compensate.")
- (mapcar (lambda (entry)
+ (mapc (lambda (entry)
(let ((pos (nth 3 entry)))
(if pos
(setf (nth 3 entry)
expiring-group overview active articles force))))))))
(kill-buffer overview))
(gnus-agent-expire-unagentized-dirs)
- (gnus-message 4 (gnus-agent-expire-done-message))))))
+ (gnus-message 4 "%s" (gnus-agent-expire-done-message))))))
(defun gnus-agent-expire-done-message ()
(if (and (> gnus-verbose 4)
deleting them?")))
(while to-remove
(let ((dir (pop to-remove)))
- (if (gnus-y-or-n-p (format "Delete %s? " dir))
+ (if (or gnus-expert-user
+ (gnus-y-or-n-p (format "Delete %s? " dir)))
(let* (delete-recursive
+ files f
(delete-recursive
(function
(lambda (f-or-d)
(condition-case nil
(delete-directory f-or-d)
(file-error
- (mapcar (lambda (f)
- (or (member f '("." ".."))
- (funcall delete-recursive
- (nnheader-concat
- f-or-d f))))
- (directory-files f-or-d))
+ (setq files (directory-files f-or-d))
+ (while files
+ (setq f (pop files))
+ (or (member f '("." ".."))
+ (funcall delete-recursive
+ (nnheader-concat
+ f-or-d f))))
(delete-directory f-or-d)))
(delete-file f-or-d)))))))
(funcall delete-recursive dir))))))))))
(sit-for 1)
t)))))
(when group
- (gnus-message 5 "Regenerating in %s" group)
+ (gnus-message 5 "Regenerating in %s" (gnus-agent-decoded-group-name group))
(let* ((gnus-command-method (or gnus-command-method
(gnus-find-method-for-group group)))
(file (gnus-agent-article-name ".overview" group))
(or (not nov-arts)
(> (car downloaded) (car nov-arts))))
;; This entry is missing from the overview file
- (gnus-message 3 "Regenerating NOV %s %d..." group
+ (gnus-message 3 "Regenerating NOV %s %d..."
+ (gnus-agent-decoded-group-name group)
(car downloaded))
(let ((file (concat dir (number-to-string (car downloaded)))))
(mm-with-unibyte-buffer
(provide 'gnus-agent)
-;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e
;;; gnus-agent.el ends here