diff options
Diffstat (limited to 'lisp/org/org-gnus.el')
| -rw-r--r-- | lisp/org/org-gnus.el | 49 |
1 files changed, 20 insertions, 29 deletions
diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index dbc4ee7db4c..5c5bc6c07d4 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -7,7 +7,7 @@ ;; Tassilo Horn <tassilo at member dot fsf dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.29c +;; Version: 6.30c ;; ;; This file is part of GNU Emacs. ;; @@ -51,8 +51,7 @@ negates this setting for the duration of the command." :type 'boolean) ;; Declare external functions and variables -(declare-function gnus-article-show-summary "gnus-art" ()) -(declare-function gnus-summary-last-subject "gnus-sum" ()) +(declare-function gnus-summary-article-header "gnus-sum" (&optional number)) (declare-function message-fetch-field "message" (header &optional not-all)) (declare-function message-narrow-to-head-1 "message" nil) @@ -123,37 +122,29 @@ If `org-store-link' was called with a prefix arg the meaning of link))) ((memq major-mode '(gnus-summary-mode gnus-article-mode)) - (and (eq major-mode 'gnus-summary-mode) (gnus-summary-show-article)) (let* ((group gnus-newsgroup-name) - (header (with-current-buffer gnus-article-buffer - (gnus-summary-toggle-header 1) - (goto-char (point-min)) - ;; mbox files may contain a first line starting with - ;; "From" followed by a space, which cannot be parsed as - ;; header line, so we skip it. - (when (looking-at "From ") - (beginning-of-line 2)) - (mail-header-extract-no-properties))) - (from (mail-header 'from header)) - (message-id (org-remove-angle-brackets - (mail-header 'message-id header))) - (date (mail-header 'date header)) - (to (mail-header 'to header)) - (newsgroups (mail-header 'newsgroups header)) - (x-no-archive (mail-header 'x-no-archive header)) - (subject (if (eq major-mode 'gnus-article-mode) - (save-restriction - (require 'message) - (message-narrow-to-head-1) - (message-fetch-field "subject")) - (gnus-summary-subject-string))) - desc link) + (header (with-current-buffer gnus-summary-buffer + (gnus-summary-article-header))) + (from (mail-header-from header)) + (message-id (org-remove-angle-brackets (mail-header-id header))) + (date (mail-header-date header)) + (subject (mail-header-subject header)) + (to (cdr (assq 'To (mail-header-extra header)))) + newsgroups x-no-archive desc link) + ;; Fetching an article is an expensive operation; newsgroup and + ;; x-no-archive are only needed for web links. + (when (org-xor current-prefix-arg org-gnus-prefer-web-links) + ;; Make sure the original article buffer is up-to-date + (save-window-excursion (gnus-summary-select-article)) + (setq to (or to (gnus-fetch-original-field "To")) + newsgroups (gnus-fetch-original-field "Newsgroups") + x-no-archive (gnus-fetch-original-field "x-no-archive"))) (org-store-link-props :type "gnus" :from from :subject subject :message-id message-id :group group :to to) (setq desc (org-email-link-description) - link (org-gnus-article-link group newsgroups message-id x-no-archive)) + link (org-gnus-article-link + group newsgroups message-id x-no-archive)) (org-add-link-props :link link :description desc) - (gnus-summary-toggle-header -1) link)))) (defun org-gnus-open (path) |