-;;; gnus-agent.el --- unplugged support for Gnus
-;; Copyright (C) 1997,98,99 Free Software Foundation, Inc.
+;;; gnus-agent.el --- unplugged support for Semi-gnus
+;; 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>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;;; Code:
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'gnus-clfns))
+
(require 'gnus)
(require 'gnus-cache)
(require 'nnvirtual)
(require 'gnus-sum)
-(eval-when-compile
- (require 'cl)
- (require 'gnus-score))
+(eval-when-compile (require 'gnus-score) (require 'gnus-group))
(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
"Where the Gnus agent will store its files."
: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
+fetched will be limited to it. If not a positive integer, never consider it."
+ :group 'gnus-agent
+ :type '(choice (const nil)
+ (integer :tag "Number")))
+
;;; Internal variables
(defvar gnus-agent-history-buffers nil)
(setq gnus-agent-overview-buffer
(gnus-get-buffer-create " *Gnus agent overview*"))
(with-current-buffer gnus-agent-overview-buffer
- (mm-enable-multibyte))
+ (set-buffer-multibyte t))
nil))
(gnus-add-shutdown 'gnus-close-agent 'gnus)
(setq gnus-plugged plugged)
(gnus-run-hooks 'gnus-agent-unplugged-hook)
(setcar (cdr gnus-agent-mode-status) " Unplugged"))
- (set-buffer-modified-p t))
+ (force-mode-line-update))
(defun gnus-agent-close-connections ()
"Close all methods covered by the Gnus agent."
(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
(funcall function nil new)
(gnus-agent-write-active file new)
(erase-buffer)
- (insert-file-contents-literally file))))
+ (insert-file-contents-as-coding-system gnus-agent-file-coding-system
+ file))))
(defun gnus-agent-write-active (file new)
(let ((orig (gnus-make-hashtable (count-lines (point-min) (point-max))))
elem osym)
(when (file-exists-p file)
(with-temp-buffer
- (insert-file-contents file)
+ (insert-file-contents-as-coding-system gnus-agent-file-coding-system
+ file)
(gnus-active-to-gnus-format nil orig))
(mapatoms
(lambda (sym)
(set (intern (symbol-name sym) orig) (symbol-value sym)))))
new))
(gnus-make-directory (file-name-directory file))
- (let ((coding-system-for-write gnus-agent-file-coding-system))
- (gnus-write-active-file file orig))))
+ ;; 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 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 ()
(save-excursion
(set-buffer gnus-agent-current-history)
(gnus-make-directory (file-name-directory gnus-agent-file-name))
- (let ((coding-system-for-write gnus-agent-file-coding-system))
- (write-region (1+ (point-min)) (point-max)
- gnus-agent-file-name nil 'silent))))
+ (write-region-as-coding-system
+ gnus-agent-file-coding-system
+ (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)
(if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t))
(setq id "No-Message-ID-in-article")
(setq id (buffer-substring (match-beginning 1) (match-end 1))))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max)
- (concat dir (number-to-string (caar pos)))
- nil 'silent))
+ (write-region-as-coding-system
+ gnus-agent-file-coding-system
+ (point-min) (point-max)
+ (concat dir (number-to-string (caar pos))) nil 'silent)
(when (setq elem (assq (caar pos) gnus-agent-article-alist))
(setcdr elem t))
(gnus-agent-enter-history
(save-excursion
(while gnus-agent-buffer-alist
(set-buffer (cdar gnus-agent-buffer-alist))
- (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))
+ (write-region-as-coding-system
+ gnus-agent-file-coding-system
+ (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)
(pop gnus-agent-group-alist))))
(defun gnus-agent-fetch-headers (group &optional force)
- (let ((articles (gnus-list-of-unread-articles group))
- (gnus-decode-encoded-word-function 'identity)
- (file (gnus-agent-article-name ".overview" group)))
- ;; add article with marks to list of article headers we want to fetch
+ (let* ((articles (gnus-list-of-unread-articles group))
+ (len (length articles))
+ (gnus-decode-encoded-word-function 'identity)
+ (file (gnus-agent-article-name ".overview" group))
+ i)
+ ;; Check the number of articles is not too large.
+ (when (and (integerp gnus-agent-large-newsgroup)
+ (< 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.
(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
- (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))
+ (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))
(when (file-exists-p file)
(gnus-agent-braid-nov group articles file))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max) file nil 'silent))
+ (write-region-as-coding-system
+ gnus-agent-file-coding-system
+ (point-min) (point-max) file nil 'silent)
(gnus-agent-save-alist group articles nil)
(gnus-agent-enter-history
"last-header-fetched-for-session"
(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) "/"
(if (stringp article) article (string-to-number article))))
-(defun gnus-agent-batch-confirmation (msg)
- "Show error message and return t."
- (gnus-message 1 msg)
- t)
-
;;;###autoload
(defun gnus-agent-batch-fetch ()
"Start Gnus and fetch session."
;; 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
+ (gnus-get-newsgroup-headers-xover articles nil nil
group)))
;; `gnus-agent-overview-buffer' may be killed for
;; timeout reason. If so, recreate it.
(caddr info)
(format "Editing the score expression for category %s" category)
`(lambda (groups)
- (setcar (cddr (assq ',category gnus-category-alist)) groups)
+ (setcar (nthcdr 2 (assq ',category gnus-category-alist)) groups)
(gnus-category-write)
(gnus-category-list)))))
(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."
(while (setq gnus-command-method (pop methods))
(when (file-exists-p (gnus-agent-lib-file "active"))
(with-temp-buffer
- (insert-file-contents (gnus-agent-lib-file "active"))
- (gnus-active-to-gnus-format
+ (insert-file-contents-as-coding-system
+ gnus-agent-file-coding-system (gnus-agent-lib-file "active"))
+ (gnus-active-to-gnus-format
gnus-command-method
(setq orig (gnus-make-hashtable
(count-lines (point-min) (point-max))))))
(gnus-uncompress-range
(cdr (assq 'tick (gnus-info-marks info))))
(gnus-uncompress-range
- (cdr (assq 'dormant
- (gnus-info-marks info)))))
+ (cdr (assq 'dormant (gnus-info-marks info))))
+ (gnus-uncompress-range
+ (cdr (assq 'save (gnus-info-marks info))))
+ (gnus-uncompress-range
+ (cdr (assq 'reply (gnus-info-marks info)))))
nov-file (gnus-agent-article-name ".overview" group)
lowest nil
highest nil)
(or (not (numberp
(setq art (read (current-buffer)))))
(< art article)))
- (if (and (numberp art)
+ (if (and (numberp art)
(file-exists-p
(gnus-agent-article-name
(number-to-string art) group)))
;; Schedule the history line for nuking.
(push (cdr elem) histories)))
(gnus-make-directory (file-name-directory nov-file))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max) nov-file nil 'silent))
+ (write-region-as-coding-system
+ gnus-agent-file-coding-system
+ (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))
(gnus-delete-line))
(gnus-agent-save-history)
(gnus-agent-close-history)
- (gnus-write-active-file
+ (gnus-write-active-file-as-coding-system
+ gnus-agent-file-coding-system
(gnus-agent-lib-file "active") orig))
(gnus-message 4 "Expiry...done")))))))
projects / elisp / gnus.git- / blobdiff