[elpa] externals/gnorb 44f8d23 165/449: Begin shift to using the registry

[Stefan Monnier]

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

    Begin shift to using the registry
    
    All the property-based stuff is still in place, as is the association
    hashtable. But as a first step we're now using the registry to track
    incoming and outgoing messages that are related to Org TODOs. Once this
    is working and debugged, then start refactoring other parts of the code
    to use this and not the hashtable.
    
    * lisp/gnorb-gnus.el (gnorb-gnus-capture-registry): New function. When
      capturing Org headings from Gnus messages, store the Org id in the
      message's registry entry.
      (gnorb-gnus-make-registry-entry): New function. Make a registry entry
      from message headers.
      (gnorb-gnus-outgoing-make-todo-1): Manually make registry entries from
      new outgoing message.
      (gnorb-gnus-incoming-do-todo): Make registry entries from incoming
      messages.
    
    * lisp/gnorb-utils.el (gnorb-trigger-todo-action): After sending
      relevant messages, add the Org id of triggered headlines to that
      message's registry entry.
---
 lisp/gnorb-gnus.el  | 89 +++++++++++++++++++++++++++++++++++++----------------
 lisp/gnorb-utils.el |  6 ++++
 2 files changed, 68 insertions(+), 27 deletions(-)

diff --git a/lisp/gnorb-gnus.el b/lisp/gnorb-gnus.el
index 54ee920..044694b 100644
--- a/lisp/gnorb-gnus.el
+++ b/lisp/gnorb-gnus.el
@@ -240,10 +240,45 @@ save them into `gnorb-tmp-dir'."
 
 ;;; Storing, removing, and acting on Org headers in messages.
 
+(defun gnorb-gnus-capture-registry ()
+  "When capturing from a gnus message, add our new org heading id
+to the message's registry entry, under the 'gnorb-ids key."
+  (when (and (with-current-buffer
+                (org-capture-get :original-buffer)
+              (memq major-mode '(gnus-summary-mode gnus-article-mode)))
+            (not org-note-abort)
+            gnus-registry-enabled)
+    (let* ((msg-id
+           (concat "<" (plist-get org-store-link-plist :message-id) ">"))
+          (entry (gnus-registry-get-or-make-entry msg-id))
+          (org-ids
+           (gnus-registry-get-id-key msg-id 'gnorb-ids))
+          (new-org-id (org-id-get-create)))
+      (setq org-ids (cons new-org-id org-ids))
+      (setq org-ids (delete-dups org-ids))
+      (gnus-registry-set-id-key msg-id 'gnorb-ids org-ids))))
+
+(add-hook 'org-capture-prepare-finalize-hook
+         'gnorb-gnus-capture-registry)
+
 (defvar gnorb-gnus-sending-message-info nil
   "Place to store the To, Subject, Date, and Message-ID headers
   of the currently-sending or last-sent message.")
 
+(defun gnorb-gnus-make-registry-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."
+  (when gnus-registry-enabled
+    ;; This set-id-key stuff is actually horribly
+    ;; inefficient.
+    (gnus-registry-get-or-make-entry msg-id)
+    (gnus-registry-set-id-key msg-id 'sender (list sender))
+    (gnus-registry-set-id-key msg-id 'subject (list subject))
+    (gnus-registry-set-id-key msg-id 'gnorb-ids (if (stringp org-id)
+                                                   (list org-id)
+                                                 org-id))
+    (gnus-registry-set-id-key msg-id 'group (list gcc))))
+
 (defun gnorb-gnus-check-outgoing-headers ()
   "Save the value of the `gnorb-mail-header' for the current
 message; multiple header values returned as a string. Also save
