;;; gnus-agent.el --- unplugged support for Gnus
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
:group 'gnus-agent
:type '(radio (const :format "Always" always)
(const :format "Never" nil)
- (const :format "When plugged" t)))
+ (const :format "When unplugged" t)))
(defcustom gnus-agent-prompt-send-queue nil
"If non-nil, `gnus-group-send-queue' will prompt if called when
(defvar gnus-headers)
(defvar gnus-score)
+;; Added to support XEmacs
+(eval-and-compile
+ (unless (fboundp 'directory-files-and-attributes)
+ (defun directory-files-and-attributes (directory
+ &optional full match nosort)
+ (let (result)
+ (dolist (file (directory-files directory full match nosort))
+ (push (cons file (file-attributes file)) result))
+ (nreverse result)))))
+
;;;
;;; Setup
;;;
(fboundp 'make-mode-line-mouse-map))
(propertize string 'local-map
(make-mode-line-mouse-map mouse-button mouse-func)
- 'mouse-face 'mode-line-highlight)
+ 'mouse-face
+ (cond ((and (featurep 'xemacs)
+ ;; XEmacs' `facep' only checks for a face
+ ;; object, not for a face name, so it's useless
+ ;; to check with `facep'.
+ (find-face 'modeline))
+ 'modeline)
+ ((facep 'mode-line-highlight) ;; Emacs 22
+ 'mode-line-highlight)
+ ((facep 'mode-line) ;; Emacs 21
+ 'mode-line)) )
string))
(defun gnus-agent-toggle-plugged (set-to)
;; For each article that I processed that is no longer
;; undownloaded, remove its processable mark.
- (mapc #'gnus-summary-remove-process-mark
+ (mapc #'gnus-summary-remove-process-mark
(gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
;; The preceeding call to (gnus-agent-summary-fetch-group)
(setq prev-num cur)))
(forward-line 1)))))))
+(defun gnus-agent-flush-server (&optional server-or-method)
+ "Flush all agent index files for every subscribed group within
+ the given SERVER-OR-METHOD. When called with nil, the current
+ value of gnus-command-method identifies the server."
+ (let* ((gnus-command-method (if server-or-method
+ (gnus-server-to-method server-or-method)
+ gnus-command-method))
+ (alist gnus-newsrc-alist))
+ (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)))))))
+
+(defun gnus-agent-flush-group (group)
+ "Flush the agent's index files such that the GROUP no longer
+appears to have any local content. The actual content, the
+article files, may then be deleted using gnus-agent-expire-group.
+If flushing was a mistake, the gnus-agent-regenerate-group method
+provides an undo mechanism by reconstructing the index files from
+the article files."
+ (interactive
+ (list (let ((def (or (gnus-group-group-name)
+ gnus-newsgroup-name)))
+ (let ((select (read-string (if def
+ (concat "Group Name ("
+ def "): ")
+ "Group Name: "))))
+ (if (and (equal "" select)
+ def)
+ def
+ select)))))
+
+ (let* ((gnus-command-method (or gnus-command-method
+ (gnus-find-method-for-group group)))
+ (overview (gnus-agent-article-name ".overview" group))
+ (agentview (gnus-agent-article-name ".agentview" group)))
+
+ (if (file-exists-p overview)
+ (delete-file overview))
+ (if (file-exists-p agentview)
+ (delete-file agentview))
+
+ (gnus-agent-update-view-total-fetched-for group nil gnus-command-method)
+ (gnus-agent-update-view-total-fetched-for group t gnus-command-method)
+
+ ;(gnus-agent-set-local group nil nil)
+ ;(gnus-agent-save-local t)
+ (gnus-agent-save-group-info nil group nil)))
+
(defun gnus-agent-flush-cache ()
+"Flush the agent's index files such that the group no longer
+appears to have any local content. The actual content, the
+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."
(save-excursion
(while gnus-agent-buffer-alist
(set-buffer (cdar gnus-agent-buffer-alist))
;; First, we'll fix the sort.
(sort-numeric-fields 1 (point-min) (point-max))
- ;; but now we have to consider that we may have duplicate rows...
+ ;; but now we have to consider that we may have duplicate rows...
;; so reset to beginning of file
(goto-char (point-min))
(setq last -134217728)
-
+
;; and throw a code that restarts this scan
(throw 'problems t))
nil))))))
(let ((gnus-agent-article-alist alist))
(gnus-agent-save-alist gnus-agent-read-agentview)))
alist))
- (file-error nil))))
+ ((end-of-file file-error)
+ ;; 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-attributes (directory-files-and-attributes
+ (gnus-agent-article-name ""
+ gnus-agent-read-agentview) nil "^[0-9]+$" t)))
+ (while file-attributes
+ (let ((fa (pop file-attributes)))
+ (unless (nth 1 fa)
+ (push (cons (string-to-number (nth 0 fa)) (time-to-days (nth 5 fa))) alist))))
+ alist)
+ (file-error nil))))))
(defun gnus-agent-save-alist (group &optional articles state)
"Save the article-state alist for GROUP."
(let (group
min
max
- (cur (current-buffer)))
+ (cur (current-buffer))
+ (obarray my-obarray))
(setq group (read cur)
min (read cur)
max (read cur))
(if (cond ((and minmax
(or (not (eq min (car minmax)))
- (not (eq max (cdr minmax)))))
+ (not (eq max (cdr minmax))))
+ min
+ max)
(setcar minmax min)
(setcdr minmax max)
t)
(or gnus-expert-user
(gnus-y-or-n-p
"gnus-agent-expire has identified local directories that are\
- not currently required by any agentized group. Do you wish to consider\
+ not currently required by any agentized group. Do you wish to consider\
deleting them?")))
(while to-remove
(let ((dir (pop to-remove)))
(dir (file-name-directory file))
point
(downloaded (if (file-exists-p dir)
- (sort (mapcar (lambda (name) (string-to-number name))
- (directory-files dir nil "^[0-9]+$" t))
+ (sort (delq nil (mapcar (lambda (name)
+ (and (not (file-directory-p (nnheader-concat dir name)))
+ (string-to-number name)))
+ (directory-files dir nil "^[0-9]+$" t)))
'>)
(progn (gnus-make-directory dir) nil)))
dl nov-arts
(gnus-agent-possibly-alter-active group group-active)))))
(when (and reread gnus-agent-article-alist)
- (gnus-agent-synchronize-group-flags
- group
+ (gnus-agent-synchronize-group-flags
+ group
(list (list
(if (listp reread)
reread
(defun gnus-agent-group-covered-p (group)
(gnus-agent-method-p (gnus-group-method group)))
-;; Added to support XEmacs
-(eval-and-compile
- (unless (fboundp 'directory-files-and-attributes)
- (defun directory-files-and-attributes (directory
- &optional full match nosort)
- (let (result)
- (dolist (file (directory-files directory full match nosort))
- (push (cons file (file-attributes file)) result))
- (nreverse result)))))
-
(defun gnus-agent-update-files-total-fetched-for
(group delta &optional method path)
"Update, or set, the total disk space used by the articles that the
(defun gnus-agent-total-fetched-for (group &optional method no-inhibit)
"Get the total disk space used by the specified GROUP."
- (unless gnus-agent-total-fetched-hashtb
- (setq gnus-agent-total-fetched-hashtb (gnus-make-hashtable 1024)))
-
- ;; if null, gnus-agent-group-pathname will calc method.
- (let* ((gnus-command-method method)
- (path (gnus-agent-group-pathname group))
- (entry (gnus-gethash path gnus-agent-total-fetched-hashtb)))
- (if entry
- (apply '+ entry)
- (let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit)))
- (+
- (gnus-agent-update-view-total-fetched-for group nil method path)
- (gnus-agent-update-view-total-fetched-for group t method path)
- (gnus-agent-update-files-total-fetched-for group nil method path))))))
+ (unless (equal group "dummy.group")
+ (unless gnus-agent-total-fetched-hashtb
+ (setq gnus-agent-total-fetched-hashtb (gnus-make-hashtable 1024)))
+
+ ;; if null, gnus-agent-group-pathname will calc method.
+ (let* ((gnus-command-method method)
+ (path (gnus-agent-group-pathname group))
+ (entry (gnus-gethash path gnus-agent-total-fetched-hashtb)))
+ (if entry
+ (apply '+ entry)
+ (let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit)))
+ (+
+ (gnus-agent-update-view-total-fetched-for group nil method path)
+ (gnus-agent-update-view-total-fetched-for group t method path)
+ (gnus-agent-update-files-total-fetched-for group nil method path)))))))
(provide 'gnus-agent)
projects / gnus / blobdiff