;;; gnus-agent.el --- unplugged support for Gnus
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006 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
(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 ()
(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))
(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)))
;; 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)
(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))
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."
(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)
(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))
(delete-this (pop articles)))
(while (and (cdr next-possibility) delete-this)
(let ((have-this (caar (cdr next-possibility))))
- (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)))
- (size-file (float (or (and gnus-agent-total-fetched-hashtb
- (nth 7 (file-attributes file-name)))
- 0))))
- (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))))))
+ (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)))
+ (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)))))
(when (= (point-max) (point-min))
(push (cons group (current-buffer)) gnus-agent-buffer-alist)
(ignore-errors
- (nnheader-insert-file-contents
- (gnus-agent-article-name ".overview" group))))
+ (let ((file-name-coding-system nnmail-pathname-coding-system))
+ (nnheader-insert-file-contents
+ (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)
(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))) "~"))))
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)))))
+ (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)))
+ (agentview (gnus-agent-article-name ".agentview" group))
+ (file-name-coding-system nnmail-pathname-coding-system))
(if (file-exists-p overview)
(delete-file overview))
(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
+ "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))
- (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))
- nil 'silent))
- (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
- (while gnus-agent-group-alist
- (with-temp-file (gnus-agent-article-name
- ".agentview" (caar gnus-agent-group-alist))
- (princ (cdar gnus-agent-group-alist))
- (insert "\n")
- (princ 1 (current-buffer))
- (insert "\n"))
- (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
+ (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))
+ (write-region (point-min) (point-max)
+ (gnus-agent-article-name ".overview"
+ (caar gnus-agent-buffer-alist))
+ nil 'silent))
+ (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
+ (while gnus-agent-group-alist
+ (with-temp-file (gnus-agent-article-name
+ ".agentview" (caar gnus-agent-group-alist))
+ (princ (cdar gnus-agent-group-alist))
+ (insert "\n")
+ (princ 1 (current-buffer))
+ (insert "\n"))
+ (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))))
;;;###autoload
(defun gnus-agent-find-parameter (group symbol)
(gnus-agent-find-parameter group
'agent-predicate)))))
(articles (if fetch-all
- (gnus-uncompress-range (gnus-active group))
+ (if gnus-maximum-newsgroup
+ (let ((active (gnus-active group)))
+ (gnus-uncompress-range
+ (cons (max (car active)
+ (- (cdr active)
+ gnus-maximum-newsgroup -1))
+ (cdr active))))
+ (gnus-uncompress-range (gnus-active group)))
(gnus-list-of-unread-articles group)))
(gnus-decode-encoded-word-function 'identity)
- (file (gnus-agent-article-name ".overview" group)))
+ (gnus-decode-encoded-address-function 'identity)
+ (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
;; 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))))))
(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)
;; 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)))
(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)
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)
;; 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)
(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)
(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
(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.")))
(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)))
)
;; 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
(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)))
(save-excursion
(gnus-agent-create-buffer)
(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))
(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)
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)
(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)
+ (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)))
(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
(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))))
+ gnus-agent-total-fetched-hashtb)))
+ (file-name-coding-system nnmail-pathname-coding-system))
(when (listp delta)
(if delta
(let ((sum 0.0)
(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