- ;; Delete other windows, users can restore with
- ;; `gnorb-restore-layout'.
- (delete-other-windows)
- (if id
- (gnorb-trigger-todo-action arg 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))
- (if (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)))))
- (gnorb-trigger-todo-action arg targ)
- (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"))))