tec/org-mode
tec/org-mode
1
0
Fork 0
forked from mirrors/org-mode
Code Pull requests Releases Activity

org-gnus.el: Allow org-link creation from message-mode.

Browse source 
* org-gnus.el (org-gnus-store-link): Allow org-link creation from
message-mode.
This commit is contained in:
Ulf Stegemann 2011-02-09 16:54:36 +01:00 committed by Bastien Guerry
parent ce217d153a
commit c56d295b9b
1 changed files with 29 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lisp/org-gnus.el
View file

@ -186,7 +186,35 @@ If `org-store-link' was called with a prefix arg the meaning of
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."