1 ;;; gnus-agent.el --- unplugged support for Gnus
2 ;; Copyright (C) 1997,98 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
32 (require 'gnus-score))
34 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
35 "Where the Gnus agent will store its files."
39 (defcustom gnus-agent-plugged-hook nil
40 "Hook run when plugging into the network."
44 (defcustom gnus-agent-unplugged-hook nil
45 "Hook run when unplugging from the network."
49 (defcustom gnus-agent-handle-level gnus-level-subscribed
50 "Groups on levels higher than this variable will be ignored by the Agent."
54 (defcustom gnus-agent-expire-days 7
55 "Read articles older than this will be expired."
59 (defcustom gnus-agent-expire-all nil
60 "If non-nil, also expire unread, ticked and dormant articles.
61 If nil, only read articles will be expired."
65 (defcustom gnus-agent-group-mode-hook nil
66 "Hook run in Agent group minor modes."
70 (defcustom gnus-agent-summary-mode-hook nil
71 "Hook run in Agent summary minor modes."
75 (defcustom gnus-agent-server-mode-hook nil
76 "Hook run in Agent summary minor modes."
80 ;;; Internal variables
82 (defvar gnus-agent-history-buffers nil)
83 (defvar gnus-agent-buffer-alist nil)
84 (defvar gnus-agent-article-alist nil)
85 (defvar gnus-agent-group-alist nil)
86 (defvar gnus-agent-covered-methods nil)
87 (defvar gnus-category-alist nil)
88 (defvar gnus-agent-current-history nil)
89 (defvar gnus-agent-overview-buffer nil)
90 (defvar gnus-category-predicate-cache nil)
91 (defvar gnus-category-group-cache nil)
92 (defvar gnus-agent-spam-hashtb nil)
93 (defvar gnus-agent-file-name nil)
94 (defvar gnus-agent-send-mail-function nil)
95 (defvar gnus-agent-article-file-coding-system 'no-conversion)
97 (defconst gnus-agent-scoreable-headers
99 "subject" "from" "date" "message-id"
100 "references" "chars" "lines" "xref")
101 "Headers that are considered when scoring articles
102 for download via the Agent.")
105 (defvar gnus-headers)
112 (defun gnus-open-agent ()
114 (gnus-agent-read-servers)
116 (setq gnus-agent-overview-buffer
117 (gnus-get-buffer-create " *Gnus agent overview*"))
118 (add-hook 'gnus-group-mode-hook 'gnus-agent-mode)
119 (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode)
120 (add-hook 'gnus-server-mode-hook 'gnus-agent-mode))
122 (gnus-add-shutdown 'gnus-close-agent 'gnus)
124 (defun gnus-close-agent ()
125 (setq gnus-agent-covered-methods nil
126 gnus-category-predicate-cache nil
127 gnus-category-group-cache nil
128 gnus-agent-spam-hashtb nil)
129 (gnus-kill-buffer gnus-agent-overview-buffer))
132 ;;; Utility functions
135 (defun gnus-agent-read-file (file)
136 "Load FILE and do a `read' there."
139 (nnheader-insert-file-contents file)
140 (goto-char (point-min))
141 (read (current-buffer)))))
143 (defsubst gnus-agent-method ()
144 (concat (symbol-name (car gnus-command-method)) "/"
145 (if (equal (cadr gnus-command-method) "")
147 (cadr gnus-command-method))))
149 (defsubst gnus-agent-directory ()
150 "Path of the Gnus agent directory."
151 (nnheader-concat gnus-agent-directory
152 (nnheader-translate-file-chars (gnus-agent-method)) "/"))
154 (defun gnus-agent-lib-file (file)
155 "The full path of the Gnus agent library FILE."
156 (concat (gnus-agent-directory) "agent.lib/" file))
158 ;;; Fetching setup functions.
160 (defun gnus-agent-start-fetch ()
161 "Initialize data structures for efficient fetching."
162 (gnus-agent-open-history)
163 (setq gnus-agent-current-history (gnus-agent-history-buffer)))
165 (defun gnus-agent-stop-fetch ()
166 "Save all data structures and clean up."
167 (gnus-agent-save-history)
168 (gnus-agent-close-history)
169 (setq gnus-agent-spam-hashtb nil)
171 (set-buffer nntp-server-buffer)
174 (defmacro gnus-agent-with-fetch (&rest forms)
178 (gnus-agent-start-fetch)
180 (gnus-agent-stop-fetch)))
182 (put 'gnus-agent-with-fetch 'lisp-indent-function 0)
183 (put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
189 (defvar gnus-agent-mode-hook nil
190 "Hook run when installing agent mode.")
192 (defvar gnus-agent-mode nil)
193 (defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged"))
195 (defun gnus-agent-mode ()
196 "Minor mode for providing a agent support in Gnus buffers."
197 (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$"
198 (symbol-name major-mode))
199 (match-string 1 (symbol-name major-mode))))
200 (mode (intern (format "gnus-agent-%s-mode" buffer))))
201 (set (make-local-variable 'gnus-agent-mode) t)
203 (set (make-local-variable mode) t)
205 (when (gnus-visual-p 'agent-menu 'menu)
206 (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer))))
207 (unless (assq 'gnus-agent-mode minor-mode-alist)
208 (push gnus-agent-mode-status minor-mode-alist))
209 (unless (assq mode minor-mode-map-alist)
210 (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
212 minor-mode-map-alist))
213 (when (eq major-mode 'gnus-group-mode)
214 (gnus-agent-toggle-plugged gnus-plugged))
215 (gnus-run-hooks 'gnus-agent-mode-hook
216 (intern (format "gnus-agent-%s-mode-hook" buffer)))))
218 (defvar gnus-agent-group-mode-map (make-sparse-keymap))
219 (gnus-define-keys gnus-agent-group-mode-map
220 "Ju" gnus-agent-fetch-groups
221 "Jc" gnus-enter-category-buffer
222 "Jj" gnus-agent-toggle-plugged
223 "Js" gnus-agent-fetch-session
224 "JS" gnus-group-send-drafts
225 "Ja" gnus-agent-add-group)
227 (defun gnus-agent-group-make-menu-bar ()
228 (unless (boundp 'gnus-agent-group-menu)
230 gnus-agent-group-menu gnus-agent-group-mode-map ""
232 ["Toggle plugged" gnus-agent-toggle-plugged t]
233 ["List categories" gnus-enter-category-buffer t]
234 ["Send drafts" gnus-group-send-drafts gnus-plugged]
236 ["All" gnus-agent-fetch-session gnus-plugged]
237 ["Group" gnus-agent-fetch-group gnus-plugged])))))
239 (defvar gnus-agent-summary-mode-map (make-sparse-keymap))
240 (gnus-define-keys gnus-agent-summary-mode-map
241 "Jj" gnus-agent-toggle-plugged
242 "J#" gnus-agent-mark-article
243 "J\M-#" gnus-agent-unmark-article
244 "@" gnus-agent-toggle-mark
245 "Jc" gnus-agent-catchup)
247 (defun gnus-agent-summary-make-menu-bar ()
248 (unless (boundp 'gnus-agent-summary-menu)
250 gnus-agent-summary-menu gnus-agent-summary-mode-map ""
252 ["Toggle plugged" gnus-agent-toggle-plugged t]
253 ["Mark as downloadable" gnus-agent-mark-article t]
254 ["Unmark as downloadable" gnus-agent-unmark-article t]
255 ["Toggle mark" gnus-agent-toggle-mark t]
256 ["Catchup undownloaded" gnus-agent-catchup t]))))
258 (defvar gnus-agent-server-mode-map (make-sparse-keymap))
259 (gnus-define-keys gnus-agent-server-mode-map
260 "Jj" gnus-agent-toggle-plugged
261 "Ja" gnus-agent-add-server
262 "Jr" gnus-agent-remove-server)
264 (defun gnus-agent-server-make-menu-bar ()
265 (unless (boundp 'gnus-agent-server-menu)
267 gnus-agent-server-menu gnus-agent-server-mode-map ""
269 ["Toggle plugged" gnus-agent-toggle-plugged t]
270 ["Add" gnus-agent-add-server t]
271 ["Remove" gnus-agent-remove-server t]))))
273 (defun gnus-agent-toggle-plugged (plugged)
274 "Toggle whether Gnus is unplugged or not."
275 (interactive (list (not gnus-plugged)))
278 (setq gnus-plugged plugged)
279 (gnus-run-hooks 'gnus-agent-plugged-hook)
280 (setcar (cdr gnus-agent-mode-status) " Plugged"))
281 (gnus-agent-close-connections)
282 (setq gnus-plugged plugged)
283 (gnus-run-hooks 'gnus-agent-unplugged-hook)
284 (setcar (cdr gnus-agent-mode-status) " Unplugged"))
285 (set-buffer-modified-p t))
287 (defun gnus-agent-close-connections ()
288 "Close all methods covered by the Gnus agent."
289 (let ((methods gnus-agent-covered-methods))
291 (gnus-close-server (pop methods)))))
294 (defun gnus-unplugged ()
295 "Start Gnus unplugged."
297 (setq gnus-plugged nil)
301 (defun gnus-plugged ()
302 "Start Gnus plugged."
304 (setq gnus-plugged t)
308 (defun gnus-agentize ()
309 "Allow Gnus to be an offline newsreader.
310 The normal usage of this command is to put the following as the
311 last form in your `.gnus.el' file:
315 This will modify the `gnus-before-startup-hook', `gnus-post-method',
316 and `message-send-mail-function' variables, and install the Gnus
317 agent minor mode in all Gnus buffers."
320 (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
321 (unless gnus-agent-send-mail-function
322 (setq gnus-agent-send-mail-function message-send-mail-function
323 message-send-mail-function 'gnus-agent-send-mail))
324 (unless gnus-agent-covered-methods
325 (setq gnus-agent-covered-methods (list gnus-select-method))))
327 (defun gnus-agent-queue-setup ()
328 "Make sure the queue group exists."
329 (unless (gnus-gethash "nndraft:queue" gnus-newsrc-hashtb)
330 (gnus-request-create-group "queue" '(nndraft ""))
331 (let ((gnus-level-default-subscribed 1))
332 (gnus-subscribe-group "nndraft:queue" nil '(nndraft "")))
333 (gnus-group-set-parameter
334 "nndraft:queue" 'gnus-dummy '((gnus-draft-mode)))))
336 (defun gnus-agent-send-mail ()
338 (funcall gnus-agent-send-mail-function)
339 (goto-char (point-min))
341 (concat "^" (regexp-quote mail-header-separator) "\n"))
343 (gnus-agent-insert-meta-information 'mail)
344 (gnus-request-accept-article "nndraft:queue")))
346 (defun gnus-agent-insert-meta-information (type &optional method)
347 "Insert meta-information into the message that says how it's to be posted.
348 TYPE can be either `mail' or `news'. If the latter METHOD can
351 (message-remove-header gnus-agent-meta-information-header)
352 (goto-char (point-min))
353 (insert gnus-agent-meta-information-header ": "
354 (symbol-name type) " " (format "%S" method)
357 (while (search-backward "\n" nil t)
358 (replace-match "\\n" t t))))
361 ;;; Group mode commands
364 (defun gnus-agent-fetch-groups (n)
365 "Put all new articles in the current groups into the Agent."
367 (gnus-group-iterate n 'gnus-agent-fetch-group))
369 (defun gnus-agent-fetch-group (group)
370 "Put all new articles in GROUP into the Agent."
371 (interactive (list (gnus-group-group-name)))
373 (error "No group on the current line"))
374 (let ((gnus-command-method (gnus-find-method-for-group group)))
375 (gnus-agent-with-fetch
376 (gnus-agent-fetch-group-1 group gnus-command-method)
377 (gnus-message 5 "Fetching %s...done" group))))
379 (defun gnus-agent-add-group (category arg)
380 "Add the current group to an agent category."