;;; gnus-registry.el --- article registry for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: news
(defun gnus-registry-trim (alist)
"Trim alist to size, using gnus-registry-max-entries.
-Also, drop all gnus-registry-ignored-groups matches.
Any entries with extra data (marks, currently) are left alone."
(if (null gnus-registry-max-entries)
alist ; just return the alist
(let ((extra (gnus-registry-fetch-extra key)))
(dolist (item gnus-registry-extra-entries-precious)
(dolist (e extra)
- (when (eq (nth 0 e) item)
+ (when (equal (nth 0 e) item)
(puthash key t precious)
(return))))
(puthash key (gnus-registry-fetch-extra key 'mtime) timehash)))
gnus-registry-hashtb)
(dolist (item alist)
- (let ((key (nth 0 item)))
+ (let ((key (nth 0 item)))
(if (gethash key precious)
(push item precious-list)
(push item junk-list))))
-
+
+ (sort
+ junk-list
+ (lambda (a b)
+ (let ((t1 (or (cdr (gethash (car a) timehash))
+ '(0 0 0)))
+ (t2 (or (cdr (gethash (car b) timehash))
+ '(0 0 0))))
+ (time-less-p t1 t2))))
+
;; we use the return value of this setq, which is the trimmed alist
- (setq alist
- (concat
- precious-list
- (nthcdr
- trim-length
- (sort junk-list
- (lambda (a b)
- (time-less-p
- (or (cdr (gethash (car a) timehash)) '(0 0 0))
- (or (cdr (gethash (car b) timehash)) '(0 0 0)))))))))))
+ (setq alist (append precious-list
+ (nthcdr trim-length junk-list))))))
(defun gnus-registry-action (action data-header from &optional to method)
(let* ((id (mail-header-id data-header))
(unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
(dolist (article gnus-newsgroup-articles)
(let ((id (gnus-registry-fetch-message-id-fast article)))
- (unless (gnus-registry-fetch-group id)
+ (unless (member gnus-newsgroup-name (gnus-registry-fetch-group id))
(gnus-message 9 "Registry: Registering article %d with group %s"
article gnus-newsgroup-name)
- (gnus-registry-add-group
- (gnus-registry-fetch-message-id-fast article)
+ (gnus-registry-add-group
+ id
gnus-newsgroup-name
(gnus-registry-fetch-simplified-message-subject-fast article)
(gnus-registry-fetch-sender-fast article)))))))