;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
(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'."
+See Info nodes `(gnus)Server Buffer', `(gnus)Agent Variables'."
:version "22.1"
:type '(repeat symbol)
:group 'gnus-agent)
(defvar gnus-category-group-cache nil)
(defvar gnus-agent-spam-hashtb nil)
(defvar gnus-agent-file-name nil)
-(defvar gnus-agent-send-mail-function nil)
(defvar gnus-agent-file-coding-system 'raw-text)
(defvar gnus-agent-file-loading-cache nil)
(defvar gnus-agent-total-fetched-hashtb nil)
(func LIST): Returns VALUE1
(setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
`(progn (defmacro ,name (category)
- (list (quote cdr) (list (quote assq)
- (quote (quote ,prop-name)) category)))
-
- (define-setf-method ,name (category)
- (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
- (let* ((category --category--temp--) ; store-form
- (value --value--temp--))
- (list (quote gnus-agent-cat-set-property)
- category
- (quote (quote ,prop-name))
- value))
- (list (quote ,name) --category--temp--) ; access-form
- )))))
+ (list 'cdr (list 'assq '',prop-name category)))
+
+ (defsetf ,name (category) (value)
+ (list 'gnus-agent-cat-set-property
+ category '',prop-name value))))
)
(defmacro gnus-agent-cat-name (category)
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
- (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--))))
- )
+;; This form may expand to code that uses CL functions at run-time,
+;; but that's OK since those functions will only ever be called from
+;; something like `setf', so only when CL is loaded anyway.
+(defsetf gnus-agent-cat-groups gnus-agent-set-cat-groups)
(defun gnus-agent-set-cat-groups (category groups)
(unless (eq groups 'ignore)
(make-mode-line-mouse-map mouse-button mouse-func)
'mouse-face
(if (and (featurep 'xemacs)
- ;; XEmacs' `facep' only checks for a face
+ ;; XEmacs's `facep' only checks for a face
;; object, not for a face name, so it's useless
;; to check with `facep'.
(find-face 'modeline))
minor mode in all Gnus buffers."
(interactive)
(gnus-open-agent)
- (unless gnus-agent-send-mail-function
- (setq gnus-agent-send-mail-function
- (or message-send-mail-real-function
- (function (lambda () (funcall message-send-mail-function))))
- message-send-mail-real-function 'gnus-agent-send-mail))
+ (setq message-send-mail-real-function 'gnus-agent-send-mail)
;; If the servers file doesn't exist, auto-agentize some servers and
;; save the servers file so this auto-agentizing isn't invoked
(defun gnus-agent-send-mail ()
(if (or (not gnus-agent-queue-mail)
(and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
- (funcall gnus-agent-send-mail-function)
+ (message-multi-smtp-send-mail)
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "\n"))
(gnus-summary-position-point)))
(defun gnus-agent-summary-fetch-series ()
+ "Fetch the process-marked articles into the Agent."
(interactive)
(when gnus-newsgroup-processable
(setq gnus-newsgroup-downloadable
(cond (gnus-agent-mark-unread-after-downloaded
(setq gnus-newsgroup-downloadable
(delq article gnus-newsgroup-downloadable))
-
- (gnus-summary-mark-article article gnus-unread-mark))
+ (when (and (not (member article gnus-newsgroup-dormant))
+ (not (member article gnus-newsgroup-marked)))
+ (gnus-summary-mark-article article gnus-unread-mark)))
(was-marked-downloadable
(gnus-summary-set-agent-mark article t)))
(when (gnus-summary-goto-subject article nil t)
(gnus-group-update-group group t)))
nil))
-(defun gnus-agent-save-active (method)
+(defun gnus-agent-save-active (method &optional groups-p)
+ "Sync the agent's active file with the current buffer.
+Pass non-nil for GROUPS-P if the buffer starts out in groups format.
+Regardless, both the file and the buffer end up in active format
+if METHOD is agentized; otherwise the function is a no-op."
(when (gnus-agent-method-p method)
(let* ((gnus-command-method method)
(new (gnus-make-hashtable (count-lines (point-min) (point-max))))
(file (gnus-agent-lib-file "active")))
- (gnus-active-to-gnus-format nil new)
+ (if groups-p
+ (gnus-groups-to-gnus-format nil new)
+ (gnus-active-to-gnus-format nil new))
(gnus-agent-write-active file new)
(erase-buffer)
(let ((nnheader-file-coding-system gnus-agent-file-coding-system))
article counts for each of the method's subscribed groups."
(let ((gnus-command-method (or method gnus-command-method)))
(when (or (null gnus-agent-article-local-times)
- (zerop gnus-agent-article-local-times))
+ (zerop gnus-agent-article-local-times)
+ (not (gnus-methods-equal-p
+ gnus-command-method
+ (symbol-value (intern "+method" gnus-agent-article-local)))))
(setq gnus-agent-article-local
(gnus-cache-file-contents
(gnus-agent-lib-file "local")
(setq r d
d (directory-file-name d)))
;; if ANY ancestor was NOT in keep hash and
- ;; it's already in to-remove, add it to
+ ;; it's not already in to-remove, add it to
;; to-remove.
(if (and r
(not (member r to-remove)))
(gnus-make-directory (nnheader-translate-file-chars
(file-name-directory file) t))
+ (when fetch-old
+ (setq articles (gnus-uncompress-range
+ (cons (if (numberp fetch-old)
+ (max 1 (- (car articles) fetch-old))
+ 1)
+ (car (last articles))))))
+
;; Populate temp buffer with known headers
(when (file-exists-p file)
(with-current-buffer gnus-agent-overview-buffer
(set-buffer nntp-server-buffer)
(let* ((fetched-articles (list nil))
(tail-fetched-articles fetched-articles)
- (min (cond ((numberp fetch-old)
- (max 1 (- (car articles) fetch-old)))
- (fetch-old
- 1)
- (t
- (car articles))))
+ (min (car articles))
(max (car (last articles))))
;; Get the list of articles that were fetched
(not (numberp fetch-old)))
t ; Don't remove anything.
(nnheader-nov-delete-outside-range
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles))
+ (car articles)
(car (last articles)))
t)
(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))))
+ (write-region (point-min) (point-max) file nil 'silent)
+ ;; Tell the Agent when the article was fetched, so that it can
+ ;; be expired later.
+ (gnus-agent-load-alist group)
+ (gnus-agent-save-alist group (list article)
+ (time-to-days (current-time))))))
(defun gnus-agent-regenerate-group (group &optional reread)
"Regenerate GROUP.
;; gnus-agent-regenerate-group can remove the article ID of every
;; 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,
+ ;; situation, the last article ID in the list implies that it,
;; and every article ID preceding it, have been fetched from the
;; server.