X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=10264656ecbfafe6ccfbf9846645e824844a1485;hb=a0184aa5635fa2cf100200c2637c40dabb9c4925;hp=ed4cc72db5a17a327eb43eda712306da7d9ddabf;hpb=1859f381e7fdc6e127a2335d7c217c6c6c33f39c;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index ed4cc72..1026465 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1,4 +1,4 @@ -;;; 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 @@ -49,6 +49,32 @@ :group 'gnus-agent :type 'integer) +(defcustom gnus-agent-expire-days 7 + "Read articles older than this will be expired." + :group 'gnus-agent + :type 'integer) + +(defcustom gnus-agent-expire-all nil + "If non-nil, also expire unread, ticked and dormant articles. +If nil, only read articles will be expired." + :group 'gnus-agent + :type 'boolean) + +(defcustom gnus-agent-group-mode-hook nil + "Hook run in Agent group minor modes." + :group 'gnus-agent + :type 'hook) + +(defcustom gnus-agent-summary-mode-hook nil + "Hook run in Agent summary minor modes." + :group 'gnus-agent + :type 'hook) + +(defcustom gnus-agent-server-mode-hook nil + "Hook run in Agent summary minor modes." + :group 'gnus-agent + :type 'hook) + ;;; Internal variables (defvar gnus-agent-history-buffers nil) @@ -176,7 +202,8 @@ buffer)))) minor-mode-map-alist)) (gnus-agent-toggle-plugged gnus-plugged) - (gnus-run-hooks 'gnus-agent-mode-hook))) + (gnus-run-hooks 'gnus-agent-mode-hook + (intern (format "gnus-agent-%s-mode-hook" buffer))))) (defvar gnus-agent-group-mode-map (make-sparse-keymap)) (gnus-define-keys gnus-agent-group-mode-map @@ -261,6 +288,13 @@ (gnus)) ;;;###autoload +(defun gnus-plugged () + "Start Gnus plugged." + (interactive) + (setq gnus-plugged t) + (gnus)) + +;;;###autoload (defun gnus-agentize () "Allow Gnus to be an offline newsreader. The normal usage of this command is to put the following as the @@ -481,9 +515,9 @@ the actual number of articles toggled is returned." (defun gnus-agent-group-path (group) "Translate GROUP into a path." (if nnmail-use-long-file-names - group + (gnus-group-real-name group) (nnheader-replace-chars-in-string - (nnheader-translate-file-chars group) + (nnheader-translate-file-chars (gnus-group-real-name group)) ?. ?/))) @@ -539,7 +573,7 @@ the actual number of articles toggled is returned." (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 (caar group-arts) " " (number-to-string (cdr (pop group-arts))) " ")) (insert "\n"))) @@ -655,7 +689,7 @@ the actual number of articles toggled is returned." (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))) @@ -696,6 +730,17 @@ the actual number of articles toggled is returned." (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 + (goto-char (point-min)) + (while (not (eobp)) + (goto-char (point-at-eol)) + (insert "\t") + (forward-line 1)) + ;; Tatsuya Ichikawa + ;; 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) @@ -724,7 +769,7 @@ the actual number of articles toggled is returned." (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 @@ -799,12 +844,14 @@ the actual number of articles toggled is returned." groups group gnus-command-method) (save-excursion (while methods - (setq gnus-command-method (car methods) - groups (gnus-groups-from-server (pop 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))))) + (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))) + (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-message 6 "Finished fetching articles into the Gnus agent")))) (defun gnus-agent-fetch-group-1 (group method) @@ -1126,7 +1173,7 @@ The following commands are available: (defun gnus-agent-high-scored-p () "Say whether an article has a high score or not." - (> gnus-score gnus-agent-low-score)) + (> gnus-score gnus-agent-high-score)) (defun gnus-category-make-function (cat) "Make a function from category CAT." @@ -1185,88 +1232,85 @@ The following commands are available: "Expire all old articles." (interactive) (let ((methods gnus-agent-covered-methods) - (alist (cdr gnus-newsrc-alist)) - gnus-command-method ofiles info method file group) - (while (setq gnus-command-method (pop methods)) - (setq ofiles (nconc ofiles (gnus-agent-expire-directory - (gnus-agent-directory))))) - (while (setq info (pop alist)) - (when (and (gnus-agent-method-p - (setq gnus-command-method - (gnus-find-method-for-group - (setq group (gnus-info-group info))))) - (member - (setq file - (concat - (gnus-agent-directory) - (gnus-agent-group-path group) "/.overview")) - ofiles)) - (setq ofiles (delete file ofiles)) - (gnus-agent-expire-group file group))) - (while ofiles - (gnus-agent-expire-group (pop ofiles))))) - -(defun gnus-agent-expire-directory (dir) - "Expire all groups in DIR recursively." - (when (file-directory-p dir) - (let ((files (directory-files dir t)) - file ofiles) - (while (setq file (pop files)) - (cond - ((member (file-name-nondirectory file) '("." "..")) - ;; Do nothing. - ) - ((file-directory-p file) - ;; Recurse. - (setq ofiles (nconc ofiles (gnus-agent-expire-directory file)))) - ((string-match "\\.overview$" file) - ;; Expire group. - (push file ofiles)))) - ofiles))) - -(defun gnus-agent-expire-group (overview &optional group) - "Expire articles in OVERVIEW." - (gnus-message 5 "Expiring %s..." overview) - (let ((odate (- (gnus-time-to-day (current-time)) 4)) - (dir (file-name-directory overview)) - (info (when group (gnus-get-info group))) - headers article file point unreads) - (gnus-agent-load-alist nil dir) - (when info - (setq unreads - (nconc - (gnus-list-of-unread-articles group) - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant (gnus-info-marks info))))))) - (nnheader-temp-write overview - (insert-file-contents overview) - (goto-char (point-min)) - (while (not (eobp)) - (setq point (point)) - (condition-case () - (setq headers (inline (nnheader-parse-nov))) - (error - (goto-char point) - (gnus-delete-line) - (setq headers nil))) - (when headers - (unless (memq (setq article (mail-header-number headers)) unreads) - (if (not (< (inline - (gnus-time-to-day - (inline (nnmail-date-to-time - (mail-header-date headers))))) - odate)) - (forward-line 1) - (gnus-delete-line) - (setq gnus-agent-article-alist - (delq (assq article gnus-agent-article-alist) - gnus-agent-article-alist)) - (when (file-exists-p - (setq file (concat dir (number-to-string article)))) - (delete-file file)))))) - (gnus-agent-save-alist nil nil nil dir)))) + (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)) + (gnus-agent-open-history) + (set-buffer + (setq gnus-agent-current-history + (setq history (gnus-agent-history-buffer)))) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward "^\t") + (if (> (read (current-buffer)) day) + ;; New article; we don't expire it. + (forward-line 1) + ;; Old article. Schedule it for possible nuking. + (while (not (eolp)) + (setq sym (let ((obarray expiry-hashtb)) + (read (current-buffer)))) + (if (boundp sym) + (set sym (cons (cons (read (current-buffer)) (point)) + (symbol-value sym))) + (set sym (list (cons (read (current-buffer)) (point))))) + (skip-chars-forward " ")) + (forward-line 1))) + ;; We now have all articles that can possibly be expired. + (mapatoms + (lambda (sym) + (setq group (symbol-name sym) + articles (sort (symbol-value sym) 'car-less-than-car) + low (car (gnus-active group)) + 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)))) + (gnus-uncompress-range + (cdr (assq 'dormant (gnus-info-marks info))))) + nov-file (gnus-agent-article-name ".overview" 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)) + (while (setq elem (pop articles)) + (setq article (car elem)) + (when (or (null low) + (< article low) + gnus-agent-expire-all + (and (not (memq article unreads)) + (not (memq article marked)))) + ;; Find and nuke the NOV line. + (while (and (not (eobp)) + (< (setq art (read (current-buffer))) article)) + (forward-line 1)) + (if (or (eobp) + (/= art article)) + (beginning-of-line) + (gnus-delete-line)) + ;; Nuke the article. + (when (file-exists-p (setq file (gnus-agent-article-name + (number-to-string article) + group))) + (delete-file file)) + ;; Schedule the history line for nuking. + (push (cdr elem) histories))) + (write-region (point-min) (point-max) nov-file nil 'silent)) + expiry-hashtb) + (set-buffer history) + (setq histories (nreverse (sort histories '<))) + (while histories + (goto-char (pop histories)) + (gnus-delete-line)) + (gnus-agent-save-history) + (gnus-agent-close-history)) + (gnus-message 4 "Expiry...done")))) ;;;###autoload (defun gnus-agent-batch ()