[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/gnorb 9fff78a 057/449: Changing email TODO handling to
From: |
Stefan Monnier |
Subject: |
[elpa] externals/gnorb 9fff78a 057/449: Changing email TODO handling to operate by org ID |
Date: |
Fri, 27 Nov 2020 23:15:07 -0500 (EST) |
branch: externals/gnorb
commit 9fff78af15a2251d74bb91193b2b7a0889577a20
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>
Changing email TODO handling to operate by org ID
gnorb-utils.el: new var gnorb-message-org-ids
Instead of marking mail TODOs as done based only on position of point in
a window configuration, we now stick the TODO's ID value into the
message as a custom header. When the mail is sent, the custom header is
stripped, and the user returned to the TODO with the matching ID. should
be a little more robust.
---
lisp/gnorb-gnus.el | 37 +++++++++++++++
lisp/gnorb-org.el | 127 +++++++++++++++++++++++++++++++++++-----------------
lisp/gnorb-utils.el | 9 ++++
3 files changed, 131 insertions(+), 42 deletions(-)
diff --git a/lisp/gnorb-gnus.el b/lisp/gnorb-gnus.el
index d6e0d0b..f94a0ea 100644
--- a/lisp/gnorb-gnus.el
+++ b/lisp/gnorb-gnus.el
@@ -174,5 +174,42 @@ save them into `gnorb-tmp-dir'."
(add-hook 'org-capture-prepare-finalize-hook
'gnorb-gnus-capture-abort-cleanup)
+;;; Storing, removing, and acting on Org headers in messages.
+
+(defcustom gnorb-gnus-org-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
+ sent."
+ :group 'gnorb-gnus
+ :type 'string)
+
+;;; this is just ghastly, but the value of this var is single regexp
+;;; group containing various header names, and we want our value
+;;; inside that group.
+(eval-after-load "message"
+ (let ((ign-headers-list
+ (org-split-string message-ignored-mail-headers
+ "|"))
+ (our-val (concat gnorb-org-mail-header "\\")))
+ (unless (member our-val ign-headers-list)
+ (setq ign-headers-list
+ `(,@(butlast ign-headers-list 1) ,our-val
+ ,@(last ign-headers-list 1)))
+ (setq message-ignored-mail-headers
+ (mapconcat
+ 'identity ign-headers-list "|")))))
+
+(defun gnorb-gnus-check-org-header ()
+ "Return the value of the `gnorb-gnus-org-header' for the
+current message; multiple header values returned as a string."
+ (save-restriction
+ (message-narrow-to-headers)
+ (let ((org-ids (mail-fetch-field gnorb-gnus-org-header nil nil t)))
+ (if org-ids
+ (setq gnorb-message-org-ids org-ids)
+ (setq gnorb-message-org-ids nil)))))
+
+(add-hook 'message-send-hook 'gnorb-gnus-check-org-header)
+
(provide 'gnorb-gnus)
;;; gnorb-gnus.el ends here
diff --git a/lisp/gnorb-org.el b/lisp/gnorb-org.el
index 920f84e..4f41da6 100644
--- a/lisp/gnorb-org.el
+++ b/lisp/gnorb-org.el
@@ -55,28 +55,43 @@ point."
after the mail is sent.")
(defun gnorb-org-restore-after-send ()
- (when (eq major-mode 'gnus-summary-exit)
+ (when (eq major-mode 'gnus-summary-mode)
(gnus-summary-exit nil t))
+ ;; this var would have been set in `gnorb-gnus-check-org-header',
+ ;; which was run during `message-send-hook'
+ (when gnorb-message-org-ids
+ (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)))))
(when (window-configuration-p gnorb-org-window-conf)
(set-window-configuration gnorb-org-window-conf))
- (cond ((eq major-mode 'org-agenda-mode)
- (if (null gnorb-org-mail-todos)
- (call-interactively 'org-agenda-todo)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker)))
- (when (save-excursion
- (with-current-buffer buffer
- (goto-char (marker-position marker))
- (member (org-entry-get (point) "TODO")
- gnorb-org-mail-todos)))
- (call-interactively 'org-agenda-todo)))))
- ((eq major-mode 'org-mode)
- (when (or (null gnorb-org-mail-todos)
- (member (org-entry-get (point) "TODO")
- gnorb-org-mail-todos))
- (call-interactively 'org-todo)))
- (t nil)))
+ ;; this is a little unnecessary, but still...
+ (setq gnorb-org-window-conf nil)
+ (setq gnorb-message-org-ids nil))
+
+ ;; (cond ((eq major-mode 'org-agenda-mode)
+ ;; (if (null gnorb-org-mail-todos)
+ ;; (call-interactively 'org-agenda-todo)
+ ;; (let* ((marker (or (org-get-at-bol 'org-marker)
+ ;; (org-agenda-error)))
+ ;; (buffer (marker-buffer marker)))
+ ;; (when (save-excursion
+ ;; (with-current-buffer buffer
+ ;; (goto-char (marker-position marker))
+ ;; (member (org-entry-get (point) "TODO")
+ ;; gnorb-org-mail-todos)))
+ ;; (call-interactively 'org-agenda-todo)))))
+ ;; ((eq major-mode 'org-mode)
+ ;; (when (or (null gnorb-org-mail-todos)
+ ;; (member (org-entry-get (point) "TODO")
+ ;; gnorb-org-mail-todos))
+ ;; (call-interactively 'org-todo)))
+ ;; (t nil))
(defun gnorb-org-extract-mail-stuff ()
(let (message mails)
@@ -97,43 +112,65 @@ point."
(push mail mails))))))))
(list message mails)))
-(defun gnorb-org-setup-message (&optional messages mails attachments text)
- "Common message setup routine for other gnorb-org commands."
+(defun gnorb-org-setup-message (&optional messages mails attachments text ids)
+ "Common message setup routine for other gnorb-org commands.
+MESSAGES is a list of gnus links pointing to messages -- we
+currently only use the first of the list. MAILS is a list of
+email address strings suitable for inserting in the To header.
+ATTACHMENTS is a list of filenames to attach. TEXT is a string or
+buffer, which is inserted in the message body. IDS is one or more
+Org heading ids, associating the outgoing message with those
+headings."
+ (require 'gnorb-gnus)
(if (not messages)
; either compose new message...
- (compose-mail (mapconcat 'identity mails ", ")
- nil nil nil nil nil nil
- '(gnorb-org-restore-after-send))
+ (compose-mail (mapconcat 'identity mails ", "))
; ...or follow link and start reply
- (org-gnus-open (org-link-unescape (car messages)))
- (call-interactively
- 'gnus-summary-wide-reply-with-original)
- ; add MAILS to message To header
- (when mails
- (message-goto-to)
- (insert ", ")
- (insert (mapconcat 'identity mails ", ")))
- (add-to-list 'message-exit-actions
- 'gnorb-org-restore-after-send t))
+ (condition-case nil
+ (progn
+ (org-gnus-open (org-link-unescape (car messages)))
+ (call-interactively
+ 'gnus-summary-wide-reply-with-original)
+ ;; add MAILS to message To header
+ (when mails
+ (message-goto-to)
+ (insert ", ")
+ (insert (mapconcat 'identity mails ", "))))
+ (error (message "Couldn't open linked message"))))
+ ;; return us after message is sent
+ (add-to-list 'message-exit-actions
+ 'gnorb-org-restore-after-send t)
; attach ATTACHMENTS
(map-y-or-n-p
(lambda (a) (format "Attach %s to outgoing message? "
(file-name-nondirectory a)))
(lambda (a)
- (mml-attach-file
- a (mm-default-file-encoding a)
+ (mml-attach-file a (mm-default-file-encoding a)
nil "attachment"))
attachments
'("file" "files" "attach"))
- ; insert text, if any
+ ;; insert text, if any
(when text
(message-goto-body)
(insert"\n")
(if (bufferp text)
(insert-buffer text)
(insert text)))
+ ;; insert org ids, if any
+ (when ids
+ (unless (listp ids)
+ (setq ids (list ids)))
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (dolist (i ids)
+ (goto-char (point-at-bol))
+ (open-line 1)
+ ;; this function hardly does anything
+ (message-insert-header
+ (intern gnorb-gnus-org-header) i)))))
; put point somewhere reasonable
- (if (or mails message)
+ (if (or mails messages)
(message-goto-body)
(message-goto-to)))
@@ -165,10 +202,11 @@ current heading."
(unless (org-back-to-heading t)
(error "Not in an org item"))
(let ((mail-stuff (gnorb-org-extract-mail-stuff))
- (attachments (gnorb-org-attachment-list)))
+ (attachments (gnorb-org-attachment-list))
+ (org-id (org-id-get-create)))
(gnorb-org-setup-message
(first mail-stuff) (second mail-stuff)
- attachments)))
+ attachments nil org-id)))
;;; Email subtree
@@ -252,6 +290,7 @@ default set of parameters."
,gnorb-org-email-subtree-parameters))))
(mail-stuff (gnorb-org-extract-mail-stuff))
(attachments (gnorb-org-attachment-list))
+ (org-id (org-id-get-create))
text)
(setq gnorb-org-window-conf (current-window-configuration))
(if (bufferp result)
@@ -259,7 +298,7 @@ default set of parameters."
(push result attachments))
(gnorb-org-setup-message
(first mail-stuff) (second mail-stuff)
- attachments text)))
+ attachments text org-id)))
(defcustom gnorb-org-capture-collect-link-p t
"Should the capture process store a link to the gnus message or
@@ -279,6 +318,8 @@ default set of parameters."
(add-hook 'org-capture-mode-hook 'gnorb-org-capture-collect-link)
+;;; Agenda/BBDB popup stuff
+
(defcustom gnorb-org-agenda-popup-bbdb nil
"Should Agenda tags search pop up a BBDB buffer with matching
records?
@@ -346,7 +387,9 @@ search."
recs gnorb-org-bbdb-popup-layout)
(when (get-buffer-window bbdb-buffer-name)
(quit-window nil
- (get-buffer-window bbdb-buffer-name)))))))
+ (get-buffer-window bbdb-buffer-name)))
+ (when (called-interactively-p)
+ (message "No relevant BBDB records"))))))
(add-hook 'org-agenda-finalize-hook 'gnorb-org-agenda-popup-bbdb)
diff --git a/lisp/gnorb-utils.el b/lisp/gnorb-utils.el
index 1f7d05f..535082f 100644
--- a/lisp/gnorb-utils.el
+++ b/lisp/gnorb-utils.el
@@ -54,5 +54,14 @@
(defvar gnorb-tmp-dir (make-temp-file "emacs-gnorb" t)
"Temporary directory where attachments etc are saved.")
+(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."
+ ;; The send hook either populates this, or sets it to nil, depending
+ ;; on whether the message in question has an Org id header. Then
+ ;; `gnorb-org-restore-after-send' checks for it and acts
+ ;; appropriately.
+)
+
(provide 'gnorb-utils)
;;; gnorb-utils.el ends here
- [elpa] externals/gnorb a083a99 114/449: First draft: BBDB field for saving links to messages, (continued)
- [elpa] externals/gnorb a083a99 114/449: First draft: BBDB field for saving links to messages, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb e33a758 127/449: Clearer docstring, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb f3f3bf2 128/449: Fix Agenda BBDB popup for searches with no tags, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 7e9235f 138/449: First highly ugly version of gnorb-gnus-view, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb a51a99d 142/449: Speedier display of messages in nnir search, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 0b7c640 074/449: Make use of the multivalued property functions, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb f3e56d2 042/449: gnorb-org-mail-todos -- new docstring and default, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 8f598e1 044/449: Delete previous commented function, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb b5d3731 046/449: What on earth was that still doing there?, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 0db3991 051/449: Move mail search backend stuff to gnorb-gnus, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 9fff78a 057/449: Changing email TODO handling to operate by org ID,
Stefan Monnier <=
- [elpa] externals/gnorb 30afb67 068/449: Various docstring and comment edits., Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 7052248 069/449: New generalized function gnorb-trigger-todo-action, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 70b5534 070/449: Make TODOs from outgoing messages, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb bda9cfe 079/449: More complete docs: How to use Gnorb for email tracking, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb c0e03b2 081/449: Actually add the sent message ID to the TODO, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 96afd01 084/449: Skip Note items when scanning state changes, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 0c247d4 085/449: Remember to put :group and :type on defcustoms, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 5876834 088/449: BBDB posting styles, first draft, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 69c3312 089/449: Refactoring of gnorb-org link scanning, Stefan Monnier, 2020/11/27
- [elpa] externals/gnorb 6a66e21 093/449: Got the arguments to org-get-heading backwards, Stefan Monnier, 2020/11/27