-;;; gnus-agent.el --- unplugged support for Gnus
+;;; gnus-agent.el --- unplugged support for Semi-gnus
;; Copyright (C) 1997,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'gnus-cache)
(require 'nnvirtual)
(require 'gnus-sum)
-(eval-when-compile
- (require 'cl)
- (require 'gnus-score))
+(eval-when-compile (require 'cl))
(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
"Where the Gnus agent will store its files."
;;; Internal variables
+(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
+
(defvar gnus-agent-history-buffers nil)
(defvar gnus-agent-buffer-alist nil)
(defvar gnus-agent-article-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)
-
-(defconst gnus-agent-scoreable-headers
- (list
- "subject" "from" "date" "message-id"
- "references" "chars" "lines" "xref")
- "Headers that are considered when scoring articles
-for download via the Agent.")
+(defvar gnus-agent-file-coding-system 'no-conversion)
;; Dynamic variables
(defvar gnus-headers)
(defun gnus-agent-read-file (file)
"Load FILE and do a `read' there."
- (with-temp-buffer
+ (nnheader-temp-write nil
(ignore-errors
(nnheader-insert-file-contents file)
(goto-char (point-min))
(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")))
(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-write-servers ()
"Write the alist of covered servers."
- (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
+ (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/servers")
(prin1 gnus-agent-covered-methods (current-buffer))))
;;;
(let* ((gnus-command-method method)
(file (gnus-agent-lib-file "active")))
(gnus-make-directory (file-name-directory file))
- (let ((coding-system-for-write gnus-agent-article-file-coding-system))
+ (let ((coding-system-for-write gnus-agent-file-coding-system))
(write-region (point-min) (point-max) file nil 'silent))
(when (file-exists-p (gnus-agent-lib-file "groups"))
(delete-file (gnus-agent-lib-file "groups"))))))
(let* ((gnus-command-method method)
(file (gnus-agent-lib-file "groups")))
(gnus-make-directory (file-name-directory file))
- (write-region (point-min) (point-max) file nil 'silent))
+ (let ((coding-system-for-write gnus-agent-file-coding-system))
+ (write-region (point-min) (point-max) file nil 'silent))
(when (file-exists-p (gnus-agent-lib-file "active"))
- (delete-file (gnus-agent-lib-file "active"))))
+ (delete-file (gnus-agent-lib-file "active")))))
(defun gnus-agent-save-group-info (method group active)
(when (gnus-agent-method-p method)
(gnus-agent-lib-file "active")
(gnus-agent-lib-file "groups"))))
(gnus-make-directory (file-name-directory file))
- (with-temp-file file
+ (nnheader-temp-write file
(when (file-exists-p file)
(nnheader-insert-file-contents file))
(goto-char (point-min))
(concat "^" (regexp-quote group) " ") nil t)
(gnus-delete-line))
(insert group " " (number-to-string (cdr active)) " "
- (number-to-string (car active)) "\n"))
+ (number-to-string (car active)) " y\n"))
(when (re-search-forward (concat (regexp-quote group) " ") nil t)
(gnus-delete-line))
(insert-buffer-substring nntp-server-buffer))))))
(save-excursion
(set-buffer gnus-agent-current-history)
(gnus-make-directory (file-name-directory gnus-agent-file-name))
- (write-region (1+ (point-min)) (point-max)
- gnus-agent-file-name nil 'silent)))
+ (let ((coding-system-for-write gnus-agent-file-coding-system))
+ (write-region (1+ (point-min)) (point-max)
+ gnus-agent-file-name nil 'silent))))
(defun gnus-agent-close-history ()
(when (gnus-buffer-live-p gnus-agent-current-history)
;; 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))
(let ((dir (concat
(gnus-agent-directory)
(gnus-agent-group-path group) "/"))
- (date (time-to-days (current-time)))
+ (date (gnus-time-to-day (current-time)))
(case-fold-search t)
pos crosses id elem)
(gnus-make-directory dir)
;; Fetch the articles from the backend.
(if (gnus-check-backend-function 'retrieve-articles group)
(setq pos (gnus-retrieve-articles articles group))
- (with-temp-file nil
+ (nnheader-temp-write nil
(let (article)
(while (setq article (pop articles))
(when (gnus-request-article article group)
(setq id "No-Message-ID-in-article")
(setq id (buffer-substring (match-beginning 1) (match-end 1))))
(let ((coding-system-for-write
- gnus-agent-article-file-coding-system))
+ gnus-agent-file-coding-system))
(write-region (point-min) (point-max)
(concat dir (number-to-string (caar pos)))
nil 'silent))
(save-excursion
(while gnus-agent-buffer-alist
(set-buffer (cdar gnus-agent-buffer-alist))
- (write-region (point-min) (point-max)
- (gnus-agent-article-name ".overview"
- (caar gnus-agent-buffer-alist))
- nil 'silent)
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (write-region (point-min) (point-max)
+ (gnus-agent-article-name ".overview"
+ (caar gnus-agent-buffer-alist))
+ nil 'silent))
(pop gnus-agent-buffer-alist))
(while gnus-agent-group-alist
- (with-temp-file (caar gnus-agent-group-alist)
+ (nnheader-temp-write (caar gnus-agent-group-alist)
(princ (cdar gnus-agent-group-alist))
(insert "\n"))
(pop gnus-agent-group-alist))))
(defun gnus-agent-fetch-headers (group &optional force)
(let ((articles (if (gnus-agent-load-alist group)
- (gnus-sorted-intersection
- (gnus-list-of-unread-articles group)
- (gnus-uncompress-range
- (cons (1+ (caar (last gnus-agent-article-alist)))
- (cdr (gnus-active group)))))
- (gnus-list-of-unread-articles group))))
+ (gnus-sorted-intersection
+ (gnus-list-of-unread-articles group)
+ (gnus-uncompress-range
+ (cons (1+ (caar (last gnus-agent-article-alist)))
+ (cdr (gnus-active group)))))
+ (gnus-list-of-unread-articles group))))
;; Fetch them.
(when articles
(gnus-message 7 "Fetching headers for %s..." group)
(save-excursion
- (set-buffer nntp-server-buffer)
- (unless (eq 'nov (gnus-retrieve-headers articles group))
- (nnvirtual-convert-headers))
- ;; Save these headers for later processing.
- (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
- (let (file)
- (when (file-exists-p
- (setq file (gnus-agent-article-name ".overview" group)))
- (gnus-agent-braid-nov group articles file))
- (gnus-make-directory (nnheader-translate-file-chars
- (file-name-directory file)))
- (write-region (point-min) (point-max) file nil 'silent)
- (gnus-agent-save-alist group articles nil)
- (gnus-agent-enter-history
- "last-header-fetched-for-session"
- (list (cons group (nth (- (length articles) 1) articles)))
- (time-to-days (current-time)))
- articles)))))
+ (set-buffer nntp-server-buffer)
+ (unless (eq 'nov (gnus-retrieve-headers articles group))
+ (nnvirtual-convert-headers))
+ ;; Save these headers for later processing.
+ (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
+ (let (file)
+ (when (file-exists-p
+ (setq file (gnus-agent-article-name ".overview" group)))
+ (gnus-agent-braid-nov group articles file))
+ (gnus-make-directory (nnheader-translate-file-chars
+ (file-name-directory file)))
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (write-region (point-min) (point-max) file nil 'silent))
+ (gnus-agent-save-alist group articles nil)
+ (gnus-agent-enter-history
+ "last-header-fetched-for-session"
+ (list (cons group (nth (- (length articles) 1) articles)))
+ (gnus-time-to-day (current-time)))
+ articles)))))
(defsubst gnus-agent-copy-nov-line (article)
(let (b e)
(defun gnus-agent-save-alist (group &optional articles state dir)
"Save the article-state alist for GROUP."
- (with-temp-file (if dir
- (concat dir ".agentview")
- (gnus-agent-article-name ".agentview" group))
+ (nnheader-temp-write (if dir
+ (concat dir ".agentview")
+ (gnus-agent-article-name ".agentview" group))
(princ (setq gnus-agent-article-alist
(nconc gnus-agent-article-alist
(mapcar (lambda (article) (cons article state))
;; Parse them and see which articles we want to fetch.
(setq gnus-newsgroup-dependencies
(make-vector (length articles) 0))
- ;; No need to call `gnus-get-newsgroup-headers-xover' with
- ;; the entire .overview for group as we still have the just
- ;; downloaded headers in `gnus-agent-overview-buffer'.
- (let ((nntp-server-buffer gnus-agent-overview-buffer))
- (setq gnus-newsgroup-headers
- (gnus-get-newsgroup-headers-xover articles nil nil group)))
+ (setq gnus-newsgroup-headers
+ (gnus-get-newsgroup-headers-xover articles nil nil group))
(setq category (gnus-group-category group))
(setq predicate
(gnus-get-predicate
- (or (gnus-group-get-parameter group 'agent-predicate t)
+ (or (gnus-group-get-parameter group 'agent-predicate)
(cadr category))))
- ;; Do we want to download everything, or nothing?
- (if (or (eq (caaddr predicate) 'gnus-agent-true)
- (eq (caaddr predicate) 'gnus-agent-false))
- ;; Yes.
- (setq arts (symbol-value
- (cadr (assoc (caaddr predicate)
- '((gnus-agent-true articles)
- (gnus-agent-false nil))))))
- ;; No, we need to decide what we want.
- (setq score-param
- (let ((score-method (or
- (gnus-group-get-parameter group 'agent-score t)
- (caddr category))))
- (when score-method
- (require 'gnus-score)
- (if (eq score-method 'file)
- (let ((entries
- (gnus-score-load-files
- (gnus-all-score-files group)))
- list score-file)
- (while (setq list (car entries))
- (push (car list) score-file)
- (setq list (cdr list))
- (while list
- (when (member (caar list)
- gnus-agent-scoreable-headers)
- (push (car list) score-file))
- (setq list (cdr list)))
- (setq score-param
- (append score-param (list (nreverse score-file)))
- score-file nil entries (cdr entries)))
- (list score-param))
- (if (stringp (car score-method))
- score-method
- (list (list score-method)))))))
- (when score-param
- (gnus-score-headers score-param))
- (setq arts nil)
- (while (setq gnus-headers (pop gnus-newsgroup-headers))
- (setq gnus-score
- (or (cdr (assq (mail-header-number gnus-headers)
- gnus-newsgroup-scored))
- gnus-summary-default-score))
- (when (funcall predicate)
- (push (mail-header-number gnus-headers)
- arts))))
+ (setq score-param
+ (or (gnus-group-get-parameter group 'agent-score)
+ (caddr category)))
+ (when score-param
+ (gnus-score-headers (list (list score-param))))
+ (setq arts nil)
+ (while (setq gnus-headers (pop gnus-newsgroup-headers))
+ (setq gnus-score
+ (or (cdr (assq (mail-header-number gnus-headers)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score))
+ (when (funcall predicate)
+ (push (mail-header-number gnus-headers)
+ arts)))
;; Fetch the articles.
(when arts
(gnus-agent-fetch-articles group arts)))
(gnus-set-default-directory)
(setq mode-line-process nil)
(use-local-map gnus-category-mode-map)
- (buffer-disable-undo)
+ (buffer-disable-undo (current-buffer))
(setq truncate-lines t)
(setq buffer-read-only t)
(gnus-run-hooks 'gnus-category-mode-hook))
"Write the category alist."
(setq gnus-category-predicate-cache nil
gnus-category-group-cache nil)
- (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
+ (nnheader-temp-write (nnheader-concat gnus-agent-directory "lib/categories")
(prin1 gnus-category-alist (current-buffer))))
(defun gnus-category-edit-predicate (category)
"Expire all old articles."
(interactive)
(let ((methods gnus-agent-covered-methods)
- (day (- (time-to-days (current-time)) gnus-agent-expire-days))
+ (day (- (gnus-time-to-day (current-time)) gnus-agent-expire-days))
gnus-command-method sym group articles
history overview file histories elem art nov-file low info
unreads marked article)
(cdr (assq 'dormant
(gnus-info-marks info)))))
nov-file (gnus-agent-article-name ".overview" group))
- (gnus-agent-load-alist group)
+ (gnus-agent-load-alist group)
(gnus-message 5 "Expiring articles in %s" group)
(set-buffer overview)
(erase-buffer)
(when (file-exists-p nov-file)
(nnheader-insert-file-contents nov-file))
(goto-char (point-min))
- (setq article 0)
+ (setq article 0)
(while (setq elem (pop articles))
(setq article (car elem))
(when (or (null low)
;; Schedule the history line for nuking.
(push (cdr elem) histories)))
(gnus-make-directory (file-name-directory nov-file))
- (write-region (point-min) (point-max) nov-file nil 'silent)
+ (let ((coding-system-for-write
+ gnus-agent-file-coding-system))
+ (write-region (point-min) (point-max) nov-file nil 'silent))
;; Delete the unwanted entries in the alist.
(setq gnus-agent-article-alist
(sort gnus-agent-article-alist 'car-less-than-car))
(setq prev alist
alist (cdr alist))))
(setq gnus-agent-article-alist (cdr first))
- (gnus-agent-save-alist group)
- ;; Mark all articles up to the first article
- ;; in `gnus-article-alist' as read.
+ ;;; Mark all articles up to the first article
+ ;;; in `gnus-article-alist' as read.
(when (and info (caar gnus-agent-article-alist))
(setcar (nthcdr 2 info)
(gnus-range-add
;; Maybe everything has been expired from `gnus-article-alist'
;; and so the above marking as read could not be conducted,
;; or there are expired article within the range of the alist.
- (when (and info
- expired
- (or (not (caar gnus-agent-article-alist))
- (> (car expired)
- (caar gnus-agent-article-alist))))
- (setcar (nthcdr 2 info)
- (gnus-add-to-range
- (nth 2 info)
- (nreverse expired))))
+ (when (or (not (caar gnus-agent-article-alist))
+ (> (car expired) (caar gnus-agent-article-alist)))
+ (setcar (nthcdr 2 info)
+ (gnus-add-to-range
+ (nth 2 info)
+ (nreverse expired))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(gnus-prin1-to-string info)