;;; gnus-agent.el --- unplugged support for Semi-gnus
-;; Copyright (C) 1997,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
;;; Code:
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'gnus-clfns))
+
(require 'gnus)
(require 'gnus-cache)
(require 'nnvirtual)
:group 'gnus-agent
:type 'hook)
+(defcustom gnus-agent-confirmation-function 'y-or-n-p
+ "Function to confirm when error happens."
+ :group 'gnus-agent
+ :type 'function)
+
(defcustom gnus-agent-large-newsgroup nil
"*The number of articles which indicates a large newsgroup.
If the number of unread articles exceeds it, The number of articles to be
(set (intern (symbol-name sym) orig) (symbol-value sym)))))
new))
(gnus-make-directory (file-name-directory file))
+ ;; The hashtable contains real names of groups, no more prefix
+ ;; removing, so set `full' to `t'.
(gnus-write-active-file-as-coding-system gnus-agent-file-coding-system
- file orig)))
+ file orig t)))
(defun gnus-agent-save-groups (method)
(gnus-agent-save-active-1 method 'gnus-groups-to-gnus-format))
(defun gnus-agent-save-group-info (method group active)
(when (gnus-agent-method-p method)
(let* ((gnus-command-method method)
- (file (gnus-agent-lib-file "active")))
+ (file (gnus-agent-lib-file "active"))
+ oactive)
(gnus-make-directory (file-name-directory file))
(with-temp-file file
(when (file-exists-p file)
(goto-char (point-min))
(when (re-search-forward
(concat "^" (regexp-quote group) " ") nil t)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (match-beginning 0)
+ (progn
+ (forward-line 1)
+ (point)))
+ (setq oactive (car (nnmail-parse-active)))))
(gnus-delete-line))
- (insert (format "%S %d %d y\n" (intern group) (cdr active)
- (car active)))
+ (insert (format "%S %d %d y\n" (intern group)
+ (cdr active)
+ (or (car oactive) (car active))))
(goto-char (point-max))
(while (search-backward "\\." nil t)
(delete-char 1))))))
(save-excursion
(set-buffer gnus-agent-current-history)
(goto-char (point-max))
- (insert id "\t" (number-to-string date) "\t")
- (while group-arts
- (insert (caar group-arts) " " (number-to-string (cdr (pop group-arts)))
- " "))
- (insert "\n")))
+ (let ((p (point)))
+ (insert id "\t" (number-to-string date) "\t")
+ (while group-arts
+ (insert (format "%S" (intern (caar group-arts)))
+ " " (number-to-string (cdr (pop group-arts)))
+ " "))
+ (insert "\n")
+ (while (search-backward "\\." p t)
+ (delete-char 1)))))
(defun gnus-agent-article-in-history-p (id)
(save-excursion
;; Prune off articles that we have already fetched.
(while (and articles
(cdr (assq (car articles) gnus-agent-article-alist)))
- (pop articles))
+ (pop articles))
(let ((arts articles))
(while (cdr arts)
(if (cdr (assq (cadr arts) gnus-agent-article-alist))
(with-temp-buffer
(let (article)
(while (setq article (pop articles))
- (when (gnus-request-article article group)
+ (when (or
+ (gnus-backlog-request-article group article
+ nntp-server-buffer)
+ (gnus-request-article article group))
(goto-char (point-max))
(push (cons article (point)) pos)
(insert-buffer-substring nntp-server-buffer)))
(setcdr alist (cons (cons (cdar crosses) t) (cdr alist)))
(save-excursion
(set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
- group)))
+ group)))
(when (= (point-max) (point-min))
(push (cons group (current-buffer)) gnus-agent-buffer-alist)
(ignore-errors
(< 0 gnus-agent-large-newsgroup))
(and (< 0 (setq i (- len gnus-agent-large-newsgroup)))
(setq articles (nthcdr i articles))))
- ;; add article with marks to list of article headers we want to fetch
+ ;; add article with marks to list of article headers we want to fetch.
(dolist (arts (gnus-info-marks (gnus-get-info group)))
(setq articles (union (gnus-uncompress-sequence (cdr arts))
articles)))
(setq articles (sort articles '<))
- ;; remove known articles
+ ;; Remove known articles.
(when (gnus-agent-load-alist group)
(setq articles (gnus-sorted-intersection
articles
(cdr (gnus-active group)))))))
;; Fetch them.
(gnus-make-directory (nnheader-translate-file-chars
- (file-name-directory file)))
+ (file-name-directory file) t))
(when articles
(gnus-message 7 "Fetching headers for %s..." group)
(save-excursion
"Start Gnus and fetch session."
(interactive)
(gnus)
- (gnus-agent-fetch-session)
+ (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
+ (gnus-agent-fetch-session))
(gnus-group-exit))
(defun gnus-agent-fetch-session ()
groups group gnus-command-method)
(save-excursion
(while methods
- (setq gnus-command-method (car methods))
- (when (or (gnus-server-opened gnus-command-method)
- (gnus-open-server gnus-command-method))
- (setq groups (gnus-groups-from-server (car methods)))
- (gnus-agent-with-fetch
- (while (setq group (pop groups))
- (when (<= (gnus-group-level group) gnus-agent-handle-level)
- (gnus-agent-fetch-group-1 group gnus-command-method)))))
+ (condition-case err
+ (progn
+ (setq gnus-command-method (car methods))
+ (when (or (gnus-server-opened gnus-command-method)
+ (gnus-open-server gnus-command-method))
+ (setq groups (gnus-groups-from-server (car methods)))
+ (gnus-agent-with-fetch
+ (while (setq group (pop groups))
+ (when (<= (gnus-group-level group) gnus-agent-handle-level)
+ (gnus-agent-fetch-group-1 group gnus-command-method))))))
+ (error
+ (unless (funcall gnus-agent-confirmation-function
+ (format "Error (%s). Continue? " err))
+ (error "Cannot fetch articles into the Gnus agent."))))
(pop methods))
(gnus-message 6 "Finished fetching articles into the Gnus agent"))))
(gnus-get-newsgroup-headers-xover articles nil nil
group)))
;; `gnus-agent-overview-buffer' may be killed for
- ;; timeout reason. If so, recreate it.
+ ;; timeout reason. If so, recreate it.
(gnus-agent-create-buffer)))
(setq category (gnus-group-category group))
(setq predicate
(let ((info (assq category gnus-category-alist))
(buffer-read-only nil))
(gnus-delete-line)
- (gnus-category-write)
- (setq gnus-category-alist (delq info gnus-category-alist))))
+ (setq gnus-category-alist (delq info gnus-category-alist))
+ (gnus-category-write)))
(defun gnus-category-copy (category to)
"Copy the current category."
(forward-line 1)
;; Old article. Schedule it for possible nuking.
(while (not (eolp))
- (setq sym (let ((obarray expiry-hashtb))
- (read (current-buffer))))
+ (setq sym (let ((obarray expiry-hashtb) s)
+ (setq s (read (current-buffer)))
+ (if (stringp s) (intern s) s)))
(if (boundp sym)
(set sym (cons (cons (read (current-buffer)) (point))
(symbol-value sym)))
projects / elisp / gnus.git- / blobdiff