X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=04bdb3be6267a8621dfc801f0d82403bdc0bff02;hp=918aa2d6ea819847680ecabc14ce3c5e2628e152;hb=ca3685c9e20ae1fe87c3147c6b6eb9b4d18f9ccb;hpb=a9a9b06ed0b9c8a32feead9191ea729d411a3a49 diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 918aa2d6e..04bdb3be6 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,15 +1,15 @@ ;;; 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 ;; 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 @@ -17,9 +17,7 @@ ;; 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 . ;;; Commentary: @@ -39,10 +37,8 @@ (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." @@ -188,7 +184,7 @@ When found, offer to remove them." :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'." @@ -309,8 +305,7 @@ 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) + (with-current-buffer gnus-group-buffer (setq gnus-agent-need-update-total-fetched-for nil) (gnus-group-update-group ,group t))))) @@ -459,6 +454,13 @@ manipulated as follows: (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 nil nil t nil nil def))) + ;;; Fetching setup functions. (defun gnus-agent-start-fetch () @@ -468,8 +470,7 @@ manipulated as follows: (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) @@ -602,16 +603,13 @@ manipulated as follows: (propertize string 'local-map (make-mode-line-mouse-map mouse-button mouse-func) '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)) ) + (if (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 + 'mode-line-highlight)) string)) (defun gnus-agent-toggle-plugged (set-to) @@ -626,8 +624,7 @@ manipulated as follows: (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) @@ -816,11 +813,11 @@ be a select method." (interactive (list (intern - (completing-read - "Add to category: " - (mapcar (lambda (cat) (list (symbol-name (car cat)))) + (gnus-completing-read + "Add to category" + (mapcar (lambda (cat) (symbol-name (car cat))) gnus-category-alist) - nil t)) + t)) current-prefix-arg)) (let ((cat (assq category gnus-category-alist)) c groups) @@ -858,8 +855,7 @@ be a select method." (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) @@ -895,11 +891,13 @@ be a select 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 @@ -1025,7 +1023,7 @@ supported." (unless (member server gnus-agent-covered-methods) (push server gnus-agent-covered-methods) (setq gnus-agent-method-p-cache nil)) - (gnus-message 1 "Ignoring disappeared server `%s'" server)))) + (gnus-message 8 "Ignoring disappeared server `%s'" server)))) (prog1 gnus-agent-covered-methods (setq gnus-agent-covered-methods nil)))) @@ -1311,7 +1309,8 @@ This can be added to `gnus-select-article-hook' or (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)) @@ -1424,6 +1423,18 @@ downloaded into the agent." 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." @@ -1435,7 +1446,7 @@ downloaded into the agent." (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 @@ -1448,11 +1459,12 @@ downloaded into the agent." ;; 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) @@ -1563,7 +1575,8 @@ downloaded into the agent." (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)) @@ -1574,7 +1587,8 @@ downloaded into the agent." (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) @@ -1586,8 +1600,7 @@ downloaded into the agent." 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)) @@ -1671,8 +1684,7 @@ downloaded into the agent." (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)) @@ -1683,9 +1695,8 @@ downloaded into the agent." (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 @@ -1766,7 +1777,7 @@ and that there are no duplicates." (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 @@ -1775,17 +1786,7 @@ 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))))) + (interactive (list (gnus-agent-read-group))) (let* ((gnus-command-method (or gnus-command-method (gnus-find-method-for-group group))) @@ -1811,6 +1812,7 @@ 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 @@ -1860,7 +1862,15 @@ article numbers will be returned." (gnus-agent-find-parameter group 'agent-predicate))))) (articles (if fetch-all - (gnus-uncompress-range (gnus-active group)) + (if gnus-newsgroup-maximum-articles + (let ((active (gnus-active group))) + (gnus-uncompress-range + (cons (max (car active) + (- (cdr active) + gnus-newsgroup-maximum-articles + -1)) + (cdr active)))) + (gnus-uncompress-range (gnus-active group))) (gnus-list-of-unread-articles group))) (gnus-decode-encoded-word-function 'identity) (gnus-decode-encoded-address-function 'identity) @@ -1918,12 +1928,11 @@ article numbers will be returned." 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 @@ -2081,19 +2090,20 @@ doesn't exist, to valid the overview buffer." ;; 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." @@ -2127,17 +2137,13 @@ doesn't exist, to valid the overview buffer." ((= 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 @@ -2145,13 +2151,13 @@ doesn't exist, to valid the overview buffer." (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 @@ -2190,23 +2196,21 @@ doesn't exist, to valid the overview buffer." (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)) @@ -2215,23 +2219,28 @@ doesn't exist, to valid the overview 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)) @@ -2338,7 +2347,6 @@ modified) original contents, they are first saved to their own file." (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)))) @@ -2363,7 +2371,7 @@ modified) original contents, they are first saved to their own file." (defun gnus-agent-batch-confirmation (msg) "Show error message and return t." - (gnus-message 1 msg) + (gnus-message 1 "%s" msg) t) ;;;###autoload @@ -2629,10 +2637,10 @@ General format specifiers can also be used. See Info node (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 @@ -2745,8 +2753,7 @@ The following commands are available: (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 () @@ -3082,17 +3089,7 @@ The articles on which the expiration process runs are selected as follows: 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) @@ -3120,7 +3117,7 @@ FORCE is equivalent to setting the expiration predicates to true." 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 @@ -3128,7 +3125,8 @@ FORCE is equivalent to setting the expiration predicates to true." ;; provided a non-nil active (let ((dir (gnus-agent-group-pathname group)) - (file-name-coding-system nnmail-pathname-coding-system)) + (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) @@ -3139,8 +3137,8 @@ FORCE is equivalent to setting the expiration predicates to true." (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) @@ -3252,7 +3250,7 @@ FORCE is equivalent to setting the expiration predicates to true." (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 @@ -3320,16 +3318,17 @@ line." (point) nov-file))) ;; 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) @@ -3364,7 +3363,7 @@ line." (point) nov-file))) (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 @@ -3372,7 +3371,7 @@ line." (point) nov-file))) (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."))) @@ -3449,12 +3448,12 @@ article alist" type) actions)) (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))) ) @@ -3543,7 +3542,7 @@ articles in every agentized group? ")) 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) @@ -3571,7 +3570,8 @@ articles in every agentized group? ")) ;; 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 @@ -3626,8 +3626,10 @@ articles in every agentized group? ")) 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) @@ -3636,12 +3638,13 @@ articles in every agentized group? ")) (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)))))))))) @@ -3746,7 +3749,7 @@ has been fetched." (erase-buffer) (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent (gnus-retrieve-headers - uncached-articles group fetch-old)))) + uncached-articles group)))) (nnvirtual-convert-headers)) ((eq 'nntp (car gnus-current-select-method)) ;; The author of gnus-get-newsgroup-headers-xover @@ -3879,16 +3882,7 @@ In addition, their NOV entries in .overview will be refreshed using 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) @@ -3906,7 +3900,7 @@ If REREAD is not nil, downloaded articles are marked as unread." (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)) @@ -3983,7 +3977,8 @@ If REREAD is not nil, downloaded articles are marked as unread." (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 @@ -4224,5 +4219,4 @@ modified." (provide 'gnus-agent) -;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e ;;; gnus-agent.el ends here