[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/gnorb a9535ae 223/449: Merge branch 'registry'
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/gnorb a9535ae 223/449: Merge branch 'registry' |
|
Date: |
Fri, 27 Nov 2020 23:15:44 -0500 (EST) |
branch: externals/gnorb
commit a9535aea9f1585d0889febe1d5894308a5eb440a
Merge: b95f371 d0d196f
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>
Merge branch 'registry'
Config changes required! See README.org
---
README.org | 170 +++++++++------
lisp/gnorb-gnus.el | 243 ++++++++++-----------
lisp/gnorb-org.el | 579 ++++++++++++++++++-------------------------------
lisp/gnorb-registry.el | 193 +++++++++++++++++
lisp/gnorb-utils.el | 254 +++++++++++++---------
lisp/gnorb.el | 1 +
lisp/nngnorb.el | 194 +++++++++++++++--
7 files changed, 943 insertions(+), 691 deletions(-)
diff --git a/README.org b/README.org
index 1dc0872..06dab1c 100644
--- a/README.org
+++ b/README.org
@@ -14,6 +14,11 @@ Put "gnorb/lisp" in your load path, then either require
"gnorb" to
load everything, or pick bits and pieces: "gnorb-gnus", "gnorb-org",
or "gnorb-bbdb".
+*Note for existing users*: Gnorb recently shifted to exclusively using
+the registry to track email TODOs, and this will require some
+configuration changes, please see
[[id:5780bc9d-0756-4213-b805-2f9a2216fe15][Using Gnorb for Tracking Email
TODOs]]
+below.
+
Recommended keybindings/integration measures are shown below. Copy
them into your init files and edit as you see fit.
@@ -27,20 +32,49 @@ 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:
+:PROPERTIES:
+:ID: 5780bc9d-0756-4213-b805-2f9a2216fe15
+:END:
+
+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.
+
+In addition, Gnorb can provide the very useful service of opening nnir
+*Summary* buffers containing all the messages linked to from a given
+subtree, see [[id:89ec2ade-5686-402e-a23c-2af36325d1f3][Showing gnus messages
from links in Org buffers]] below.
+
+NOTE: If you were using an earlier version of Gnorb that stored
+correspondences in Org 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
-you can get back to it later. Once the TODO is made, you can call
-`gnorb-org-handle-mail' on it, to look for message and mail links and
-automatically start a reply to the original message. The option
-`gnorb-org-mail-scan-strategies' determines how the TODO heading and
-its subtree are scanned for links -- see the docstring of that option.
-
-Your capture template should therefore put the link where
-`gnorb-org-handle-mail' can find it. Say your capture template looks
+messages. When the TODO is made, Gnorb will record the connection
+between the message and the TODO, using the Gnus registry. Later, you
+can call `gnorb-org-handle-mail' on the TODO: Gnorb will find the
+associated message and start a reply to it.
+
+If you've made a TODO that doesn't have any messages associated with
+it yet (for instance, a TODO reminding you to email someone), then
+Gnorb will look for gnus:, mailto:, or bbdb: links in the subtree, and
+act on them accordingly.
+
+The option `gnorb-org-mail-scan-scope' determines how many paragraphs
+of the subtree will be scanned for links. 0 means only the heading
+text, a positive integer means the heading plus that many paragraphs
+of body text, and any other non-nil value means the whole subtree will
+be scanned.
+
+Your capture templates should therefore put links where
+`gnorb-org-handle-mail' can find them. Say your capture template looks
like this:
#+BEGIN_SRC emacs-lisp
@@ -50,58 +84,51 @@ like this:
#+END_SRC
-In this case, you'll want a scan strategy that looks at the first
-paragraph of body text.
+In this case, you'll want to set `gnorb-org-mail-scan-scope' to at
+least 1, to scan the first paragraph of body text.
+
+The same goes for "remind me to email so-and-so" TODOs. The mailto: or
+bbdb: link pointing at so-and-so should be located where
+`gnorb-org-handle-mail' can find it.
+
+In fact, you can use any Org TODO as a starting point for
+`gnorb-org-handle-mail'. Gnorb will do its best to find mail-related
+information from the subtree, but if it can't it will simply start
+composing a blank message. When the message is sent, it will be
+associated with the TODO.
*** Tracking conversations
-It can be useful to use a single TODO heading to keep track of the
-salient points of an entire email back-and-forth conversation -- a
-business negotiation, for instance. You can do this by using TODO
-keywords that trigger state-change notes, and putting links to emails
-into those notes. That way, your logbook becomes a full record of the
-conversation.
-
-For example, you might have two keywords, "REPLY" and "WAIT", which
-both trigger state-change notes. Say you call `gnorb-org-handle-mail'
-on a heading that's set to "REPLY", then send the email. You'll be
-returned to the heading and prompted to change its state. Change it to
-"WAIT" and leave a note.
-
-When you receive a reply to your sent email, call
-`gnorb-gnus-incoming-do-todo' on that message. You'll be taken back to
-the TODO, and again prompted to change its state. Change it to
-"REPLY", and again leave a note. Gnorb stores a link to the incoming
-message automatically, so insert the link into the note.
-
-Now your TODO has a logdrawer with a link to the most
-recently-received email in the most recent state-change note. If
-`gnorb-org-mail-scan-state-changes' is set to 'first, then the next
-time you call `gnorb-org-handle-mail' on the heading, everything else
-will be disregarded in favor of replying to that most recent email.
-
-That way, you can use the paired keywords "REPLY" and "WAIT", and the
-paired functions `gnorb-org-handle-mail' and
-`gnorb-gnus-incoming-do-todo', to play a sort of email ping-pong.
-
-Of course you don't /have/ to use this sort of system, Gnorb just
-gives you the bits and pieces to put it together.
-
-PS: What if you receive an email that's relevant to a TODO, and just
-want to reply to it on the spot (ie, without going through the whole
-`gnorb-gnus-incoming-do-todo' and state-change rigmarole)? In that
-case, you can use `gnorb-gnus-outgoing-do-todo' on the reply as you're
-composing it (or right after you've sent it), and Gnorb will notice
-that it is part of an ongoing conversation. The only thing it
-(currently) won't do is automatically store a link to the message you
-just replied to, so if you want to put that into the conversation,
-you'll have to do it manually.
+You can use Gnorb to remind you to reply to a message, to track
+extended email conversations, or to manage complex email-centric
+projects.
+
+The principle is simple: Incoming and outgoing messages are all
+associated with an Org heading, or its sub-headings. Outgoing messages
+are created by calling `gnorb-org-handle-mail' on an Org TODO, which
+starts a reply or a new message, depending on the state of the TODO.
+Incoming messages are associated with TODOs by calling
+`gnorb-gnus-incoming-do-todo' on the message, and choosing the TODO.
+
+In both cases, you'll be asked to "trigger an action" on the TODO in
+question. Actions including changing TODO state (and associating the
+message with the TODO), taking a note (and associating the message),
+just associating the message, and doing nothing at all. We're also
+planning trigger actions that will capture new headings as children or
+siblings of the original TODO, but that's not done yet. You can also
+provide your own actions.
+
+In this way, a single TODO collects an entire conversation of emails.
+If you have subtrees as a part of the original TODO, each subtree has
+its own collection of emails, which are inherited by the parent. To
+view all these messages in a single Gnus *Summary* buffer, see
[[id:89ec2ade-5686-402e-a23c-2af36325d1f3][Showing
+gnus messages from links in Org buffers]] below.
*** Hinting in Gnus
When you receive new mails that might be relevant to existing Org
TODOs, Gnorb can alert you to that fact. When
`gnorb-gnus-hint-relevant-article' is t (the default), Gnorb will
display a message in the minibuffer when opening potentially relevant
-messages. You can then use `gnorb-gnus-incoming-to-todo' to act on
-them: usually triggering a state change on the relevant TODO.
+messages. You can then use `gnorb-gnus-incoming-to-todo' to trigger an
+action on the relevant TODO.
This hinting can happen in the Gnus summary buffer as well. If you use
the escape indicated by `gnorb-gnus-summary-mark-format-letter" as
@@ -111,28 +138,33 @@ as determined by `gnorb-gnus-summary-mark'. By default,
the format
letter is "g" (meaning it is used as "%ug" in the format line), and
the mark is "ยก".
** Showing gnus messages from links in Org buffers
-Sometimes you've got an Org subtree containing a bunch of Gnus links,
-and you'd like to see all those message in a single Gnus summary
-buffer. Gnorb can do this, but you'll have to add a new backend to
-your list of Gnus servers. If that makes your skin crawl a little, it
-probably should. But no fear! The server essentially does nothing but
-provide a place for nnir to hang searches.
+:PROPERTIES:
+:ID: 89ec2ade-5686-402e-a23c-2af36325d1f3
+:END:
+Sometimes you've got an Org subtree tracking many relevant Gnus
+messages, and you'd like to see all those message in a single Gnus
+summary buffer. Gnorb can do this, but you'll have to add a new
+backend to your list of Gnus servers. If that makes your skin crawl a
+little, it probably should. But no fear! The server essentially does
+nothing but provide a place for nnir to hang searches.
Add an entry like this to your `gnus-secondary-select-methods':
(nngnorb "Purely Decorative Server Name")
And restart Gnus. Now, on any given Org subtree, you can call
-`gnorb-org-view', and you'll be presented with an nnir Summary
-buffer containing all the messages linked to within the subtree.
+`gnorb-org-view', and you'll be presented with an nnir Summary buffer
+containing all the messages connected to the subtree. If you reply to
+any messages from this buffer, your reply will also be tracked as part
+of the subtree.
-As a bonus, it's possible to go into Gnus' Server buffer, find the
+As a bonus, it's possible to go into Gnus' *Server* buffer, find the
line specifying your nngnorb server, and hit "G" (aka
`gnus-group-make-nnir-group'). At the query prompt, enter an Org-style
tags-todo Agenda query string (eg "+work-computer", or what have you).
Gnorb will find all headings matching this query, scan their subtrees
-for gnus links, and then give you a Summary buffer containing all
-the linked messages.
+for gnus links, and then give you a Summary buffer containing all the
+linked messages. This is dog-slow at the moment; it will get faster.
** Recent mails from BBDB contacts
If you're using a recent git version of BBDB (circa mid-May 2014 or
later), you can give your BBDB contacts a special field which will
@@ -148,7 +180,7 @@ message.
Once some links are stored, `gnorb-bbdb-open-link' will open them: Use
a prefix arg to the function call to select particular messages to
open. There are several options controlling how all this works; see
-the gnorb-bbdb user-options section below for details.
+the gnorb-bbdb user options section below for details.
** BBDB posting styles
Gnorb comes with a BBDB posting-style system, inspired by (copied
from) gnus-posting-styles. You can specify how messages are composed
diff --git a/lisp/gnorb-gnus.el b/lisp/gnorb-gnus.el
index 15eb2c0..24fb046 100644
--- a/lisp/gnorb-gnus.el
+++ b/lisp/gnorb-gnus.el
@@ -31,13 +31,6 @@
(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.
-(eval-after-load "gnus-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"
@@ -121,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
@@ -240,56 +247,22 @@ 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
+(defvar gnorb-gnus-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 group))))
-
(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
information about the outgoing message into
-`gnorb-gnus-sending-message-info'."
+`gnorb-gnus-message-info'."
(save-restriction
(message-narrow-to-headers)
- (setq gnorb-gnus-sending-message-info nil)
+ (setq gnorb-gnus-message-info nil)
(let* ((org-ids (mail-fetch-field gnorb-mail-header nil nil t))
(msg-id (mail-fetch-field "Message-ID"))
(refs (mail-fetch-field "References"))
+ (in-reply-to (mail-fetch-field "In-Reply-To"))
(to (if (message-news-p)
(mail-fetch-field "Newsgroups")
(mail-fetch-field "To")))
@@ -304,9 +277,11 @@ information about the outgoing message into
(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 in-reply-to
+ (setq refs (concat refs " " in-reply-to)))
(when refs
- (setq refs (split-string refs)))
- (setq gnorb-gnus-sending-message-info
+ (setq refs (gnus-extract-references refs)))
+ (setq gnorb-gnus-message-info
`(:subject ,subject :msg-id ,msg-id
:to ,to :from ,from
:link ,link :date ,date :refs ,refs
@@ -319,7 +294,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))
+ 'gnorb-org-restore-after-send t))
(setq gnorb-message-org-ids nil)))))
(add-hook 'message-header-hook 'gnorb-gnus-check-outgoing-headers)
@@ -350,7 +325,7 @@ work."
(interactive "P")
(let ((org-refile-targets gnorb-gnus-trigger-refile-targets)
header-ids ref-ids rel-headings gnorb-window-conf
- reply-id reply-group)
+ reply-id reply-group in-reply-to)
(when arg
(setq rel-headings
(org-refile-get-location "Trigger action on" nil t))
@@ -361,25 +336,24 @@ work."
(org-id-get-create))))))
(if (not (eq major-mode 'message-mode))
;; The message is already sent, so we're relying on whatever was
- ;; stored into `gnorb-gnus-sending-message-info'.
+ ;; stored into `gnorb-gnus-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))
+ (setq ref-ids (plist-get gnorb-gnus-message-info :refs))
(if ref-ids
;; the message might be relevant to some TODO
;; heading(s). But if there had been org-id
;; headers, they would already have been
;; handled when the message was sent.
- (progn (when (stringp ref-ids)
- (setq ref-ids (split-string ref-ids)))
- (setq rel-headings (gnorb-org-find-visit-candidates
ref-ids))
- (if (not rel-headings)
- (gnorb-gnus-outgoing-make-todo-1)
- (dolist (h rel-headings)
- (push (car h) gnorb-message-org-ids))
- (gnorb-org-restore-after-send)))
+ (progn
+ (setq rel-headings (gnorb-find-visit-candidates ref-ids))
+ (if (not rel-headings)
+ (gnorb-gnus-outgoing-make-todo-1)
+ (dolist (h rel-headings)
+ (push h gnorb-message-org-ids))
+ (gnorb-org-restore-after-send)))
;; not relevant, just make a new TODO
(gnorb-gnus-outgoing-make-todo-1)))
;; We are still in the message composition buffer, so let's see
@@ -398,6 +372,9 @@ work."
;; what org id headers are present, though, so we don't add
;; duplicates.
(setq ref-ids (unless arg (mail-fetch-field "References" t)))
+ (setq in-reply-to (unless arg (mail-fetch-field "In-Reply-to" t)))
+ (when in-reply-to
+ (setq ref-ids (concat ref-ids " " in-reply-to)))
(setq reply-group (when (mail-fetch-field "X-Draft-From" t)
(car-safe (read (mail-fetch-field "X-Draft-From"
t)))))
;; when it's a reply, store a link to the reply just in case.
@@ -409,26 +386,24 @@ work."
(org-gnus-follow-link reply-group reply-id)
(call-interactively 'org-store-link)))
(when ref-ids
- (when (stringp ref-ids)
- (setq ref-ids (split-string ref-ids)))
;; if the References header points to any message ids that are
;; tracked by TODO headings...
- (setq rel-headings (gnorb-org-find-visit-candidates ref-ids)))
+ (setq rel-headings (gnorb-find-visit-candidates ref-ids)))
(when rel-headings
(goto-char (point-min))
- (dolist (h rel-headings)
+ (dolist (h (delete-dups rel-headings))
;; 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
@@ -444,9 +419,9 @@ work."
(defun gnorb-gnus-outgoing-make-todo-1 ()
(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))
+ (let* ((link (plist-get gnorb-gnus-message-info :link))
+ (group (plist-get gnorb-gnus-message-info :group))
+ (date (plist-get gnorb-gnus-message-info :date))
(date-ts (and date
(ignore-errors
(format-time-string
@@ -457,9 +432,9 @@ work."
(format-time-string
(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))
+ (msg-id (plist-get gnorb-gnus-message-info :msg-id))
+ (sender (plist-get gnorb-gnus-message-info :from))
+ (subject (plist-get gnorb-gnus-message-info :subject))
;; Convince Org we already have a link stored, even if we
;; don't.
(org-capture-link-is-already-stored t))
@@ -473,8 +448,8 @@ 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)
+ :subject (plist-get gnorb-gnus-message-info :subject)
+ :to (plist-get gnorb-gnus-message-info :to)
:date date
:date-timestamp date-ts
:date-timestamp-inactive date-ts-ia
@@ -483,8 +458,7 @@ 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-gnus-make-registry-entry msg-id sender subject
(org-id-get-create) group))))
+ (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,
;;; call this function on it.
@@ -511,56 +485,53 @@ to t (it is, by default)."
;; We should only store a link if it's not already at the head of
;; `org-stored-links'. There's some duplicate storage, at
;; present. Take a look at calling it non-interactively.
- (call-interactively 'org-store-link)
(setq gnorb-window-conf (current-window-configuration))
(move-marker gnorb-return-marker (point))
+ (setq gnorb-gnus-message-info nil)
(let* ((msg-id (mail-header-id headers))
- (sender (mail-header-from headers))
+ (from (mail-header-from headers))
(subject (mail-header-subject headers))
+ (date (mail-header-date headers))
+ (to (cdr (assoc 'To (mail-header-extra headers))))
(group gnus-newsgroup-name)
+ (link (call-interactively 'org-store-link))
(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)
+ ;;
(ref-msg-ids
(with-current-buffer gnus-original-article-buffer
(message-narrow-to-headers-or-head)
- (let ((all-refs
- (message-fetch-field "references")))
- (when all-refs
- (split-string all-refs)))))
+ (message-fetch-field "references")))
(offer-heading
- (when (and (not id) ref-msg-ids)
+ (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-org-find-visit-candidates
+ (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))))
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))
(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)
+ (gnorb-trigger-todo-action 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 offer-heading)
(setq targ (org-refile-get-location
"Trigger heading" nil t))
(find-file (nth 1 targ))
(goto-char (nth 3 targ))
- (gnorb-trigger-todo-action arg)))
- (message
- "Insert a link to the message with org-insert-link (%s)"
- (key-description
- (where-is-internal 'org-insert-link nil t)))
- (gnorb-gnus-make-registry-entry
- msg-id sender subject (org-id-get-create) group)))
+ (gnorb-trigger-todo-action)))))
;;;###autoload
(defun gnorb-gnus-search-messages (str &optional ret)
@@ -602,7 +573,8 @@ work."
;; the following seems to simply be ignored under gnus 5.13
(list (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str)))
(cons 'nnir-group-spec `((,nnir-address
nil)))))
- (cons 'nnir-artlist nil)))))
+ (cons 'nnir-artlist nil)))
+ (gnorb-summary-minor-mode)))
;;; Automatic noticing of relevant messages
@@ -618,40 +590,48 @@ is relevant to any existing TODO headings. If so, flash a
message
to that effect. This function is added to the
`gnus-article-prepare-hook'. It will only do anything if the
option `gnorb-gnus-hint-relevant-article' is non-nil."
- (when (and gnorb-gnus-hint-relevant-article
- (not (memq (car (gnus-find-method-for-group group))
+ (when (and gnorb-tracking-enabled
+ gnorb-gnus-hint-relevant-article
+ (not (memq (car (gnus-find-method-for-group
+ gnus-newsgroup-name))
'(nnvirtual nnir))))
- (let ((ref-ids (gnus-fetch-original-field "references"))
- (key
- (where-is-internal 'gnorb-gnus-incoming-do-todo
- nil t))
- rel-headings)
- (when ref-ids
- (setq ref-ids (split-string ref-ids))
- (when (setq rel-headings
- (gnorb-org-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")))))))
+ (let* ((ref-ids (gnus-fetch-original-field "references"))
+ (msg-id (gnus-fetch-original-field "message-id"))
+ (assoc-heading
+ (gnus-registry-get-id-key msg-id 'gnorb-ids))
+ (key
+ (where-is-internal 'gnorb-gnus-incoming-do-todo
+ nil t))
+ rel-headings)
+ (cond (assoc-heading
+ (message "Message is associated with %s"
+ (gnorb-pretty-outline (car assoc-heading) t)))
+ (ref-ids
+ (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)
(fset (intern (concat "gnus-user-format-function-"
gnorb-gnus-summary-mark-format-letter))
- (lambda (header)
- (let ((ref-ids (mail-header-references header)))
- (if (and ref-ids
- (gnorb-org-find-visit-candidates
- (split-string ref-ids)))
- gnorb-gnus-summary-mark
- " "))))
+ (lambda (header)
+ (if (and gnorb-tracking-enabled
+ (not (memq (car (gnus-find-method-for-group
+ gnus-newsgroup-name))
+ '(nnvirtual nnir))))
+ (let ((ref-ids (mail-header-references header))
+ (msg-id (mail-header-message-id header)))
+ (if (or (gnus-registry-get-id-key msg-id 'gnorb-ids)
+ (and ref-ids
+ (gnorb-find-visit-candidates ref-ids)))
+ gnorb-gnus-summary-mark
+ " "))
+ " ")))
;;;###autoload
(defun gnorb-gnus-view ()
@@ -665,10 +645,9 @@ option `gnorb-gnus-hint-relevant-article' is non-nil."
(let ((refs (gnus-fetch-original-field "references"))
rel-headings)
(when refs
- (setq refs (split-string refs))
- (setq rel-headings (gnorb-org-find-visit-candidates 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-org.el b/lisp/gnorb-org.el
index 0122328..817478c 100644
--- a/lisp/gnorb-org.el
+++ b/lisp/gnorb-org.el
@@ -46,112 +46,73 @@ org-todo regardless of TODO type."
:group 'gnorb-org
:type 'hook)
+(defcustom gnorb-org-trigger-actions
+ '(("todo state" . todo)
+ ("take note" . note)
+ ("don't associate" . no-associate)
+ ("only associate" . associate)
+; ("capture to child" . cap-child)
+; ("capture to sibling" . cap-sib)
+)
+ "List of potential actions that can be taken on headings.
+
+When triggering an Org heading after receiving or sending a
+message, this option lists the possible actions to take. Built-in
+actions include:
+
+todo state: Associate the message, and change TODO state.
+take note: Associate the message, and take a note.
+don't associate: Do nothing at all, don't connect the message and TODO.
+only associate: Associate the message with this heading, do nothing else.
+capture to child: [not yet implemented] Associate this message with a new
child heading.
+capture to sibling: [not yet implemented] Associate this message with a new
sibling heading.
+
+You can reorder this list or remove items as suits your workflow.
+The two \"capture\" options will use the value of
+`gnorb-gnus-new-todo-capture-key' to find the appropriate
+template.
+
+You can also add custom actions to the list. Actions should be a
+cons of a string tag and a symbol indicating a custom function.
+This function will be called on the heading in question, and
+passed a plist containing information about the message from
+which we're triggering."
+ :group 'gnorb-org
+ :type 'list)
+
(defcustom gnorb-org-msg-id-key "GNORB_MSG_ID"
"The name of the org property used to store the Message-IDs
- from relevant messages."
+ from relevant messages. This is no longer used, and will be
+ removed soon."
:group 'gnorb-org
:type 'string)
-(defcustom gnorb-org-mail-scan-strategies
- '(((:type state :scope first-link) 1)
- (nil text)
- offer)
- "This option controls how `gnorb-org-handle-mail' scans the
-subtree under point for links, and what it does with the links it
-finds. It is a list of up to three elements, representing three
-different scanning strategies. The first is used when calling the
-function with no prefix arg; the second is used with a single
-\\[universal-argument], and the third with a double
-\\[universal-argument]. You can thus prepare different scanning
-strategies in advance, and choose whichever is appropriate.
-
-Each \"strategy\" will usually be a list of two items. The first
-item determines how the heading's state-change notes are scanned,
-the second item governs how the heading's body text is scanned.
-If the scan of the state notes produces usable links, the second
-item will be disregarded -- the rest of the heading won't be
-scanned at all. This is because, if you're responding to message
-links in the state-notes, they probably represent later messages
-in an ongoing conversation. If you want a particular strategy to
-always skip the state notes, just set the first item to nil.
-
-The state specification is an alist with two possible keys: :type
-and :scope. The :type key can be set to either 'state or 'note,
-which means the scanning process will only consider logdrawer
-items of one sort or the other. Setting the key to anything
-lese (or leaving it out) means both state-change notes and
-regular notes will be scanned. The :scope key controls how many
-items will be scanned. Set to a positive integer to scan that
-many items. The symbol 'first is a synonym for 1. The symbol
-'first-link means scan each state note until one containing links
-is found, and use only links from that item. The symbol 'all
-means scan all state notes.
-
-The second specification is used when the state-notes scan
-produces no results, or was skipped with a nil specification.
-This second item can be 0, meaning only scan the text of the
-heading itself; a positive integer, meaning scan that many
-paragraphs of body text; the symbol 'text, meaning scan the
-entire body text; or the symbol 'subtree, meaning scan the
-heading's text and all its subtrees.
-
-Instead of a two-value specification, a strategy can just be a
-single symbol: 'all will scan both the state notes and the body
-text, and 'offer will collect all the links in the entire subtree
-and pop up a buffer allowing the user to choose which links to
-act on [this is a lie, 'offer hasn't been implemented yet].
-
-Lastly, any of the elements can be a symbol representing a custom
-function. When placed in the state-log or body-text
-specifications, the function will be called in a temporary buffer
-containing only the text of the state-log drawer, or the body
-text, respectively. If the entire strategy is replaced by a
-function name, that function will be called with point at the
-beginning of the heading. Custom functions can use the internal
-function `gnorb-scan-links' to return the appropriate alist of
-links.
-
-If `gnorb-org-handle-mail' is called while the region is active,
-this variable will be disregarded entirely, and only the active
-region will be scanned for links. If you call
-`gnorb-org-handle-mail' with a prefix argument while the region
-is active, it will look for links everywhere _but_ the active
-region.
-
-If all that sounds confusing, consider the default value:
-
-'(((:type state :scope first-link) 1)
- (nil text)
- offer)
-
-With no prefix arg, `gnorb-org-handle-mail' will look into the
-logbook, and look at each state log item (skipping regular notes)
-until it finds a state log with links in it, then operate on all
-the links in that log item. If it finds nothing in the drawer, it
-will scan the text of the heading, and the first paragraph of
-body text.
-
-With one prefix arg, it will always ignore the state-change
-notes, instead scanning the heading and the entirety of its body
-text.
+(defcustom gnorb-org-mail-scan-scope 2
+ "Number of paragraphs to scan for mail-related links.
-With two prefix args, it will simply offer all the links in the
-subtree for selection.")
+When handling a TODO heading with `gnorb-org-handle-mail', Gnorb
+will typically reply to the most recent message associated with
+this heading. If there are no such messages, or message tracking
+is disabled entirely, or `gnorb-org-handle-mail' has been called
+with a prefix arg, the heading and body text of the subtree under
+point will instead be scanned for gnus:, mailto:, and bbdb:
+links. This option controls how many paragraphs of body text to
+scan. Set to 0 to only look in the heading.")
(make-obsolete-variable
- 'gnorb-org-mail-scan-scope
- "This variable has been superseded by `gnorb-org-mail-scan-strategies'"
- "June 7, 2014" 'set)
+ 'gnorb-org-mail-scan-strategies
+ "This variable has been superseded by `gnorb-org-trigger-actions'"
+ "September 12, 2014" 'set)
(make-obsolete-variable
'gnorb-org-mail-scan-state-changes
- "This variable has been superseded by `gnorb-org-mail-scan-strategies'"
- "June 7, 2014" 'set)
+ "This variable has been superseded by `gnorb-org-trigger-actions'"
+ "September 12, 2014" 'set)
(make-obsolete-variable
'gnorb-org-mail-scan-function
- "This variable has been superseded by `gnorb-org-mail-scan-strategies'"
- "June 7, 2014" 'set)
+ "This variable has been superseded by `gnorb-org-trigger-actions'"
+ "September 12, 2014" 'set)
(defcustom gnorb-org-find-candidates-match nil
"When scanning all org files for heading related to an incoming
@@ -189,7 +150,7 @@ future!"
"After an email is sent, clean up the gnus summary buffer, put
us back where we came from, and go through all the org ids that
might have been in the outgoing message's headers and call
-`gnorb-org-do-restore-action' on each one."
+`gnorb-trigger-todo-action' on each one."
(when (eq major-mode 'gnus-summary-mode)
(gnus-summary-exit nil t))
(when (and (window-configuration-p gnorb-window-conf)
@@ -197,199 +158,115 @@ might have been in the outgoing message's headers and
call
(set-window-configuration gnorb-window-conf)
(goto-char gnorb-return-marker))
(dolist (id gnorb-message-org-ids)
- (gnorb-trigger-todo-action nil id))
+ (gnorb-trigger-todo-action id))
;; this is a little unnecessary, but it may save grief
- (setq gnorb-gnus-sending-message-info nil)
+ (setq gnorb-gnus-message-info nil)
(setq gnorb-message-org-ids nil))
-(defun gnorb-org-extract-mail-stuff (strategy &optional region)
- "Extract mail-related information from the current heading. How
-the heading is scanned depends on the value of
-`gnorb-org-mail-scan-strategies' -- STRATEGY represents an
-element chosen from that variable. If BOUNDS is non-nil, it
-should represent point and mark of the active region, and means
-STRATEGY will be disregarded."
- (save-restriction
- (org-narrow-to-subtree)
- ;; first collect all the relevant bits of the subtree
- (let* ((parsed (org-element-parse-buffer))
- (headline
- (org-element-map parsed 'headline 'identity nil t))
- (head-text (org-element-property :raw-value headline))
- (state-log
- (org-element-map parsed 'plain-list
- (lambda (l)
- (when (org-element-map l 'paragraph
- ;; kludge to tell a state-log drawer list from
- ;; a regular old list.
- (lambda (p)
- (string-match-p
- "\\(State \"\\|Note taken on\\)"
- (car (org-element-contents p)))) nil t)
- l)) nil t))
- (pars
- (org-element-map parsed 'paragraph
- (lambda (p)
- (buffer-substring
- (org-element-property :contents-begin p)
- (org-element-property :contents-end p)))
- nil nil 'drawer))
- state-strategy text-strategy search-func
- strings state-success all-links)
- (when (listp strategy)
- (setq state-strategy (car strategy)
- text-strategy (nth 1 strategy)))
- ;; Order of precedence is: active region beats custom function
- ;; beats all-or-offer beats state-logs beats general text
- ;; scan. First we check everything up to all-or-offer.
- (unless
- (cond
- ((and region (eq 'reverse-region strategy))
- (setq strings
- ;; sure hope the region is contained within the
- ;; headline!
- (list
- (buffer-substring
- (point-min)
- (car region))
- (buffer-substring
- (cdr region)
- (point-max)))))
- (region
- (push (buffer-substring (car region) (cdr region))
- strings))
- ((and (symbolp strategy)
- (fboundp strategy))
- ;; user is responsible for finding links
- (setq strings
- (list
- (buffer-substring
- (point-min)
- (point-max))))
- (setq search-func strategy))
- ((eq strategy 'all)
- (setq strings
- (list
- (buffer-substring
- (point-min)
- (point-max)))))
- ((eq strategy 'offer)
- (user-error "Don't use 'offer, it's not done yet")))
- ;; The above produced nothing, so try first the
- ;; state-logs, then the body text
- (when (and state-log state-strategy)
- (cond
- ((and (symbolp state-strategy)
- (fboundp state-strategy)
- (setq all-links
- (gnorb-org-find-links
- (buffer-substring
- (org-element-property :begin state-log)
- (org-element-property :end state-log))
- state-strategy))
- (setq state-success t)))
- ((listp state-strategy)
- (when (setq all-links
- (gnorb-org-scan-log-notes
- state-log state-strategy))
- (setq state-success t)))
- (t
- (and (setq
- all-links
- (gnorb-org-find-links
- (buffer-substring
- (org-element-property :begin state-log)
- (org-element-property :end state-log))))
- (setq state-success t)))))
- ;; at last, we get to check the plain old text
- (when (and (not state-success) text-strategy)
- (cond
- ((and (symbolp text-strategy)
- (fboundp text-strategy))
- (setq strings
- (cons
- head-text
- pars))
- (setq search-func text-strategy))
- ((eq 'text text-strategy)
- (setq strings
- (cons
- head-text
- pars)))
- ((eq 'subtree text-strategy)
- (setq strings
- (list
- head-text
- (buffer-substring-no-properties
- (org-element-map headline 'paragraph
- (lambda (p)
- (org-element-property :begin p))
- nil t 'drawer)
- (point-max)))))
- ((integerp text-strategy)
- (setq strings
- (cons
- head-text
- (subseq pars 0 text-strategy)))))))
- ;; return the links if we've got them, or find them in strings
- (setq strings (delq nil strings))
- (when (and strings (not all-links))
- (setq all-links (gnorb-org-find-links strings search-func)))
- all-links)))
-
-(defun gnorb-org-scan-log-notes (state-log strategy)
- ;; `gnorb-org-extract-mail-stuff' was way too long already
-
- ;; I've had a hell of a time just figuring out how to get the
- ;; complete paragraph text out of a parsed paragraph.
- (let ((type (plist-get strategy :type))
- (scope (plist-get strategy :scope))
- (rev (not org-log-states-order-reversed))
- (par-texts (org-element-map state-log 'paragraph
- (lambda (p)
- (buffer-substring
- (org-element-property :contents-begin p)
- (org-element-property :contents-end p)))))
- (note-match "Note taken on ")
- (state-match "State \"") ; good enough?
- (link-match "\\[\\[\\(gnus:\\|mailto:\\|bbdb:\\)")
- (count 0)
- candidates)
- (when rev
- (setq par-texts (nreverse par-texts)))
- (when (eq scope 'first)
- (setq scope 1))
- (catch 'bail
- (dolist (p par-texts)
- (when (or (and (not (eq type 'state))
- (string-match-p note-match p))
- (and (not (eq type 'note))
- (string-match-p state-match p)))
- (incf count)
- (when (and (integerp scope)
- (>= count scope)))
- (when (string-match-p link-match p)
- (push p candidates)
- (when (eq scope 'first-link)
- (throw 'bail t))))))
- (when candidates
- (gnorb-org-find-links candidates))))
-
-(defun gnorb-org-find-links (strings &optional func)
- "Do the actual check to see if there are viable links in the
-places we've decided to look."
- (when strings
- (when (not (listp strings))
- (setq strings (list strings)))
- (with-temp-buffer
- (dolist (s strings)
- (insert s)
- (insert "\n"))
- (goto-char (point-min))
- (if func
- (funcall func (point-max))
+(defun gnorb-org-extract-links (&optional arg region)
+ "See if there are viable links in the subtree under point."
+ ;; We're not currently using the arg. What could we do with it?
+ (let (strings)
+ ;; If the region was active, only use the region
+ (if region
+ (push (buffer-substring (car region) (cdr region))
+ strings)
+ ;; Otherwise collect the heading text, and all the paragraph
+ ;; text.
+ (save-restriction
+ (org-narrow-to-subtree)
+ (let ((head (org-element-at-point))
+ (tree (org-element-parse-buffer)))
+ (push (org-element-property
+ :raw-value
+ head)
+ strings)
+ (org-element-map tree 'paragraph
+ (lambda (p)
+ ;; Don't select paragraphs from the LOGBOOK drawer. This
+ ;; will actually skip over any list, but we'll refine
+ ;; that later.
+ (when (not (eq
+ (org-element-type
+ (org-element-property :parent p))
+ 'item))
+ ;; Why is this so verbose?
+ (push
+ (buffer-substring
+ (org-element-property :contents-begin p)
+ (org-element-property :contents-end p))
+ strings)))))))
+ (when strings
+ ;; Limit number of paragraphs based on
+ ;; `gnorb-org-mail-scan-scope'
+ (setq strings
+ (cond ((eq gnorb-org-mail-scan-scope 'all)
+ strings)
+ ((numberp gnorb-org-mail-scan-scope)
+ (delq nil
+ (subseq
+ strings 0 (1+ gnorb-org-mail-scan-scope))))
+ ;; We could provide more options here. 'tree vs
+ ;; 'subtree, for instance.
+ (t
+ strings)))
+ (with-temp-buffer
+ (dolist (s strings)
+ (insert s)
+ (insert "\n"))
+ (goto-char (point-min))
(gnorb-scan-links (point-max) 'gnus 'mail 'bbdb)))))
+(defun gnorb-org-extract-mail-stuff (&optional arg region)
+ "Decide how to hande the Org heading under point as an email task.
+
+See the docstring of `gnorb-org-handle-mail' for details."
+ (if (or (not gnorb-tracking-enabled)
+ region)
+ (gnorb-org-extract-links arg region)
+ ;; Get all the messages associated with the IDS in this subtree.
+ (let ((assoc-msg-ids
+ (delete-dups
+ (cl-mapcan
+ (lambda (id)
+ (gnorb-registry-org-id-search id))
+ (gnorb-collect-ids)))))
+ (gnorb-org-extract-mail-tracking assoc-msg-ids arg region))))
+
+(defun gnorb-org-extract-mail-tracking (assoc-msg-ids &optional arg region)
+
+ (let* ((all-links (gnorb-org-extract-links nil region))
+ ;; The latest (by the creation-time registry key) of all the
+ ;; tracked messages that were not sent by our user.
+ (latest-msg-id
+ (when assoc-msg-ids
+ (car
+ (sort
+ (remove-if
+ (lambda (m)
+ (let ((from (car (gnus-registry-get-id-key m 'sender))))
+ (or (null from)
+ (string-match-p
+ user-mail-address from)
+ (string-match-p
+ message-alternative-emails from))))
+ assoc-msg-ids)
+ (lambda (r l)
+ (time-less-p
+ (car (gnus-registry-get-id-key l 'creation-time))
+ (car (gnus-registry-get-id-key r 'creation-time)))))))))
+ (cond
+ ;; If there are no tracked messages, or the user has specifically
+ ;; requested we ignore them with the prefix arg, just return the
+ ;; found links in the subtree.
+ ((or arg
+ (null latest-msg-id))
+ all-links)
+ ;; Otherwise ignore the other links in the subtree, and return
+ ;; the latest message.
+ (latest-msg-id
+ `(:gnus ,(list (gnorb-msg-id-to-link latest-msg-id)))))))
+
(defun gnorb-org-setup-message
(&optional messages mails from cc bcc attachments text ids)
"Common message setup routine for other gnorb-org commands.
@@ -475,11 +352,14 @@ headings."
(message-goto-to))
(run-hooks 'gnorb-org-after-message-setup-hook))
-(defun gnorb-org-attachment-list ()
+(defun gnorb-org-attachment-list (&optional id)
"Get a list of files (absolute filenames) attached to the
-current heading."
+current heading, or the heading indicated by optional argument ID."
(when (featurep 'org-attach)
- (let* ((attach-dir (org-attach-dir t))
+ (let* ((attach-dir (save-excursion
+ (when id
+ (org-id-goto id))
+ (org-attach-dir t)))
(files
(mapcar
(lambda (f)
@@ -489,12 +369,41 @@ current heading."
;;;###autoload
(defun gnorb-org-handle-mail (&optional arg text file)
- "Handle current headline as a mail TODO."
+ "Handle current headline as a mail TODO.
+
+How this function behaves depends on whether you're using Gnorb
+for email tracking, also on the prefix arg, and on the active
+region.
+
+If tracking is enabled and there is no prefix arg, Gnorb will
+begin a reply to the newest associated message that wasn't sent
+by the user -- ie, the Sender header doesn't match
+`user-mail-address' or `message-alternative-emails'.
+
+If tracking is enabled and there is a prefix arg, ignore the
+tracked messages and instead scan the subtree for mail-related
+links. This means links prefixed with gnus:, mailto:, or bbdb:.
+See `gnorb-org-mail-scan-scope' to limit the scope of this scan.
+Do something appropriate with the resulting links.
+
+With a double prefix arg, ignore all tracked messages and all
+links, and compose a blank new message.
+
+If tracking is enabled and you want to reply to a
+specific (earlier) message in the tracking history, use
+`gnorb-org-view' to open an nnir *Summary* buffer containing all
+the messages, and reply to the one you want. Your reply will be
+automatically tracked, as well.
+
+If tracking is not enabled and you want to use a specific link in
+the subtree as a basis for the email action, then put the region
+around that link before you call this message."
(interactive "P")
(setq gnorb-window-conf (current-window-configuration))
(move-marker gnorb-return-marker (point))
(when (eq major-mode 'org-agenda-mode)
- (org-agenda-check-type t 'agenda 'timeline 'todo 'tags)
+ ;; If this is all the different types, we could skip the check.
+ (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
@@ -503,28 +412,18 @@ current heading."
(switch-to-buffer buffer)
(widen)
(goto-char pos)))
- (let* ((region
- (when (use-region-p)
- (cons (region-beginning) (region-end))))
- ;; handle malformed values of `gnorb-org-mail-scan-strategies'
- (strategy (cond
- ((and region
- arg)
- 'reverse-region)
- (region
- nil)
- ((null arg)
- (car gnorb-org-mail-scan-strategies))
- ((equal '(4) arg)
- (nth 1 gnorb-org-mail-scan-strategies))
- ((equal '(16) arg)
- (nth 2 gnorb-org-mail-scan-strategies)))))
+ (let ((region
+ (when (use-region-p)
+ (cons (region-beginning) (region-end)))))
(deactivate-mark)
(save-excursion
(unless (org-back-to-heading t)
(error "Not in an org item"))
(cl-flet ((mp (p) (org-entry-get (point) p t)))
- (let* ((links (gnorb-org-extract-mail-stuff strategy region))
+ ;; Double prefix means ignore everything and compose a blank
+ ;; mail.
+ (let* ((links (unless (equal arg '(16))
+ (gnorb-org-extract-mail-stuff arg region)))
(attachments (gnorb-org-attachment-list))
(from (mp "MAIL_FROM"))
(cc (mp "MAIL_CC"))
@@ -537,13 +436,13 @@ current heading."
(cons file attachments))
(when recs
(setq recs
- (delete nil
- (mapcar
- (lambda (r)
- (car (bbdb-message-search
- (org-link-unescape r)
- nil)))
- recs))))
+ (delq nil
+ (mapcar
+ (lambda (r)
+ (car (bbdb-message-search
+ (org-link-unescape r)
+ nil)))
+ recs))))
(when recs
(dolist (r recs)
(push (bbdb-mail-address r) mails)))
@@ -559,66 +458,6 @@ current heading."
from cc bcc
attachments text org-id))))))
-(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)
- (org-map-entries
- (lambda ()
- (setq props
- (org-entry-get-multivalued-property
- (point) gnorb-org-msg-id-key))
- (dolist (p props)
- (gnorb-org-add-id-hash-entry p)))
- gnorb-org-find-candidates-match
- 'agenda 'archive 'comment)))
-
-(defun gnorb-org-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."
- (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))))
- ret-val))
-
;;; Email subtree
(defcustom gnorb-org-email-subtree-text-parameters nil
diff --git a/lisp/gnorb-registry.el b/lisp/gnorb-registry.el
new file mode 100644
index 0000000..71b7f20
--- /dev/null
+++ b/lisp/gnorb-registry.el
@@ -0,0 +1,193 @@
+;;; gnorb-registry.el --- Registry implementation for Gnorb
+
+;; This file is in the public domain.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net.>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Early on, Gnorb's message/todo tracking was done by relying on the
+;; user to insert links to received messages into an Org heading, and
+;; by automatically storing the Message-Ids of sent messages in a
+;; property (`gnorb-org-msg-id-key', defaulting to GNORB_MSG_ID) on
+;; the same heading. The heading could find all relevant messages by
+;; combining the links (incoming) and the IDs of the Gnorb-specific
+;; property (outgoing).
+;;
+;; In the end, this proved to be fragile and messy. Enter the
+;; registry. The Gnus registry is a specialization of a general
+;; "registry" library -- it's possible to roll your own. If you want
+;; to track connections between messages and Org headings, it's an
+;; obvious choice: Each relevant message is stored in the registry,
+;; keyed on its Message-ID, and the org-ids of all relevant headings
+;; are stored in a custom property, in our case gnorb-ids. This allows
+;; us to keep all Gnorb-specific data in one place, without polluting
+;; Org files or Gnus messages, persistent on disk, and with the added
+;; bonus of providing a place to keep arbitrary additional metadata.
+;;
+;; The drawback is that the connections are no longer readily visible
+;; to the user (they need to query the registry to see them), and it
+;; becomes perhaps a bit more difficult (but only a bit) to keep
+;; registry data in sync with the current state of the user's Gnus and
+;; Org files. But a clear win, in the end.
+
+;;; Code:
+
+(require 'gnus-registry)
+
+(defgroup gnorb-registry nil
+ "Gnorb's use of the Gnus registry."
+ :tag "Gnorb Registry"
+ :group 'gnorb)
+
+(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."
+ ;; This set-id-key stuff is actually horribly
+ ;; inefficient.
+ (when gnorb-tracking-enabled
+ (gnus-registry-get-or-make-entry msg-id)
+ (when sender
+ (gnus-registry-set-id-key msg-id 'sender (list sender)))
+ (when subject
+ (gnus-registry-set-id-key msg-id 'subject (list subject)))
+ (when org-id
+ (let ((ids (gnus-registry-get-id-key msg-id 'gnorb-ids)))
+ (unless (member org-id ids)
+ (gnus-registry-set-id-key msg-id 'gnorb-ids (if (stringp org-id)
+ (cons org-id ids)
+ (append org-id ids))))))
+ (when group
+ (gnus-registry-set-id-key msg-id 'group (list group)))
+ (gnus-registry-get-or-make-entry msg-id)))
+
+(defun gnorb-registry-capture ()
+ "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))
+ (let* ((msg-id
+ (format "<%s>" (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)))
+ (plist-put org-capture-plist :gnorb-id new-org-id)
+ (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))))
+
+
+(defun gnorb-registry-capture-abort-cleanup ()
+ (when (and (org-capture-get :gnorb-id)
+ org-note-abort)
+ (condition-case error
+ (let* ((msg-id (format "<%s>" (plist-get org-store-link-plist
:message-id)))
+ (existing-org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))
+ (org-id (org-capture-get :gnorb-id)))
+ (when (member org-id existing-org-ids)
+ (gnus-registry-set-id-key msg-id 'gnorb-ids
+ (remove org-id existing-org-ids)))
+ (setq abort-note 'clean))
+ (error
+ (setq abort-note 'dirty)))))
+
+(defun gnorb-find-visit-candidates (ids)
+ "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."
+ (let (ret-val sub-val)
+ (when (stringp ids)
+ (setq ids (gnus-extract-references ids)))
+ (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-registry-org-id-search (id)
+ "Find all messages that have the org ID in their 'gnorb-ids
+key."
+ (registry-search gnus-registry-db :member `((gnorb-ids ,id))))
+
+(defun gnorb-registry-transition-from-props (arg)
+ "Helper function for transitioning the old tracking system to the new.
+
+The old system relied on storing sent message ids on relevant Org
+headings, in the `gnorb-org-msg-id-key' property. The new system
+uses the gnus registry to track relations between messages and
+Org headings. This function will go through your agenda files,
+find headings that have the `gnorb-org-msg-id-key' property set,
+and create new registry entries that reflect that connection.
+
+Call with a prefix arg to additionally delete the
+`gnorb-org-msg-id-key' altogether from your Org headings. As this
+function will not create duplicate registry entries, it's safe to
+run it once with no prefix arg, to keep the properties in place,
+and then once you're sure everything's working okay, run it again
+with a prefix arg, to clean the Gnorb-specific properties from
+your Org files."
+ (interactive "P")
+ (let ((count 0))
+ (message "Collecting all relevant Org headings, this could take a
while...")
+ (org-map-entries
+ (lambda ()
+ (let ((id (org-id-get))
+ (props (org-entry-get-multivalued-property
+ (point) gnorb-org-msg-id-key))
+ links group id)
+ (when props
+ ;; If the property is set, we should probably assume that any
+ ;; Gnus links in the subtree are relevant, and should also be
+ ;; collected and associated.
+ (setq links (gnorb-scan-links
+ (org-element-property :end (org-element-at-point))
+ 'gnus))
+ (dolist (l (plist-get links :gnus))
+ (gnorb-registry-make-entry
+ (second (split-string l "#")) nil nil
+ id (first (split-string l "#"))))
+ (dolist (p props)
+ (setq id )
+ (gnorb-registry-make-entry p nil nil id nil)
+ ;; This function will try to find the group for the message
+ ;; and set that value on the registry entry if it can find
+ ;; it.
+ (unless (gnus-registry-get-id-key p 'group)
+ (gnorb-msg-id-to-group p))
+ (incf count)))))
+ gnorb-org-find-candidates-match
+ 'agenda 'archive 'comment)
+ (message "Collecting all relevant Org headings, this could take a while...
done")
+ ;; Delete the properties if the user has asked us to do so.
+ (if (equal arg '(4))
+ (progn
+ (dolist (f (org-agenda-files))
+ (with-current-buffer (get-file-buffer f)
+ (org-delete-property-globally gnorb-org-msg-id-key)))
+ (message "%d entries created; all Gnorb-specific properties deleted."
+ count))
+ (message "%d entries created." count))))
+
+(provide 'gnorb-registry)
diff --git a/lisp/gnorb-utils.el b/lisp/gnorb-utils.el
index 43c7ba7..68fe6b6 100644
--- a/lisp/gnorb-utils.el
+++ b/lisp/gnorb-utils.el
@@ -39,14 +39,11 @@
"Glue code between Gnus, Org, and BBDB."
:tag "Gnorb")
-(defcustom gnorb-trigger-todo-default 'prompt
- "What default action should be taken when triggering TODO
- state-change from a message? Valid values are the symbols note
- and todo, or prompt to pick one of the two."
- :group 'gnorb
- :type '(choice (const note)
- (const todo)
- (const prompt)))
+(make-obsolete-variable
+ 'gnorb-trigger-todo-default
+ "This variable has been superseded by
+`gnorb-org-trigger-actions'"
+ "September 8, 2014" 'set)
(defun gnorb-prompt-for-bbdb-record ()
"Prompt the user for a BBDB record."
@@ -66,12 +63,6 @@
(defvar gnorb-tmp-dir (make-temp-file "emacs-gnorb" t)
"Temporary directory where attachments etc are saved.")
-(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.")
-
(defvar gnorb-message-org-ids nil
"List of Org heading IDs from the outgoing Gnus message, used
to mark mail TODOs as done once the message is sent."
@@ -128,65 +119,97 @@ and Gnus and BBDB maps."
(defun gnorb-trigger-todo-action (arg &optional id)
"Do the actual restore action. Two main things here. First: if
we were in the agenda when this was called, then keep us in the
-agenda. Second: try to figure out the correct thing to do once we
-reach the todo. That depends on `gnorb-trigger-todo-default', and
-the prefix arg."
- (let* ((agenda-p (eq major-mode 'org-agenda-mode))
- (todo-func (if agenda-p
- 'org-agenda-todo
- 'org-todo))
- (note-func (if agenda-p
- 'org-agenda-add-note
- 'org-add-note))
- root-marker ret-dest-todo action)
- (when (and (not agenda-p) id)
- (org-id-goto id))
- (setq root-marker (if agenda-p
- (org-get-at-bol 'org-hd-marker)
- (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)))
- (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
- (null gnorb-org-mail-todos))
- (member ret-dest-todo gnorb-org-mail-todos)))
- 'note)
- ((eq gnorb-trigger-todo-default 'prompt)
- (intern (completing-read
- "Take note, or trigger TODO state change? "
- '("note" "todo") nil t)))
- ((null arg)
- gnorb-trigger-todo-default)
- (t
- (if (eq gnorb-trigger-todo-default 'todo)
- 'note
- 'todo))))
+agenda. Then let the user choose an action from the value of
+`gnorb-org-trigger-actions'."
+ (let ((agenda-p (eq major-mode 'org-agenda-mode))
+ (action (cdr (assoc
+ (org-completing-read
+ "Action to take: "
+ gnorb-org-trigger-actions nil t)
+ gnorb-org-trigger-actions)))
+ (root-marker (make-marker)))
+ ;; Place the marker for the relevant TODO heading.
+ (cond (agenda-p
+ (setq root-marker
+ (copy-marker
+ (org-get-at-bol 'org-hd-marker))))
+ ((derived-mode-p 'org-mode)
+ (move-marker root-marker (point-at-bol)))
+ (id
+ (save-excursion
+ (org-id-goto id)
+ (move-marker root-marker (point-at-bol)))))
+ ;; Query about attaching email attachments.
+ (org-with-point-at root-marker
(map-y-or-n-p
(lambda (a)
(format "Attach %s to heading? "
(file-name-nondirectory a)))
(lambda (a) (org-attach-attach a nil 'mv))
gnorb-gnus-capture-attachments
- '("file" "files" "attach"))
- (setq gnorb-gnus-capture-attachments nil)
- (if (eq action 'note)
- (call-interactively note-func)
- (call-interactively todo-func)))))
+ '("file" "files" "attach")))
+ (setq gnorb-gnus-capture-attachments nil)
+ (cl-labels
+ ((make-entry
+ (id)
+ (gnorb-registry-make-entry
+ (plist-get gnorb-gnus-message-info :msg-id)
+ (plist-get gnorb-gnus-message-info :from)
+ (plist-get gnorb-gnus-message-info :subject)
+ id
+ (plist-get gnorb-gnus-message-info :group))))
+ ;; Handle our action.
+ (cond ((eq action 'note)
+ (org-with-point-at root-marker
+ (make-entry (org-id-get-create))
+ (call-interactively 'org-add-note)))
+ ((eq action 'todo)
+ (if agenda-p
+ (progn
+ (org-with-point-at root-marker
+ (make-entry (org-id-get-create)))
+ (call-interactively 'org-agenda-todo))
+ (org-with-point-at root-marker
+ (make-entry (org-id-get-create))
+ (call-interactively 'org-todo))))
+ ((eq action 'no-associate)
+ nil)
+ ((eq action 'associate)
+ (org-with-point-at root-marker
+ (make-entry (org-id-get-create))))
+ ((fboundp action)
+ (org-with-point-at root-marker
+ (make-entry (org-id-get-create))
+ (funcall action gnorb-gnus-message-info)))))))
+
+(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)
+ "Scan from point to BOUND looking for links of type in TYPES.
+
+TYPES is a list of symbols, possible values include 'bbdb, 'mail,
+and 'gnus."
;; this function could be refactored somewhat -- lots of code
;; repetition. It also should be a little faster for when we're
;; scanning for gnus links only, that's a little slow. We should
@@ -210,52 +233,79 @@ the prefix arg."
((and (memq 'bbdb types)
(string-match "^<?bbdb:" addr))
(push (substring addr (match-end 0)) bbdb))))
- `(:gnus ,gnus :mail ,mail :bbdb ,bbdb))))
+ `(:gnus ,(reverse gnus) :mail ,(reverse mail) :bbdb ,(reverse bbdb)))))
(defun gnorb-msg-id-to-link (msg-id)
+ "Given a message id, try to create a full org link to the
+message."
(let ((server-group (gnorb-msg-id-to-group msg-id)))
(when server-group
(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 gnus-registry-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)))))
+ (when gnorb-tracking-enabled
+ ;; 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))))
+
+(defun gnorb-collect-ids (&optional id)
+ "Collect all Org IDs for a subtree.
+
+Starting with the heading under point (or the heading indicated
+by the ID argument), collect its ID property, and the IDs of all
+child headings."
+ (save-excursion
+ (save-restriction
+ (when id
+ (org-id-goto id))
+ (org-narrow-to-subtree)
+ (org-element-map (org-element-parse-buffer)
+ 'headline
+ (lambda (hl)
+ (org-element-property :ID hl))))))
+
+;; Loading the registry
+
+(defvar gnorb-tracking-enabled nil
+ "Internal flag indicating whether Gnorb is successfully plugged
+ into the registry or not.")
+
+(defun gnorb-tracking-initialize ()
+ "Start using the Gnus registry to track correspondences between
+Gnus messages and Org headings. This requires that the Gnus
+registry be in use, and should be called after the call to
+`gnus-registry-initialize'."
+ (require 'gnorb-registry)
+ (add-hook
+ 'gnus-started-hook
+ (lambda ()
+ (unless (gnus-registry-install-p)
+ (user-error "Gnorb tracking requires that the Gnus registry be
installed."))
+ (add-to-list 'gnus-registry-extra-entries-precious 'gnorb-ids)
+ (add-to-list 'gnus-registry-track-extra 'gnorb-ids)
+ (add-hook 'org-capture-mode-hook 'gnorb-registry-capture)
+ (add-hook 'org-capture-prepare-finalize-hook
'gnorb-registry-capture-abort-cleanup)
+ (setq gnorb-tracking-enabled t))))
(provide 'gnorb-utils)
;;; gnorb-utils.el ends here
diff --git a/lisp/gnorb.el b/lisp/gnorb.el
index d972ee8..a7676b1 100644
--- a/lisp/gnorb.el
+++ b/lisp/gnorb.el
@@ -29,6 +29,7 @@
(require 'gnorb-gnus)
(require 'gnorb-bbdb)
(require 'gnorb-org)
+(require 'gnorb-registry)
(provide 'gnorb)
;;; gnorb.el ends here
diff --git a/lisp/nngnorb.el b/lisp/nngnorb.el
index 70b3a88..8048304 100644
--- a/lisp/nngnorb.el
+++ b/lisp/nngnorb.el
@@ -61,16 +61,21 @@ different things. First is the ID string of an Org heading,
prefixed with \"id+\". This was probably a bad choice as it could
conceivably look like an org tags search string. Fix that later.
If it's an ID, then the entire subtree text of that heading is
-scanned for gnus links, and all the linked messages are displayed
-in an ephemeral group.
+scanned for gnus links, and the messages relevant to the subtree
+are collected from the registry, and all the resulting messages
+are displayed in an ephemeral group.
Otherwise, the query string can be a tags match string, a la the
Org agenda tags search. All headings matched by this string will
be scanned for gnus messages, and those messages displayed."
+ ;; During the transition period between using message-ids stored in
+ ;; a property, and the new registry-based system, we're going to use
+ ;; both methods to collect relevant messages. This could be a little
+ ;; slower, but for the time being it will be safer.
(save-excursion
(let ((q (cdr (assq 'query query)))
(buf (get-buffer-create nnir-tmp-buffer))
- links vectors)
+ msg-ids org-ids links vectors)
(with-current-buffer buf
(erase-buffer))
(when (equal "5.13" gnus-version-number)
@@ -82,7 +87,13 @@ be scanned for gnus messages, and those messages displayed."
buf
(point)
(org-element-property
- :end (org-element-at-point)))))
+ :end (org-element-at-point)))
+ (save-restriction
+ (org-narrow-to-subtree)
+ (setq org-ids
+ (append
+ (gnorb-collect-ids)
+ org-ids)))))
((listp q)
;; be a little careful: this could be a list of links, or
;; it could be the full plist
@@ -91,6 +102,7 @@ be scanned for gnus messages, and those messages displayed."
q)))
(t (org-map-entries
(lambda ()
+ (push (org-id-get) org-ids)
(append-to-buffer
buf
(point)
@@ -100,20 +112,25 @@ be scanned for gnus messages, and those messages
displayed."
q
'agenda)))
(with-current-buffer buf
- (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)))))))
+ (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 msg-ids (append (split-string (match-string 1)) msg-ids))))
+ ;; Here's where we maybe do some duplicate work using the
+ ;; registry. Take our org ids and find all relevant message ids.
+ (dolist (i (delq nil org-ids))
+ (let ((rel-msg-id (gnorb-registry-org-id-search i)))
+ (when rel-msg-id
+ (setq msg-ids (append rel-msg-id msg-ids)))))
+ (when msg-ids
+ (dolist (id msg-ids)
+ (let ((link (gnorb-msg-id-to-link id)))
+ (when link
+ (push link links)))))
(setq links (delete-dups links))
(unless (gnus-alive-p)
(gnus))
@@ -130,6 +147,147 @@ be scanned for gnus messages, and those messages
displayed."
(when (and (integerp artno) (> artno 0))
(push (vector server-group artno 100) vectors)))))))))
+(defvar gnorb-summary-minor-mode-map (make-sparse-keymap)
+ "Keymap for use in Gnorb's *Summary* minor mode.")
+
+(define-minor-mode gnorb-summary-minor-mode
+ "A minor mode for use in nnir *Summary* buffers created by Gnorb.
+
+These *Summary* buffers are usually created by calling
+`gnorb-org-view', or by initiating an nnir search on a nngnorb server.
+
+While active, this mode provides some Gnorb-specific commands,
+and also advises Gnus' reply-related commands in order to
+continue to provide tracking of sent messages."
+ nil " Gnorb" gnorb-summary-minor-mode-map)
+
+(define-key gnorb-summary-minor-mode-map
+ [remap gnus-summary-exit]
+ 'gnorb-summary-exit)
+
+(define-key gnorb-summary-minor-mode-map (kbd "C-c d")
+ 'gnorb-summary-disassociate-message)
+
+;; All this is pretty horrible, but it's the only way to get sane
+;; behavior, there are no appropriate hooks, and I want to avoid
+;; advising functions.
+
+(define-key gnorb-summary-minor-mode-map
+ [remap gnus-summary-very-wide-reply-with-original]
+ 'gnorb-summary-very-wide-reply-with-original)
+
+(define-key gnorb-summary-minor-mode-map
+ [remap gnus-summary-wide-reply-with-original]
+ 'gnorb-summary-wide-reply-with-original)
+
+(define-key gnorb-summary-minor-mode-map
+ [remap gnus-summary-reply]
+ 'gnorb-summary-reply)
+
+(define-key gnorb-summary-minor-mode-map
+ [remap gnus-summary-very-wide-reply]
+ 'gnorb-summary-very-wide-reply)
+
+(define-key gnorb-summary-minor-mode-map
+ [remap gnus-summary-reply-with-original]
+ 'gnorb-summary-reply-with-original)
+
+(define-key gnorb-summary-minor-mode-map
+ [remap gnus-summary-wide-reply]
+ 'gnorb-summary-wide-reply)
+
+(define-key gnorb-summary-minor-mode-map
+ [remap gnus-summary-mail-forward]
+ 'gnorb-summary-mail-forward)
+
+(defun gnorb-summary-wide-reply (&optional yank)
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnorb-summary-reply yank t))
+
+(defun gnorb-summary-reply-with-original (n &optional wide)
+ (interactive "P")
+ (gnorb-summary-reply (gnus-summary-work-articles n) wide))
+
+(defun gnorb-summary-very-wide-reply (&optional yank)
+ (interactive
+ (list (and current-prefix-arg
+ (gnus-summary-work-articles 1))))
+ (gnorb-summary-reply yank t (gnus-summary-work-articles yank)))
+
+(defun gnorb-summary-reply (&optional yank wide very-wide)
+ (interactive)
+ (gnus-summary-reply yank wide very-wide)
+ (gnorb-summary-reply-hook))
+
+(defun gnorb-summary-wide-reply-with-original (n)
+ (interactive "P")
+ (gnorb-summary-reply-with-original n t))
+
+(defun gnorb-summary-very-wide-reply-with-original (n)
+ (interactive "P")
+ (gnorb-summary-reply
+ (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
+
+(defun gnorb-summary-mail-forward (n)
+ (interactive "P")
+ (gnus-summary-mail-forward n t)
+ (gnorb-summary-reply-hook))
+
+(defun gnorb-summary-reply-hook (&rest args)
+ "Function that runs after any command that creates a reply."
+ ;; Not actually a "hook"
+ (let* ((msg-id (aref message-reply-headers 4))
+ (org-id (car-safe (gnus-registry-get-id-key msg-id 'gnorb-ids))))
+ (when org-id
+ (save-restriction
+ (save-excursion
+ (widen)
+ (message-narrow-to-headers-or-head)
+ (goto-char (point-at-bol))
+ (open-line 1)
+ (message-insert-header
+ (intern gnorb-mail-header)
+ org-id)
+ (add-to-list 'message-exit-actions
+ 'gnorb-org-restore-after-send t))))))
+
+(defun gnorb-summary-exit ()
+ "Like `gnus-summary-exit', but restores the gnorb window conf."
+ (interactive)
+ (call-interactively 'gnus-summary-exit)
+ (gnorb-restore-layout))
+
+(defun gnorb-summary-disassociate-message ()
+ "Disassociate a message from its Org TODO.
+
+This is used in a Gnorb-created *Summary* buffer to remove the
+connection between the message and whichever Org TODO resulted in
+the message being included in this search."
+ (interactive)
+ (let* ((msg-id (gnus-fetch-original-field "message-id"))
+ (org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))
+ chosen)
+ (when org-ids
+ (if (= (length org-ids) 1)
+ ;; Only one associated Org TODO.
+ (progn (gnus-registry-set-id-key msg-id 'gnorb-ids)
+ (setq chosen (car org-ids)))
+ ;; Multiple associated TODOs, prompt to choose one.
+ (setq chosen
+ (cdr
+ (org-completing-read
+ "Choose a TODO to disassociate from: "
+ (mapcar
+ (lambda (h)
+ (cons (gnorb-pretty-outline h) h))
+ org-ids))))
+ (gnus-registry-set-id-key msg-id 'gnorb-ids
+ (remove chosen org-ids)))
+ (message "Message disassociated from %s"
+ (gnorb-pretty-outline chosen)))))
+
(defvar nngnorb-status-string "")
(defun nngnorb-retrieve-headers (articles &optional group server fetch-old)
- [elpa] externals/gnorb 9a2f747 175/449: Don't hint messages in nnir or virtual summaries, (continued)
- [elpa] externals/gnorb 9a2f747 175/449: Don't hint messages in nnir or virtual summaries, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb ec44a6d 182/449: Continue shifting candidate finding to the registry, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 927e401 184/449: New function for restoring window layout, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb a352586 189/449: Improve lookups for entries with unknown groups, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 81fed4b 193/449: Helper function for transitioning to the new system, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb d7327b5 192/449: The big switch! Rely only on registry for tracking, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 7ba1786 196/449: Use gnorb-gnus-message-info for incoming and outgoing, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 0cb4d1a 201/449: Docstring for gnorb-scan-links, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 5c9ef6e 203/449: Don't create Org IDs when scanning for mails, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 9ac84b7 218/449: Return links in the order which they were found, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb a9535ae 223/449: Merge branch 'registry',
Stefan Monnier <=
- [elpa] externals/gnorb dd4e013 225/449: Restore action shouldn't quit summary buffer, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 08e0742 229/449: Empty News and gnorb.texi files, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb bcfd501 236/449: gitignore Elpa-generated stuff, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 55a630d 238/449: Gnus hinting needs to check in-reply-to as well, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb d2831b8 237/449: Refactor summary buffer hinting into separate function, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 2be4a71 240/449: Save point with marker when adding headers to replies, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb ba99110 242/449: Check for relevant headings when handling attachments, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 1a0cfc7 243/449: Delete duplicates before and after finding candidates, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 35284f2 248/449: Add TODO for collecting BBDB messages by thread, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 2c0f43d 249/449: Refinements to link extraction, Stefan Monnier, 2020/11/27