1 ;;; gnorb-gnus.el --- The gnus-centric fuctions of gnorb
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
28 (require 'gnorb-utils)
30 (declare-function org-gnus-article-link "org-gnus"
31 (group newsgroups message-id x-no-archive))
32 (declare-function org-gnus-follow-link "org-gnus"
35 (defgroup gnorb-gnus nil
36 "The Gnus bits of Gnorb."
41 (defcustom gnorb-gnus-mail-search-backends
42 '((notmuch (lambda (terms)
45 (replace-regexp-in-string "\\." "\\\\." m))
48 (mairix (lambda (terms)
52 (namazu (lambda (terms)
56 "Various backends for mail search.
58 An alist of backends, where each element consists of three parts:
59 the symbol name of the backend, a lambda form which receives a
60 list of email addresses and returns a properly-formatted search
61 string, and the symbol name of the function used to initiate the
66 (defcustom gnorb-gnus-mail-search-backend nil
67 "Mail search backend currently in use. One of the three symbols
68 notmuch, namazu, or mairix."
72 (defcustom gnorb-gnus-capture-always-attach nil
73 "Always prompt about attaching attachments when capturing from
74 a Gnus message, even if the template being used hasn't
75 specified the :gnus-attachments key.
77 Basically behave as if all attachments have \":gnus-attachments t\"."
81 (defcustom gnorb-gnus-new-todo-capture-key nil
82 "Key for the capture template to use when creating a new TODO
83 from an outgoing message."
87 (defcustom gnorb-gnus-hint-relevant-article t
88 "When opening a gnus message, should gnorb let you know if the
89 message is relevant to an existing TODO?"
93 (defcustom gnorb-gnus-summary-mark-format-letter "g"
94 "Format letter to be used as part of your
95 `gnus-summary-line-format', to indicate in the *Summary* buffer
96 which articles might be relevant to TODOs. Since this is a user
97 format code, it should be prefixed with %u, eg %ug. It will
98 result in the insertion of the value of
99 `gnorb-gnus-summary-mark', for relevant messages, or
104 (defcustom gnorb-gnus-summary-mark "ยก"
105 "Default mark to insert in the summary format line of articles
106 that are likely relevant to existing TODO headings."
110 (defcustom gnorb-gnus-summary-tracked-mark "&"
111 "Default mark to insert in the summary format line of articles
112 that are already tracked by TODO headings."
116 (defcustom gnorb-gnus-trigger-refile-targets
117 '((org-agenda-files :maxlevel . 4))
118 "A value to use as an equivalent of `org-refile-targets' (which
119 see) when offering trigger targets for
120 `gnorb-gnus-incoming-do-todo'."
124 (defcustom gnorb-gnus-sent-groups nil
125 "A list of strings indicating sent mail groups.
127 In some cases, Gnorb can't detect where your sent messages are
128 stored (ie if you're using IMAP sent mail folders instead of
129 local archiving. If you want Gnorb to be able to find sent
130 messages, this option can help it do that. It should be set to a
131 list of strings, which are assumed to be fully qualified
132 server+group combinations, ie \"nnimap+Server:[Gmail]/Sent
133 Mail\", or something similar. This only has to be done once for
138 (defvar gnorb-gnus-capture-attachments nil
139 "Holding place for attachment names during the capture
142 ;;; What follows is a very careful copy-pasta of bits and pieces from
143 ;;; mm-decode.el and gnus-art.el. Voodoo was involved.
146 (defun gnorb-gnus-article-org-attach (n)
147 "Save MIME part N, which is the numerical prefix, of the
148 article under point as an attachment to the specified org
151 (gnus-article-part-wrapper n 'gnorb-gnus-attach-part))
154 (defun gnorb-gnus-mime-org-attach ()
155 "Save the MIME part under point as an attachment to the
156 specified org heading."
158 (gnus-article-check-buffer)
159 (let ((data (get-text-property (point) 'gnus-data)))
161 (gnorb-gnus-attach-part data))))
163 (defun gnorb-gnus-attach-part (handle &optional org-heading)
164 "Attach HANDLE to an existing org heading."
165 (let* ((filename (gnorb-gnus-save-part handle))
166 (org-refile-targets gnorb-gnus-trigger-refile-targets)
167 (headers (gnus-data-header
169 (gnus-summary-article-number))))
170 (tracked-headings (gnorb-find-tracked-headings headers))
172 (gnorb-choose-trigger-heading tracked-headings)))
173 (require 'org-attach)
174 (save-window-excursion
175 (org-id-goto target-heading)
176 (org-attach-attach filename nil 'mv))))
178 (defun gnorb-gnus-save-part (handle)
179 (let ((filename (or (mail-content-type-get
180 (mm-handle-disposition handle) 'filename)
181 (mail-content-type-get
182 (mm-handle-type handle) 'name))))
184 (gnus-map-function mm-file-name-rewrite-functions
185 (file-name-nondirectory filename)))
186 (setq filename (expand-file-name filename gnorb-tmp-dir))
187 (mm-save-part-to-file handle filename)
190 (defun gnorb-gnus-collect-all-attachments (&optional capture-p store)
191 "Collect all the attachments from the message under point, and
192 save them into `gnorb-tmp-dir'."
193 (save-window-excursion
195 (set-buffer (org-capture-get :original-buffer)))
196 (unless (memq major-mode '(gnus-summary-mode gnus-article-mode))
197 (error "Only works in Gnus summary or article buffers"))
198 (let ((article (gnus-summary-article-number))
200 (when (or (null gnus-current-article)
201 (null gnus-article-current)
202 (/= article (cdr gnus-article-current))
203 (not (equal (car gnus-article-current) gnus-newsgroup-name)))
204 (gnus-summary-display-article article))
205 (gnus-eval-in-buffer-window gnus-article-buffer
206 (setq mime-handles (cl-remove-if-not
208 (let ((disp (mm-handle-disposition (cdr h))))
209 (and (member (car disp)
210 '("inline" "attachment"))
211 (mail-content-type-get disp 'filename))))
212 gnus-article-mime-handle-alist)))
214 (dolist (h mime-handles)
216 (gnorb-gnus-save-part (cdr h))))
217 (when (or capture-p store)
218 (push filename gnorb-gnus-capture-attachments))))))))
220 ;;; Make the above work in the capture process
222 (defun gnorb-gnus-capture-attach ()
223 (when (and (or gnorb-gnus-capture-always-attach
224 (org-capture-get :gnus-attachments))
226 (org-capture-get :original-buffer)
227 (memq major-mode '(gnus-summary-mode gnus-article-mode))))
228 (require 'org-attach)
229 (setq gnorb-gnus-capture-attachments nil)
230 (gnorb-gnus-collect-all-attachments t)
233 (format "Attach %s to capture heading? "
234 (file-name-nondirectory a)))
235 (lambda (a) (org-attach-attach a nil 'mv))
236 gnorb-gnus-capture-attachments
237 '("file" "files" "attach"))
238 (setq gnorb-gnus-capture-attachments nil)))
240 (add-hook 'org-capture-mode-hook 'gnorb-gnus-capture-attach)
242 (defvar org-note-abort)
244 (defun gnorb-gnus-capture-abort-cleanup ()
245 (with-no-warnings ; For `org-note-abort'
246 (when (and org-note-abort
247 (or gnorb-gnus-capture-always-attach
248 (org-capture-get :gnus-attachments)))
249 (condition-case error
250 (progn (org-attach-delete-all)
251 (setq abort-note 'clean)
252 ;; remove any gnorb-mail-header values here
255 (setq abort-note 'dirty))))))
257 (add-hook 'org-capture-prepare-finalize-hook
258 'gnorb-gnus-capture-abort-cleanup)
260 ;;; Storing, removing, and acting on Org headers in messages.
262 (defvar gnorb-gnus-message-info nil
263 "Place to store the To, Subject, Date, and Message-ID headers
264 of the currently-sending or last-sent message.")
266 (defun gnorb-gnus-check-outgoing-headers ()
267 "Save the value of the `gnorb-mail-header' for the current
268 message; multiple header values returned as a string. Also save
269 information about the outgoing message into
270 `gnorb-gnus-message-info'."
272 (message-narrow-to-headers)
273 (setq gnorb-gnus-message-info nil)
274 (let* ((org-ids (mail-fetch-field gnorb-mail-header nil nil t))
275 (msg-id (mail-fetch-field "Message-ID"))
276 (refs (mail-fetch-field "References"))
277 (in-reply-to (mail-fetch-field "In-Reply-To"))
278 (to (if (message-news-p)
279 (mail-fetch-field "Newsgroups")
280 (mail-fetch-field "To")))
281 (from (mail-fetch-field "From"))
282 (subject (mail-fetch-field "Subject"))
283 (date (mail-fetch-field "Date"))
284 ;; If we can get a link, that's awesome.
285 (gcc (mail-fetch-field "Gcc"))
287 (org-store-link nil))
289 (group (ignore-errors (car (split-string link "#")))))
290 ;; If we can't make a real link, then save some information so
293 (setq refs (concat refs " " in-reply-to)))
295 (setq refs (gnus-extract-references refs)))
296 (setq gnorb-gnus-message-info
297 `(:subject ,subject :msg-id ,msg-id
299 :link ,link :date ,date :refs ,refs
304 (setq gnorb-message-org-ids org-ids)
305 ;; `gnorb-org-setup-message' may have put this here, but
306 ;; if we're working from a draft, or triggering this from
307 ;; a reply, it might not be there yet.
308 (add-to-list 'message-send-actions
309 'gnorb-org-restore-after-send t))
310 (setq gnorb-message-org-ids nil)))))
312 (add-hook 'message-sent-hook 'gnorb-gnus-check-outgoing-headers t)
315 (defun gnorb-gnus-outgoing-do-todo (&optional arg)
316 "Use this command to use the message currently being composed
317 as an email todo action.
319 If it's a new message, or a reply to a message that isn't
320 referenced by any TODOs, a new TODO will be created.
322 If it references an existing TODO, you'll be prompted to trigger
323 a state-change or a note on that TODO after the message is sent.
325 You can call it with a prefix arg to force choosing an Org
326 subtree to associate with.
328 If you've already called this command, but realize you made a
329 mistake, you can call this command with a double prefix to reset
332 If a new todo is made, it needs a capture template: set
333 `gnorb-gnus-new-todo-capture-key' to the string key for the
334 appropriate capture template. If you're using a gnus-based
335 archive method (ie you have `gnus-message-archive-group' set to
336 something, and your outgoing messages have a \"Fcc\" header),
337 then a real link will be made to the outgoing message, and all
338 the gnus-type escapes will be available (see the Info
339 manual (org) Template expansion section). If you don't, then the
340 %:subject, %:to, %:toname, %:toaddress, and %:date escapes for
341 the outgoing message will still be available -- nothing else will
344 (let ((org-refile-targets gnorb-gnus-trigger-refile-targets)
345 (compose-marker (make-marker))
346 header-ids ref-ids rel-headings
347 gnorb-window-conf in-reply-to)
348 (when (equal arg '(4))
350 (org-refile-get-location "Trigger action on" nil t))
352 (list (list (save-window-excursion
353 (find-file (nth 1 rel-headings))
354 (goto-char (nth 3 rel-headings))
355 (org-id-get-create))))))
356 (if (not (eq major-mode 'message-mode))
357 ;; The message is already sent, so we're relying on whatever was
358 ;; stored into `gnorb-gnus-message-info'.
359 (if (equal arg '(16))
360 (user-error "A double prefix is only useful with an
364 (push (car rel-headings) gnorb-message-org-ids)
365 (gnorb-org-restore-after-send))
366 (setq ref-ids (plist-get gnorb-gnus-message-info :refs))
368 ;; the message might be relevant to some TODO
369 ;; heading(s). But if there had been org-id
370 ;; headers, they would already have been
371 ;; handled when the message was sent.
373 (setq rel-headings (gnorb-find-visit-candidates ref-ids))
374 (if (not rel-headings)
375 (gnorb-gnus-outgoing-make-todo-1)
376 (dolist (h rel-headings)
377 (push h gnorb-message-org-ids))
378 (gnorb-org-restore-after-send)))
379 ;; not relevant, just make a new TODO
380 (gnorb-gnus-outgoing-make-todo-1))))
381 ;; We are still in the message composition buffer, so let's see
384 (if (equal arg '(16))
385 ;; Double prefix arg means delete the association we already
390 (setq message-send-actions
391 (remove 'gnorb-gnus-outgoing-make-todo-1
392 message-send-actions))
393 (message-narrow-to-headers-or-head)
394 (message-remove-header
396 (message "Message associations have been reset")))
397 ;; Save-excursion won't work, because point will move if we
399 (move-marker compose-marker (point))
402 (message-narrow-to-headers-or-head)
403 (setq header-ids (mail-fetch-field gnorb-mail-header nil nil t))
404 ;; With a prefix arg we do not check references, because the
405 ;; whole point is to add new references. We still want to know
406 ;; what org id headers are present, though, so we don't add
408 (setq ref-ids (unless arg (mail-fetch-field "References" t)))
409 (setq in-reply-to (unless arg (mail-fetch-field "In-Reply-to" t)))
411 (setq ref-ids (concat ref-ids " " in-reply-to)))
413 ;; if the References header points to any message ids that are
414 ;; tracked by TODO headings...
415 (setq rel-headings (gnorb-find-visit-candidates ref-ids)))
417 (goto-char (point-min))
418 (dolist (h (delete-dups rel-headings))
419 ;; then get the org-ids of those headings, and insert
420 ;; them into this message as headers. If the id was
421 ;; already present in a header, don't add it again.
422 (unless (member h header-ids)
423 (goto-char (point-at-bol))
425 (message-insert-header
426 (intern gnorb-mail-header)
428 ;; tell the rest of the function that this is a relevant
430 (push h header-ids)))))
431 (goto-char compose-marker)
433 (add-to-list 'message-send-actions
434 'gnorb-gnus-outgoing-make-todo-1 t))
437 "Message will trigger TODO state-changes after sending"
438 "A TODO will be made from this message after it's sent"))))))
440 (defvar org-capture-link-is-already-stored)
442 (defun gnorb-gnus-outgoing-make-todo-1 ()
443 (unless gnorb-gnus-new-todo-capture-key
444 (error "No capture template key set, customize gnorb-gnus-new-todo-capture-key"))
445 (let* ((link (plist-get gnorb-gnus-message-info :link))
446 (group (plist-get gnorb-gnus-message-info :group))
447 (date (plist-get gnorb-gnus-message-info :date))
451 (org-time-stamp-format t)
452 (date-to-time date)))))
453 (date-ts-ia (and date
456 (org-time-stamp-format t t)
457 (date-to-time date)))))
458 (msg-id (plist-get gnorb-gnus-message-info :msg-id))
459 (sender (plist-get gnorb-gnus-message-info :from))
460 (subject (plist-get gnorb-gnus-message-info :subject))
461 ;; Convince Org we already have a link stored, even if we
463 (org-capture-link-is-already-stored t))
465 ;; Even if you make a link to not-yet-sent messages, even if
466 ;; you've saved the draft and it has a Date header, that
467 ;; header isn't saved into the link plist. So fake that, too.
470 :date-timestamp date-ts
471 :date-timestamp-inactive date-ts-ia
473 (org-store-link-props
474 :subject (plist-get gnorb-gnus-message-info :subject)
475 :to (plist-get gnorb-gnus-message-info :to)
477 :date-timestamp date-ts
478 :date-timestamp-inactive date-ts-ia
481 (org-capture nil gnorb-gnus-new-todo-capture-key)
483 (org-entry-put (point) gnorb-org-msg-id-key msg-id)
484 (gnorb-registry-make-entry msg-id sender subject (org-id-get-create) group))))
486 ;;; If an incoming message should trigger state-change for a Org todo,
487 ;;; call this function on it.
490 (defun gnorb-gnus-incoming-do-todo (arg &optional id)
491 "Call this function from a received gnus message to store a
492 link to the message, prompt for a related Org heading, visit the
493 heading, and trigger an action on it \(see
494 `gnorb-org-trigger-actions'\).
496 If you've set up message tracking \(with
497 `gnorb-tracking-initialize'\), Gnorb can guess which Org heading
498 you probably want to trigger, which can save some time. It does
499 this by looking in the References header, and seeing if any of
500 the messages referenced there are already being tracked by any
503 If you mark several messages before calling this function, or
504 call it with a numerical prefix arg, those messages will be
505 \"bulk associated\" with the chosen Org heading: associations
506 will be made, but you won't be prompted to trigger an action, and
507 you'll stay in the Gnus summary buffer."
509 (when (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
510 (user-error "Only works in gnus summary or article mode"))
511 ;; We should only store a link if it's not already at the head of
512 ;; `org-stored-links'. There's some duplicate storage, at
513 ;; present. Take a look at calling it non-interactively.
514 (setq gnorb-window-conf (current-window-configuration))
515 (move-marker gnorb-return-marker (point))
516 (setq gnorb-gnus-message-info nil)
517 (let* ((articles (gnus-summary-work-articles arg))
518 (art-no (gnus-summary-article-number))
519 (headers (gnus-data-header
520 (gnus-data-find art-no)))
521 (msg-id (mail-header-id headers))
522 (from (mail-header-from headers))
523 (subject (mail-header-subject headers))
524 (date (mail-header-date headers))
525 (to (cdr (assoc 'To (mail-header-extra headers))))
526 (group (gnorb-get-real-group-name
529 (link (call-interactively 'org-store-link))
530 (org-refile-targets gnorb-gnus-trigger-refile-targets)
531 (ref-msg-ids (concat (mail-header-references headers) " "
534 (when (and (null id) ref-msg-ids)
535 ;; Specifically ask for zombies, so the user has chance to
537 (gnorb-find-tracked-headings headers t)))
539 (setq gnorb-gnus-message-info
540 `(:subject ,subject :msg-id ,msg-id
542 :link ,link :date ,date :refs ,ref-msg-ids
544 (gnorb-gnus-collect-all-attachments nil t)
548 (delete-other-windows)
549 (gnorb-trigger-todo-action nil id))
550 ;; Flush out zombies (dead associations).
551 (setq related-headings
554 (when (null (org-id-find-id-file h))
557 "ID %s no longer exists, disassociate message?"
559 (gnorb-delete-association msg-id h))))
561 ;; See if one of the related headings is chosen.
562 (unless (catch 'target
563 (dolist (h related-headings nil)
565 (format "Trigger action on %s"
566 (gnorb-pretty-outline h)))
567 (throw 'target (setq targ h)))))
568 ;; If not, use the refile interface to choose one.
569 (setq targ (org-refile-get-location
570 "Trigger heading" nil t))
572 (save-window-excursion
573 (find-file (nth 1 targ))
574 (goto-char (nth 3 targ))
575 (org-id-get-create))))
576 ;; Either bulk associate multiple messages...
577 (if (> (length articles) 1)
580 (gnorb-registry-make-entry
584 from subject targ group)
585 (gnus-summary-remove-process-mark a))
586 (message "Associated %d messages with %s"
587 (length articles) (gnorb-pretty-outline targ)))
588 ;; ...or just trigger the one.
589 (delete-other-windows)
590 (gnorb-trigger-todo-action nil targ)))
592 ;; If these are left populated after an error, it plays hell
593 ;; with future trigger processes.
594 (setq gnorb-gnus-message-info nil)
595 (setq gnorb-gnus-capture-attachments nil)
596 (signal (car err) (cdr err))))))
599 (defun gnorb-gnus-quick-reply ()
600 "Compose a reply to the message under point, and associate both
601 the original message and the reply with the selected heading.
602 Take no other action.
604 Use this when you want to compose a reply to a message on the
605 spot, and track both messages, without having to go through the
606 hassle of triggering an action on a heading, and then starting a
609 (when (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
610 (user-error "Only works in gnus summary or article mode"))
611 (let* ((art-no (gnus-summary-article-number))
612 (headers (gnus-data-header
613 (gnus-data-find art-no)))
614 (msg-id (mail-header-id headers))
615 (from (mail-header-from headers))
616 (subject (mail-header-subject headers))
617 (group (gnorb-get-real-group-name
620 (ref-msg-ids (concat (mail-header-references headers) " "
624 (gnorb-find-tracked-headings headers t)))
625 (targ (car-safe related-headings)))
627 (let ((ret (make-marker)))
628 (setq gnorb-window-conf (current-window-configuration))
629 (move-marker gnorb-return-marker (point))
630 ;; Assume the first heading is the one we want.
631 (gnorb-registry-make-entry
632 msg-id from subject targ group)
633 (gnus-summary-wide-reply-with-original 1)
634 (move-marker ret (point))
637 (message-narrow-to-headers-or-head)
638 (goto-char (point-min))
640 (message-insert-header
641 (intern gnorb-mail-header) targ))
644 (format "Original message and reply will be associated with %s"
645 (gnorb-pretty-outline targ))))
646 (message "No associated headings found"))))
649 (defun gnorb-gnus-search-messages (str persist &optional head-text ret)
650 "Initiate a search for gnus message links in an org subtree.
651 The arg STR can be one of two things: an Org heading id value
652 \(IDs should be prefixed with \"id+\"\), in which case links will
653 be collected from that heading, or a string corresponding to an
654 Org tags search, in which case links will be collected from all
657 In either case, once a collection of links have been made, they
658 will all be displayed in an ephemeral group on the \"nngnorb\"
659 server. There must be an active \"nngnorb\" server for this to
664 (or (gnus-method-to-server '(nngnorb))
666 "Please add a \"nngnorb\" backend to your gnus installation.")))
668 (when (version= "5.13" gnus-version-number)
669 (with-no-warnings ; All these variables are available.
670 (setq nnir-current-query nil
671 nnir-current-server nil
672 nnir-current-group-marked nil
674 ;; In 24.4, the group name is mostly decorative, but in 24.3, the
675 ;; actual query is held there.
676 (setq name (if (version= "5.13" gnus-version-number)
677 (concat "nnir:" (prin1-to-string `((query ,str))))
680 (format "Name for group (default %s): " head-text)
682 (concat "gnorb-" str))))
683 (setq method (if (version= "5.13" gnus-version-number)
684 (list 'nnir nnir-address)
685 (list 'nnir "Gnorb")))
688 (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str)))
689 (cons 'nnir-group-spec `((,nnir-address nil)))))
690 (cons 'nnir-artlist nil)))
693 (switch-to-buffer gnus-group-buffer)
694 (gnus-group-make-group name method nil spec)
695 (gnus-group-select-group))
696 (gnus-group-read-ephemeral-group name method nil ret nil nil spec))))
698 (defun gnorb-gnus-summary-mode-hook ()
699 "Check if we've entered a Gnorb-generated group, and activate
700 `gnorb-summary-minor-mode', if so."
701 (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
702 (when (string-match-p "Gnorb" (cadr method))
703 (gnorb-summary-minor-mode))))
705 (add-hook 'gnus-summary-mode-hook #'gnorb-gnus-summary-mode-hook)
707 ;;; Automatic noticing of relevant messages
709 ;; likely hooks for the summary buffer include:
710 ;; `gnus-parse-headers-hook'
712 ;; BBDB puts its notice stuff in the `gnus-article-prepare-hook',
713 ;; which seems as good a spot as any.
715 (defun gnorb-gnus-hint-relevant-message ()
716 "When opening an article buffer, check the message to see if it
717 is relevant to any existing TODO headings. If so, flash a message
718 to that effect. This function is added to the
719 `gnus-article-prepare-hook'. It will only do anything if the
720 option `gnorb-gnus-hint-relevant-article' is non-nil."
721 (when (and gnorb-gnus-hint-relevant-article
722 (not (memq (car (gnus-find-method-for-group
723 gnus-newsgroup-name))
728 (gnus-summary-article-number))))
730 (gnus-registry-get-id-key
731 (gnus-fetch-original-field "message-id") 'gnorb-ids))
732 (tracked-headings (gnorb-find-tracked-headings headers))
734 (where-is-internal 'gnorb-gnus-incoming-do-todo
737 (message "Message is associated with %s"
738 (gnorb-pretty-outline (car assoc-heading) t)))
740 (message "Possible relevant todo %s, trigger with %s"
741 (gnorb-pretty-outline (car tracked-headings) t)
743 (key-description key)
744 "M-x gnorb-gnus-incoming-do-todo")))
747 (add-hook 'gnus-article-prepare-hook 'gnorb-gnus-hint-relevant-message)
749 (defun gnorb-gnus-insert-format-letter-maybe (header)
750 (if (not (memq (car (gnus-find-method-for-group
751 gnus-newsgroup-name))
753 (cond ((gnus-registry-get-id-key
754 (mail-header-message-id header) 'gnorb-ids)
755 gnorb-gnus-summary-tracked-mark)
756 ((gnorb-find-tracked-headings header)
757 gnorb-gnus-summary-mark)
761 (fset (intern (concat "gnus-user-format-function-"
762 gnorb-gnus-summary-mark-format-letter))
764 (gnorb-gnus-insert-format-letter-maybe header)))
767 (defun gnorb-gnus-view ()
768 "Display the first relevant TODO heading for the message under point"
770 (let* ((headers (gnus-data-header
772 (gnus-summary-article-number))))
774 (gnorb-find-tracked-headings headers)))
775 (when tracked-headings
776 (setq gnorb-window-conf (current-window-configuration))
777 (move-marker gnorb-return-marker (point))
778 (delete-other-windows)
779 (org-id-goto (car tracked-headings)))))
781 (provide 'gnorb-gnus)
782 ;;; gnorb-gnus.el ends here