(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))
(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))
(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]")
(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
projects / gnus / commitdiff