X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/566a7ab1cc2a2a382c6d7df5353f0e1572521fac..ce7004456df8d17d1b1bb9b1feab3ddafb1e078a:/packages/gnorb/gnorb-registry.el

diff --git a/packages/gnorb/gnorb-registry.el b/packages/gnorb/gnorb-registry.el
index ecd723e06..f7b402cd4 100644
--- a/packages/gnorb/gnorb-registry.el
+++ b/packages/gnorb/gnorb-registry.el
@@ -112,11 +112,14 @@ to the message's registry entry, under the 'gnorb-ids key."
       (error
        (setq abort-note 'dirty)))))
 
-(defun gnorb-find-visit-candidates (ids)
+(defun gnorb-find-visit-candidates (ids &optional include-zombies)
   "For all message-ids in IDS (which should be a list of
 Message-ID strings, with angle brackets, or a single string of
 Message-IDs), produce a list of Org ids for headings that are
-relevant to that message."
+relevant to that message.
+
+If optional argument INCLUDE_ZOMBIES is non-nil, return ID values
+even for headings that appear to no longer exist."
   (let (ret-val sub-val)
     (when (stringp ids)
       (setq ids (gnus-extract-references ids)))
@@ -128,8 +131,39 @@ relevant to that message."
 	      (setq sub-val
 		    (gnus-registry-get-id-key id 'gnorb-ids))
 	    (setq ret-val (append sub-val ret-val))))))
+    ;; This lets us be reasonably confident that the
+    ;; headings still exist.
+    (unless include-zombies
+      (cl-remove-if-not
+       (lambda (org-id)
+	 (org-id-find-id-file org-id))
+       ret-val))
     (delete-dups ret-val)))
 
+(defun gnorb-delete-association (msg-id org-id)
+  "Disassociate a message and a headline.
+
+This removes an Org heading's ORG-ID from the 'gnorb-ids key of
+the MSG-ID."
+  (let ((org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids)))
+    (when (member org-id org-ids)
+      (gnus-registry-set-id-key msg-id 'gnorb-ids
+				(remove org-id org-ids)))))
+
+(defun gnorb-delete-all-assocations (org-id)
+  "Delete all message associations for an Org heading.
+
+The heading is identified by ORG-ID. This is suitable for use
+after an Org heading is deleted, for instance."
+  (let ((assoc-msgs (gnorb-registry-org-id-search org-id)))
+    (mapcar
+     (lambda (msg-id)
+       (let ((org-ids
+	      (gnus-registry-get-id-key msg-id 'gnorb-ids)))
+	 (gnus-registry-set-id-key
+	  msg-id 'gnorb-ids (remove org-id org-ids))))
+     assoc-msgs)))
+
 (defun gnorb-registry-org-id-search (id)
   "Find all messages that have the org ID in their 'gnorb-ids
 key."