[elpa] externals/gnorb d7327b5 192/449: The big switch! Rely only on registry for tracking

[Stefan Monnier]

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

    The big switch! Rely only on registry for tracking
    
    * lisp/gnorb-registry.el (gnorb-msg-id-to-heading-table): Deleted
      variable.
      (gnorb-find-visit-candidates): Find candidates via the registry,
      not the hash table.
      (gnorb-org-add-id-hash-entry): Deleted function.
      (gnorb-org-populate-id-hash): Deleted function.
    
    * lisp/gnorb-utils.el (gnorb-pretty-outline): Because tracking now only
      stores Org ids, not Org ids plus outline path, we need a separate
      function for creating a pretty outline path from an id.
    
    * lisp/gnorb-gnus.el: Lists of relevant headings are now simple lists of
      ids, not lists of lists, so use car rather than caar to get the first.
      Also, use `gnorb-pretty-outline' where appropriate.
    
    * README.org: Document
---
 README.org             | 19 ++++++++++++++---
 lisp/gnorb-gnus.el     | 36 +++++++++++++------------------
 lisp/gnorb-registry.el | 58 +++++++-------------------------------------------
 lisp/gnorb-utils.el    | 29 +++++++++++++++++++++----
 4 files changed, 64 insertions(+), 78 deletions(-)

diff --git a/README.org b/README.org
index 1dc0872..9488364 100644
--- a/README.org
+++ b/README.org
@@ -27,9 +27,22 @@ they do one thing only, and (I hope) don't require anything 
special in
 terms of file formats or workflow. A few exceptions to that are listed
 below.
 ** Using Gnorb for Tracking Email TODOs
-Because we try to track email messages and related TODOs round-trip --
-incoming and outgoing under one TODO representing a conversation -- it
-works best if things match up at both ends. Specifically:
+
+Tracking correspondences between Org TODOs and email messages is one
+of the more complicated things that Gnorb does, and thus requires a
+little setup. Tracking relies on the Gnus registry, so that must be
+installed (ie you've called `gnus-registry-initialize' somewhere). It
+also relies on Org ids, so you'll want to require 'org-id, and set
+`org-id-track-globally' to t (that's the default anyway).
+
+Once that's done, call `gnorb-tracking-initialize' after loading
+Gnorb, and you should be done.
+
+NOTE: If you were using an earlier version of Gnorb that stored
+correspondences in Org heading properties, you can transition to the
+newer system with the function `gnorb-registry-transition-from-props'.
+See the docstring for details.
+
 *** Capture templates for emails
 Most people will be using plain capture templates to create TODOs from
 messages. You'll almost always want to save a link to the message, so
diff --git a/lisp/gnorb-gnus.el b/lisp/gnorb-gnus.el
index 216b066..559015f 100644
--- a/lisp/gnorb-gnus.el
+++ b/lisp/gnorb-gnus.el
@@ -336,7 +336,7 @@ work."
        ;; stored into `gnorb-gnus-sending-message-info'.
        (if arg
            (progn
-             (push (caar rel-headings) gnorb-message-org-ids)
+             (push (car rel-headings) gnorb-message-org-ids)
              (gnorb-org-restore-after-send))
          (setq ref-ids (plist-get gnorb-gnus-sending-message-info :refs))
          (if ref-ids
@@ -350,7 +350,7 @@ work."
                     (if (not rel-headings)
                         (gnorb-gnus-outgoing-make-todo-1)
                       (dolist (h rel-headings)
-                        (push (car h) gnorb-message-org-ids))
+                        (push h gnorb-message-org-ids))
                       (gnorb-org-restore-after-send)))
            ;; not relevant, just make a new TODO
            (gnorb-gnus-outgoing-make-todo-1)))
@@ -392,15 +392,15 @@ work."
            ;; then get the org-ids of those headings, and insert
            ;; them into this message as headers. If the id was
            ;; already present in a header, don't add it again.
