[elpa] externals/gnorb b951675 303/449: Merge capture-to-child branch

[Stefan Monnier]

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

    Merge capture-to-child branch
---
 gnorb-gnus.el  |  23 ++++++------
 gnorb-org.el   |  21 ++++++-----
 gnorb-utils.el | 112 +++++++++++++++++++++++++++++++++++++++------------------
 nngnorb.el     |   8 +++--
 4 files changed, 107 insertions(+), 57 deletions(-)

diff --git a/gnorb-gnus.el b/gnorb-gnus.el
index 0803809..87087ab 100644
--- a/gnorb-gnus.el
+++ b/gnorb-gnus.el
@@ -297,11 +297,14 @@ information about the outgoing message into
            ;; `gnorb-org-setup-message' may have put this here, but
            ;; 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
+           (add-to-list 'message-send-actions
                         'gnorb-org-restore-after-send t))
        (setq gnorb-message-org-ids nil)))))
 
-(add-hook 'message-header-hook 'gnorb-gnus-check-outgoing-headers)
+;; This sets the global value, but the hook is made buffer-local in
+;; `gnus-inews-add-send-actions', so this is ignored
+;(add-hook 'message-header-hook 'gnorb-gnus-check-outgoing-headers)
+(add-hook 'message-send-hook 'gnorb-gnus-check-outgoing-headers t)
 
 ;;;###autoload
 (defun gnorb-gnus-outgoing-do-todo (&optional arg)
@@ -379,10 +382,9 @@ work."
          (save-excursion
            (save-restriction
              (widen)
-             (setq message-exit-actions
-                   (remove 'gnorb-org-restore-after-send
-                           (remove 'gnorb-gnus-outgoing-make-todo-1
-                                   message-exit-actions)))
+             (setq message-send-actions
+                   (remove 'gnorb-gnus-outgoing-make-todo-1
+                           message-send-actions))
              (message-narrow-to-headers-or-head)
              (message-remove-header
               gnorb-mail-header)
@@ -422,12 +424,9 @@ work."
                ;; message
                (push h header-ids)))))
        (goto-char compose-marker)
