X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-registry.el;h=d173bc0c640bae08f77494cf5e2533a65c13ee9d;hb=7b075803fd5428598ddf3f1b8e907cfecfeb7d9d;hp=cc4c96e72a960225580bd8a1dd58e519a4d94279;hpb=b0cdeb271f3af30ee2877e6f49608ce045749a41;p=gnus

diff --git a/lisp/gnus-registry.el b/lisp/gnus-registry.el
index cc4c96e72..d173bc0c6 100644
--- a/lisp/gnus-registry.el
+++ b/lisp/gnus-registry.el
@@ -1,7 +1,7 @@
 ;;; gnus-registry.el --- article registry for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 ;; Keywords: news
@@ -76,14 +76,14 @@
 			      :test 'equal)
   "*The article registry by Message ID.")
 
-(defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue")
+(defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$")
   "List of groups that gnus-registry-split-fancy-with-parent won't return.
 The group names are matched, they don't have to be fully
 qualified.  This parameter tells the Registry 'never split a
 message into a group that matches one of these, regardless of
 references.'"
   :group 'gnus-registry
-  :type '(repeat string))
+  :type '(repeat regexp))
 
 (defcustom gnus-registry-install nil
   "Whether the registry should be installed."
@@ -156,6 +156,8 @@ way."
       (gnus-load file)
       (gnus-message 5 "Reading %s...done" file))))
 
+;; FIXME: Get rid of duplicated code, cf. `gnus-save-newsrc-file' in
+;; `gnus-start.el'.  --rsteib
 (defun gnus-registry-cache-save ()
   "Save the registry cache file."
   (interactive)
@@ -582,9 +584,36 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
 	  (mapcar 'not
 		  (mapcar
 		   (lambda (x)
-		     (string-match x word))
+		     (string-match word x))
 		   list)))))
 
+;;; if this extends to more than 'flags, it should be improved to be more generic.
+(defun gnus-registry-fetch-extra-flags (id)
+  "Get the flags of a message, based on the message ID.
+Returns a list of symbol flags or nil."
+  (car-safe (cdr (gnus-registry-fetch-extra id 'flags))))
+
+(defun gnus-registry-has-extra-flag (id flag)
+  "Checks if a message has `flag', based on the message ID."
+  (memq flag (gnus-registry-fetch-extra-flags id)))
+
+(defun gnus-registry-store-extra-flags (id &rest flag-list)
+  "Set the flags of a message, based on the message ID.
+The `flag-list' can be nil, in which case no flags are left."
+  (gnus-registry-store-extra-entry id 'flags (list flag-list)))
+
+(defun gnus-registry-delete-extra-flags (id &rest flag-delete-list)
+  "Delete the message flags in `flag-delete-list', based on the message ID."
+  (let ((flags (gnus-registry-fetch-extra-flags id)))
+    (when flags
+      (dolist (flag flag-delete-list)
+	(setq flags (delq flag flags))))
+    (gnus-registry-store-extra-flags id (car flags))))
+
+(defun gnus-registry-delete-all-extra-flags (id)
+  "Delete all the flags for a message ID."
+  (gnus-registry-store-extra-flags id nil))
+
 (defun gnus-registry-fetch-extra (id &optional entry)
   "Get the extra data of a message, based on the message ID.
 Returns the first place where the trail finds a nonstring."
@@ -642,12 +671,20 @@ The message must have at least one group name."
 	       gnus-registry-hashtb)
       (setq gnus-registry-dirty t)))))
 
+(defun gnus-registry-delete-extra-entry (id key)
+  "Delete a specific entry in the extras field of the registry entry for id."
+  (gnus-registry-store-extra-entry id key nil))
+
 (defun gnus-registry-store-extra-entry (id key value)
   "Put a specific entry in the extras field of the registry entry for id."
   (let* ((extra (gnus-registry-fetch-extra id))
-	 (alist (gnus-registry-remove-alist-text-properties 
-		 (cons (cons key value)
-		       (gnus-assq-delete-all key (gnus-registry-fetch-extra id))))))
+	 ;; all the entries except the one for `key'
+	 (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id))) 
+	 (alist (if value
+		    (gnus-registry-remove-alist-text-properties
+		     (cons (cons key value)
+			   the-rest))
+		  the-rest)))
     (gnus-registry-store-extra id alist)))
 
 (defun gnus-registry-fetch-group (id)