Bastien <bastien.gue...@wikimedia.fr> wrote:
> Ulf Stegemann <ulf-n...@zeitform.de> writes:
>
>> If you think --despite of those issues-- it's worth adding the creation
>> of gnus links while in message mode I could provide a patch.
>
> FWIW, I think it would be useful.
>
>> I'd probably add the functionality to `org-gnus-store-link' but I'm
>> not an org code expert and a different location may be more
>> appropriate. What do you think?
>
> Such a change belongs to `org-gnus-store-link' -- I'd be glad to apply a
> patch to this effect.
Please find a patch attached. I works for me with latest Emacs, Org,
Gnus from bzr/git but with all the limitations mentioned earlier in this
thread.
The patch includes the generation of the `Message-ID' header if none is
present. It also removes the `message-deletable' property from that
header to prevent Gnus from re-generating the message id and thus
breaking the org link. This should (hopefully) work regardless of the
value of `message-generate-headers-first', `message-deletable-headers'
et al.
Ulf
--- org-gnus.el.orig 2011-02-09 10:20:37.003314968 +0100
+++ org-gnus.el 2011-02-09 14:50:55.320440970 +0100
@@ -186,7 +186,35 @@
link (org-gnus-article-link
group newsgroups message-id x-no-archive))
(org-add-link-props :link link :description desc)
- link))))
+ link))
+ ((eq major-mode 'message-mode)
+ (setq org-store-link-plist nil) ; reset
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (and (not (message-fetch-field "Message-ID"))
+ (message-generate-headers '(Message-ID)))
+ (goto-char (point-min))
+ (re-search-forward "^Message-ID: *.*$" nil t)
+ (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil)
+ (let ((gcc (car (last
+ (message-unquote-tokens
+ (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,")))))
+ (id (org-remove-angle-brackets (mail-fetch-field "Message-ID")))
+ (to (mail-fetch-field "To"))
+ (from (mail-fetch-field "From"))
+ (subject (mail-fetch-field "Subject"))
+ desc link
+ newsgroup xarchive) ; those are always nil for gcc
+ (and (not gcc)
+ (error "Can not create link: No Gcc header found."))
+ (org-store-link-props :type "gnus" :from from :subject subject
+ :message-id id :group gcc :to to)
+ (setq desc (org-email-link-description)
+ link (org-gnus-article-link
+ gcc newsgroup id xarchive))
+ (org-add-link-props :link link :description desc)
+ link))))))
(defun org-gnus-open-nntp (path)
"Follow the nntp: link specified by PATH."
_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
