[elpa] externals/gnorb 7052248 069/449: New generalized function gnorb-trigger-todo-action

[Stefan Monnier]

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

    New generalized function gnorb-trigger-todo-action
    
    lisp/gnorb-gnus.el: Renamed `gnorb-gnus-message-trigger-default' and
    moved to gnorb-utils.el, now called `gnorb-trigger-todo-default'.
    
    lisp/gnorb-utils.el: New function `gnorb-trigger-todo-action', new
    variable `gnorb-gnus-trigger-refile-args'.
    
    lisp/gnorb-org.el: Rework `gnorb-org-restore-after-send' to use
    gnorb-trigger-todo-action
    
    Basically, what happened is, as I was writing the gnorb-gnus TODO
    triggering stuff, it seemed like we wanted just one triggering
    routine (with its own options, etc), that both gnorb-gnus triggering and
    gnorb-org handle email restore would use when visiting their respective
    TODO headings.
---
 README.org          | 13 ++++++++++++
 lisp/gnorb-gnus.el  | 43 ++++++++++++++++++----------------------
 lisp/gnorb-org.el   | 43 ++--------------------------------------
 lisp/gnorb-utils.el | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 91 insertions(+), 65 deletions(-)

diff --git a/README.org b/README.org
index 2d17d55..66603a6 100644
--- a/README.org
+++ b/README.org
@@ -147,6 +147,13 @@ and attach the files to that heading using org-attach.
 Set the new :gnus-attachments key to "t" in a capture template that
 you use on mail messages, and you'll be queried to re-attach the
 message's attachments onto the newly-captured heading.
+**** gnorb-gnus-message-trigger-todo
+Call on an incoming message that should trigger a state change or a
+note on an existing TODO. You'll be asked to locate the appropriate
+TODO, and the action will depend in part on the value of
+`gnorb-gnus-message-trigger-default', which see. Future versions of
+Gnorb will automagically suggest TODOs relevant to the incoming
+message.
 *** User Options
 **** gnorb-gnus-mail-search-backend
 Specifies the search backend that you use for searching mails.
@@ -156,11 +163,17 @@ of those symbols.
 Treat all capture templates as if they had the :gnus-attachments key
 set to "t". This only has any effect if you're capturing from a Gnus
 summary or article buffer.
