-;;; 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@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
;;; 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)
(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")))
+(defun gnus-agent-insert-meta-information (type &optional method)
+ "Insert meta-information into the message that says how it's to be posted.
+TYPE can be either `mail' or `news'. If the latter METHOD can
+be a select method."
+ (save-excursion
+ (message-remove-header gnus-agent-meta-information-header)
+ (goto-char (point-min))
+ (insert gnus-agent-meta-information-header ": "
+ (symbol-name type) " " (format "%S" method)
+ "\n")
+ (forward-char -1)
+ (while (search-backward "\n" nil t)
+ (replace-match "\\n" t t))))
+
;;;
;;; Group mode commands
;;;
(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")
(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 group
(error "No group on the current line"))
(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."
(when (file-exists-p (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)
+ (let* ((gnus-command-method method)
+ (file (gnus-agent-lib-file "active")))
+ (gnus-make-directory (file-name-directory file))
+ (nnheader-temp-write file
+ (when (file-exists-p file)
+ (insert-file-contents file))
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^" (regexp-quote group) " ") nil t)
+ (gnus-delete-line))
+ (insert group " " (number-to-string (cdr active)) " "
+ (number-to-string (car active)) "\n")))))
+
(defun gnus-agent-group-path (group)
"Translate GROUP into a path."
(if nnmail-use-long-file-names
;;;
(defun gnus-agent-fetch-articles (group articles)
- "Fetch ARTICLES from GROUP and put them into the agent."
+ "Fetch ARTICLES from GROUP and put them into the Agent."
(when articles
;; Prune off articles that we have already fetched.
(while (and articles
(insert-buffer-substring nntp-server-buffer)))
(copy-to-buffer nntp-server-buffer (point-min) (point-max))
(setq pos (nreverse pos)))))
- ;; Then save these articles into the agent.
+ ;; Then save these articles into the Agent.
(save-excursion
(set-buffer nntp-server-buffer)
(while pos
(when (= (point-max) (point-min))
(push (cons group (current-buffer)) gnus-agent-buffer-alist)
(ignore-errors
- (insert-file-contents
+ (nnheader-insert-file-contents
(gnus-agent-article-name ".overview" group))))
(nnheader-find-nov-line (string-to-number (cdar crosses)))
(insert (string-to-number (cdar crosses)))
(set-buffer nntp-server-buffer)
(unless (eq 'nov (gnus-retrieve-headers articles group))
(nnvirtual-convert-headers))
+ ;;
+ ;; To gnus-agent-expire work fine with no Xref field in .overview
+ ;; Tatsuya Ichikawa <ichikawa@hv.epson.co.jp>
+ (goto-char (point-min))
+ (while (not (eobp))
+ (goto-char (point-at-eol))
+ (insert "\t")
+ (forward-line 1))
+ ;; Tatsuya Ichikawa <ichikawa@hv.epson.co.jp>
+ ;; To gnus-agent-expire work fine with no Xref field in .overview
+ ;;
;; Save these headers for later processing.
(copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
(let (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))
- t))))
+ (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)))
+ t)))))
(defsubst gnus-agent-copy-nov-line (article)
(let (b e)
(goto-char (point-min))
(set-buffer nntp-server-buffer)
(erase-buffer)
- (insert-file-contents file)
+ (nnheader-insert-file-contents file)
(goto-char (point-min))
(if (or (= (point-min) (point-max))
(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 (pop methods)))
+ (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))))))
+ (gnus-agent-fetch-group-1 group gnus-command-method)))))
+ (pop methods))
(gnus-message 6 "Finished fetching articles into the Gnus agent"))))
(defun gnus-agent-fetch-group-1 (group method)
gnus-use-cache articles score arts
category predicate info marks score-param)
;; Fetch headers.
- (when (and (setq articles (gnus-list-of-unread-articles group))
+ (when (and (or (gnus-active group) (gnus-activate-group group))
+ (setq articles (gnus-list-of-unread-articles group))
(gnus-agent-fetch-headers group articles))
;; Parse them and see which articles we want to fetch.
(setq gnus-newsgroup-dependencies
(interactive)
(let ((methods gnus-agent-covered-methods)
(day (- (gnus-time-to-day (current-time)) gnus-agent-expire-days))
- (expiry-hashtb (gnus-make-hashtable 1023))
gnus-command-method sym group articles
history overview file histories elem art nov-file low info
unreads marked article)
(save-excursion
(setq overview (get-buffer-create " *expire overview*"))
(while (setq gnus-command-method (pop methods))
+ (let ((expiry-hashtb (gnus-make-hashtable 1023)))
(gnus-agent-open-history)
(set-buffer
(setq gnus-agent-current-history
(setq history (gnus-agent-history-buffer))))
- (unless (zerop (buffer-size))
+ (goto-char (point-min))
+ (when (> (buffer-size) 1)
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward "^\t")
info (gnus-get-info group)
unreads (ignore-errors (gnus-list-of-unread-articles group))
marked (nconc (gnus-uncompress-range
- (cdr (assq 'ticked (gnus-info-marks info))))
+ (cdr (assq 'tick (gnus-info-marks info))))
(gnus-uncompress-range
(cdr (assq 'dormant
(gnus-info-marks info)))))
nov-file (gnus-agent-article-name ".overview" 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)
- (insert-file-contents nov-file))
+ (nnheader-insert-file-contents nov-file))
(goto-char (point-min))
+ (setq article 0)
(while (setq elem (pop articles))
(setq article (car elem))
(when (or (null low)
(not (memq article marked))))
;; Find and nuke the NOV line.
(while (and (not (eobp))
- (< (setq art (read (current-buffer))) article))
- (forward-line 1))
+ (or (not (numberp
+ (setq art (read (current-buffer)))))
+ (< art article)))
+ (if (file-exists-p
+ (gnus-agent-article-name
+ (number-to-string art) group))
+ (forward-line 1)
+ ;; Remove old NOV lines that have no articles.
+ (gnus-delete-line)))
(if (or (eobp)
(/= art article))
(beginning-of-line)
(delete-file file))
;; Schedule the history line for nuking.
(push (cdr elem) histories)))
- (write-region (point-min) (point-max) nov-file nil 'silent))
+ (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))
+ (let* ((alist gnus-agent-article-alist)
+ (prev (cons nil alist))
+ (first prev))
+ (while (and alist
+ (<= (caar alist) article))
+ (if (or (not (cdar alist))
+ (not (file-exists-p
+ (gnus-agent-article-name
+ (number-to-string
+ (caar alist))
+ group))))
+ (setcdr prev (setq alist (cdr alist)))
+ (setq prev alist
+ alist (cdr alist))))
+ (setq gnus-agent-article-alist (cdr first))
+ ;;; Mark all articles up to the first article
+ ;;; in `gnus-article-alist' as read.
+ (when (caar gnus-agent-article-alist)
+ (setcar (nthcdr 2 info)
+ (gnus-range-add
+ (nth 2 info)
+ (cons 1 (- (caar gnus-agent-article-alist) 1)))))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string info)
+ ")"))
+ (gnus-agent-save-alist group)))
expiry-hashtb)
(set-buffer history)
(setq histories (nreverse (sort histories '<)))
(gnus-delete-line))
(gnus-agent-save-history)
(gnus-agent-close-history))
- (gnus-message 4 "Expiry...done")))))
+ (gnus-message 4 "Expiry...done"))))))
;;;###autoload
(defun gnus-agent-batch ()
projects / elisp / gnus.git- / blobdiff