-           (unless (member (car h) header-ids)
+           (unless (member h header-ids)
              (goto-char (point-at-bol))
              (open-line 1)
              (message-insert-header
               (intern gnorb-mail-header)
-              (car h))
+              h)
              ;; tell the rest of the function that this is a relevant
              ;; message
-             (push (car h) header-ids)))))
+             (push h header-ids)))))
       (message-goto-body)
       (add-to-list
        'message-exit-actions
@@ -455,7 +455,6 @@ work."
     (org-capture nil gnorb-gnus-new-todo-capture-key)
     (when msg-id
       (org-entry-put (point) gnorb-org-msg-id-key msg-id)
-      (gnorb-org-add-id-hash-entry msg-id)
       (gnorb-registry-make-entry msg-id sender subject (org-id-get-create) 
group))))
 
 ;;; If an incoming message should trigger state-change for a Org todo,
@@ -520,8 +519,8 @@ to t (it is, by default)."
        (gnorb-trigger-todo-action arg id)
       (if (and offer-heading
               (y-or-n-p (format "Trigger action on %s"
-                                (org-format-outline-path (cadr 
offer-heading)))))
-         (gnorb-trigger-todo-action arg (car offer-heading))
+                                (gnorb-pretty-outline offer-heading))))
+         (gnorb-trigger-todo-action arg offer-heading)
        (setq targ (org-refile-get-location
                    "Trigger heading" nil t))
        (find-file (nth 1 targ))
@@ -600,18 +599,13 @@ option `gnorb-gnus-hint-relevant-article' is non-nil."
          rel-headings)
       (when ref-ids
        (setq ref-ids (split-string ref-ids))
-       (when (setq rel-headings
-                  (gnorb-find-visit-candidates ref-ids))
-        (message "Possible relevant todo (%s): %s, trigger with %s"
-                 (org-with-point-at (org-id-find
-                                     (caar rel-headings) t)
-                   (org-element-property
-                    :todo-keyword (org-element-at-point)))
-                 (org-format-outline-path
-                  (cadr (car rel-headings)))
-                 (if key
-                     (key-description key)
-                   "M-x gnorb-gnus-incoming-do-todo")))))))
+       (when (setq rel-headings
+                   (gnorb-find-visit-candidates ref-ids))
+         (message "Possible relevant todo %s, trigger with %s"
+                  (gnorb-pretty-outline (car rel-headings) t)
+                  (if key
+                      (key-description key)
+                    "M-x gnorb-gnus-incoming-do-todo")))))))
 
 (add-hook 'gnus-article-prepare-hook 'gnorb-gnus-hint-relevant-message)
 
@@ -640,7 +634,7 @@ option `gnorb-gnus-hint-relevant-article' is non-nil."
       (setq refs (split-string refs))
       (setq rel-headings (gnorb-find-visit-candidates refs))
       (delete-other-windows)
