[elpa] externals/gnorb a352586 189/449: Improve lookups for entries with unknown groups

[Stefan Monnier]

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

    Improve lookups for entries with unknown groups
    
    * lisp/gnorb-gnus.el (gnorb-gnus-sent-groups): New user option. Set to a
      list of groups where sent messages are stored; we look for registered
      messages with no group key in these groups.
    
    * lisp/gnorb-utils.el (gnorb-msg-id-to-group): Use the new option for
      locating mystery messages. General improvements to lookup logic.
---
 lisp/gnorb-gnus.el  | 18 +++++++++++++++--
 lisp/gnorb-utils.el | 56 ++++++++++++++++++++---------------------------------
 2 files changed, 37 insertions(+), 37 deletions(-)

diff --git a/lisp/gnorb-gnus.el b/lisp/gnorb-gnus.el
index 69602ab..216b066 100644
--- a/lisp/gnorb-gnus.el
+++ b/lisp/gnorb-gnus.el
@@ -114,13 +114,27 @@ Basically behave as if all attachments have 
\":gnus-attachments t\"."
   :group 'gnorb-gnus
   :type 'list)
 
-;;; What follows is a very careful copy-pasta of bits and pieces from
-;;; mm-decode.el and gnus-art.el. Voodoo was involved.
+(defcustom gnorb-gnus-sent-groups nil
+  "A list of strings indicating sent mail groups.
+
+In some cases, Gnorb can't detect where your sent messages are
+stored (ie if you're using IMAP sent mail folders instead of
+local archiving. If you want Gnorb to be able to find sent
+messages, this option can help it do that. It should be set to a
+list of strings, which are assumed to be fully qualified
+server+group combinations, ie \"nnimap+Server:[Gmail]/Sent
+Mail\", or something similar. This only has to be done once for
+each message."
+  :group 'gnorb-gnus
+  :type 'list)
 
 (defvar gnorb-gnus-capture-attachments nil
   "Holding place for attachment names during the capture
   process.")
 
+;;; What follows is a very careful copy-pasta of bits and pieces from
+;;; mm-decode.el and gnus-art.el. Voodoo was involved.
+
 ;;;###autoload
 (defun gnorb-gnus-article-org-attach (n)
   "Save MIME part N, which is the numerical prefix, of the
diff --git a/lisp/gnorb-utils.el b/lisp/gnorb-utils.el
index 4916910..620a73b 100644
--- a/lisp/gnorb-utils.el
+++ b/lisp/gnorb-utils.el
@@ -208,44 +208,30 @@ the prefix arg."
       (org-link-escape (concat server-group "#" msg-id)))))
 
 (defun gnorb-msg-id-to-group (msg-id)
-  "Given only a message id, try a few different things to
-reconstruct a complete org link, including server and group. So
-far we're only checking the registry, and also notmuch if notmuch
-is in use. Other search engines? Other clever methods?"
-  ;; The real problem here is how to get stuff into the registry? If
-  ;; we're using a local archive method, we can force the addition
-  ;; when the message is sent. But if we're not (ie nnimap), then it's
-  ;; pretty rare that the the user is going to go to the sent message
-  ;; folder and open the messages so that they're entered into the
-  ;; registry. That probably means hooking into some fairly low-level
-  ;; processing: allowing users to specify which mailboxes hold their
-  ;; sent mail, and then watching to see any time messages are put
-  ;; into those boxes, and adding them to the registry. One bonus
-  ;; should be, if incoming sent messages are then split, the registry
-  ;; will notice them and add their group key.
-  (let (server-group)
+  "Given a message id, try to find the group it's in.
+
+So far we're checking the registry, then the groups in
+`gnorb-gnus-sent-groups'. Use search engines? Other clever
+methods?"
+  (let (candidates server-group)
     (catch 'found
       (when gnorb-tracking-enabled
-       ;; The following is a cheap knock-off of
-       ;; `gnus-try-warping-via-registry'. I can't use that, though,
-       ;; because it isn't low-level enough -- it starts with a
-       ;; message under point and ends by opening the message in the
-       ;; group.
-       (setq server-group
-             (gnus-registry-get-id-key msg-id 'group))
-       ;; If the id is registered at all, group will be a list. If it
-       ;; isn't, group stays nil.
-       (when (consp server-group)
-         (dolist (g server-group)
-           ;; Get past UNKNOWN and nil group values.
-           (unless (or (null g)
-                       (and (stringp g)
-                            (string-match-p "UNKNOWN" g)))
-             (setq server-group g)
-             (throw 'found server-group)))))
+       ;; Make a big list of all the groups where this message might
+       ;; conceivably be.
+       (setq candidates
+             (append (gnus-registry-get-id-key msg-id 'group)
+                     gnorb-gnus-sent-groups))
+       (while (setq server-group (pop candidates))
+         (when (and (stringp server-group)
+                    (not
+                     (string-match-p
+                      "\\(nnir\\|nnvirtual\\|UNKNOWN\\)"
+                      server-group))
+                    (ignore-errors
+                      (gnus-request-head msg-id server-group)))
+               (throw 'found server-group))))
       (when (featurep 'notmuch)
-       t)) ;; Is this even feasible? I suspect not.
-    server-group))
+       nil))))
 
 ;; Loading the registry