;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;; 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 <larsi@gnus.org>
;; 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
-;; 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
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(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."
(defcustom gnus-agent-fetched-hook nil
"Hook run when finished fetching articles."
+ :version "22.1"
:group 'gnus-agent
:type 'hook)
:group 'gnus-agent
:type 'function)
-(defcustom gnus-agent-synchronize-flags 'ask
+(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
+ ;; should be fixed not be exceedingly slow. See 2005-09-20 ChangeLog entry.
:version "21.1"
:type '(choice (const :tag "Always" t)
(const :tag "Never" nil)
(defcustom gnus-agent-go-online 'ask
"Indicate if offline servers go online when you plug in.
If this is `ask' the hook will query the user."
- :version "21.1"
+ :version "21.3"
:type '(choice (const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "Ask" ask))
groups with large active ranges may open slower and you may also want
to look into the agent expiry settings to block the expiration of
read articles as they would just be downloaded again."
- :version "21.4"
+ :version "22.1"
:type 'boolean
:group 'gnus-agent)
"Chunk size for `gnus-agent-fetch-session'.
The function will split its article fetches into chunks smaller than
this limit."
+ :version "22.1"
:group 'gnus-agent
:type 'integer)
to disable expiration in specific categories, topics, and groups. Of
course, you could change gnus-agent-enable-expiration to DISABLE then
enable expiration per categories, topics, and groups."
+ :version "22.1"
:group 'gnus-agent
:type '(radio (const :format "Enable " ENABLE)
(const :format "Disable " DISABLE)))
Have gnus-agent-expire scan the directories under
\(gnus-agent-directory) for groups that are no longer agentized.
When found, offer to remove them."
+ :version "22.1"
:type 'boolean
:group 'gnus-agent)
"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'."
+ :version "22.1"
:type '(repeat symbol)
:group 'gnus-agent)
"Whether and when outgoing mail should be queued by the agent.
When `always', always queue outgoing mail. When nil, never
queue. Otherwise, queue if and only if unplugged."
+ :version "22.1"
:group 'gnus-agent
:type '(radio (const :format "Always" always)
(const :format "Never" nil)
- (const :format "When plugged" t)))
+ (const :format "When unplugged" t)))
(defcustom gnus-agent-prompt-send-queue nil
"If non-nil, `gnus-group-send-queue' will prompt if called when
unplugged."
+ :version "22.1"
:group 'gnus-agent
:type 'boolean)
+(defcustom gnus-agent-article-alist-save-format 1
+ "Indicates whether to use compression(2), versus no
+compression(1), when writing agentview files. The compressed
+files do save space but load times are 6-7 times higher. A group
+must be opened then closed for the agentview to be updated using
+the new format."
+ ;; Wouldn't symbols instead numbers be nicer? --rsteib
+ :version "22.1"
+ :group 'gnus-agent
+ :type '(radio (const :format "Compressed" 2)
+ (const :format "Uncompressed" 1)))
+
;;; Internal variables
(defvar gnus-agent-history-buffers nil)
(defvar gnus-agent-buffer-alist nil)
(defvar gnus-agent-article-alist nil
- "An assoc list identifying the articles whose headers have been fetched.
+ "An assoc list identifying the articles whose headers have been fetched.
If successfully fetched, these headers will be stored in the group's overview
file. The key of each assoc pair is the article ID, the value of each assoc
pair is a flag indicating whether the identified article has been downloaded
\(gnus-agent-fetch-articles sets the value to the day of the download).
NOTES:
-1) The last element of this list can not be expired as some
+1) The last element of this list can not be expired as some
routines (for example, get-agent-fetch-headers) use the last
value to track which articles have had their headers retrieved.
2) The function `gnus-agent-regenerate' may destructively modify the value.")
(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
;;;
(let* ((--category--temp-- (make-symbol "--category--"))
(--value--temp-- (make-symbol "--value--")))
(list (list --category--temp--) ; temporary-variables
- (list category) ; value-forms
- (list --value--temp--) ; store-variables
+ (list category) ; value-forms
+ (list --value--temp--) ; store-variables
(let* ((category --category--temp--) ; store-form
(value --value--temp--))
(list (quote gnus-agent-cat-set-property)
(gnus-agent-cat-defaccessor
gnus-agent-cat-high-score agent-high-score)
(gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-long agent-length-when-long)
+ gnus-agent-cat-length-when-long agent-long-article)
(gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-short agent-length-when-short)
+ gnus-agent-cat-length-when-short agent-short-article)
(gnus-agent-cat-defaccessor
gnus-agent-cat-low-score agent-low-score)
(gnus-agent-cat-defaccessor
gnus-agent-cat-predicate agent-predicate)
(gnus-agent-cat-defaccessor
- gnus-agent-cat-score-file agent-score-file)
+ gnus-agent-cat-score-file agent-score)
(gnus-agent-cat-defaccessor
- gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
+ gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
+
+
+;; This form is equivalent to defsetf except that it calls make-symbol
+;; whereas defsetf calls gensym (Using gensym creates a run-time
+;; dependency on the CL library).
(eval-and-compile
- (defsetf gnus-agent-cat-groups (category) (groups)
- (list 'gnus-agent-set-cat-groups category groups)))
+ (define-setf-method gnus-agent-cat-groups (category)
+ (let* ((--category--temp-- (make-symbol "--category--"))
+ (--groups--temp-- (make-symbol "--groups--")))
+ (list (list --category--temp--)
+ (list category)
+ (list --groups--temp--)
+ (let* ((category --category--temp--)
+ (groups --groups--temp--))
+ (list (quote gnus-agent-set-cat-groups) category groups))
+ (list (quote gnus-agent-cat-groups) --category--temp--))))
+ )
(defun gnus-agent-set-cat-groups (category groups)
(unless (eq groups 'ignore)
(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 ()
(if (and (fboundp 'propertize)
(fboundp 'make-mode-line-mouse-map))
(propertize string 'local-map
- (make-mode-line-mouse-map mouse-button mouse-func))
+ (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)) )
string))
(defun gnus-agent-toggle-plugged (set-to)
(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)
(unless gnus-agent-send-mail-function
(setq gnus-agent-send-mail-function
(or message-send-mail-real-function
- message-send-mail-function)
+ (function (lambda () (funcall message-send-mail-function))))
message-send-mail-real-function 'gnus-agent-send-mail))
;; If the servers file doesn't exist, auto-agentize some servers and
"Restore GCC field from saved header."
(save-excursion
(goto-char (point-min))
- (while (re-search-forward (concat gnus-agent-gcc-header ":") nil t)
+ (while (re-search-forward
+ (concat "^" (regexp-quote gnus-agent-gcc-header) ":") nil t)
(replace-match "Gcc:" 'fixedcase))))
(defun gnus-agent-any-covered-gcc ()
(interactive)
(save-excursion
(dolist (gnus-command-method (gnus-agent-covered-methods))
- (when (file-exists-p (gnus-agent-lib-file "flags"))
+ (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)
"Synchronize flags set when unplugged for server."
- (let ((gnus-command-method method))
+ (let ((gnus-command-method method)
+ (gnus-agent nil))
(when (file-exists-p (gnus-agent-lib-file "flags"))
(set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
(erase-buffer)
(nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
- (if (null (gnus-check-server gnus-command-method))
- (gnus-message 1 "Couldn't open server %s" (nth 1 gnus-command-method))
-
projects / gnus / blobdiff