-      (org-id-goto (caar rel-headings)))))
+      (org-id-goto (car rel-headings)))))
 
 (provide 'gnorb-gnus)
 ;;; gnorb-gnus.el ends here
diff --git a/lisp/gnorb-registry.el b/lisp/gnorb-registry.el
index 2fc2d0d..b590b87 100644
--- a/lisp/gnorb-registry.el
+++ b/lisp/gnorb-registry.el
@@ -55,12 +55,6 @@
   :tag "Gnorb Registry"
   :group 'gnorb)
 
-(defvar gnorb-msg-id-to-heading-table nil
-  "Hash table where keys are message-ids, and values are lists of
-  org headings which have that message-id in their GNORB_MSG_ID
-  property. Values are actually two-element lists: the heading's
-  id, and its outline path.")
-
 (defun gnorb-registry-make-entry (msg-id sender subject org-id group)
   "Create a Gnus registry entry for a message, either received or
 sent. Save the relevant Org ids in the 'gnorb-ids key."
@@ -118,53 +112,17 @@ to the message's registry entry, under the 'gnorb-ids 
key."
 (defun gnorb-find-visit-candidates (ids)
   "For all message-ids in IDS (which should be a list of
 Message-ID strings, with angle brackets), produce a list of Org
-ids (and ol-paths) for headings that contain one of those id
-values in their `gnorb-org-org-msg-id-key' property."
+ids for headings that are relevant to that message."
   (let (ret-val sub-val)
-    (unless gnorb-msg-id-to-heading-table
-      (gnorb-org-populate-id-hash))
-    (dolist (id ids)
-      (when (setq sub-val (gethash id gnorb-msg-id-to-heading-table))
-       (setq ret-val (append sub-val ret-val))))
+    (when gnorb-tracking-enabled
+      (progn
+       (dolist (id ids)
+         (when
+             (setq sub-val
+                   (gnus-registry-get-id-key id 'gnorb-ids))
+           (setq ret-val (append sub-val ret-val))))))
     ret-val))
 
-(defun gnorb-org-add-id-hash-entry (msg-id &optional marker)
-  (org-with-point-at (or marker (point))
-    (let ((old-val (gethash msg-id gnorb-msg-id-to-heading-table))
-         (new-val (list
-                   (org-id-get-create)
-                   (append
-                    (list
-                     (file-name-nondirectory
-                      (buffer-file-name
-                       (org-base-buffer (current-buffer)))))
-                    (org-get-outline-path)
-                    (list
-                     (org-no-properties
-                      (replace-regexp-in-string
-                       org-bracket-link-regexp
-                       "\\3"
-                       (nth 4 (org-heading-components)))))))))
-      (unless (member (car new-val) old-val)
-       (puthash msg-id
-                (if old-val
-                    (append (list new-val) old-val)
-                  (list new-val))
-                gnorb-msg-id-to-heading-table)))))
-
-(defun gnorb-org-populate-id-hash ()
-  "Scan all agenda files for headings with the
-  `gnorb-org-msg-id-key' property, and construct a hash table of
-  message-ids as keys, and org headings as values -- actually
-  two-element lists representing the heading's id and outline
-  path."
-  ;; where are all the places where we might conceivably want to
-  ;; refresh this?
-  (interactive)
-  (setq gnorb-msg-id-to-heading-table
-       (make-hash-table
-        :test 'equal :size 100))
-  (let (props)
 (defun gnorb-registry-org-id-search (id)
   (registry-search gnus-registry-db :member `((gnorb-ids ,id))))
 
diff --git a/lisp/gnorb-utils.el b/lisp/gnorb-utils.el
index 620a73b..97817c2 100644
--- a/lisp/gnorb-utils.el
+++ b/lisp/gnorb-utils.el
@@ -139,15 +139,13 @@ the prefix arg."
                        (point-at-bol))
          ret-dest-todo (org-entry-get
                         root-marker "TODO"))
-    (let ((ids (org-entry-get-multivalued-property
-               root-marker gnorb-org-msg-id-key))
-         (sent-id (plist-get gnorb-gnus-sending-message-info :msg-id)))
+    (let ((sent-id (plist-get gnorb-gnus-sending-message-info :msg-id)))
       (when sent-id
        (gnorb-registry-make-entry
         sent-id
         (plist-get gnorb-gnus-sending-message-info :from)
         (plist-get gnorb-gnus-sending-message-info :subject)
-        (org-id-get)
+        (org-id-get-create)
         (plist-get gnorb-gnus-sending-message-info :group)))
       (setq action (cond ((not
                           (or (and ret-dest-todo
@@ -176,6 +174,29 @@ the prefix arg."
          (call-interactively note-func)
        (call-interactively todo-func)))))
 
+(defun gnorb-pretty-outline (id &optional kw)
+  "Return pretty outline path of the Org heading indicated by ID.
+
+If the KW argument is true, add the TODO keyword into the path."
+  (org-with-point-at (org-id-find id t)
+    (let ((el (org-element-at-point)))
+      (concat
+       (if kw
+          (format "(%s): "
+                  (org-element-property :todo-keyword el))
+        "")
+       (org-format-outline-path
+       (append
+        (list
+         (file-name-nondirectory
+          (buffer-file-name
+           (org-base-buffer (current-buffer)))))
+        (org-get-outline-path)
+        (list
+         (replace-regexp-in-string
+          org-bracket-link-regexp
+          "\\3" (org-element-property :raw-value el)))))))))
+
 (defun gnorb-scan-links (bound &rest types)
   ;; this function could be refactored somewhat -- lots of code
   ;; repetition. It also should be a little faster for when we're