;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009, 2010 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)
(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."
+ "If non-nil, `gnus-group-send-queue' will prompt if called when unplugged."
:version "22.1"
:group 'gnus-agent
:type 'boolean)
(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)
(setf (gnus-agent-cat-groups old-category)
(delete group (gnus-agent-cat-groups
old-category))))))
- ;; Purge cache as preceeding loop invalidated it.
+ ;; Purge cache as preceding loop invalidated it.
(setq gnus-category-group-cache nil))
(setcdr (or (assq 'agent-groups category)
(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)))
+ (gnus-group-completing-read nil nil t nil nil def)))
;;; Fetching setup functions.
;; Set up the menu.
(when (gnus-visual-p 'agent-menu 'menu)
(funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer))))
- (unless (assq 'gnus-agent-mode minor-mode-alist)
- (push gnus-agent-mode-status minor-mode-alist))
+ (unless (assq mode minor-mode-alist)
+ (push (cons mode (cdr gnus-agent-mode-status)) minor-mode-alist))
(unless (assq mode minor-mode-map-alist)
(push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
buffer))))
(propertize string 'local-map
(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)) )
+ (if (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
+ 'mode-line-highlight))
string))
(defun gnus-agent-toggle-plugged (set-to)
minor mode in all Gnus buffers."
(interactive)
(gnus-open-agent)
- (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
- (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
;; again.
- (unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers"))
+ (when (and (not (file-exists-p (nnheader-concat
+ gnus-agent-directory "lib/servers")))
+ gnus-agent-auto-agentize-methods)
(gnus-message 3 "First time agent user, agentizing remote groups...")
(mapc
(lambda (server-or-method)
(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"))
(replace-match "\n")
(gnus-agent-insert-meta-information 'mail)
- (gnus-request-accept-article "nndraft:queue" nil t t)))
+ (gnus-request-accept-article "nndraft:queue" nil t t)
+ (gnus-group-refresh-group "nndraft:queue")))
(defun gnus-agent-insert-meta-information (type &optional method)
"Insert meta-information into the message that says how it's to be posted.
(setq group (or group gnus-newsgroup-name))
(unless group
(error "No group on the current line"))
-
- (gnus-agent-while-plugged
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (gnus-agent-with-fetch
- (gnus-agent-fetch-group-1 group gnus-command-method)
- (gnus-message 5 "Fetching %s...done" group)))))
+ (if (not (gnus-agent-group-covered-p group))
+ (message "%s isn't covered by the agent" group)
+ (gnus-agent-while-plugged
+ (let ((gnus-command-method (gnus-find-method-for-group group)))
+ (gnus-agent-with-fetch
+ (gnus-agent-fetch-group-1 group gnus-command-method)
+ (gnus-message 5 "Fetching %s...done" group))))))
(defun gnus-agent-add-group (category arg)
"Add the current group to an agent category."
(interactive
(list
(intern
- (completing-read
- "Add to category: "
- (mapcar (lambda (cat) (list (symbol-name (car cat))))
+ (gnus-completing-read
+ "Add to category"
+ (mapcar (lambda (cat) (symbol-name (car cat)))
gnus-category-alist)
- nil t))
+ t))
current-prefix-arg))
(let ((cat (assq category gnus-category-alist))
c groups)
(unless (member server gnus-agent-covered-methods)
(push server gnus-agent-covered-methods)
(setq gnus-agent-method-p-cache nil))
- (gnus-message 1 "Ignoring disappeared server `%s'" server))))
+ (gnus-message 8 "Ignoring disappeared server `%s'" server))))
(prog1 gnus-agent-covered-methods
(setq gnus-agent-covered-methods nil))))
(setq alist (cdr alist)))
((> a h)
;; Headers that are not in the alist should be
- ;; fictious (see nnagent-retrieve-headers); they
+ ;; fictitious (see nnagent-retrieve-headers); they
;; imply that this article isn't in the agent.
(gnus-agent-append-to-list tail-undownloaded h)
(gnus-agent-append-to-list tail-unfetched h)
(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
(mapc #'gnus-summary-remove-process-mark
(gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
- ;; The preceeding call to (gnus-agent-summary-fetch-group)
+ ;; The preceding call to (gnus-agent-summary-fetch-group)
;; updated the temporary gnus-newsgroup-downloadable to
;; remove each article successfully fetched. Now, I
;; update the real gnus-newsgroup-downloadable to only
(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)
;; disable the set read each time this server is opened.
;; NOTE: Opening this group will restore the valid local
;; range but it will also expand the local range to
- ;; incompass the new active range.
+ ;; encompass the new active range.
(gnus-agent-set-local group agent-min (1- active-min)))))))
(defun gnus-agent-save-group-info (method group active)
"Fetch ARTICLES from GROUP and put them into the Agent."
(when articles
(gnus-agent-load-alist group)
- (let* ((alist gnus-agent-article-alist)
+ (let* ((alist gnus-agent-article-alist)
(headers (if (< (length articles) 2) nil gnus-newsgroup-headers))
(selected-sets (list nil))
(current-set-size 0)
header-number)
;; Check each article
(while (setq article (pop articles))
- ;; Skip alist entries preceeding this article
+ ;; Skip alist entries preceding this article
(while (> article (or (caar alist) (1+ article)))
(setq alist (cdr alist)))
;; Prune off articles that we have already fetched.
(unless (and (eq article (caar alist))
(cdar alist))
- ;; Skip headers preceeding this article
+ ;; Skip headers preceding this article
(while (> article
(setq header-number
(let* ((header (car headers)))
;; 65 char/line. If the line count
;; is missing, arbitrarily assume a
;; size of 1000 characters.
- (max (* 65 (mail-header-lines
- (car headers)))
- 1000)
+ (max (* 65 (mail-header-lines
+ (car headers)))
+ 1000)
char-size))
0))))
(setcar selected-sets (nreverse (car selected-sets)))
(setq articles (gnus-list-range-intersection
articles (list (cons low high)))))))
- (gnus-message
- 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
- (gnus-compress-sequence articles t))
+ (when articles
+ (gnus-message
+ 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
+ (gnus-compress-sequence articles t)))
(with-current-buffer nntp-server-buffer
(if articles
(progn
- (gnus-message 7 "Fetching headers for %s..."
+ (gnus-message 8 "Fetching headers for %s..."
(gnus-agent-decoded-group-name group))
;; Fetch them.
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")
(defun gnus-agent-batch-confirmation (msg)
"Show error message and return t."
- (gnus-message 1 msg)
+ (gnus-message 1 "%s" msg)
t)
;;;###autoload
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string info)
- ")"))))))))))))
+ ")")
+ (concat "^(gnus-group-set-info '(\""
+ (regexp-quote group) "\""))))))))))))
;;;
;;; Agent Category Mode
group overview (gnus-gethash-safe group orig)
articles force))))
(kill-buffer overview))))
- (gnus-message 4 (gnus-agent-expire-done-message)))))
+ (gnus-message 4 "%s" (gnus-agent-expire-done-message)))))
(defun gnus-agent-expire-group-1 (group overview active articles force)
;; Internal function - requires caller to have set
;; Convert the keep lists to elements that look like (article#
;; nil keep_flag nil) then append it to the expanded dlist
- ;; These statements are sorted by ascending precidence of the
+ ;; These statements are sorted by ascending precedence of the
;; keep_flag.
(setq dlist (nconc dlist
(mapcar (lambda (e)
;; If considering all articles is set, I can only
;; expire article IDs that are no longer in the
- ;; active range (That is, articles that preceed the
+ ;; active range (That is, articles that precede the
;; first article in the new alist).
(if (and gnus-agent-consider-all-articles
(>= article-number (car active)))
expiring-group overview active articles force))))))))
(kill-buffer overview))
(gnus-agent-expire-unagentized-dirs)
- (gnus-message 4 (gnus-agent-expire-done-message))))))
+ (gnus-message 4 "%s" (gnus-agent-expire-done-message))))))
(defun gnus-agent-expire-done-message ()
(if (and (> gnus-verbose 4)
units (cdr units)))
(format "Expiry recovered %d NOV entries, deleted %d files,\
- and freed %f %s."
+ and freed %.f %s."
(nth 0 stats)
(nth 1 stats)
size (car units)))
(setq r d
d (directory-file-name d)))
;; if ANY ancestor was NOT in keep hash and
- ;; it 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-agent-append-to-list tail-uncached v1))
(setq arts (cdr arts))
(setq ref (cdr ref)))
- (t ; reference article (v2) preceeds the list being filtered
+ (t ; reference article (v2) precedes the list being filtered
(setq ref (cdr ref))))))
(while arts
(gnus-agent-append-to-list tail-uncached (pop arts)))
(erase-buffer)
(cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
(gnus-retrieve-headers
- uncached-articles group fetch-old))))
+ uncached-articles group))))
(nnvirtual-convert-headers))
((eq 'nntp (car gnus-current-select-method))
;; The author of gnus-get-newsgroup-headers-xover
(insert-file-contents file))
t))))
+(defun gnus-agent-store-article (article group)
+ (let* ((gnus-command-method (gnus-find-method-for-group group))
+ (file (gnus-agent-article-name (number-to-string article) group))
+ (file-name-coding-system nnmail-pathname-coding-system)
+ (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)
+ ;; 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.
If REREAD is t, all articles in the .overview are marked as unread.
;; 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,
- ;; and every article ID preceeding it, have been fetched from the
+ ;; situation, the last article ID in the list implies that it,
+ ;; and every article ID preceding it, have been fetched from the
;; server.
(if gnus-agent-consider-all-articles
projects / gnus / blobdiff