summaryrefslogtreecommitdiff
path: root/lisp/org-gnus.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
committerS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
commit1a7cd65ca362047cd97d4127d49108994baebc6c (patch)
treef18735f3b77120ef2e91043f2f662b03e47ccbb0 /lisp/org-gnus.el
parent55074078ca876273e3fa58ee6838cba90d2b6100 (diff)
parentec84430cf4e09ba25ec675debdf802bc28111e06 (diff)
Merge tag 'upstream/9.0'
Upstream version 9.0
Diffstat (limited to 'lisp/org-gnus.el')
-rw-r--r--lisp/org-gnus.el55
1 files changed, 23 insertions, 32 deletions
diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el
index a574c0f..a0de1c1 100644
--- a/lisp/org-gnus.el
+++ b/lisp/org-gnus.el
@@ -1,4 +1,4 @@
-;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode
+;;; org-gnus.el --- Support for Links to Gnus Groups and Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
@@ -25,8 +25,8 @@
;;
;;; Commentary:
-;; This file implements links to Gnus groups and messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to Gnus groups and messages from within Org.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
@@ -39,18 +39,17 @@
(declare-function message-fetch-field "message" (header &optional not-all))
(declare-function message-narrow-to-head-1 "message" nil)
-(declare-function nnimap-group-overview-filename "nnimap" (group server))
(declare-function gnus-summary-last-subject "gnus-sum" nil)
(declare-function nnvirtual-map-article "nnvirtual" (article))
;; Customization variables
-(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)
+(defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)
(defcustom org-gnus-prefer-web-links nil
"If non-nil, `org-store-link' creates web links to Google groups or Gmane.
-When nil, Gnus will be used for such links.
-Using a prefix arg to the command \\[org-store-link] (`org-store-link')
+\\<org-mode-map>When nil, Gnus will be used for such links.
+Using a prefix argument to the command `\\[org-store-link]' (`org-store-link')
negates this setting for the duration of the command."
:group 'org-link-store
:type 'boolean)
@@ -75,8 +74,7 @@ this variable to t."
:type 'boolean)
;; Install the link type
-(org-add-link-type "gnus" 'org-gnus-open)
-(add-hook 'org-store-link-functions 'org-gnus-store-link)
+(org-link-set-parameters "gnus" :follow #'org-gnus-open :store #'org-gnus-store-link)
;; Implementation
@@ -85,8 +83,12 @@ this variable to t."
MESSAGE-ID is the message-id header field that identifies the
message. If the uid is not cached, return nil."
(with-temp-buffer
- (let ((nov (nnimap-group-overview-filename group server)))
- (when (file-exists-p nov)
+ (let ((nov (and (fboundp 'nnimap-group-overview-filename)
+ ;; nnimap-group-overview-filename was removed from
+ ;; Gnus in September 2010, and therefore should
+ ;; only be present in Emacs 23.1.
+ (nnimap-group-overview-filename group server))))
+ (when (and nov (file-exists-p nov))
(mm-insert-file-contents nov)
(set-buffer-modified-p nil)
(goto-char (point-min))
@@ -105,7 +107,7 @@ Otherwise create a link to the group inside Gnus.
If `org-store-link' was called with a prefix arg the meaning of
`org-gnus-prefer-web-links' is reversed."
(let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" group)))
- (if (and (string-match "^nntp" group) ;; Only for nntp groups
+ (if (and (string-prefix-p "nntp" group) ;; Only for nntp groups
(org-xor current-prefix-arg
org-gnus-prefer-web-links))
(concat (if (string-match "gmane" unprefixed-group)
@@ -157,25 +159,17 @@ If `org-store-link' was called with a prefix arg the meaning of
(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)))
+ (message-id (org-unbracket-string "<" ">" (mail-header-id header)))
(date (org-trim (mail-header-date header)))
- (date-ts (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t)
- (date-to-time date)))))
- (date-ts-ia (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date)))))
(subject (copy-sequence (mail-header-subject header)))
(to (cdr (assq 'To (mail-header-extra header))))
newsgroups x-no-archive desc link)
- (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name))
- 'nnvirtual)
- (setq group (car (nnvirtual-map-article
- (gnus-summary-article-number)))))
+ (cl-case (car (gnus-find-method-for-group gnus-newsgroup-name))
+ (nnvirtual
+ (setq group (car (nnvirtual-map-article
+ (gnus-summary-article-number)))))
+ (nnir
+ (setq group (nnir-article-group (gnus-summary-article-number)))))
;; Remove text properties of subject string to avoid Emacs bug
;; #3506
(set-text-properties 0 (length subject) nil subject)
@@ -188,11 +182,8 @@ If `org-store-link' was called with a prefix arg the meaning of
(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
+ (org-store-link-props :type "gnus" :from from :date date :subject subject
:message-id message-id :group group :to to)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
(setq desc (org-email-link-description)
link (org-gnus-article-link
group newsgroups message-id x-no-archive))
@@ -211,7 +202,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(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")))
+ (id (org-unbracket-string "<" ">" (mail-fetch-field "Message-ID")))
(to (mail-fetch-field "To"))
(from (mail-fetch-field "From"))
(subject (mail-fetch-field "Subject"))