@@ -265,7 +300,8 @@ information about the outgoing message into
           (gcc (mail-fetch-field "Gcc"))
           (link (or (and gcc
                          (org-store-link nil))
-                    nil)))
+                    nil))
+          (group (ignore-errors (car (split-string link "#")))))
       ;; If we can't make a real link, then save some information so
       ;; we can fake it.
       (when refs
@@ -273,7 +309,8 @@ information about the outgoing message into
       (setq gnorb-gnus-sending-message-info
            `(:subject ,subject :msg-id ,msg-id
                       :to ,to :from ,from
-                      :link ,link :date ,date :refs ,refs))
+                      :link ,link :date ,date :refs ,refs
+                      :group ,group))
       (if org-ids
          (progn
            (require 'gnorb-org)
@@ -282,19 +319,7 @@ information about the outgoing message into
            ;; if we're working from a draft, or triggering this from
            ;; a reply, it might not be there yet.
            (add-to-list 'message-exit-actions
-                        'gnorb-org-restore-after-send)
-           ;; Relevant sent messages should be saved in the registry.
-           ;; If we have a full Gcc link, then we're good to go. If
-           ;; not, then just insert a registry entry with no group
-           ;; key, and figure it out later.
-           (when gnus-registry-enabled
-             (gnus-registry-insert gnus-registry-db msg-id
-                                   (list (list 'creation-time (current-time))
-                                         (list 'sender from)
-                                         (list 'subject subject)))
-             (gnus-registry-set-id-key msg-id 'gnorb-ids org-ids)
-             (when gcc
-               (gnus-registry-set-id-key msg-id 'group gcc))))
+                        'gnorb-org-restore-after-send))
        (setq gnorb-message-org-ids nil)))))
 
 (add-hook 'message-header-hook 'gnorb-gnus-check-outgoing-headers)
@@ -420,6 +445,7 @@ work."
   (unless gnorb-gnus-new-todo-capture-key
     (error "No capture template key set, customize 
gnorb-gnus-new-todo-capture-key"))
   (let* ((link (plist-get gnorb-gnus-sending-message-info :link))
+        (group (plist-get gnorb-gnus-sending-message-info :group))
         (date (plist-get gnorb-gnus-sending-message-info :date))
         (date-ts (and date
                       (ignore-errors
@@ -432,6 +458,8 @@ work."
                             (org-time-stamp-format t t)
                             (date-to-time date)))))
         (msg-id (plist-get gnorb-gnus-sending-message-info :msg-id))
+        (sender (plist-get gnorb-gnus-sending-message-info :from))
+        (subject (plist-get gnorb-gnus-sending-message-info :subject))
         ;; Convince Org we already have a link stored, even if we
         ;; don't.
         (org-capture-link-is-already-stored t))
@@ -445,23 +473,24 @@ work."
         :date-timestamp-inactive date-ts-ia
         :annotation link)
       (org-store-link-props
-           :subject (plist-get gnorb-gnus-sending-message-info :subject)
-           :to (plist-get gnorb-gnus-sending-message-info :to)
-           :date date
-           :date-timestamp date-ts
-           :date-timestamp-inactive date-ts-ia
-           :message-id msg-id
-           :annotation link))
+       :subject (plist-get gnorb-gnus-sending-message-info :subject)
+       :to (plist-get gnorb-gnus-sending-message-info :to)
+       :date date
+       :date-timestamp date-ts
+       :date-timestamp-inactive date-ts-ia
+       :message-id msg-id
+       :annotation link))
     (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-org-add-id-hash-entry msg-id)
+      (gnorb-gnus-make-registry-entry msg-id sender subject 
(org-id-get-create) group))))
 
 ;;; If an incoming message should trigger state-change for a Org todo,
 ;;; call this function on it.
 
 ;;;###autoload
-(defun gnorb-gnus-incoming-do-todo (arg &optional id)
+(defun gnorb-gnus-incoming-do-todo (arg headers &optional id)
   "Call this function from a received gnus message to store a
 link to the message, prompt for a related Org heading, visit the
 heading, and either add a note or trigger a TODO state change.
@@ -476,7 +505,7 @@ there match the value of the `gnorb-org-msg-id-key' 
property for
 any headings. In order for this to work, you will have to have
 loaded org-id, and have the variable `org-id-track-globally' set
 to t (it is, by default)."
-  (interactive "P")
+  (interactive (gnus-interactive "P\nH"))
   (when (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
     (user-error "Only works in gnus summary or article mode"))
   ;; We should only store a link if it's not already at the head of
@@ -484,7 +513,11 @@ to t (it is, by default)."
   ;; present. Take a look at calling it non-interactively.
   (call-interactively 'org-store-link)
   (setq gnorb-org-window-conf (current-window-configuration))
-  (let* ((org-refile-targets gnorb-gnus-trigger-refile-targets)
+  (let* ((msg-id (mail-header-id headers))
+        (sender (mail-header-from headers))
+        (subject (mail-header-subject headers))
+        (group gnus-newsgroup-name)
+        (org-refile-targets gnorb-gnus-trigger-refile-targets)
         ;; otherwise `gnorb-trigger-todo-action' will think we
         ;; started from an outgoing message
         (gnorb-gnus-sending-message-info nil)
@@ -521,7 +554,9 @@ to t (it is, by default)."
     (message
      "Insert a link to the message with org-insert-link (%s)"
      (key-description
-               (where-is-internal 'org-insert-link nil t)))))
+      (where-is-internal 'org-insert-link nil t)))
+    (gnorb-gnus-make-registry-entry
+     msg-id sender subject (org-id-get-create) group)))
 
 ;;;###autoload
 (defun gnorb-gnus-search-messages (str &optional ret)
diff --git a/lisp/gnorb-utils.el b/lisp/gnorb-utils.el
index e4558d7..3edc3d1 100644
--- a/lisp/gnorb-utils.el
+++ b/lisp/gnorb-utils.el
@@ -131,6 +131,12 @@ the prefix arg."
       (when sent-id
        (org-entry-add-to-multivalued-property
         root-marker gnorb-org-msg-id-key sent-id)
+       (gnorb-gnus-make-registry-entry
+        sent-id
+        (plist-get gnorb-gnus-sending-message-info :from)
+        (plist-get gnorb-gnus-sending-message-info :subject)
+        (org-id-get)
+        (plist-get gnorb-gnus-sending-message-info :group))
        (gnorb-org-add-id-hash-entry sent-id root-marker))
       (setq action (cond ((not
                           (or (and ret-dest-todo