Commit | Line | Data |
---|---|---|
20908596 CD |
1 | ;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode |
2 | ||
3 | ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
6 | ;; Keywords: outlines, hypermedia, calendar, wp | |
7 | ;; Homepage: http://orgmode.org | |
8 | ;; Version: 6.02b | |
9 | ;; | |
10 | ;; This file is part of GNU Emacs. | |
11 | ;; | |
b1fc2b50 | 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
20908596 | 13 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
14 | ;; the Free Software Foundation, either version 3 of the License, or |
15 | ;; (at your option) any later version. | |
20908596 CD |
16 | |
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
20908596 CD |
24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
25 | ;; | |
26 | ;;; Commentary: | |
27 | ||
28 | ;; This file implements links to Gnus groups and messages from within Org-mode. | |
29 | ;; Org-mode loads this module by default - if this is not what you want, | |
30 | ;; configure the variable `org-modules'. | |
31 | ||
32 | ;;; Code: | |
33 | ||
34 | (require 'org) | |
35 | (eval-when-compile | |
36 | (require 'gnus-sum)) | |
37 | ||
38 | ;; Customization variables | |
39 | ||
40 | (defcustom org-usenet-links-prefer-google nil | |
41 | "Non-nil means, `org-store-link' will create web links to Google groups. | |
42 | When nil, Gnus will be used for such links. | |
43 | Using a prefix arg to the command \\[org-store-link] (`org-store-link') | |
44 | negates this setting for the duration of the command." | |
45 | :group 'org-link-store | |
46 | :type 'boolean) | |
47 | ||
48 | ;; Declare external functions and variables | |
49 | (declare-function gnus-article-show-summary "gnus-art" ()) | |
50 | (declare-function gnus-summary-last-subject "gnus-sum" ()) | |
51 | (defvar gnus-other-frame-object) | |
52 | (defvar gnus-group-name) | |
53 | (defvar gnus-article-current) | |
54 | ||
55 | ;; Install the link type | |
56 | (org-add-link-type "gnus" 'org-gnus-open) | |
57 | (add-hook 'org-store-link-functions 'org-gnus-store-link) | |
58 | ||
59 | ;; Implementation | |
60 | (defun org-gnus-store-link () | |
61 | "Store a link to a Gnus folder or message." | |
62 | (cond | |
63 | ((eq major-mode 'gnus-group-mode) | |
64 | (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus | |
65 | (gnus-group-group-name)) ; version | |
66 | ((fboundp 'gnus-group-name) | |
67 | (gnus-group-name)) | |
68 | (t "???"))) | |
69 | desc link) | |
70 | (unless group (error "Not on a group")) | |
71 | (org-store-link-props :type "gnus" :group group) | |
72 | (setq desc (concat | |
73 | (if (org-xor current-prefix-arg | |
74 | org-usenet-links-prefer-google) | |
75 | "http://groups.google.com/groups?group=" | |
76 | "gnus:") | |
77 | group) | |
78 | link (org-make-link desc)) | |
79 | (org-add-link-props :link link :description desc) | |
80 | link)) | |
81 | ||
82 | ((memq major-mode '(gnus-summary-mode gnus-article-mode)) | |
83 | (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) | |
84 | (let* ((group gnus-newsgroup-name) | |
85 | (article (gnus-summary-article-number)) | |
86 | (header (gnus-summary-article-header article)) | |
87 | (from (mail-header-from header)) | |
88 | (message-id (mail-header-id header)) | |
89 | (date (mail-header-date header)) | |
90 | (subject (gnus-summary-subject-string)) | |
91 | desc link) | |
92 | (org-store-link-props :type "gnus" :from from :subject subject | |
93 | :message-id message-id :group group) | |
94 | (setq desc (org-email-link-description)) | |
95 | (if (org-xor current-prefix-arg org-usenet-links-prefer-google) | |
96 | (setq link | |
97 | (concat | |
98 | desc "\n " | |
99 | (format "http://groups.google.com/groups?as_umsgid=%s" | |
100 | (org-fixup-message-id-for-http message-id)))) | |
101 | (setq link (org-make-link "gnus:" group | |
102 | "#" (number-to-string article)))) | |
103 | (org-add-link-props :link link :description desc) | |
104 | link)))) | |
105 | ||
106 | (defun org-gnus-open (path) | |
107 | "Follow the Gnus message or folder link specified by PATH." | |
108 | (let (group article) | |
109 | (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) | |
110 | (error "Error in Gnus link")) | |
111 | (setq group (match-string 1 path) | |
112 | article (match-string 3 path)) | |
113 | (org-gnus-follow-link group article))) | |
114 | ||
115 | (defun org-gnus-follow-link (&optional group article) | |
116 | "Follow a Gnus link to GROUP and ARTICLE." | |
117 | (require 'gnus) | |
118 | (funcall (cdr (assq 'gnus org-link-frame-setup))) | |
119 | (if gnus-other-frame-object (select-frame gnus-other-frame-object)) | |
120 | (cond ((and group article) | |
121 | (gnus-group-read-group 1 nil group) | |
122 | (gnus-summary-goto-article (string-to-number article) nil t)) | |
123 | (group (gnus-group-jump-to-group group)))) | |
124 | ||
125 | (provide 'org-gnus) | |
126 | ||
88ac7b50 | 127 | ;; arch-tag: 512e0840-58fa-45b3-b456-71e10fa2376d |
20908596 | 128 | ;;; org-gnus.el ends here |