[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-agent.el,v
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-agent.el,v |
|
Date: |
Sun, 28 Oct 2007 09:19:15 +0000 |
CVSROOT: /cvsroot/emacs
Module name: emacs
Changes by: Miles Bader <miles> 07/10/28 09:18:40
Index: lisp/gnus/gnus-agent.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/gnus-agent.el,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -b -r1.35 -r1.36
--- lisp/gnus/gnus-agent.el 9 Oct 2007 08:52:57 -0000 1.35
+++ lisp/gnus/gnus-agent.el 28 Oct 2007 09:18:31 -0000 1.36
@@ -115,7 +115,7 @@
:group 'gnus-agent
:type 'function)
-(defcustom gnus-agent-synchronize-flags t
+(defcustom gnus-agent-synchronize-flags nil
"Indicate if flags are synchronized when you plug in.
If this is `ask' the hook will query the user."
;; If the default switches to something else than nil, then the function
@@ -251,11 +251,24 @@
(defvar gnus-agent-send-mail-function nil)
(defvar gnus-agent-file-coding-system 'raw-text)
(defvar gnus-agent-file-loading-cache nil)
+(defvar gnus-agent-total-fetched-hashtb nil)
+(defvar gnus-agent-inhibit-update-total-fetched-for nil)
+(defvar gnus-agent-need-update-total-fetched-for nil)
;; Dynamic variables
(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
;;;
@@ -290,6 +303,17 @@
;;; Utility functions
;;;
+(defmacro gnus-agent-with-refreshed-group (group &rest body)
+ "Performs the body then updates the group's line in the group
+buffer. Automatically blocks multiple updates due to recursion."
+`(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)
+ (setq gnus-agent-need-update-total-fetched-for nil)
+ (gnus-group-update-group ,group t)))))
+
(defun gnus-agent-read-file (file)
"Load FILE and do a `read' there."
(with-temp-buffer
@@ -435,6 +459,16 @@
(defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
(list name `(agent-predicate . ,(or default-agent-predicate 'false))))
+(defun gnus-agent-read-group ()
+ "Read a group name in the minibuffer, with completion."
+ (let ((def (or (gnus-group-group-name) gnus-newsgroup-name)))
+ (when def
+ (setq def (gnus-group-decoded-name def)))
+ (gnus-group-completing-read (if def
+ (concat "Group Name (" def "): ")
+ "Group Name: ")
+ nil nil t nil nil def)))
+
;;; Fetching setup functions.
(defun gnus-agent-start-fetch ()
@@ -892,7 +926,8 @@
(new-command-method (gnus-find-method-for-group new-group))
(new-path (directory-file-name
(let (gnus-command-method new-command-method)
- (gnus-agent-group-pathname new-group)))))
+ (gnus-agent-group-pathname new-group))))
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-rename-file old-path new-path t)
(let* ((old-real-group (gnus-group-real-name old-group))
@@ -920,7 +955,8 @@
(let* ((command-method (gnus-find-method-for-group group))
(path (directory-file-name
(let (gnus-command-method command-method)
- (gnus-agent-group-pathname group)))))
+ (gnus-agent-group-pathname group))))
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-delete-directory path)
(let* ((real-group (gnus-group-real-name group)))
@@ -1285,7 +1321,8 @@
(gnus-active-to-gnus-format nil new)
(gnus-agent-write-active file new)
(erase-buffer)
- (nnheader-insert-file-contents file))))
+ (let ((nnheader-file-coding-system gnus-agent-file-coding-system))
+ (nnheader-insert-file-contents file)))))
(defun gnus-agent-write-active (file new)
(gnus-make-directory (file-name-directory file))
@@ -1398,6 +1435,18 @@
oactive-min (read (current-buffer))) ;; min
(cons oactive-min oactive-max))))))))
+(defvar gnus-agent-decoded-group-names nil
+ "Alist of non-ASCII group names and decoded ones.")
+
+(defun gnus-agent-decoded-group-name (group)
+ "Return a decoded group name of GROUP."
+ (or (cdr (assoc group gnus-agent-decoded-group-names))
+ (if (string-match "[^\000-\177]" group)
+ (let ((decoded (gnus-group-decoded-name group)))
+ (push (cons group decoded) gnus-agent-decoded-group-names)
+ decoded)
+ group)))
+
(defun gnus-agent-group-path (group)
"Translate GROUP into a file name."
@@ -1409,26 +1458,25 @@
(nnheader-translate-file-chars
(nnheader-replace-duplicate-chars-in-string
(nnheader-replace-chars-in-string
- (gnus-group-real-name (gnus-group-decoded-name group))
+ (gnus-group-real-name (gnus-agent-decoded-group-name group))
?/ ?_)
?. ?_)))
(if (or nnmail-use-long-file-names
(file-directory-p (expand-file-name group (gnus-agent-directory))))
group
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string group ?. ?/)
- nnmail-pathname-coding-system)))
+ (nnheader-replace-chars-in-string group ?. ?/)))
(defun gnus-agent-group-pathname (group)
"Translate GROUP into a file name."
;; nnagent uses nnmail-group-pathname to read articles while
;; unplugged. The agent must, therefore, use the same directory
;; while plugged.
- (let ((gnus-command-method (or gnus-command-method
- (gnus-find-method-for-group group))))
- (nnmail-group-pathname (gnus-group-real-name
- (gnus-group-decoded-name group))
- (gnus-agent-directory))))
+ (nnmail-group-pathname
+ (gnus-group-real-name (gnus-agent-decoded-group-name group))
+ (if gnus-command-method
+ (gnus-agent-directory)
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (gnus-agent-directory)))))
(defun gnus-agent-get-function (method)
(if (gnus-online method)
@@ -1532,7 +1580,8 @@
(dir (gnus-agent-group-pathname group))
(date (time-to-days (current-time)))
(case-fold-search t)
- pos crosses id)
+ pos crosses id
+ (file-name-coding-system nnmail-pathname-coding-system))
(setcar selected-sets (nreverse (car selected-sets)))
(setq selected-sets (nreverse selected-sets))
@@ -1601,12 +1650,16 @@
(setq pos (cdr pos)))))
(gnus-agent-save-alist group (cdr fetched-articles) date)
+ (gnus-agent-update-files-total-fetched-for group (cdr
fetched-articles))
+
(gnus-message 7 ""))
(cdr fetched-articles))))))
(defun gnus-agent-unfetch-articles (group articles)
"Delete ARTICLES that were fetched from GROUP into the agent."
(when articles
+ (gnus-agent-with-refreshed-group
+ group
(gnus-agent-load-alist group)
(let* ((alist (cons nil gnus-agent-article-alist))
(articles (sort articles #'<))
@@ -1614,20 +1667,29 @@
(delete-this (pop articles)))
(while (and (cdr next-possibility) delete-this)
(let ((have-this (caar (cdr next-possibility))))
- (cond ((< delete-this have-this)
+ (cond
+ ((< delete-this have-this)
(setq delete-this (pop articles)))
((= delete-this have-this)
(let ((timestamp (cdar (cdr next-possibility))))
(when timestamp
(let* ((file-name (concat (gnus-agent-group-pathname group)
- (number-to-string have-this))))
- (delete-file file-name))))
+ (number-to-string have-this)))
+ (size-file
+ (float (or (and gnus-agent-total-fetched-hashtb
+ (nth 7 (file-attributes file-name)))
+ 0)))
+ (file-name-coding-system
+ nnmail-pathname-coding-system))
+ (delete-file file-name)
+ (gnus-agent-update-files-total-fetched-for
+ group (- size-file)))))
(setcdr next-possibility (cddr next-possibility)))
(t
(setq next-possibility (cdr next-possibility))))))
(setq gnus-agent-article-alist (cdr alist))
- (gnus-agent-save-alist group))))
+ (gnus-agent-save-alist group)))))
(defun gnus-agent-crosspost (crosses article &optional date)
(setq date (or date t))
@@ -1651,8 +1713,9 @@
(when (= (point-max) (point-min))
(push (cons group (current-buffer)) gnus-agent-buffer-alist)
(ignore-errors
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
(nnheader-insert-file-contents
- (gnus-agent-article-name ".overview" group))))
+ (gnus-agent-article-name ".overview" group)))))
(nnheader-find-nov-line (string-to-number (cdar crosses)))
(insert (string-to-number (cdar crosses)))
(insert-buffer-substring gnus-agent-overview-buffer beg end)
@@ -1663,7 +1726,8 @@
(when gnus-newsgroup-name
(let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name))
(cnt 0)
- name)
+ name
+ (file-name-coding-system nnmail-pathname-coding-system))
(while (file-exists-p
(setq name (concat root "~"
(int-to-string (setq cnt (1+ cnt))) "~"))))
@@ -1697,7 +1761,7 @@
(gnus-message 1
"Overview buffer contains garbage '%s'."
(buffer-substring
- p (gnus-point-at-eol))))
+ p (point-at-eol))))
((= cur prev-num)
(or backed-up
(setq backed-up (gnus-agent-backup-overview-buffer)))
@@ -1715,12 +1779,58 @@
(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 (gnus-agent-read-group)))
+
+ (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))
+ (file-name-coding-system nnmail-pathname-coding-system))
+
+ (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."
+ (interactive)
(save-excursion
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
(while gnus-agent-buffer-alist
(set-buffer (cdar gnus-agent-buffer-alist))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
+ (let ((coding-system-for-write gnus-agent-file-coding-system))
(write-region (point-min) (point-max)
(gnus-agent-article-name ".overview"
(caar gnus-agent-buffer-alist))
@@ -1733,7 +1843,7 @@
(insert "\n")
(princ 1 (current-buffer))
(insert "\n"))
- (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
+ (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))))
;;;###autoload
(defun gnus-agent-find-parameter (group symbol)
@@ -1777,7 +1887,8 @@
(gnus-list-of-unread-articles group)))
(gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
- (file (gnus-agent-article-name ".overview" group)))
+ (file (gnus-agent-article-name ".overview" group))
+ (file-name-coding-system nnmail-pathname-coding-system))
(unless fetch-all
;; Add articles with marks to the list of article headers we want to
@@ -1857,6 +1968,7 @@
gnus-agent-file-coding-system))
(gnus-agent-check-overview-buffer)
(write-region (point-min) (point-max) file nil 'silent))
+ (gnus-agent-update-view-total-fetched-for group t)
(gnus-agent-save-alist group articles nil)
articles)
(ignore-errors
@@ -1998,7 +2110,8 @@
(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))
+ (let ((gnus-agent-read-agentview group)
+ (file-name-coding-system nnmail-pathname-coding-system))
(setq gnus-agent-article-alist
(gnus-cache-file-contents
(gnus-agent-article-name ".agentview" group)
@@ -2037,24 +2150,35 @@
((= 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
(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-name-coding-system nnmail-pathname-coding-system)
+ (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."
@@ -2085,27 +2209,27 @@
(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)))
+ (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
- (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)
+ (gnus-compress-sequence (nreverse (cdr comp-list)))))
(princ compressed (current-buffer)))))
(insert "\n")
(princ gnus-agent-article-alist-save-format (current-buffer))
- (insert "\n"))))
+ (insert "\n"))
+
+ (gnus-agent-update-view-total-fetched-for group nil)))
(defvar gnus-agent-article-local nil)
(defvar gnus-agent-file-loading-local nil)
@@ -2183,10 +2307,10 @@
(dest (gnus-agent-lib-file "local")))
(gnus-make-directory (gnus-agent-lib-file ""))
- (let ((buffer-file-coding-system gnus-agent-file-coding-system))
+ (let ((coding-system-for-write gnus-agent-file-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system))
(with-temp-file dest
(let ((gnus-command-method (symbol-value (intern "+method"
my-obarray)))
- (file-name-coding-system nnmail-pathname-coding-system)
print-level print-length item article
(standard-output (current-buffer)))
(mapatoms (lambda (symbol)
@@ -2654,7 +2778,7 @@
(gnus-category-position-point)))
(defun gnus-category-name ()
- (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category))
+ (or (intern (get-text-property (point-at-bol) 'gnus-category))
(error "No category on the current line")))
(defun gnus-category-read ()
@@ -2975,17 +3099,7 @@
if ARTICLES is t, all articles.
if ARTICLES is a list, just those articles.
FORCE is equivalent to setting the expiration predicates to true."
- (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)))))
+ (interactive (list (gnus-agent-read-group)))
(if (not group)
(gnus-agent-expire articles group force)
@@ -3020,7 +3134,11 @@
;; gnus-command-method, initialized overview buffer, and to have
;; provided a non-nil active
- (let ((dir (gnus-agent-group-pathname group)))
+ (let ((dir (gnus-agent-group-pathname group))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ (decoded (gnus-agent-decoded-group-name group)))
+ (gnus-agent-with-refreshed-group
+ group
(when (boundp 'gnus-agent-expire-current-dirs)
(set 'gnus-agent-expire-current-dirs
(cons dir
@@ -3029,10 +3147,11 @@
(if (and (not force)
(eq 'DISABLE (gnus-agent-find-parameter group
'agent-enable-expiration)))
- (gnus-message 5 "Expiry skipping over %s" group)
- (gnus-message 5 "Expiring articles in %s" group)
+ (gnus-message 5 "Expiry skipping over %s" decoded)
+ (gnus-message 5 "Expiring articles in %s" decoded)
(gnus-agent-load-alist group)
(let* ((bytes-freed 0)
+ (size-files-deleted 0.0)
(files-deleted 0)
(nov-entries-deleted 0)
(info (gnus-get-info group))
@@ -3109,7 +3228,7 @@
;; information with this list. For example, a flag indicating
;; that a particular article MUST BE KEPT. To do this, I'm
;; going to transform the elements to look like (article#
- ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
+ ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse
;; the process to generate the expired article alist.
;; Convert the alist elements to (article# fetch_date nil
@@ -3146,10 +3265,10 @@
(while (< (setq p (point)) (point-max))
(condition-case nil
;; If I successfully read an integer (the plus zero
- ;; ensures a numeric type), prepend a marker entry
+ ;; ensures a numeric type), append the position
;; to the list
(push (list (+ 0 (read (current-buffer))) nil nil
- (set-marker (make-marker) p))
+ p)
dlist)
(error
(gnus-message 1 "gnus-agent-expire: read error \
@@ -3201,15 +3320,40 @@
(setq first (cdr first)
secnd (cdr secnd))
(setcar first (or (car first)
- (car secnd))) ; NOV_entry_marker
+ (car secnd))) ; NOV_entry_position
(setcdr dlist (cddr dlist)))
(setq dlist (cdr dlist)))))
+
+ ;; 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 (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.")
+ (mapc (lambda (entry)
+ (let ((pos (nth 3 entry)))
+ (if pos
+ (setf (nth 3 entry)
+ (set-marker (make-marker)
+ pos)))))
+ dlist))
+
(gnus-message 7 "gnus-agent-expire: Merging entries... Done")
(let* ((len (float (length dlist)))
(alist (list nil))
- (tail-alist alist))
+ (tail-alist alist)
+ (position-offset 0)
+ )
+
(while dlist
(let ((new-completed (truncate (* 100.0
(/ (setq cnt (1+ cnt))
@@ -3229,7 +3373,7 @@
(keep
(gnus-agent-message 10
"gnus-agent-expire: %s:%d: Kept %s
article%s."
- group article-number keep (if fetch-date "
and file" ""))
+ decoded article-number keep (if fetch-date
" and file" ""))
(when fetch-date
(unless (file-exists-p
(concat dir (number-to-string
@@ -3237,7 +3381,7 @@
(setf (nth 1 entry) nil)
(gnus-agent-message 3 "gnus-agent-expire cleared \
download flag on %s:%d as the cached article file is missing."
- group (caar dlist)))
+ decoded (caar dlist)))
(unless marker
(gnus-message 1 "gnus-agent-expire detected a \
missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
@@ -3277,6 +3421,7 @@
article-number)))
(size (float (nth 7 (file-attributes file-name)))))
(incf bytes-freed size)
+ (incf size-files-deleted size)
(incf files-deleted)
(delete-file file-name))
(push "expired cached article" actions))
@@ -3285,13 +3430,18 @@
(when marker
(push "NOV entry removed" actions)
- (goto-char marker)
+
+ (goto-char (if (markerp marker)
+ marker
+ (- marker position-offset)))
(incf nov-entries-deleted)
- (let ((from (gnus-point-at-bol))
- (to (progn (forward-line 1) (point))))
- (incf bytes-freed (- to from))
+ (let* ((from (point-at-bol))
+ (to (progn (forward-line 1) (point)))
+ (freed (- to from)))
+ (incf bytes-freed freed)
+ (incf position-offset freed)
(delete-region from to)))
;; If considering all articles is set, I can only
@@ -3308,19 +3458,19 @@
(when actions
(gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
- group article-number
+ decoded article-number
(mapconcat 'identity actions ", ")))))
(t
(gnus-agent-message
10 "gnus-agent-expire: %s:%d: Article kept as \
-expiration tests failed." group article-number)
+expiration tests failed." decoded article-number)
(gnus-agent-append-to-list
tail-alist (cons article-number fetch-date)))
)
- ;; Clean up markers as I want to recycle this buffer
- ;; over several groups.
- (when marker
+ ;; Remove markers as I intend to reuse this buffer again.
+ (when (and marker
+ (markerp marker))
(set-marker marker nil))
(setq dlist (cdr dlist))))
@@ -3340,7 +3490,8 @@
'silent)
;; clear the modified flag as that I'm not confused by
;; its status on the next pass through this routine.
- (set-buffer-modified-p nil)))
+ (set-buffer-modified-p nil)
+ (gnus-agent-update-view-total-fetched-for group t)))
(when (eq articles t)
(gnus-summary-update-info))))
@@ -3350,7 +3501,8 @@
(incf (nth 2 stats) bytes-freed)
(incf (nth 1 stats) files-deleted)
(incf (nth 0 stats) nov-entries-deleted)))
- ))))
+
+ (gnus-agent-update-files-total-fetched-for group (-
size-files-deleted)))))))
(defun gnus-agent-expire (&optional articles group force)
"Expire all old articles.
@@ -3428,7 +3580,8 @@
;; compiler will not complain about free references.
(gnus-agent-expire-current-dirs
(symbol-value 'gnus-agent-expire-current-dirs))
- dir)
+ dir
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-sethash gnus-agent-directory t keep)
(while gnus-agent-expire-current-dirs
@@ -3485,6 +3638,7 @@
(let ((dir (pop to-remove)))
(if (gnus-y-or-n-p (format "Delete %s? " dir))
(let* (delete-recursive
+ files f
(delete-recursive
(function
(lambda (f-or-d)
@@ -3493,12 +3647,13 @@
(condition-case nil
(delete-directory f-or-d)
(file-error
- (mapcar (lambda (f)
+ (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))))
- (directory-files f-or-d))
(delete-directory f-or-d)))
(delete-file f-or-d)))))))
(funcall delete-recursive dir))))))))))
@@ -3582,7 +3737,8 @@
(let ((gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
(file (gnus-agent-article-name ".overview" group))
- cached-articles uncached-articles)
+ cached-articles uncached-articles
+ (file-name-coding-system nnmail-pathname-coding-system))
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
@@ -3685,6 +3841,8 @@
(gnus-agent-check-overview-buffer)
(write-region (point-min) (point-max) file nil 'silent))
+ (gnus-agent-update-view-total-fetched-for group t)
+
;; Update the group's article alist to include the newly
;; fetched articles.
(gnus-agent-load-alist group)
@@ -3715,7 +3873,8 @@
(numberp article))
(let* ((gnus-command-method (gnus-find-method-for-group group))
(file (gnus-agent-article-name (number-to-string article) group))
- (buffer-read-only nil))
+ (buffer-read-only nil)
+ (file-name-coding-system nnmail-pathname-coding-system))
(when (and (file-exists-p file)
(> (nth 7 (file-attributes file)) 0))
(erase-buffer)
@@ -3732,16 +3891,7 @@
the articles' current headers.
If REREAD is not nil, downloaded articles are marked as unread."
(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)))
+ (list (gnus-agent-read-group)
(catch 'mark
(while (let (c
(cursor-in-echo-area t)
@@ -3765,6 +3915,7 @@
(file (gnus-agent-article-name ".overview" group))
(dir (file-name-directory file))
point
+ (file-name-coding-system nnmail-pathname-coding-system)
(downloaded (if (file-exists-p dir)
(sort (delq nil (mapcar (lambda (name)
(and (not
(file-directory-p (nnheader-concat dir name)))
@@ -3947,8 +4098,8 @@
'del '(read)))
gnus-command-method)
- (when (gnus-buffer-live-p gnus-group-buffer)
- (gnus-group-update-group group t)))
+ (when regenerated
+ (gnus-agent-update-files-total-fetched-for group nil)))
(gnus-message 5 "")
regenerated)))
@@ -3996,6 +4147,84 @@
(defun gnus-agent-group-covered-p (group)
(gnus-agent-method-p (gnus-group-method group)))
+(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
+agent has fetched."
+ (when gnus-agent-total-fetched-hashtb
+ (gnus-agent-with-refreshed-group
+ group
+ ;; if null, gnus-agent-group-pathname will calc method.
+ (let* ((gnus-command-method method)
+ (path (or path (gnus-agent-group-pathname group)))
+ (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
+ (gnus-sethash path (make-list 3 0)
+ gnus-agent-total-fetched-hashtb)))
+ (file-name-coding-system nnmail-pathname-coding-system))
+ (when (listp delta)
+ (if delta
+ (let ((sum 0.0)
+ file)
+ (while (setq file (pop delta))
+ (incf sum (float (or (nth 7 (file-attributes
+ (nnheader-concat
+ path
+ (if (numberp file)
+ (number-to-string file)
+ file)))) 0))))
+ (setq delta sum))
+ (let ((sum (- (nth 2 entry)))
+ (info (directory-files-and-attributes path nil "^-?[0-9]+$" t))
+ file)
+ (while (setq file (pop info))
+ (incf sum (float (or (nth 8 file) 0))))
+ (setq delta sum))))
+
+ (setq gnus-agent-need-update-total-fetched-for t)
+ (incf (nth 2 entry) delta)))))
+
+(defun gnus-agent-update-view-total-fetched-for
+ (group agent-over &optional method path)
+ "Update, or set, the total disk space used by the .agentview and
+.overview files. These files are calculated separately as they can be
+modified."
+ (when gnus-agent-total-fetched-hashtb
+ (gnus-agent-with-refreshed-group
+ group
+ ;; if null, gnus-agent-group-pathname will calc method.
+ (let* ((gnus-command-method method)
+ (path (or path (gnus-agent-group-pathname group)))
+ (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb)
+ (gnus-sethash path (make-list 3 0)
+ gnus-agent-total-fetched-hashtb)))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ (size (or (nth 7 (file-attributes
+ (nnheader-concat
+ path (if agent-over
+ ".overview"
+ ".agentview"))))
+ 0)))
+ (setq gnus-agent-need-update-total-fetched-for t)
+ (setf (nth (if agent-over 1 0) entry) size)))))
+
+(defun gnus-agent-total-fetched-for (group &optional method no-inhibit)
+ "Get the total disk space used by the specified GROUP."
+ (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)
;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e