;;; Code:
+(require 'gnus)
(require 'gnorb-utils)
(declare-function org-gnus-article-link "org-gnus"
:group 'gnorb-gnus
:type 'string)
+(defcustom gnorb-gnus-summary-tracked-mark "&"
+ "Default mark to insert in the summary format line of articles
+ that are already tracked by TODO headings."
+ :group 'gnorb-gnus
+ :type 'string)
+
(defcustom gnorb-gnus-trigger-refile-targets
'((org-agenda-files :maxlevel . 4))
"A value to use as an equivalent of `org-refile-targets' (which
"Attach HANDLE to an existing org heading."
(let* ((filename (gnorb-gnus-save-part handle))
(org-refile-targets gnorb-gnus-trigger-refile-targets)
- (ref-msg-ids
- (concat (gnus-fetch-original-field "references") " "
- (gnus-fetch-original-field "in-reply-to")))
- (rel-heading
- (when gnorb-tracking-enabled
- (car (gnorb-find-visit-candidates
- ref-msg-ids))))
- (org-heading
- (if (and rel-heading
- (y-or-n-p (message
- "Attach part to %s"
- (gnorb-pretty-outline rel-heading))))
- rel-heading
- (org-refile-get-location "Attach part to" nil t))))
+ (headers (gnus-data-header
+ (gnus-data-find
+ (gnus-summary-article-number))))
+ (tracked-headings (gnorb-find-tracked-headings headers))
+ (target-heading
+ (gnorb-choose-trigger-heading tracked-headings)))
(require 'org-attach)
(save-window-excursion
- (if (stringp org-heading)
- (org-id-goto org-heading)
- (progn
- (find-file (nth 1 org-heading))
- (goto-char (nth 3 org-heading))))
+ (org-id-goto target-heading)
(org-attach-attach filename nil 'mv))))
(defun gnorb-gnus-save-part (handle)
(set-buffer (org-capture-get :original-buffer)))
(unless (memq major-mode '(gnus-summary-mode gnus-article-mode))
(error "Only works in Gnus summary or article buffers"))
- (let ((article (gnus-summary-article-number))
+ (let ((article (gnus-summary-article-number))
mime-handles)
(when (or (null gnus-current-article)
(null gnus-article-current)
(add-hook 'org-capture-mode-hook 'gnorb-gnus-capture-attach)
+(defvar org-note-abort)
+
(defun gnorb-gnus-capture-abort-cleanup ()
- (when (and org-note-abort
- (org-capture-get :gnus-attachments))
- ;; FIXME: Yuck: setting `abort-note' will fail as soon as org-capture.el is
- ;; compiled with lexical-binding!
- (condition-case nil
- (progn (org-attach-delete-all)
- (setq abort-note 'clean)
- ;; remove any gnorb-mail-header values here
- )
- (error
- (setq abort-note 'dirty)))))
+ (with-no-warnings ; For `org-note-abort'
+ (when (and org-note-abort
+ (or gnorb-gnus-capture-always-attach
+ (org-capture-get :gnus-attachments)))
+ (condition-case error
+ (progn (org-attach-delete-all)
+ (setq abort-note 'clean)
+ ;; remove any gnorb-mail-header values here
+ )
+ (error
+ (setq abort-note 'dirty))))))
(add-hook 'org-capture-prepare-finalize-hook
'gnorb-gnus-capture-abort-cleanup)
;; `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)
- "Call this function to use the message currently being composed
-as an email todo action. If it's a new message, or a reply to a
-message that isn't referenced by any TODOs, a new TODO will be
-created. If it references an existing TODO, you'll be prompted to
-trigger a state-change or a note on that TODO.
+ "Use this command to use the message currently being composed
+as an email todo action.
-Otherwise, you can call it with a prefix arg to associate the
-sending/sent message with an existing Org subtree, and trigger an
-action on that subtree.
+If it's a new message, or a reply to a message that isn't
+referenced by any TODOs, a new TODO will be created.
+
+If it references an existing TODO, you'll be prompted to trigger
+a state-change or a note on that TODO after the message is sent.
+
+You can call it with a prefix arg to force choosing an Org
+subtree to associate with.
+
+If you've already called this command, but realize you made a
+mistake, you can call this command with a double prefix to reset
+the association.
If a new todo is made, it needs a capture template: set
`gnorb-gnus-new-todo-capture-key' to the string key for the
(interactive "P")
(let ((org-refile-targets gnorb-gnus-trigger-refile-targets)
(compose-marker (make-marker))
- header-ids ref-ids rel-headings gnorb-window-conf
- reply-id reply-group in-reply-to)
- (when arg
+ header-ids ref-ids rel-headings
+ gnorb-window-conf in-reply-to)
+ (when (equal arg '(4))
(setq rel-headings
(org-refile-get-location "Trigger action on" nil t))
(setq rel-headings
(if (not (eq major-mode 'message-mode))
;; The message is already sent, so we're relying on whatever was
;; stored into `gnorb-gnus-message-info'.
- (if arg
- (progn
- (push (car rel-headings) gnorb-message-org-ids)
- (gnorb-org-restore-after-send))
- (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.
+ (if (equal arg '(16))
+ (user-error "A double prefix is only useful with an
+ unsent message.")
+ (if arg
(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)))
+ (push (car rel-headings) gnorb-message-org-ids)
+ (gnorb-org-restore-after-send))
+ (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
+ (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
;; what we've got.
- ;; What we want is a link to the original message we're replying
- ;; to, if this is actually a reply.
- (when message-reply-headers
- (setq reply-id (aref message-reply-headers 4)))
- ;; Save-excursion won't work, because point will move if we
- ;; insert headings.
- (move-marker compose-marker (point))
- (save-restriction
- (widen)
- (message-narrow-to-headers-or-head)
- (setq header-ids (mail-fetch-field gnorb-mail-header nil nil t))
- ;; With a prefix arg we do not check references, because the
- ;; whole point is to add new references. We still want to know
- ;; 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.
- ;; This is pretty embarrassing -- we follow a link just to
- ;; create a link. But I'm not going to recreate all of
- ;; `org-store-link' by hand.
- (when (and reply-group reply-id)
- (save-window-excursion
- (org-gnus-follow-link reply-group reply-id)
- (call-interactively 'org-store-link)))
- (when ref-ids
- ;; if the References header points to any message ids that are
- ;; tracked by TODO headings...
- (setq rel-headings (gnorb-find-visit-candidates ref-ids)))
- (when rel-headings
- (goto-char (point-min))
- (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 h header-ids)
- (goto-char (point-at-bol))
- (open-line 1)
- (message-insert-header
- (intern gnorb-mail-header)
- h)
- ;; tell the rest of the function that this is a relevant
- ;; 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)
- (message
- (if header-ids
- "Message will trigger TODO state-changes after sending"
- "A TODO will be made from this message after it's sent")))))
+ (if (equal arg '(16))
+ ;; Double prefix arg means delete the association we already
+ ;; made.
+ (save-excursion
+ (save-restriction
+ (widen)
+ (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)
+ (message "Message associations have been reset")))
+ ;; Save-excursion won't work, because point will move if we
+ ;; insert headings.
+ (move-marker compose-marker (point))
+ (save-restriction
+ (widen)
+ (message-narrow-to-headers-or-head)
+ (setq header-ids (mail-fetch-field gnorb-mail-header nil nil t))
+ ;; With a prefix arg we do not check references, because the
+ ;; whole point is to add new references. We still want to know
+ ;; 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)))
+ (when ref-ids
+ ;; if the References header points to any message ids that are
+ ;; tracked by TODO headings...
+ (setq rel-headings (gnorb-find-visit-candidates ref-ids)))
+ (when rel-headings
+ (goto-char (point-min))
+ (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 h header-ids)
+ (goto-char (point-at-bol))
+ (open-line 1)
+ (message-insert-header
+ (intern gnorb-mail-header)
+ h)
+ ;; tell the rest of the function that this is a relevant
+ ;; message
+ (push h header-ids)))))
+ (goto-char compose-marker)
+ (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"
+ "A TODO will be made from this message after it's sent"))))))
(defvar org-capture-link-is-already-stored)
;;; call this function on it.
;;;###autoload
-(defun gnorb-gnus-incoming-do-todo (arg headers &optional id)
+(defun gnorb-gnus-incoming-do-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.
-Set `gnorb-trigger-todo-default' to 'note or 'todo (you can
-get the non-default behavior by calling this function with a
-prefix argument), or to 'prompt to always be prompted.
-
-In some cases, Gnorb can guess for you which Org heading you
-probably want to trigger, which can save some time. It does this
-by looking in the References header, and seeing if any of the IDs
-there match the value of the `gnorb-org-msg-id-key' property for
-any headings. In order for this to work, you will have to have
-loaded org-id, and have the variable `org-id-track-globally' set
-to t (it is, by default)."
- (interactive (gnus-interactive "P\nH"))
+heading, and trigger an action on it \(see
+`gnorb-org-trigger-actions'\).
+
+If you've set up message tracking \(with
+`gnorb-tracking-initialize'\), Gnorb can guess which Org heading
+you probably want to trigger, which can save some time. It does
+this by looking in the References header, and seeing if any of
+the messages referenced there are already being tracked by any
+headings.
+
+If you mark several messages before calling this function, or
+call it with a numerical prefix arg, those messages will be
+\"bulk associated\" with the chosen Org heading: associations
+will be made, but you won't be prompted to trigger an action, and
+you'll stay in the Gnus summary buffer."
+ (interactive "P")
(when (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
(user-error "Only works in gnus summary or article mode"))
;; We should only store a link if it's not already at the head of
(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))
+ (let* ((articles (gnus-summary-work-articles arg))
+ (art-no (gnus-summary-article-number))
+ (headers (gnus-data-header
+ (gnus-data-find art-no)))
+ (msg-id (mail-header-id 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)
+ (group (gnorb-get-real-group-name
+ gnus-newsgroup-name
+ art-no))
(link (call-interactively 'org-store-link))
(org-refile-targets gnorb-gnus-trigger-refile-targets)
- (ref-msg-ids (mail-header-references headers))
- (offer-heading
- (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-find-visit-candidates
- ref-msg-ids))
- (message "Gnorb can't check for relevant headings unless `org-id-track-globally' is t")
- (sit-for 1))))
+ (ref-msg-ids (concat (mail-header-references headers) " "
+ msg-id))
+ (related-headings
+ (when (and (null id) ref-msg-ids)
+ ;; Specifically ask for zombies, so the user has chance to
+ ;; flush them out.
+ (gnorb-find-tracked-headings headers t)))
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))
+ `(: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)
- (if (and offer-heading
- (y-or-n-p (format "Trigger action on %s"
- (gnorb-pretty-outline offer-heading))))
- (gnorb-trigger-todo-action arg 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)))))
+ (condition-case err
+ (if id
+ (progn
+ (delete-other-windows)
+ (gnorb-trigger-todo-action nil id))
+ ;; Flush out zombies (dead associations).
+ (setq related-headings
+ (cl-remove-if
+ (lambda (h)
+ (when (null (org-id-find-id-file h))
+ (when (y-or-n-p
+ (format
+ "ID %s no longer exists, disassociate message?"
+ h))
+ (gnorb-delete-association msg-id h))))
+ related-headings))
+ ;; See if one of the related headings is chosen.
+ (unless (catch 'target
+ (dolist (h related-headings nil)
+ (when (yes-or-no-p
+ (format "Trigger action on %s"
+ (gnorb-pretty-outline h)))
+ (throw 'target (setq targ h)))))
+ ;; If not, use the refile interface to choose one.
+ (setq targ (org-refile-get-location
+ "Trigger heading" nil t))
+ (setq targ
+ (save-window-excursion
+ (find-file (nth 1 targ))
+ (goto-char (nth 3 targ))
+ (org-id-get-create))))
+ ;; Either bulk associate multiple messages...
+ (if (> (length articles) 1)
+ (progn
+ (dolist (a articles)
+ (gnorb-registry-make-entry
+ (mail-header-id
+ (gnus-data-header
+ (gnus-data-find a)))
+ from subject targ group)
+ (gnus-summary-remove-process-mark a))
+ (message "Associated %d messages with %s"
+ (length articles) (gnorb-pretty-outline targ)))
+ ;; ...or just trigger the one.
+ (delete-other-windows)
+ (gnorb-trigger-todo-action nil targ)))
+ (error
+ ;; If these are left populated after an error, it plays hell
+ ;; with future trigger processes.
+ (setq gnorb-gnus-message-info nil)
+ (setq gnorb-gnus-capture-attachments nil)
+ (signal (car err) (cdr err))))))
+
+;;;###autoload
+(defun gnorb-gnus-quick-reply ()
+ "Compose a reply to the message under point, and associate both
+the original message and the reply with the selected heading.
+Take no other action.
+
+Use this when you want to compose a reply to a message on the
+spot, and track both messages, without having to go through the
+hassle of triggering an action on a heading, and then starting a
+reply."
+ (interactive)
+ (when (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
+ (user-error "Only works in gnus summary or article mode"))
+ (let* ((art-no (gnus-summary-article-number))
+ (headers (gnus-data-header
+ (gnus-data-find art-no)))
+ (msg-id (mail-header-id headers))
+ (from (mail-header-from headers))
+ (subject (mail-header-subject headers))
+ (group (gnorb-get-real-group-name
+ gnus-newsgroup-name
+ art-no))
+ (ref-msg-ids (concat (mail-header-references headers) " "
+ msg-id))
+ (related-headings
+ (when ref-msg-ids
+ (gnorb-find-tracked-headings headers t)))
+ (targ (car-safe related-headings)))
+ (if targ
+ (let ((ret (make-marker)))
+ ;; Assume the first heading is the one we want.
+ (gnorb-registry-make-entry
+ msg-id from subject targ group)
+ (gnus-summary-wide-reply-with-original 1)
+ (move-marker ret (point))
+ (save-restriction
+ (widen)
+ (message-narrow-to-headers-or-head)
+ (goto-char (point-min))
+ (open-line 1)
+ (message-insert-header
+ (intern gnorb-mail-header) targ))
+ (goto-char ret)
+ (message
+ (format "Original message and reply will be associated with %s"
+ (gnorb-pretty-outline targ))))
+ (message "No associated headings found"))))
;;;###autoload
-(defun gnorb-gnus-search-messages (str &optional ret)
+(defun gnorb-gnus-search-messages (str persist &optional head-text ret)
"Initiate a search for gnus message links in an org subtree.
The arg STR can be one of two things: an Org heading id value
\(IDs should be prefixed with \"id+\"\), in which case links will
server. There must be an active \"nngnorb\" server for this to
work."
(interactive)
+ (require 'nnir)
(let ((nnir-address
(or (gnus-method-to-server '(nngnorb))
(user-error
- "Please add a \"nngnorb\" backend to your gnus installation."))))
+ "Please add a \"nngnorb\" backend to your gnus installation.")))
+ name method spec)
(when (version= "5.13" gnus-version-number)
- (setq nnir-current-query nil
- nnir-current-server nil
- nnir-current-group-marked nil
- nnir-artlist nil))
- (gnus-group-read-ephemeral-group
- ;; in 24.4, the group name is mostly decorative. in 24.3, the
- ;; query itself is read from there. It should look like (concat
- ;; "nnir:" (prin1-to-string '((query str))))
- (if (version= "5.13" gnus-version-number)
- (concat "nnir:" (prin1-to-string `((query ,str))))
- (concat "gnorb-" str))
- (if (version= "5.13" gnus-version-number)
- (list 'nnir nnir-address)
- (list 'nnir "nnir"))
- nil
- ret ;; it's possible you can't just put an arbitrary form in
- ;; here, which sucks.
- nil nil
- ;; the following seems to simply be ignored under gnus 5.13
- (list (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str)))
+ (with-no-warnings ; All these variables are available.
+ (setq nnir-current-query nil
+ nnir-current-server nil
+ nnir-current-group-marked nil
+ nnir-artlist nil)))
+ ;; In 24.4, the group name is mostly decorative, but in 24.3, the
+ ;; actual query is held there.
+ (setq name (if (version= "5.13" gnus-version-number)
+ (concat "nnir:" (prin1-to-string `((query ,str))))
+ (if persist
+ (read-string
+ (format "Name for group (default %s): " head-text)
+ nil head-text t)
+ (concat "gnorb-" str))))
+ (setq method (if (version= "5.13" gnus-version-number)
+ (list 'nnir nnir-address)
+ (list 'nnir "Gnorb")))
+ (setq spec
+ (list
+ (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str)))
(cons 'nnir-group-spec `((,nnir-address nil)))))
(cons 'nnir-artlist nil)))
- (gnorb-summary-minor-mode)))
+ (if persist
+ (progn
+ (switch-to-buffer gnus-group-buffer)
+ (gnus-group-make-group name method nil spec)
+ (gnus-group-select-group))
+ (gnus-group-read-ephemeral-group name method nil ret nil nil spec))))
+
+(defun gnorb-gnus-summary-mode-hook ()
+ "Check if we've entered a Gnorb-generated group, and activate
+ `gnorb-summary-minor-mode', if so."
+ (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
+ (when (string-match-p "Gnorb" (cadr method))
+ (gnorb-summary-minor-mode))))
+
+(add-hook 'gnus-summary-mode-hook #'gnorb-gnus-summary-mode-hook)
;;; Automatic noticing of relevant messages
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-tracking-enabled
- gnorb-gnus-hint-relevant-article
+ (when (and gnorb-gnus-hint-relevant-article
(not (memq (car (gnus-find-method-for-group
gnus-newsgroup-name))
'(nnvirtual nnir))))
- (let* ((ref-ids (concat
- (gnus-fetch-original-field "references") " "
- (gnus-fetch-original-field "in-reply-to")))
- (msg-id (gnus-fetch-original-field "message-id"))
+ (let* ((headers
+ (gnus-data-header
+ (gnus-data-find
+ (gnus-summary-article-number))))
(assoc-heading
- (gnus-registry-get-id-key msg-id 'gnorb-ids))
+ (gnus-registry-get-id-key
+ (gnus-fetch-original-field "message-id") 'gnorb-ids))
+ (tracked-headings (gnorb-find-tracked-headings headers))
(key
(where-is-internal 'gnorb-gnus-incoming-do-todo
- nil t))
- rel-headings)
+ nil t)))
(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"))))))))
+ (tracked-headings
+ (message "Possible relevant todo %s, trigger with %s"
+ (gnorb-pretty-outline (car tracked-headings) t)
+ (if key
+ (key-description key)
+ "M-x gnorb-gnus-incoming-do-todo")))
+ (t nil)))))
(add-hook 'gnus-article-prepare-hook 'gnorb-gnus-hint-relevant-message)
(defun gnorb-gnus-insert-format-letter-maybe (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
- " "))
- " "))
+ (if (not (memq (car (gnus-find-method-for-group
+ gnus-newsgroup-name))
+ '(nnvirtual nnir)))
+ (cond ((gnus-registry-get-id-key
+ (mail-header-message-id header) 'gnorb-ids)
+ gnorb-gnus-summary-tracked-mark)
+ ((gnorb-find-tracked-headings header)
+ gnorb-gnus-summary-mark)
+ (t " "))
+ " "))
(fset (intern (concat "gnus-user-format-function-"
gnorb-gnus-summary-mark-format-letter))
;;;###autoload
(defun gnorb-gnus-view ()
"Display the first relevant TODO heading for the message under point"
- ;; this is pretty barebones, need to make sure we have a valid
- ;; article buffer to access, and think about what to do for
- ;; window-configuration!
-
- ;; boy is this broken now.
(interactive)
- (let ((refs (gnus-fetch-original-field "references"))
- rel-headings)
- (when refs
- (setq rel-headings (gnorb-find-visit-candidates refs))
+ (let* ((headers (gnus-data-header
+ (gnus-data-find
+ (gnus-summary-article-number))))
+ (tracked-headings
+ (gnorb-find-tracked-headings headers)))
+ (when tracked-headings
+ (setq gnorb-window-conf (current-window-configuration))
+ (move-marker gnorb-return-marker (point))
(delete-other-windows)
- (org-id-goto (car rel-headings)))))
+ (org-id-goto (car tracked-headings)))))
(provide 'gnorb-gnus)
;;; gnorb-gnus.el ends here