Merge from emacs-24; up to 2012-12-11T09:51:12Z!dmantipov@yandex.ru
[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
ab422c4d 3;; Copyright (C) 2004-2013 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
20908596
CD
8;;
9;; This file is part of GNU Emacs.
10;;
b1fc2b50 11;; GNU Emacs is free software: you can redistribute it and/or modify
20908596 12;; it under the terms of the GNU General Public License as published by
b1fc2b50
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
20908596
CD
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
b1fc2b50 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
20908596
CD
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24;;
25;;; Commentary:
26
27;; This file implements links to MH-E messages from within Org-mode.
28;; Org-mode loads this module by default - if this is not what you want,
29;; configure the variable `org-modules'.
30
31;;; Code:
32
33(require 'org)
34
35;; Customization variables
36
37(defcustom org-mhe-search-all-folders nil
38 "Non-nil means the search for the mh-message may extend to all folders.
39When non-nil, the search for a message will extend to all other
40folders if it cannot be found in the folder given in the link.
41Searching all folders may be slow with the default pick based
42search but is very efficient with one of the other search engines
43supported by MH-E."
44 :group 'org-link-follow
45 :type 'boolean)
46
47;; Declare external functions and variables
48(declare-function mh-display-msg "mh-show" (msg-num folder-name))
49(declare-function mh-find-path "mh-utils" ())
50(declare-function mh-get-header-field "mh-utils" (field))
51(declare-function mh-get-msg-num "mh-utils" (error-if-no-message))
52(declare-function mh-header-display "mh-show" ())
53(declare-function mh-index-previous-folder "mh-search" ())
54(declare-function mh-normalize-folder-name "mh-utils"
55 (folder &optional empty-string-okay dont-remove-trailing-slash
56 return-nil-if-folder-empty))
57(declare-function mh-search "mh-search"
58 (folder search-regexp &optional redo-search-flag
59 window-config))
60(declare-function mh-search-choose "mh-search" (&optional searcher))
61(declare-function mh-show "mh-show" (&optional message redisplay-flag))
62(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer))
63(declare-function mh-show-header-display "mh-show" t t)
64(declare-function mh-show-msg "mh-show" (msg))
65(declare-function mh-show-show "mh-show" t t)
66(declare-function mh-visit-folder "mh-folder" (folder &optional
67 range index-data))
68(defvar mh-progs)
69(defvar mh-current-folder)
70(defvar mh-show-folder-buffer)
71(defvar mh-index-folder)
72(defvar mh-searcher)
b349f79f 73(defvar mh-search-regexp-builder)
20908596
CD
74
75;; Install the link type
76(org-add-link-type "mhe" 'org-mhe-open)
77(add-hook 'org-store-link-functions 'org-mhe-store-link)
78
79;; Implementation
80(defun org-mhe-store-link ()
81 "Store a link to an MH-E folder or message."
82 (when (or (equal major-mode 'mh-folder-mode)
83 (equal major-mode 'mh-show-mode))
3ab2c837
BG
84 (save-window-excursion
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)
96 (org-store-link-props :type "mh" :from from :to to
97 :subject subject :message-id message-id)
98 (when date
99 (org-add-link-props :date date :date-timestamp date-ts
100 :date-timestamp-inactive date-ts-ia))
101 (setq desc (org-email-link-description))
8223b1d2
BG
102 (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#"
103 (org-remove-angle-brackets message-id)))
3ab2c837
BG
104 (org-add-link-props :link link :description desc)
105 link))))
20908596
CD
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))
8223b1d2
BG
182 (with-current-buffer buffer
183 (mh-display-msg num folder)
184 (if (equal major-mode 'mh-folder-mode)
185 (mh-header-display)
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)
190 (mh-show)
191 (mh-show-show))
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
227;;; org-mhe.el ends here