+**** gnorb-gnus-message-trigger-default
+Set to either 'note or 'todo to tell `gnorb-gnus-message-trigger-todo'
+what to do by default. You can reach the non-default behavior by
+calling that function with a prefix argument. Alternately, set to
+'prompt to always prompt for the appropriate action.
 *** Suggested Keybindings
 #+BEGIN_SRC emacs-lisp
   (eval-after-load "gnorb-gnus"
     '(progn
        (define-key gnus-summary-mime-map "a" 'gnorb-gnus-article-org-attach)
+       (define-key gnus-summary-mode-map (kbd "C-c t") 
'gnorb-gnus-message-trigger-todo)
        (push '("attach to org heading" . gnorb-gnus-mime-org-attach)
              gnus-mime-action-alist)
        ;; The only way to add mime button command keys is by redefining
diff --git a/lisp/gnorb-gnus.el b/lisp/gnorb-gnus.el
index ba9db4b..f292d68 100644
--- a/lisp/gnorb-gnus.el
+++ b/lisp/gnorb-gnus.el
@@ -72,6 +72,12 @@ Basically behave as if all attachments have 
\":gnus-attachments t\"."
   :group 'gnorb-gnus
   :type 'boolean)
 
+(defcustom gnorb-gnus-trigger-refile-args '((org-agenda-files :maxlevel . 4))
+  "A value to use as an equivalent of `org-refile-targets' (which
+  see) when offering trigger targets for
+  `gnorb-gnus-message-trigger-todo'."
+  :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.
@@ -240,16 +246,7 @@ current message; multiple header values returned as a 
string."
 ;;; If an incoming message should trigger state-change for a Org todo,
 ;;; call this function on it.
 
-(defcustom gnorb-gnus-message-trigger-default 'note
-  "What default action should be taken when triggering TODO
-  state-change from a message? Valid values are the symbols note
-  and todo. Whatever the default is, giving the command a prefix
-  argument will do the opposite."
-  :group 'gnorb-gnus
-  :type '(choice (const note)
-                (const todo)))
-
-(defun gnorb-gnus-message-trigger-todo (arg &optional heading)
+(defun gnorb-gnus-message-trigger-todo (arg &optional id)
   "Call this function from a received gnus message to store a
 link to the message, prompt for a related Org heading, visit the
 heading, and either add a note or trigger a TODO state change.
@@ -262,21 +259,19 @@ prefix argument), or to 'prompt to always be prompted."
   (interactive "P")
   (if (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
       (error "Only works in gnus summary or article mode")
-    (org-store-link)
-    (let* ((action (if (not arg)
-                      gnorb-gnus-message-trigger-default
-                    (if (eq gnorb-gnus-message-trigger-default 'todo)
-                        'note
-                      'todo)))
-          (targ (or heading
+    (call-interactively 'org-store-link)
+    (let* ((org-refile-targets gnorb-gnus-trigger-refile-args)
+          (targ (or id
                     (org-refile-get-location
-                     (format "Trigger heading (%s): " action) nil t))))
-      (find-file (nth 1 org-heading))
-      (goto-char (nth 3 org-heading))
-      (call-interactively
-       (if (eq action 'todo)
-          'org-todo
-        'org-add-note)))))
+                     "Trigger heading" nil t))))
+      (if id
+         (gnorb-trigger-todo-action arg id)
+       (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)"
+        (mapconcat 'key-description (where-is-internal 'org-insert-link) ", 
"))))))
 
 (provide 'gnorb-gnus)
 ;;; gnorb-gnus.el ends here
diff --git a/lisp/gnorb-org.el b/lisp/gnorb-org.el
index 4ff40d5..d75892a 100644
--- a/lisp/gnorb-org.el
+++ b/lisp/gnorb-org.el
@@ -68,47 +68,8 @@ might have been in the outgoing message's headers and call
     (gnus-summary-exit nil t))
   (when (window-configuration-p gnorb-org-window-conf)
     (set-window-configuration gnorb-org-window-conf))
-  ;; This is some ugly stuff, but it (hopefully) results in smooth
-  ;; usage.
-  (let* ((agenda-p (eq major-mode 'org-agenda-mode))
-        (ret-dest-id (org-entry-get
-                      (if agenda-p
-                          (org-get-at-bol 'org-hd-marker)
-                        (point-at-bol)) "ID"))
-        (ret-dest-todo (org-entry-get
-                        (if agenda-p
-                            (org-get-at-bol 'org-hd-marker)
-                          (point-at-bol)) "TODO")))
-    (if (not gnorb-message-org-ids)
-       ;; If there were no Org ID headers, just throw us back where
-       ;; we were and hope.
-       (cond ((eq major-mode 'org-agenda-mode)
-              (call-interactively 'org-agenda-todo))
-             ((eq major-mode 'org-mode)
-              (call-interactively 'org-todo))
-             (t nil))
-      ;; We've been returned to a heading, is it the one referenced by
-      ;; the first of the Org ID headers? This should be the most
-      ;; common case.
-      (when (and (equal ret-dest-id (car gnorb-message-org-ids))
-                (or (null gnorb-org-mail-todos)
-                    (member ret-dest-todo gnorb-org-mail-todos)))
-       (if agenda-p
-           (call-interactively 'org-agenda-todo)
-         (call-interactively 'org-todo))
-       (setq gnorb-message-org-ids
-             (cdr gnorb-message-org-ids)))
-      ;; there's currently no way to attach multiple Org IDs to a
-      ;; message, but there might be in the future
-      (dolist (id gnorb-message-org-ids)
-       (with-demoted-errors
-         (org-id-goto id)
-         (delete-other-windows)
-         (when (or (null gnorb-org-mail-todos)
-                   (member (org-entry-get (point) "TODO")
-                           gnorb-org-mail-todos))
-           (call-interactively 'org-todo))))))
-  ;; this is a little unnecessary, but still...
+  (dolist (id gnorb-message-org-ids)
+    (gnorb-trigger-todo-action nil id))
   (setq gnorb-org-window-conf nil)
   (setq gnorb-message-org-ids nil))
 
diff --git a/lisp/gnorb-utils.el b/lisp/gnorb-utils.el
index 50f9b26..149b281 100644
--- a/lisp/gnorb-utils.el
+++ b/lisp/gnorb-utils.el
@@ -39,6 +39,15 @@
   "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)))
+
 (defun gnorb-prompt-for-bbdb-record ()
   "Prompt the user for a BBDB record."
   (let ((recs (bbdb-records))
@@ -89,5 +98,53 @@
             (mapconcat
              'identity ign-headers-list "|")))))
 
+(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))
+        (action (cond ((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))))
+        (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)
+    (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 root-marker gnorb-org-msg-id-key))
+         (sent-id (plist-get gnorb-gnus-sending-message-info :msg-id)))
+      ;; we can use `org-entry-get-multivalued-property' and
+      ;; `org-entry-put-multivalued-property' here.
+      (when sent-id
+       (org-entry-put root-marker
+                      gnorb-org-msg-id-key
+                      (if (stringp ids)
+                          (concat ids "," sent-id)
+                        sent-id)))
+      (if (eq action 'note)
+         (call-interactively note-func)
+       (when (or (and ret-dest-todo
+                      (null gnorb-org-mail-todos))
+                 (member ret-dest-todo gnorb-org-mail-todos))
+         (call-interactively todo-func))))))
+
 (provide 'gnorb-utils)
 ;;; gnorb-utils.el ends here