;;; 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>
(require 'gnus-cache)
(require 'nnvirtual)
(require 'gnus-sum)
-(eval-when-compile (require 'gnus-score) (require 'gnus-group))
+(eval-when-compile
+ (if (featurep 'xemacs)
+ (require 'itimer)
+ (require 'timer))
+ (require 'gnus-score)
+ (require 'gnus-group))
(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
"Where the Gnus agent will store its files."
(when (file-exists-p (gnus-agent-lib-file "flags"))
(set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
(erase-buffer)
- (insert-file-contents (gnus-agent-lib-file "flags"))
+ (nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
(if (null (gnus-check-server gnus-command-method))
(message "Couldn't open server %s" (nth 1 gnus-command-method))
(while (not (eobp))
(write-file (gnus-agent-lib-file "flags"))
(error "Couldn't set flags from file %s"
(gnus-agent-lib-file "flags"))))
- (write-file (gnus-agent-lib-file "flags")))))))
+ (write-file (gnus-agent-lib-file "flags")))
+ (kill-buffer nil)))))
;;;
;;; Server mode commands
(defun gnus-agent-write-servers ()
"Write the alist of covered servers."
(gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
- (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
- (prin1 gnus-agent-covered-methods (current-buffer))))
+ (let ((coding-system-for-write nnheader-file-coding-system)
+ (output-coding-system nnheader-file-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system)
+ (pathname-coding-system nnmail-pathname-coding-system))
+ (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
+ (prin1 gnus-agent-covered-methods (current-buffer)))))
;;;
;;; Summary commands
(set (intern (symbol-name sym) orig) (symbol-value sym)))))
new))
(gnus-make-directory (file-name-directory file))
- (gnus-write-active-file-as-coding-system gnus-agent-file-coding-system
- file orig)))
+ ;; The hashtable contains real names of groups, no more prefix
+ ;; removing, so set `full' to `t'.
+ (gnus-write-active-file 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")))
+ (coding-system-for-write nnheader-file-coding-system)
+ (output-coding-system nnheader-file-coding-system)
+ (file-name-coding-system nnmail-pathname-coding-system)
+ (pathname-coding-system nnmail-pathname-coding-system)
+ (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))))))
(insert "\n")
(let ((file (gnus-agent-lib-file "history")))
(when (file-exists-p file)
- (insert-file file))
+ (nnheader-insert-file-contents file))
(set (make-local-variable 'gnus-agent-file-name) file))))
(defun gnus-agent-save-history ()
(insert "\n"))
(pop gnus-agent-group-alist))))
+(defun gnus-agent-union (l1 l2)
+ "Set union of lists L1 and L2."
+ (cond ((null l1) l2)
+ ((null l2) l1)
+ ((equal l1 l2) l1)
+ (t
+ (or (>= (length l1) (length l2))
+ (setq l1 (prog1 l2 (setq l2 l1))))
+ (while l2
+ (or (memq (car l2) l1)
+ (push (car l2) l1))
+ (pop l2))
+ l1)))
+
(defun gnus-agent-fetch-headers (group &optional force)
(let* ((articles (gnus-list-of-unread-articles group))
(len (length articles))
(< 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 (gnus-agent-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
(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))
- (princ (setq gnus-agent-article-alist
- (nconc gnus-agent-article-alist
- (mapcar (lambda (article) (cons article state))
- articles)))
- (current-buffer))
- (insert "\n")))
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (pathname-coding-system nnmail-pathname-coding-system))
+ (with-temp-file (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))
+ articles)))
+ (current-buffer))
+ (insert "\n"))))
(defun gnus-agent-article-name (article group)
(concat (gnus-agent-directory) (gnus-agent-group-path group) "/"
gnus-newsgroup-dependencies gnus-newsgroup-headers
gnus-newsgroup-scored gnus-headers gnus-score
gnus-use-cache articles arts
- category predicate info marks score-param)
+ category predicate info marks score-param
+ (gnus-summary-expunge-below gnus-summary-expunge-below)
+ (gnus-summary-mark-below gnus-summary-mark-below)
+ (gnus-orphan-score gnus-orphan-score)
+ ;; Maybe some other gnus-summary local variables should also
+ ;; be put here.
+ )
(unless (gnus-check-group group)
(error "Can't open server for %s" group))
;; Fetch headers.
(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."
(gnus-delete-line))
(gnus-agent-save-history)
(gnus-agent-close-history)
- (gnus-write-active-file-as-coding-system
- gnus-agent-file-coding-system
- (gnus-agent-lib-file "active") orig))
+ (gnus-write-active-file (gnus-agent-lib-file "active") orig))
(gnus-message 4 "Expiry...done")))))))
;;;###autoload
projects / elisp / gnus.git- / blobdiff