-       (add-to-list
-        'message-exit-actions
-        (if header-ids
-            'gnorb-org-restore-after-send
-          'gnorb-gnus-outgoing-make-todo-1)
-        t)
+       (unless header-ids
+         (add-to-list 'message-send-actions
+          'gnorb-gnus-outgoing-make-todo-1 t))
        (message
         (if header-ids
             "Message will trigger TODO state-changes after sending"
diff --git a/gnorb-org.el b/gnorb-org.el
index b4de033..0af2f84 100644
--- a/gnorb-org.el
+++ b/gnorb-org.el
@@ -43,9 +43,8 @@
     ("take note" . note)
     ("don't associate" . no-associate)
     ("only associate" . associate)
-;    ("capture to child" . cap-child)
-;    ("capture to sibling" . cap-sib)
-)
+    ("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
@@ -56,8 +55,8 @@ 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.
+capture to child: Associate this message with a new child heading.
+capture to sibling: 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
@@ -270,10 +269,14 @@ headings."
     (when messages
       (insert ", "))
     (insert (mapconcat 'identity mails ", ")))
-  ;; Return us after message is sent.
-  (add-to-list 'message-exit-actions
-              'gnorb-org-restore-after-send t)
-  ;; Set headers from MAIL_* properties (from, cc, and bcc).
+  ;; Commenting this out because
+  ;; `gnorb-gnus-check-outgoing-headers' is set unconditionally in the
+  ;; `message-send-hook, so this should be redundant.  Also, we've
+  ;; switched to using message-send-actions.
+  
+  ;; (add-to-list
+  ;; 'message-exit-actions 'gnorb-org-restore-after-send t) Set
+  ;; headers from MAIL_* properties (from, cc, and bcc).
   (cl-flet ((sh (h)
                (when (cdr h)
                  (funcall (intern (format "message-goto-%s" (car h))))
diff --git a/gnorb-utils.el b/gnorb-utils.el
index a4e1471..07fdba9 100644
--- a/gnorb-utils.el
+++ b/gnorb-utils.el
@@ -74,6 +74,11 @@ are sent, or Org headings triggered.")
   "Return point here after various actions, to be used together
 with `gnorb-window-conf'.")
 
+(defvar gnorb-trigger-capture-location nil
+  "Marker pointing at the location where we want to place capture
+  templates, for the capture-to-child and capture-to-sibling
+  trigger actions.")
+
 (defcustom gnorb-mail-header "X-Org-ID"
   "Name of the mail header used to store the ID of a related Org
   heading. Only used locally: always stripped when the mail is
@@ -239,20 +244,6 @@ agenda. Then let the user choose an action from the value 
of
                       gnorb-org-trigger-actions))))
     (unless agenda-p
       (org-reveal))
-    ;; Query about attaching email attachments. No matter what
-    ;; happens, clear `gnorb-gnus-capture-attachments'.
-    (unwind-protect
-       (org-with-point-at root-marker
-         (map-y-or-n-p
-          (lambda (a)
-            (format "Attach %s to heading? "
-                    (file-name-nondirectory a)))
-          (lambda (a)
-            (with-demoted-errors
-                (org-attach-attach a nil 'mv)))
-          gnorb-gnus-capture-attachments
-          '("file" "files" "attach")))
-      (setq gnorb-gnus-capture-attachments nil))
     (cl-labels
        ((make-entry
          (id)
@@ -263,28 +254,81 @@ agenda. Then let the user choose an action from the value 
of
           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)
+      (if (fboundp action)
+         (org-with-point-at root-marker
+           (make-entry (org-id-get-create))
+           (funcall action gnorb-gnus-message-info))
+       (cl-case action
+         (note
+          (org-with-point-at root-marker
+            (make-entry (org-id-get-create))
+            (call-interactively 'org-add-note)))
+         (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))
-              (funcall action gnorb-gnus-message-info)))))))
+              (call-interactively 'org-todo))))
+         (no-associate
+          nil)
+         (associate
+          (org-with-point-at root-marker
+            (make-entry (org-id-get-create))))
+         ;; We're going to capture a new heading
+         ((cap-child cap-sib)
+          (org-with-point-at root-marker
+               (setq gnorb-trigger-capture-location (point-marker)))
+          (let ((entry
+                 ;; Pick a template.
+                 (copy-sequence (org-capture-select-template))))
+            ;; Do surgery on that template so that it finds its
+            ;; location using our function.
+            (setf (nth 3 entry)
+                  `(function
+                    ,(if (eq action 'cap-child)
+                         #'gnorb-trigger-capture-child
+                       #'gnorb-trigger-capture-sibling)))
+            ;; This will likely fail horribly for capture templates
+            ;; that aren't entries or list items.
+            (let ((org-capture-entry entry))
+              ;; When org-capture-entry is let-bound, the capture
+              ;; process will use that template instead of
+              ;; prompting the user. Also, `gnorb-registry-capture'
+              ;; will take care of making the registry entry for us.
+              (call-interactively 'org-capture)))))))
+    ;; Lastly, query about attaching email attachments. No matter what
+    ;; happens, clear `gnorb-gnus-capture-attachments'.
+    (unwind-protect
+       (org-with-point-at
+           (if (memq action '(cap-child cap-sib))
+               (point)
+             root-marker)
+         (map-y-or-n-p
+          (lambda (a)
+            (format "Attach %s to heading? "
+                    (file-name-nondirectory a)))
+          (lambda (a)
+            (with-demoted-errors
+                (org-attach-attach a nil 'mv)))
+          gnorb-gnus-capture-attachments
+          '("file" "files" "attach")))
+      (setq gnorb-gnus-capture-attachments nil))))
+
+(defun gnorb-trigger-capture-child ()
+  ;; The capture process creates a child by default
+  (org-goto-marker-or-bmk gnorb-trigger-capture-location)
+  (org-back-to-heading))
+
+(defun gnorb-trigger-capture-sibling ()
+  ;; This only works if we're not trying to create a sibling for a
+  ;; top-level heading, there appears to be no way to do that.  But in
+  ;; that case this trigger action isn't really necessary, just
+  ;; handle it with a regular capture.
+  (org-goto-marker-or-bmk gnorb-trigger-capture-location)
+  (org-up-heading-safe))
 
 (defun gnorb-pretty-outline (id &optional kw)
   "Return pretty outline path of the Org heading indicated by ID.
diff --git a/nngnorb.el b/nngnorb.el
index 907fe36..6e7a018 100644
--- a/nngnorb.el
+++ b/nngnorb.el
@@ -278,8 +278,12 @@ continue to provide tracking of sent messages."
        (message-insert-header
         (intern gnorb-mail-header)
         org-id)
-       (add-to-list 'message-exit-actions
-                    'gnorb-org-restore-after-send t))
+       ;; As with elsewhere, this should be redundant with
+       ;; `gnorb-gnus-check-outgoing-headers.'  Even if not, it
+       ;; should be switched to use `message-send-actions'
+       ;; (add-to-list 'message-exit-actions
+       ;; 'gnorb-org-restore-after-send t)
+       )
       (goto-char compose-marker))
     (when attachments
       (map-y-or-n-p