[elpa] externals/gnorb d4a4ccf 256/449: Better handling of non-existent Org headings

[Stefan Monnier]

branch: externals/gnorb
commit d4a4ccf84c85362709ee62cbad4d52f8759a2054
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>

    Better handling of non-existent Org headings
    
    * gnorb-registry.el (gnorb-find-visit-candidates): When looking for
      relevant headings, check if they seem to have been deleted.
    
    * gnorb-gnus.el (gnorb-gnus-incoming-do-todo): Collect all related
      headings (including possibly dead ones), and delete associations for
      dead headings until we find a live one.
    
    * gnorb-utils.el (gnorb-find-tracked-headings): Change calling signature
      appropriately.
---
 gnorb-gnus.el     | 37 ++++++++++++++++++++-----------------
 gnorb-registry.el | 16 ++++++++++++----
 gnorb-utils.el    |  4 ++--
 3 files changed, 34 insertions(+), 23 deletions(-)

diff --git a/gnorb-gnus.el b/gnorb-gnus.el
index 71782da..9263d1b 100644
--- a/gnorb-gnus.el
+++ b/gnorb-gnus.el
@@ -503,32 +503,35 @@ to t (it is, by default)."
         (org-refile-targets gnorb-gnus-trigger-refile-targets)
         (ref-msg-ids (concat (mail-header-references headers) " "
                              msg-id))
-        (offer-heading
-         (when (and (not id) ref-msg-ids gnorb-tracking-enabled)
-           (if org-id-track-globally
-               ;; for now we're basically ignoring the fact that
-               ;; multiple candidates could exist; just do the first
-               ;; one.
-               (car (gnorb-find-visit-candidates
-                     ref-msg-ids))
-             (message "Gnorb can't check for relevant headings unless 
`org-id-track-globally' is t")
-             (sit-for 1))))
+        (related-headings
+         (when (and (null id) ref-msg-ids)
+           (gnorb-find-tracked-headings headers t)))
         targ)
     (setq gnorb-gnus-message-info
-           `(:subject ,subject :msg-id ,msg-id
-                      :to ,to :from ,from
-                      :link ,link :date ,date :refs ,ref-msg-ids
-                      :group ,group))
+         `(:subject ,subject :msg-id ,msg-id
+                    :to ,to :from ,from
+                    :link ,link :date ,date :refs ,ref-msg-ids
+                    :group ,group))
     (gnorb-gnus-collect-all-attachments nil t)
     ;; Delete other windows, users can restore with
     ;; `gnorb-restore-layout'.
     (delete-other-windows)
     (if id
        (gnorb-trigger-todo-action arg id)
-      (if (and offer-heading
+      (if (and related-headings
+              (while (and
+                      (null (org-id-find-id-file
+                             (setq targ (pop related-headings))))
+                      targ)
+                (when (y-or-n-p
+                       (format
+                        "ID %s no longer exists, disassociate message?"
+                        targ))
+                  (gnorb-delete-association msg-id targ)))
               (y-or-n-p (format "Trigger action on %s"
-                                (gnorb-pretty-outline offer-heading))))
-         (gnorb-trigger-todo-action arg offer-heading)
+                                (gnorb-pretty-outline
+                                 targ))))
+         (gnorb-trigger-todo-action arg targ)
        (setq targ (org-refile-get-location
                    "Trigger heading" nil t))
        (find-file (nth 1 targ))
diff --git a/gnorb-registry.el b/gnorb-registry.el
index f775b2d..34ea776 100644
--- a/gnorb-registry.el
+++ b/gnorb-registry.el
@@ -109,11 +109,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)))
@@ -122,8 +125,13 @@ relevant to that message."
       (progn
        (dolist (id ids)
          (when
-             (setq sub-val
-                   (gnus-registry-get-id-key id 'gnorb-ids))
+             (and
+              (setq sub-val
+                    (gnus-registry-get-id-key id 'gnorb-ids))
+              ;; This lets us be reasonably confident that the
+              ;; heading still exists.
+              (or include-zombies
+                  (org-id-find-id-file id)))
            (setq ret-val (append sub-val ret-val))))))
     (delete-dups ret-val)))
 
diff --git a/gnorb-utils.el b/gnorb-utils.el
index 11c0de5..4065d73 100644
--- a/gnorb-utils.el
+++ b/gnorb-utils.el
@@ -387,7 +387,7 @@ child headings."
 ;; Common functions for extracting references and relevant headings
 ;; from the message under point. For use in gnorb-gnus.el functions.
 
-(defun gnorb-find-tracked-headings (headers)
+(defun gnorb-find-tracked-headings (headers &optional include-zombies)
   "Check HEADERS for message references and return relevant heading IDs.
 
 HEADERs is a message's data header, as produced by
@@ -398,7 +398,7 @@ HEADERs is a message's data header, as produced by
        (msg-id (mail-header-message-id headers)))
     (when gnorb-tracking-enabled
       (gnorb-find-visit-candidates
-       (concat msg-id " " references)))))
+       (concat msg-id " " references) include-zombies))))
 
 (defun gnorb-choose-trigger-heading (&optional id)
   "Given an Org heading ID, ask the user if they want to trigger it.