;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997,98 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; 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
(require 'gnus-cache)
(require 'nnvirtual)
(require 'gnus-sum)
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'timer)
+ (require 'cl)
+ (require 'gnus-score))
(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
"Where the Gnus agent will store its files."
:group 'gnus-agent
:type 'hook)
-;;; Internal variables
+(defcustom gnus-agent-confirmation-function 'y-or-n-p
+ "Function to confirm when error happens."
+ :group 'gnus-agent
+ :type 'function)
-(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
+;;; Internal variables
(defvar gnus-agent-history-buffers nil)
(defvar gnus-agent-buffer-alist nil)
(defvar gnus-agent-spam-hashtb nil)
(defvar gnus-agent-file-name nil)
(defvar gnus-agent-send-mail-function nil)
-(defvar gnus-agent-article-file-coding-system 'no-conversion)
+(defvar gnus-agent-file-coding-system 'raw-text)
+
+(defconst gnus-agent-scoreable-headers
+ '("subject" "from" "date" "message-id" "references" "chars" "lines" "xref")
+ "Headers that are considered when scoring articles for download via the Agent.")
;; Dynamic variables
(defvar gnus-headers)
(setq gnus-agent t)
(gnus-agent-read-servers)
(gnus-category-read)
- (setq gnus-agent-overview-buffer
- (get-buffer-create " *Gnus agent overview*"))
+ (gnus-agent-create-buffer)
(add-hook 'gnus-group-mode-hook 'gnus-agent-mode)
(add-hook 'gnus-summary-mode-hook 'gnus-agent-mode)
(add-hook 'gnus-server-mode-hook 'gnus-agent-mode))
+(defun gnus-agent-create-buffer ()
+ (if (gnus-buffer-live-p gnus-agent-overview-buffer)
+ t
+ (setq gnus-agent-overview-buffer
+ (gnus-get-buffer-create " *Gnus agent overview*"))
+ (with-current-buffer gnus-agent-overview-buffer
+ (mm-enable-multibyte))
+ nil))
+
(gnus-add-shutdown 'gnus-close-agent 'gnus)
(defun gnus-close-agent ()
(defun gnus-agent-read-file (file)
"Load FILE and do a `read' there."
- (nnheader-temp-write nil
+ (with-temp-buffer
(ignore-errors
- (insert-file-contents file)
+ (nnheader-insert-file-contents file)
(goto-char (point-min))
(read (current-buffer)))))
(defun gnus-agent-start-fetch ()
"Initialize data structures for efficient fetching."
(gnus-agent-open-history)
- (setq gnus-agent-current-history (gnus-agent-history-buffer)))
+ (setq gnus-agent-current-history (gnus-agent-history-buffer))
+ (gnus-agent-create-buffer))
(defun gnus-agent-stop-fetch ()
"Save all data structures and clean up."
(push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
buffer))))
minor-mode-map-alist))
- (gnus-agent-toggle-plugged gnus-plugged)
+ (when (eq major-mode 'gnus-group-mode)
+ (gnus-agent-toggle-plugged gnus-plugged))
(gnus-run-hooks 'gnus-agent-mode-hook
(intern (format "gnus-agent-%s-mode-hook" buffer)))))
"Jc" gnus-enter-category-buffer
"Jj" gnus-agent-toggle-plugged
"Js" gnus-agent-fetch-session
+ "JY" gnus-agent-synchronize
"JS" gnus-group-send-drafts
- "Ja" gnus-agent-add-group)
+ "Ja" gnus-agent-add-group
+ "Jr" gnus-agent-remove-group)
(defun gnus-agent-group-make-menu-bar ()
(unless (boundp 'gnus-agent-group-menu)
(interactive)
(gnus-open-agent)
(add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
- (unless gnus-agent-send-mail-function
+ (unless gnus-agent-send-mail-function
(setq gnus-agent-send-mail-function message-send-mail-function
message-send-mail-function 'gnus-agent-send-mail))
(unless gnus-agent-covered-methods
(concat "^" (regexp-quote mail-header-separator) "\n"))
(replace-match "\n")
(gnus-agent-insert-meta-information 'mail)
- (gnus-request-accept-article "nndraft:queue")))
+ (gnus-request-accept-article "nndraft:queue" nil t t)))
(defun gnus-agent-insert-meta-information (type &optional method)
"Insert meta-information into the message that says how it's to be posted.
;;;
(defun gnus-agent-fetch-groups (n)
- "Put all new articles in the current groups into the agent."
+ "Put all new articles in the current groups into the Agent."
(interactive "P")
+ (unless gnus-plugged
+ (error "Groups can't be fetched when Gnus is unplugged"))
(gnus-group-iterate n 'gnus-agent-fetch-group))
(defun gnus-agent-fetch-group (group)
- "Put all new articles in GROUP into the agent."
+ "Put all new articles in GROUP into the Agent."
(interactive (list (gnus-group-group-name)))
+ (unless gnus-plugged
+ (error "Groups can't be fetched when Gnus is unplugged"))
(unless group
(error "No group on the current line"))
(let ((gnus-command-method (gnus-find-method-for-group group)))
(setf (cadddr cat) (nconc (cadddr cat) groups))
(gnus-category-write)))
+(defun gnus-agent-remove-group (arg)
+ "Remove the current group from its agent category, if any."
+ (interactive "P")
+ (let (c)
+ (gnus-group-iterate arg
+ (lambda (group)
+ (when (cadddr (setq c (gnus-group-category group)))
+ (setf (cadddr c) (delete group (cadddr c))))))
+ (gnus-category-write)))
+
+(defun gnus-agent-synchronize ()
+ "Synchronize local, unplugged, data with backend.
+Currently sends flag setting requests, if any."
+ (interactive)
+ (save-excursion
+ (dolist (gnus-command-method gnus-agent-covered-methods)
+ (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))
+ (message "Couldn't open server %s" (nth 1 gnus-command-method))
+ (while (not (eobp))
+ (if (null (eval (read (current-buffer))))
+ (progn (forward-line)
+ (kill-line -1))
+ (write-file (gnus-agent-lib-file "flags"))
+ (error "Couldn't set flags from file %s"
+ (gnus-agent-lib-file "flags"))))
+ (write-file (gnus-agent-lib-file "flags")))
+ (kill-buffer nil)))))
+
;;;
;;; Server mode commands
;;;
(error "Server already in the agent program"))
(push method gnus-agent-covered-methods)
(gnus-agent-write-servers)
- (message "Entered %s into the agent" server)))
+ (message "Entered %s into the Agent" server)))
(defun gnus-agent-remove-server (server)
"Remove SERVER from the agent program."
(defun gnus-agent-write-servers ()
"Write the alist of covered servers."
- (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/servers")
- (prin1 gnus-agent-covered-methods (current-buffer))))
+ (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
+ (let ((coding-system-for-write nnheader-file-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system))
+ (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
+ (prin1 gnus-agent-covered-methods (current-buffer)))))
;;;
;;; Summary commands
(when (and (not gnus-plugged)
(gnus-agent-method-p gnus-command-method))
(gnus-agent-load-alist gnus-newsgroup-name)
- (let ((articles gnus-newsgroup-unreads)
+ ;; First mark all undownloaded articles as undownloaded.
+ (let ((articles (append gnus-newsgroup-unreads
+ gnus-newsgroup-marked
+ gnus-newsgroup-dormant))
article)
(while (setq article (pop articles))
(unless (or (cdr (assq article gnus-agent-article-alist))
- &nbs
projects / gnus / blobdiff