X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=424c55c40f572e2b72b73d9308b08d4ca58ce00d;hb=fa8cd3f3ef09fa4bf3771512a2c520c4ef519827;hp=d2dd0552b50c6f8626dadcd0a1259edbfcdcb5d2;hpb=7693ad423659f409f95c3faea25a601c954375e6;p=gnus diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index d2dd0552b..424c55c40 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,15 +1,14 @@ ;;; 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-2011 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 +16,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 +36,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 +183,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'." @@ -207,8 +202,7 @@ queue. Otherwise, queue if and only if unplugged." (const :format "When unplugged" t))) (defcustom gnus-agent-prompt-send-queue nil - "If non-nil, `gnus-group-send-queue' will prompt if called when -unplugged." + "If non-nil, `gnus-group-send-queue' will prompt if called when unplugged." :version "22.1" :group 'gnus-agent :type 'boolean) @@ -309,8 +303,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))))) @@ -448,7 +441,7 @@ manipulated as follows: (setf (gnus-agent-cat-groups old-category) (delete group (gnus-agent-cat-groups old-category)))))) - ;; Purge cache as preceeding loop invalidated it. + ;; Purge cache as preceding loop invalidated it. (setq gnus-category-group-cache nil)) (setcdr (or (assq 'agent-groups category) @@ -459,6 +452,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 +468,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) @@ -512,8 +511,8 @@ manipulated as follows: ;; Set up the menu. (when (gnus-visual-p 'agent-menu 'menu) (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer)))) - (unless (assq 'gnus-agent-mode minor-mode-alist) - (push gnus-agent-mode-status minor-mode-alist)) + (unless (assq mode minor-mode-alist) + (push (cons mode (cdr gnus-agent-mode-status)) minor-mode-alist)) (unless (assq mode minor-mode-map-alist) (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map" buffer)))) @@ -602,16 +601,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 +622,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) @@ -688,7 +683,6 @@ This will modify the `gnus-setup-news-hook', and minor mode in all Gnus buffers." (interactive) (gnus-open-agent) - (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup) (unless gnus-agent-send-mail-function (setq gnus-agent-send-mail-function (or message-send-mail-real-function @@ -698,7 +692,9 @@ minor mode in all Gnus buffers." ;; If the servers file doesn't exist, auto-agentize some servers and ;; save the servers file so this auto-agentizing isn't invoked ;; again. - (unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers")) + (when (and (not (file-exists-p (nnheader-concat + gnus-agent-directory "lib/servers"))) + gnus-agent-auto-agentize-methods) (gnus-message 3 "First time agent user, agentizing remote groups...") (mapc (lambda (server-or-method) @@ -733,7 +729,8 @@ Optional arg GROUP-NAME allows to specify another group." (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") (gnus-agent-insert-meta-information 'mail) - (gnus-request-accept-article "nndraft:queue" nil t t))) + (gnus-request-accept-article "nndraft:queue" nil t t) + (gnus-group-refresh-group "nndraft:queue"))) (defun gnus-agent-insert-meta-information (type &optional method) "Insert meta-information into the message that says how it's to be posted. @@ -804,23 +801,24 @@ be a select method." (setq group (or group gnus-newsgroup-name)) (unless group (error "No group on the current line")) - - (gnus-agent-while-plugged - (let ((gnus-command-method (gnus-find-method-for-group group))) - (gnus-agent-with-fetch - (gnus-agent-fetch-group-1 group gnus-command-method) - (gnus-message 5 "Fetching %s...done" group))))) + (if (not (gnus-agent-group-covered-p group)) + (message "%s isn't covered by the agent" group) + (gnus-agent-while-plugged + (let ((gnus-command-method (gnus-find-method-for-group group))) + (gnus-agent-with-fetch + (gnus-agent-fetch-group-1 group gnus-command-method) + (gnus-message 5 "Fetching %s...done" group)))))) (defun gnus-agent-add-group (category arg) "Add the current group to an agent category." (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 +856,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 +892,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 +1024,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)))) @@ -1196,7 +1195,7 @@ downloadable." (mapc #'gnus-summary-remove-process-mark (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded)) - ;; The preceeding call to (gnus-agent-summary-fetch-group) + ;; The preceding call to (gnus-agent-summary-fetch-group) ;; updated the temporary gnus-newsgroup-downloadable to ;; remove each article successfully fetched. Now, I ;; update the real gnus-newsgroup-downloadable to only @@ -1425,6 +1424,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." @@ -1436,7 +1447,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 @@ -1449,13 +1460,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 - (mm-decode-coding-string - group (gnus-group-name-charset gnus-command-method 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) @@ -1502,7 +1512,7 @@ downloaded into the agent." "Fetch ARTICLES from GROUP and put them into the Agent." (when articles (gnus-agent-load-alist group) - (let* ((alist gnus-agent-article-alist) + (let* ((alist gnus-agent-article-alist) (headers (if (< (length articles) 2) nil gnus-newsgroup-headers)) (selected-sets (list nil)) (current-set-size 0) @@ -1510,14 +1520,14 @@ downloaded into the agent." header-number) ;; Check each article (while (setq article (pop articles)) - ;; Skip alist entries preceeding this article + ;; Skip alist entries preceding this article (while (> article (or (caar alist) (1+ article))) (setq alist (cdr alist))) ;; Prune off articles that we have already fetched. (unless (and (eq article (caar alist)) (cdar alist)) - ;; Skip headers preceeding this article + ;; Skip headers preceding this article (while (> article (setq header-number (let* ((header (car headers))) @@ -1544,9 +1554,9 @@ downloaded into the agent." ;; 65 char/line. If the line count ;; is missing, arbitrarily assume a ;; size of 1000 characters. - (max (* 65 (mail-header-lines - (car headers))) - 1000) + (max (* 65 (mail-header-lines + (car headers))) + 1000) char-size)) 0)))) (setcar selected-sets (nreverse (car selected-sets))) @@ -1566,7 +1576,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)) @@ -1577,7 +1588,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) @@ -1589,8 +1601,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)) @@ -1674,8 +1685,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)) @@ -1686,9 +1696,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 @@ -1769,7 +1778,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 @@ -1778,17 +1787,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))) @@ -1814,6 +1813,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 @@ -1863,7 +1863,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) @@ -1917,16 +1925,16 @@ article numbers will be returned." (setq articles (gnus-list-range-intersection articles (list (cons low high))))))) - (gnus-message - 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" - (gnus-compress-sequence articles t)) - - (save-excursion - (set-buffer nntp-server-buffer) + (when articles + (gnus-message + 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'" + (gnus-compress-sequence articles t))) + (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 @@ -2084,19 +2092,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." @@ -2130,17 +2139,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 @@ -2148,13 +2153,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 @@ -2193,23 +2198,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)) @@ -2218,23 +2221,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)) @@ -2341,7 +2349,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)))) @@ -2366,7 +2373,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 @@ -2607,7 +2614,9 @@ modified) original contents, they are first saved to their own file." (gnus-dribble-enter (concat "(gnus-group-set-info '" (gnus-prin1-to-string info) - ")")))))))))))) + ")") + (concat "^(gnus-group-set-info '(\"" + (regexp-quote group) "\"")))))))))))) ;;; ;;; Agent Category Mode @@ -2632,10 +2641,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 @@ -2748,8 +2757,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 () @@ -3085,17 +3093,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) @@ -3123,7 +3121,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 @@ -3131,7 +3129,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) @@ -3142,8 +3141,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) @@ -3255,7 +3254,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 @@ -3323,16 +3322,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) @@ -3367,7 +3367,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 @@ -3375,7 +3375,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."))) @@ -3440,7 +3440,7 @@ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) ;; If considering all articles is set, I can only ;; expire article IDs that are no longer in the - ;; active range (That is, articles that preceed the + ;; active range (That is, articles that precede the ;; first article in the new alist). (if (and gnus-agent-consider-all-articles (>= article-number (car active))) @@ -3452,12 +3452,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))) ) @@ -3546,7 +3546,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) @@ -3574,7 +3574,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 @@ -3629,8 +3630,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) @@ -3639,12 +3642,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)))))))))) @@ -3714,7 +3718,7 @@ has been fetched." (gnus-agent-append-to-list tail-uncached v1)) (setq arts (cdr arts)) (setq ref (cdr ref))) - (t ; reference article (v2) preceeds the list being filtered + (t ; reference article (v2) precedes the list being filtered (setq ref (cdr ref)))))) (while arts (gnus-agent-append-to-list tail-uncached (pop arts))) @@ -3749,7 +3753,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 @@ -3874,6 +3878,15 @@ has been fetched." (insert-file-contents file)) t)))) +(defun gnus-agent-store-article (article group) + (let* ((gnus-command-method (gnus-find-method-for-group group)) + (file (gnus-agent-article-name (number-to-string article) group)) + (file-name-coding-system nnmail-pathname-coding-system) + (coding-system-for-write gnus-cache-coding-system)) + (when (not (file-exists-p file)) + (gnus-make-directory (file-name-directory file)) + (write-region (point-min) (point-max) file nil 'silent)))) + (defun gnus-agent-regenerate-group (group &optional reread) "Regenerate GROUP. If REREAD is t, all articles in the .overview are marked as unread. @@ -3882,16 +3895,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) @@ -3909,7 +3913,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)) @@ -3986,7 +3990,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 @@ -4027,7 +4032,7 @@ If REREAD is not nil, downloaded articles are marked as unread." ;; article (with the exception of the last ID in the list - it's ;; special) that no longer appears in the overview. In this ;; situtation, the last article ID in the list implies that it, - ;; and every article ID preceeding it, have been fetched from the + ;; and every article ID preceding it, have been fetched from the ;; server. (if gnus-agent-consider-all-articles @@ -4227,5 +4232,4 @@ modified." (provide 'gnus-agent) -;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e ;;; gnus-agent.el ends here