From: ShengHuo ZHU Date: Fri, 11 Jan 2002 15:27:18 +0000 (+0000) Subject: * gnus-agent.el (gnus-agent-regenerate-group): New function. X-Git-Url: http://cgit.sxemacs.org/?a=commitdiff_plain;h=d6fc071ac11d2854744bfb90c3f9b2aff3466579;p=gnus * gnus-agent.el (gnus-agent-regenerate-group): New function. (gnus-agent-regenerate): New function. (gnus-agent-save-alist): Sort. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3def83d17..78f1ebfcf 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2002-01-11 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-regenerate-group): New function. + (gnus-agent-regenerate): New function. + (gnus-agent-save-alist): Sort. + 2002-01-10 ShengHuo ZHU * mm-util.el (mm-charset-to-coding-system): Change charset to cs. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 0c580e7e4..1f732435b 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -1095,16 +1095,18 @@ the actual number of articles toggled is returned." (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." (let ((file-name-coding-system nnmail-pathname-coding-system) - print-level print-length) - (with-temp-file (if dir - (expand-file-name ".agentview" dir) - (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")))) + print-level print-length item) + (dolist (art articles) + (if (setq item (memq art gnus-agent-article-alist)) + (setcdr item state) + (push (cons art state) gnus-agent-article-alist))) + (setq gnus-agent-article-alist + (sort gnus-agent-article-alist 'car-less-than-car)) + (with-temp-file (if dir + (expand-file-name ".agentview" dir) + (gnus-agent-article-name ".agentview" group)) + (princ gnus-agent-article-alist (current-buffer)) + (insert "\n")))) (defun gnus-agent-article-name (article group) (expand-file-name (if (stringp article) article (string-to-number article)) @@ -1738,9 +1740,10 @@ The following commands are available: (gnus-range-add (nth 2 info) (cons 1 (- (caar gnus-agent-article-alist) 1))))) - ;; Maybe everything has been expired from `gnus-article-alist' - ;; and so the above marking as read could not be conducted, - ;; or there are expired article within the range of the alist. + ;; Maybe everything has been expired from + ;; `gnus-article-alist' and so the above marking as + ;; read could not be conducted, or there are + ;; expired article within the range of the alist. (when (and info expired (or (not (caar gnus-agent-article-alist)) @@ -1789,8 +1792,9 @@ The following commands are available: (file-name-directory file) t)) (when (file-exists-p file) (with-current-buffer gnus-agent-overview-buffer - (erase-buffer) - (nnheader-insert-file-contents file) + (let ((coding-system-for-read + gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file)) (goto-char (point-min)) (while (not (eobp)) (when (looking-at "[0-9]") @@ -1848,6 +1852,177 @@ The following commands are available: (insert-file-contents file)) t))) +(defun gnus-agent-regenerate-group (group) + "Regenerate GROUP." + (let ((dir (concat (gnus-agent-directory) + (gnus-agent-group-path group) "/")) + (file (gnus-agent-article-name ".overview" group)) + articles n point arts alist header new-alist changed) + (when (file-exists-p dir) + (setq articles + (sort (mapcar (lambda (name) (string-to-int name)) + (directory-files dir nil "^[0-9]+$" t)) + '<))) + (setq arts articles) + (gnus-make-directory (nnheader-translate-file-chars + (file-name-directory file) t)) + (mm-with-unibyte-buffer + (if (file-exists-p file) + (let ((coding-system-for-read gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file))) + (goto-char (point-min)) + (while (not (eobp)) + (while (not (or (eobp) (looking-at "[0-9]"))) + (setq point (point)) + (forward-line 1) + (delete-region point (point))) + (unless (eobp) + (setq n (read (current-buffer))) + (when (and arts (> n (car arts))) + (beginning-of-line) + (while (and arts (> n (car arts))) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents + (concat dir (number-to-string (car arts)))) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (delete-region (point) (point-max)) + (goto-char (point-max))) + (setq header (nnheader-parse-head t))) + (mail-header-set-number header (car arts)) + (nnheader-insert-nov header) + (setq changed t) + (push (cons (car arts) t) alist) + (pop arts))) + (if arts + (if (= n (car arts)) + (progn + (push (cons (car arts) t) alist) + (pop arts)) + (push (cons (car arts) nil) alist))) + (forward-line 1))) + (if changed + (let ((coding-system-for-write gnus-agent-file-coding-system)) + (write-region (point-min) (point-max) file nil 'silent)))) + (gnus-agent-load-alist group) + (setq alist (sort alist 'car-less-than-car)) + (setq gnus-agent-article-alist (sort gnus-agent-article-alist + 'car-less-than-car)) + (while (and alist gnus-agent-article-alist) + (cond + ((< (caar alist) (caar gnus-agent-article-alist)) + (push (pop alist) new-alist)) + ((> (caar alist) (caar gnus-agent-article-alist)) + (push (list (car (pop gnus-agent-article-alist))) new-alist)) + (t + (push (pop alist) new-alist) + (pop gnus-agent-article-alist)))) + (while alist + (push (pop alist) new-alist)) + (while gnus-agent-article-alist + (push (list (car (pop gnus-agent-article-alist))) new-alist)) + (setq gnus-agent-article-alist (nreverse new-alist)) + (gnus-agent-save-alist group))) + +(defun gnus-agent-regenerate-history (group article) + (let ((file (concat (gnus-agent-directory) + (gnus-agent-group-path group) "/" + (number-to-string article))) id) + (mm-with-unibyte-buffer + (nnheader-insert-file-contents file) + (message-narrow-to-head) + (goto-char (point-min)) + (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)))) + (gnus-agent-enter-history + id (list (cons group article)) + (time-to-days (nth 5 (file-attributes file))))))) + +;;;###autoload +(defun gnus-agent-regenerate () + "Regenerate all agent covered files." + (interactive) + (dolist (gnus-command-method gnus-agent-covered-methods) + (let ((active-file (gnus-agent-lib-file "active")) + history-hashtb active-hashtb active-changed + history-changed point) + (gnus-make-directory (file-name-directory active-file)) + (mm-with-unibyte-buffer + (if (file-exists-p active-file) + (let ((coding-system-for-read gnus-agent-file-coding-system)) + (nnheader-insert-file-contents active-file)) + (setq active-changed t)) + (gnus-active-to-gnus-format + nil (setq active-hashtb + (gnus-make-hashtable + (count-lines (point-min) (point-max)))))) + (gnus-agent-open-history) + (setq history-hashtb (gnus-make-hashtable 1000)) + (with-current-buffer + (setq gnus-agent-current-history (gnus-agent-history-buffer)) + (goto-char (point-min)) + (forward-line 1) + (while (not (eobp)) + (if (looking-at + "\\([^\t\n]+\\)\t[0-9]+\t\\([^ \n]+\\) \\([0-9]+\\)$") + (progn + (unless (string= (match-string 1) + "last-header-fetched-for-session") + (gnus-sethash (match-string 2) + (cons + (string-to-number (match-string 3)) + (gnus-gethash (match-string 2) + history-hashtb)) + history-hashtb)) + (forward-line 1)) + (setq point (point)) + (forward-line 1) + (delete-region point (point)) + (setq history-changed t)))) + (dolist (group (gnus-groups-from-server gnus-command-method)) + (gnus-agent-regenerate-group group) + (let ((min (or (caar gnus-agent-article-alist) 1)) + (max (or (caar (last gnus-agent-article-alist)) 0)) + (active (gnus-gethash group active-hashtb))) + (if (not active) + (progn + (setq active (cons min max) + active-changed t) + (gnus-sethash group active active-hashtb)) + (when (> (car active) min) + (setcar active min) + (setq active-changed t)) + (when (< (cdr active) max) + (setcdr active max) + (setq active-changed t)))) + (let ((arts (sort (gnus-gethash group history-hashtb) '<))) + (while (and arts gnus-agent-article-alist) + (cond + ((> (car arts) (caar gnus-agent-article-alist)) + (when (cdar gnus-agent-article-alist) + (gnus-agent-regenerate-history + group (caar gnus-agent-article-alist)) + (setq history-changed t)) + (pop gnus-agent-article-alist)) + ((= (car arts) (caar gnus-agent-article-alist)) + (pop arts) + (pop gnus-agent-article-alist)) + (t + (pop arts)))) + (while gnus-agent-article-alist + (when (cdar gnus-agent-article-alist) + (gnus-agent-regenerate-history + group (caar gnus-agent-article-alist)) + (setq history-changed t)) + (pop gnus-agent-article-alist)))) + (when history-changed + (gnus-agent-save-history)) + (gnus-agent-close-history) + (when active-changed + (let ((coding-system-for-write gnus-agent-file-coding-system)) + (gnus-write-active-file active-file active-hashtb t)))))) + (provide 'gnus-agent) ;;; gnus-agent.el ends here