Refill some long/short copyright headers.
[bpt/emacs.git] / lisp / org / org-mhe.el
CommitLineData
20908596
CD
1;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode
2
95df8112 3;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
20908596
CD
4
5;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
6;; Keywords: outlines, hypermedia, calendar, wp
7;; Homepage: http://orgmode.org
acedf35c 8;; Version: 7.4
20908596
CD
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 MH-E 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
36;; Customization variables
37
38(defcustom org-mhe-search-all-folders nil
39 "Non-nil means the search for the mh-message may extend to all folders.
40When non-nil, the search for a message will extend to all other
41folders if it cannot be found in the folder given in the link.
42Searching all folders may be slow with the default pick based
43search but is very efficient with one of the other search engines
44supported by MH-E."
45 :group 'org-link-follow
46 :type 'boolean)
47
48;; Declare external functions and variables
49(declare-function mh-display-msg "mh-show" (msg-num folder-name))
50(declare-function mh-find-path "mh-utils" ())
51(declare-function mh-get-header-field "mh-utils" (field))
52(declare-function mh-get-msg-num "mh-utils" (error-if-no-message))
53(declare-function mh-header-display "mh-show" ())
54(declare-function mh-index-previous-folder "mh-search" ())
55(declare-function mh-normalize-folder-name "mh-utils"
56 (folder &optional empty-string-okay dont-remove-trailing-slash
57 return-nil-if-folder-empty))
58(declare-function mh-search "mh-search"
59 (folder search-regexp &optional redo-search-flag
60 window-config))
61(declare-function mh-search-choose "mh-search" (&optional searcher))
62(declare-function mh-show "mh-show" (&optional message redisplay-flag))
63(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer))
64(declare-function mh-show-header-display "mh-show" t t)
65(declare-function mh-show-msg "mh-show" (msg))
66(declare-function mh-show-show "mh-show" t t)
67(declare-function mh-visit-folder "mh-folder" (folder &optional
68 range index-data))
69(defvar mh-progs)
70(defvar mh-current-folder)
71(defvar mh-show-folder-buffer)
72(defvar mh-index-folder)
73(defvar mh-searcher)
b349f79f 74(defvar mh-search-regexp-builder)
20908596
CD
75
76;; Install the link type
77(org-add-link-type "mhe" 'org-mhe-open)
78(add-hook 'org-store-link-functions 'org-mhe-store-link)
79
80;; Implementation
81(defun org-mhe-store-link ()
82 "Store a link to an MH-E folder or message."
83 (when (or (equal major-mode 'mh-folder-mode)
84 (equal major-mode 'mh-show-mode))
afe98dfa
CD
85 (let* ((from (org-mhe-get-header "From:"))
86 (to (org-mhe-get-header "To:"))
87 (message-id (org-mhe-get-header "Message-Id:"))
88 (subject (org-mhe-get-header "Subject:"))
89 (date (org-mhe-get-header "Date:"))
90 (date-ts (and date (format-time-string
91 (org-time-stamp-format t) (date-to-time date))))
92 (date-ts-ia (and date (format-time-string
93 (org-time-stamp-format t t)
94 (date-to-time date))))
95 link desc)
20908596
CD
96 (org-store-link-props :type "mh" :from from :to to
97 :subject subject :message-id message-id)
afe98dfa
CD
98 (when date
99 (org-add-link-props :date date :date-timestamp date-ts
100 :date-timestamp-inactive date-ts-ia))
20908596
CD
101 (setq desc (org-email-link-description))
102 (setq link (org-make-link "mhe:" (org-mhe-get-message-real-folder) "#"
103 (org-remove-angle-brackets message-id)))
104 (org-add-link-props :link link :description desc)
105 link)))
106
107(defun org-mhe-open (path)
108 "Follow an MH-E message link specified by PATH."
109 (let (folder article)
110 (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
111 (error "Error in MH-E link"))
112 (setq folder (match-string 1 path)
113 article (match-string 3 path))
114 (org-mhe-follow-link folder article)))
115
116;;; mh-e integration based on planner-mode
117(defun org-mhe-get-message-real-folder ()
118 "Return the name of the real folder for the current message.
119So if you use sequences, it will now work."
120 (save-excursion
121 (let* ((folder
33306645
CD
122 (if (equal major-mode 'mh-folder-mode)
123 mh-current-folder
124 ;; Refer to the show buffer
125 mh-show-folder-buffer))
126 (end-index
127 (if (boundp 'mh-index-folder)
128 (min (length mh-index-folder) (length folder))))
129 )
20908596
CD
130 ;; a simple test on mh-index-data does not work, because
131 ;; mh-index-data is always nil in a show buffer.
132 (if (and (boundp 'mh-index-folder)
33306645
CD
133 (string= mh-index-folder (substring folder 0 end-index)))
134 (if (equal major-mode 'mh-show-mode)
135 (save-window-excursion
20908596
CD
136 (let (pop-up-frames)
137 (when (buffer-live-p (get-buffer folder))
138 (progn
139 (pop-to-buffer folder)
140 (org-mhe-get-message-folder-from-index)
141 )
142 )))
33306645
CD
143 (org-mhe-get-message-folder-from-index)
144 )
145 folder
146 )
20908596
CD
147 )))
148
149(defun org-mhe-get-message-folder-from-index ()
b349f79f 150 "Return the name of the message folder in an index folder buffer."
20908596
CD
151 (save-excursion
152 (mh-index-previous-folder)
b349f79f
CD
153 (if (re-search-forward "^\\(+.*\\)$" nil t)
154 (message "%s" (match-string 1)))))
20908596
CD
155
156(defun org-mhe-get-message-folder ()
157 "Return the name of the current message folder.
158Be careful if you use sequences."
159 (save-excursion
160 (if (equal major-mode 'mh-folder-mode)
33306645 161 mh-current-folder
20908596
CD
162 ;; Refer to the show buffer
163 mh-show-folder-buffer)))
164
165(defun org-mhe-get-message-num ()
166 "Return the number of the current message.
167Be careful if you use sequences."
168 (save-excursion
169 (if (equal major-mode 'mh-folder-mode)
33306645 170 (mh-get-msg-num nil)
20908596
CD
171 ;; Refer to the show buffer
172 (mh-show-buffer-message-number))))
173
174(defun org-mhe-get-header (header)
175 "Return the field for HEADER of the message in folder mode.
176This will create a show buffer for the corresponding message. If
177you have a better idea of how to do this then please let us know."
178 (let* ((folder (org-mhe-get-message-folder))
33306645
CD
179 (num (org-mhe-get-message-num))
180 (buffer (get-buffer-create (concat "show-" folder)))
181 (header-field))
20908596
CD
182 (with-current-buffer buffer
183 (mh-display-msg num folder)
184 (if (equal major-mode 'mh-folder-mode)
33306645 185 (mh-header-display)
20908596
CD
186 (mh-show-header-display))
187 (set-buffer buffer)
188 (setq header-field (mh-get-header-field header))
189 (if (equal major-mode 'mh-folder-mode)
33306645 190 (mh-show)
20908596 191 (mh-show-show))
afe98dfa 192 (org-trim header-field))))
20908596
CD
193
194(defun org-mhe-follow-link (folder article)
195 "Follow an MH-E link to FOLDER and ARTICLE.
196If ARTICLE is nil FOLDER is shown. If the configuration variable
197`org-mhe-search-all-folders' is t and `mh-searcher' is pick,
198ARTICLE is searched in all folders. Indexed searches (swish++,
199namazu, and others supported by MH-E) will always search in all
200folders."
201 (require 'mh-e)
202 (require 'mh-search)
203 (require 'mh-utils)
204 (mh-find-path)
205 (if (not article)
206 (mh-visit-folder (mh-normalize-folder-name folder))
20908596
CD
207 (mh-search-choose)
208 (if (equal mh-searcher 'pick)
33306645 209 (progn
b349f79f 210 (setq article (org-add-angle-brackets article))
33306645
CD
211 (mh-search folder (list "--message-id" article))
212 (when (and org-mhe-search-all-folders
213 (not (org-mhe-get-message-real-folder)))
214 (kill-this-buffer)
215 (mh-search "+" (list "--message-id" article))))
b349f79f 216 (if mh-search-regexp-builder
33306645 217 (mh-search "+" (funcall mh-search-regexp-builder
b349f79f 218 (list (cons 'message-id article))))
33306645 219 (mh-search "+" article)))
20908596 220 (if (org-mhe-get-message-real-folder)
33306645 221 (mh-show-msg 1)
20908596
CD
222 (kill-this-buffer)
223 (error "Message not found"))))
224
225(provide 'org-mhe)
226
b349f79f 227
20908596 228;;; org-mhe.el ends here