cgit.sxemacs.org Git - gnus/blob - lisp/gnus-agent.el

   1 ;;; gnus-agent.el --- unplugged support for Gnus
   2 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002
   3 ;;        Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; GNU Emacs is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'gnus)
  28 (require 'gnus-cache)
  29 (require 'nnvirtual)
  30 (require 'gnus-sum)
  31 (require 'gnus-score)
  32 (require 'gnus-srvr)
  33 (eval-when-compile
  34   (if (featurep 'xemacs)
  35       (require 'itimer)
  36     (require 'timer))
  37   (require 'cl))
  38
  39 (eval-and-compile
  40   (autoload 'gnus-server-update-server "gnus-srvr"))
  41
  42 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
  43   "Where the Gnus agent will store its files."
  44   :group 'gnus-agent
  45   :type 'directory)
  46
  47 (defcustom gnus-agent-plugged-hook nil
  48   "Hook run when plugging into the network."
  49   :group 'gnus-agent
  50   :type 'hook)
  51
  52 (defcustom gnus-agent-unplugged-hook nil
  53   "Hook run when unplugging from the network."
  54   :group 'gnus-agent
  55   :type 'hook)
  56
  57 (defcustom gnus-agent-handle-level gnus-level-subscribed
  58   "Groups on levels higher than this variable will be ignored by the Agent."
  59   :group 'gnus-agent
  60   :type 'integer)
  61
  62 (defcustom gnus-agent-expire-days 7
  63   "Read articles older than this will be expired.
  64 This can also be a list of regexp/day pairs.  The regexps will
  65 be matched against group names."
  66   :group 'gnus-agent
  67   :type 'integer)
  68
  69 (defcustom gnus-agent-expire-all nil
  70   "If non-nil, also expire unread, ticked and dormant articles.
  71 If nil, only read articles will be expired."
  72   :group 'gnus-agent
  73   :type 'boolean)
  74
  75 (defcustom gnus-agent-group-mode-hook nil
  76   "Hook run in Agent group minor modes."
  77   :group 'gnus-agent
  78   :type 'hook)
  79
  80 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
  81 (when (featurep 'xemacs)
  82   (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add))
  83
  84 (defcustom gnus-agent-summary-mode-hook nil
  85   "Hook run in Agent summary minor modes."
  86   :group 'gnus-agent
  87   :type 'hook)
  88
  89 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
  90 (when (featurep 'xemacs)
  91   (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add))
  92
  93 (defcustom gnus-agent-server-mode-hook nil
  94   "Hook run in Agent summary minor modes."
  95   :group 'gnus-agent
  96   :type 'hook)
  97
  98 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
  99 (when (featurep 'xemacs)
 100   (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add))
 101
 102 (defcustom gnus-agent-confirmation-function 'y-or-n-p
 103   "Function to confirm when error happens."
 104   :version "21.1"
 105   :group 'gnus-agent
 106   :type 'function)
 107
 108 (defcustom gnus-agent-synchronize-flags 'ask
 109   "Indicate if flags are synchronized when you plug in.
 110 If this is `ask' the hook will query the user."
 111   :version "21.1"
 112   :type '(choice (const :tag "Always" t)
 113                  (const :tag "Never" nil)
 114                  (const :tag "Ask" ask))
 115   :group 'gnus-agent)
 116
 117 (defcustom gnus-agent-go-online 'ask
 118   "Indicate if offline servers go online when you plug in.
 119 If this is `ask' the hook will query the user."
 120   :version "21.1"
 121   :type '(choice (const :tag "Always" t)
 122                  (const :tag "Never" nil)
 123                  (const :tag "Ask" ask))
 124   :group 'gnus-agent)
 125
 126 (defcustom gnus-agent-mark-unread-after-downloaded t
 127   "Indicate whether to mark articles unread after downloaded."
 128   :version "21.1"
 129   :type 'boolean
 130   :group 'gnus-agent)
 131
 132 (defcustom gnus-agent-download-marks '(download)
 133   "Marks for downloading."
 134   :version "21.1"
 135   :type '(repeat (symbol :tag "Mark"))
 136   :group 'gnus-agent)
 137
 138 (defcustom gnus-agent-consider-all-articles nil
 139   "If non-nil, consider also the read articles for downloading."
 140   :version "21.4"
 141   :type 'boolean
 142   :group 'gnus-agent)
 143
 144 (defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
 145   "Chunk size for `gnus-agent-fetch-session'.
 146 The function will split its article fetches into chunks smaller than
 147 this limit."
 148   :group 'gnus-agent
 149   :type 'integer)
 150
 151 ;;; Internal variables
 152
 153 (defvar gnus-agent-history-buffers nil)
 154 (defvar gnus-agent-buffer-alist nil)
 155 (defvar gnus-agent-article-alist nil
 156 "An assoc list identifying the articles whose headers have been fetched.
 157 If successfully fetched, these headers will be stored in the group's overview
 158 file.  The key of each assoc pair is the article ID, the value of each assoc
 159 pair is a flag indicating whether the identified article has been downloaded
 160 \(gnus-agent-fetch-articles sets the value to the day of the download).
 161 NOTES:
 162 1) The last element of this list can not be expired as some
 163    routines (for example, get-agent-fetch-headers) use the last
 164    value to track which articles have had their headers retrieved.
 165 2) The gnus-agent-regenerate may destructively modify the value.
 166 ")
 167 (defvar gnus-agent-group-alist nil)
 168 (defvar gnus-category-alist nil)
 169 (defvar gnus-agent-current-history nil)
 170 (defvar gnus-agent-overview-buffer nil)
 171 (defvar gnus-category-predicate-cache nil)
 172 (defvar gnus-category-group-cache nil)
 173 (defvar gnus-agent-spam-hashtb nil)
 174 (defvar gnus-agent-file-name nil)
 175 (defvar gnus-agent-send-mail-function nil)
 176 (defvar gnus-agent-file-coding-system 'raw-text)
 177 (defvar gnus-agent-file-loading-cache nil)
 178 (defvar gnus-agent-file-header-cache nil)
 179
 180 (defvar gnus-agent-auto-agentize-methods '(nntp nnimap)
 181   "Initially, all servers from these methods are agentized.
 182 The user may remove or add servers using the Server buffer.  See Info
 183 node `(gnus)Server Buffer'.")
 184
 185 ;; Dynamic variables
 186 (defvar gnus-headers)
 187 (defvar gnus-score)
 188
 189 ;;;
 190 ;;; Setup
 191 ;;;
 192
 193 (defun gnus-open-agent ()
 194   (setq gnus-agent t)
 195   (gnus-agent-read-servers)
 196   (gnus-category-read)
 197   (gnus-agent-create-buffer)
 198   (add-hook 'gnus-group-mode-hook 'gnus-agent-mode)
 199   (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode)
 200   (add-hook 'gnus-server-mode-hook 'gnus-agent-mode))
 201
 202 (defun gnus-agent-create-buffer ()
 203   (if (gnus-buffer-live-p gnus-agent-overview-buffer)
 204       t
 205     (setq gnus-agent-overview-buffer
 206           (gnus-get-buffer-create " *Gnus agent overview*"))
 207     (with-current-buffer gnus-agent-overview-buffer
 208       (mm-enable-multibyte))
 209     nil))
 210
 211 (gnus-add-shutdown 'gnus-close-agent 'gnus)
 212
 213 (defun gnus-close-agent ()
 214   (setq gnus-category-predicate-cache nil
 215         gnus-category-group-cache nil
 216         gnus-agent-spam-hashtb nil)
 217   (gnus-kill-buffer gnus-agent-overview-buffer))
 218
 219 ;;;
 220 ;;; Utility functions
 221 ;;;
 222
 223 (defun gnus-agent-read-file (file)
 224   "Load FILE and do a `read' there."
 225   (with-temp-buffer
 226     (ignore-errors
 227       (nnheader-insert-file-contents file)
 228       (goto-char (point-min))
 229       (read (current-buffer)))))
 230
 231 (defsubst gnus-agent-method ()
 232   (concat (symbol-name (car gnus-command-method)) "/"
 233           (if (equal (cadr gnus-command-method) "")
 234               "unnamed"
 235             (cadr gnus-command-method))))
 236
 237 (defsubst gnus-agent-directory ()
 238   "The name of the Gnus agent directory."
 239   (nnheader-concat gnus-agent-directory
 240                    (nnheader-translate-file-chars (gnus-agent-method)) "/"))
 241
 242 (defun gnus-agent-lib-file (file)
 243   "The full name of the Gnus agent library FILE."
 244   (expand-file-name file
 245                     (file-name-as-directory
 246                      (expand-file-name "agent.lib" (gnus-agent-directory)))))
 247
 248 ;;; Fetching setup functions.
 249
 250 (defun gnus-agent-start-fetch ()
 251   "Initialize data structures for efficient fetching."
 252   (gnus-agent-create-buffer))
 253
 254 (defun gnus-agent-stop-fetch ()
 255   "Save all data structures and clean up."
 256   (setq gnus-agent-spam-hashtb nil)
 257   (save-excursion
 258     (set-buffer nntp-server-buffer)
 259     (widen)))
 260
 261 (defmacro gnus-agent-with-fetch (&rest forms)
 262   "Do FORMS safely."
 263   `(unwind-protect
 264        (let ((gnus-agent-fetching t))
 265          (gnus-agent-start-fetch)
 266          ,@forms)
 267      (gnus-agent-stop-fetch)))
 268
 269 (put 'gnus-agent-with-fetch 'lisp-indent-function 0)
 270 (put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
 271
 272 (defmacro gnus-agent-append-to-list (tail value)
 273   `(setq ,tail (setcdr ,tail (cons ,value nil))))
 274
 275 ;;;
 276 ;;; Mode infestation
 277 ;;;
 278
 279 (defvar gnus-agent-mode-hook nil
 280   "Hook run when installing agent mode.")
 281
 282 (defvar gnus-agent-mode nil)
 283 (defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged"))
 284
 285 (defun gnus-agent-mode ()
 286   "Minor mode for providing a agent support in Gnus buffers."
 287   (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$"
 288                                       (symbol-name major-mode))
 289                         (match-string 1 (symbol-name major-mode))))
 290          (mode (intern (format "gnus-agent-%s-mode" buffer))))
 291     (set (make-local-variable 'gnus-agent-mode) t)
 292     (set mode nil)
 293     (set (make-local-variable mode) t)
 294     ;; Set up the menu.
 295     (when (gnus-visual-p 'agent-menu 'menu)
 296       (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer))))
 297     (unless (assq 'gnus-agent-mode minor-mode-alist)
 298       (push gnus-agent-mode-status minor-mode-alist))
 299     (unless (assq mode minor-mode-map-alist)
 300       (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
 301                                                      buffer))))
 302             minor-mode-map-alist))
 303     (when (eq major-mode 'gnus-group-mode)
 304       (gnus-agent-toggle-plugged gnus-plugged))
 305     (gnus-run-hooks 'gnus-agent-mode-hook
 306                     (intern (format "gnus-agent-%s-mode-hook" buffer)))))
 307
 308 (defvar gnus-agent-group-mode-map (make-sparse-keymap))
 309 (gnus-define-keys gnus-agent-group-mode-map
 310   "Ju" gnus-agent-fetch-groups
 311   "Jc" gnus-enter-category-buffer
 312   "Jj" gnus-agent-toggle-plugged
 313   "Js" gnus-agent-fetch-session
 314   "JY" gnus-agent-synchronize-flags
 315   "JS" gnus-group-send-queue