emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/gnorb 880afd6 158/449: Register sent messages so we can


From: Stefan Monnier
Subject: [elpa] externals/gnorb 880afd6 158/449: Register sent messages so we can view them later
Date: Fri, 27 Nov 2020 23:15:30 -0500 (EST)

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

    Register sent messages so we can view them later
    
    When using gnorb-org-view on a subtree, it previously only scanned for
    gnus links to show in the nnir buffer. But we'd really like to see our
    sent messages as well, ie the ones which are recorded in the
    GNORB_MSG_IDS property. The registry is currently the most reliable way
    of doing that, so we go to some lengths to make sure sent messages are
    stored in the registry, and that we can get them out again when we use
    gnorb-org-view.
    
    The current major failure is that, if we don't use a local archive
    method, and our sent message come back to us via some unknown imap
    group (a la gmail's [Gmail]Sent Mail), we can't find them again.
    
    * lisp/gnorb-gnus.el (gnorb-gnus-check-outgoing-headers): When we have a
      real gcc, insert the message into the registry. Additionally, give
      entries a 'gnorb-ids key, and add that key to the
      gnus-registry-extra-entries-precious list, preventing them from
      getting pruned.
    * lisp/gnorb-utils.el (gnorb-msg-id-to-link): New function that tries to
      use a message-id to find the full location of a message. Currently
      only uses the registry, but other methods could be added.
    * lisp/nngnorb.el (nnir-run-gnorb): When scanning subtrees for messages
      to display, also try to pick up messages referred to in GNORB_MSG_ID
      properties, using the previous new function to find their real
      location.
---
 lisp/gnorb-gnus.el  | 20 ++++++++++++++++++--
 lisp/gnorb-utils.el | 29 +++++++++++++++++++++++++++++
 lisp/nngnorb.el     | 17 ++++++++++++++---
 3 files changed, 61 insertions(+), 5 deletions(-)

diff --git a/lisp/gnorb-gnus.el b/lisp/gnorb-gnus.el
index 124fb84..ebc4ba3 100644
--- a/lisp/gnorb-gnus.el
+++ b/lisp/gnorb-gnus.el
@@ -31,6 +31,12 @@
 (declare-function org-gnus-follow-link "org-gnus"
                  (group article))
 
+;; This prevents gnorb-related registry entries from being pruned.
+;; Probably we should provide for some backup pruning routine, so we
+;; don't stuff up the whole registry.
+(when gnus-registry-enabled
+  (add-to-list 'gnus-registry-extra-entries-precious 'gnorb-ids))
+
 (defgroup gnorb-gnus nil
   "The Gnus bits of Gnorb."
   :tag "Gnorb Gnus"
@@ -254,10 +260,20 @@ information about the outgoing message into
           (subject (mail-fetch-field "Subject"))
           (date (mail-fetch-field "Date"))
           ;; If we can get a link, that's awesome.
-          (link (or (and (mail-fetch-field "Gcc")
+          (gcc (mail-fetch-field "Gcc"))
+          (link (or (and gcc
                          (org-store-link nil))
                     nil)))
-      ;; If we can't, then save some information so we can fake it.
+      ;; We want this message in the registry, if possible.
+      (when (and gnus-registry-enabled gcc)
+       (gnus-registry-insert gnus-registry-db msg-id
+                             (list (list 'creation-time (current-time))
+                                   (list 'group gcc)
+                                   (list 'sender from)
+                                   (list 'subject subject)))
+       (gnus-registry-set-id-key msg-id 'gnorb-ids org-ids))
+      ;; If we can't make a real link, then save some information so
+      ;; we can fake it.
       (when refs
        (setq refs (split-string refs)))
       (setq gnorb-gnus-sending-message-info
diff --git a/lisp/gnorb-utils.el b/lisp/gnorb-utils.el
index 2ce2761..177adb1 100644
--- a/lisp/gnorb-utils.el
+++ b/lisp/gnorb-utils.el
@@ -185,5 +185,34 @@ the prefix arg."
          (push (substring addr (match-end 0)) bbdb))))
       `(:gnus ,gnus :mail ,mail :bbdb ,bbdb))))
 
+(defun gnorb-msg-id-to-link (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. Any other options?
+  (let (server-group)
+    (catch 'found
+      (when gnus-registry-enabled
+       (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 the UNKNOWN group values.
+           (unless (string-match-p "UNKNOWN" g)
+             (setq server-group g)
+             (throw 'found server-group)))))
+      (when (featurep 'notmuch)
+       t)) ;; Is this even feasible? I suspect not.
+    (when server-group
+      (org-link-escape (concat server-group "#" msg-id)))))
+
 (provide 'gnorb-utils)
 ;;; gnorb-utils.el ends here
diff --git a/lisp/nngnorb.el b/lisp/nngnorb.el
index 4ea139a..70b3a88 100644
--- a/lisp/nngnorb.el
+++ b/lisp/nngnorb.el
@@ -100,9 +100,20 @@ be scanned for gnus messages, and those messages 
displayed."
                q
                'agenda)))
       (with-current-buffer buf
-       (goto-char (point-min))
-       (setq links (plist-get (gnorb-scan-links (point-max) 'gnus)
-                              :gnus)))
+       (let (ids)
+         (goto-char (point-min))
+         (setq links (plist-get (gnorb-scan-links (point-max) 'gnus)
+                                :gnus))
+         (goto-char (point-min))
+         (while (re-search-forward
+                 (concat ":" gnorb-org-msg-id-key ": \\([^\n]+\\)")
+                 (point-max) t)
+           (setq ids (append (split-string (match-string 1)) ids)))
+         (when ids
+           (dolist (id ids)
+             (let ((link (gnorb-msg-id-to-link id)))
+               (when link
+                 (push link links)))))))
       (setq links (delete-dups links))
       (unless (gnus-alive-p)
        (gnus))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]