From 58c16277c9e8d3408eea0e6ec4284e4cd191fb4c Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 8 Jun 2001 07:52:50 +0000 Subject: [PATCH] * nnshimbun.el (nnshimbun-expire-nov-databases): Removed. (nnshimbun-request-expire-articles): Simplified; refer to the shimbun's default expiration days. --- ChangeLog | 6 ++ lisp/nnshimbun.el | 212 +++++++++++++++-------------------------------------- 2 files changed, 64 insertions(+), 154 deletions(-) diff --git a/ChangeLog b/ChangeLog index 152cece..0e041bf 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,11 @@ 2001-06-08 Katsumi Yamaoka + * lisp/nnshimbun.el (nnshimbun-expire-nov-databases): Removed. + (nnshimbun-request-expire-articles): Simplified; refer to the + shimbun's default expiration days. + +2001-06-08 Katsumi Yamaoka + * lisp/lpath.el: Fbind `xml-node-children' for XEmacsen and old FSF Emacsen. diff --git a/lisp/nnshimbun.el b/lisp/nnshimbun.el index 2d3faa5..a302ba5 100644 --- a/lisp/nnshimbun.el +++ b/lisp/nnshimbun.el @@ -497,165 +497,69 @@ last.") (defvar nnshimbun-keep-unparsable-dated-articles t "*If non-nil, nnshimbun will never delete articles whose NOV date is -unparsable. Even so, you can expire such articles using the command -`nnshimbun-expire-nov-databases' with a prefix argument.") +unparsable.") (deffoo nnshimbun-request-expire-articles (articles group &optional server force) - "Do expire for the specified ARTICLES in the nnshimbun GROUP. Notice -that nnshimbun does not actually delete any articles, it just delete -the corresponding entries in the NOV database locally. If ARTICLES is -`all', the expiring is performed on all the NOV lines. It does expire -only when the current SERVER is specified and the NOV is open. -However, the optional FORCE if it is non-nil (it is supposed to be -specified by the command `nnshimbun-expire-nov-databases'), it does -expire for the SERVER:GROUP even if whose NOV is not open." - (let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist))) - (nnmail-expiry-wait-function nnmail-expiry-wait-function) - (nnmail-expiry-wait nnmail-expiry-wait) - (progress-msg (format "Expiring NOV database for nnshimbun+%s:%s " - server group)) - (pinwheel "-/|\\") - (counter 0) - name should-close-nov article expirable end time) - (if (and - server - (setq name (concat "nnshimbun+" server ":" group)) - (or (let ((current (nnoo-current-server 'nnshimbun))) - (and current - (string-equal server current) - (buffer-live-p buffer))) - (when force - (setq should-close-nov t - buffer (gnus-get-buffer-create - (format " *nnshimbun overview %s %s*" - server group))) - (let ((expiry-wait (gnus-group-find-parameter name - 'expiry-wait))) - (when expiry-wait - ;; Prefer the group parameter `expiry-wait'. - (setq nnmail-expiry-wait-function nil - nnmail-expiry-wait expiry-wait))) - (save-excursion - (set-buffer buffer) - (set (make-local-variable 'nnshimbun-nov-buffer-file-name) - (expand-file-name - nnshimbun-nov-file-name - (expand-file-name - group - (expand-file-name - server - nnshimbun-directory)))) - (erase-buffer) - (nnheader-insert-file-contents - nnshimbun-nov-buffer-file-name)) - (set-buffer-modified-p nil) - t))) - (prog1 - (save-excursion - (set-buffer buffer) - (when (eq 'all articles) - (setq articles nil) - (goto-char (point-min)) - (while (not (eobp)) - (when (looking-at "[0-9]+\t") - (push (read buffer) articles)) - (forward-line 1)) - (setq articles (nreverse articles))) - (setq expirable (copy-sequence articles)) - (while expirable - (setq article (pop expirable)) - (when (and (nnheader-find-nov-line article) - (setq end (line-end-position)) - (not (and nnshimbun-keep-last-article - (= (point-max) (1+ end))))) - (setq time (and (search-forward "\t" end t) - (search-forward "\t" end t) - (search-forward "\t" end t) - (parse-time-string - (buffer-substring - (point) - (if (search-forward "\t" end t) - (1- (point)) - end))))) - (if (and - (or (setq time (condition-case nil - (apply 'encode-time time) - (error nil))) - ;; Inhibit expiring if there's no parsable date - ;; and the following option is non-nil. - (not nnshimbun-keep-unparsable-dated-articles)) - (nnmail-expired-article-p name time nil)) - (progn - (when force - (message "%s(%c)..." progress-msg article)) - (beginning-of-line) - (delete-region (point) (1+ end)) - (setq articles (delq article articles))) - (when force - (message "%s(%c)..." - progress-msg - (aref pinwheel - (setq counter - (logand 3 (1+ counter))))))))) - (when (buffer-modified-p) - (nnmail-write-region 1 (point-max) - nnshimbun-nov-buffer-file-name - nil 'nomesg) - (set-buffer-modified-p nil)) - articles) - (when should-close-nov - (kill-buffer buffer))) + "Do expiration for the specified ARTICLES in the nnshimbun GROUP. +Notice that nnshimbun does not actually delete any articles, it just +delete the corresponding entries in the NOV database locally. The +expiration will be performed only when the current SERVER is specified +and the NOV is open. The optional fourth argument FORCE is ignored." + (let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist)))) + (if (and server + ;; Don't use 'string-equal' in the following. + (equal server (nnoo-current-server 'nnshimbun)) + (buffer-live-p buffer)) + (let* ((expirable (copy-sequence articles)) + (name (concat "nnshimbun+" server ":" group)) + ;; If the group's parameter `expiry-wait' is non-nil, + ;; `nnmail-expiry-wait' is bound to that value, and + ;; `nnmail-expiry-wait-function' is bound to nil. + ;; See the source code of `gnus-summary-expire-articles'. + ;; Prefer the shimbun's default to `nnmail-expiry-wait' + ;; only when the group's parameter is nil. + (nnmail-expiry-wait + (if (gnus-group-find-parameter name 'expiry-wait) + nnmail-expiry-wait + (or (shimbun-article-expiration-days nnshimbun-shimbun) + nnmail-expiry-wait))) + article end time) + (save-excursion + (set-buffer buffer) + (while expirable + (setq article (pop expirable)) + (when (and (nnheader-find-nov-line article) + (setq end (line-end-position)) + (not (and nnshimbun-keep-last-article + (= (point-max) (1+ end))))) + (setq time (and (search-forward "\t" end t) + (search-forward "\t" end t) + (search-forward "\t" end t) + (parse-time-string + (buffer-substring + (point) + (if (search-forward "\t" end t) + (1- (point)) + end))))) + (when (and (or (setq time (condition-case nil + (apply 'encode-time time) + (error nil))) + ;; Inhibit expiration if there's no parsable + ;; date and the following option is non-nil. + (not nnshimbun-keep-unparsable-dated-articles)) + (nnmail-expired-article-p name time nil)) + (beginning-of-line) + (delete-region (point) (1+ end)) + (setq articles (delq article articles))))) + (when (buffer-modified-p) + (nnmail-write-region 1 (point-max) + nnshimbun-nov-buffer-file-name + nil 'nomesg) + (set-buffer-modified-p nil)) + articles)) t))) -;;;###autoload -(defun nnshimbun-expire-nov-databases (&optional arg) - "Expire NOV databases for all the auto expirable nnshimbun groups. -If the prefix argument is given, the value of -`nnshimbun-keep-unparsable-dated-articles' will be ignored (treated as -nil)." - (interactive "P") - (let ((nnshimbun-keep-unparsable-dated-articles - (unless arg - nnshimbun-keep-unparsable-dated-articles)) - (servers (delq nil - (mapcar - (lambda (dir) - (if (and (not (string-equal ".." dir)) - (file-directory-p (expand-file-name - dir - nnshimbun-directory))) - dir)) - (directory-files nnshimbun-directory)))) - server directory groups group nov did) - (while servers - (setq server (car servers) - servers (cdr servers) - directory (expand-file-name server nnshimbun-directory) - groups (delq nil - (mapcar (lambda (dir) - (if (and (not (string-equal ".." dir)) - (file-directory-p - (expand-file-name - dir directory))) - dir)) - (directory-files directory)))) - (while groups - (setq group (car groups) - groups (cdr groups) - nov (expand-file-name nnshimbun-nov-file-name - (expand-file-name group directory))) - (when (and (gnus-group-auto-expirable-p (concat "nnshimbun+" - server ":" group)) - (file-exists-p nov)) - (message "Expiring NOV database for nnshimbun+%s:%s..." - server group) - (nnshimbun-request-expire-articles 'all group server t) - (setq did t)))) - (message (if did - "Expiring NOV databases...done" - "Nothing to be done")))) - ;;; Server Initialize -- 1.7.10.4