1 ;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
6 ;; Keywords: outlines, hypermedia, calendar, wp
7 ;; Homepage: http://orgmode.org
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
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.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;; This file implements links to Wanderlust messages from within Org-mode.
31 ;; Org-mode loads this module by default - if this is not what you want,
32 ;; configure the variable `org-modules'.
39 "Options concerning the Wanderlust link."
43 (defcustom org-wl-link-to-refile-destination t
44 "Create a link to the refile destination if the message is marked as refile."
48 ;; Declare external functions and variables
49 (declare-function elmo-folder-exists-p
"ext:elmo" (folder) t
)
50 (declare-function elmo-message-entity-field
"ext:elmo-msgdb"
51 (entity field
&optional type
))
52 (declare-function elmo-message-field
"ext:elmo"
53 (folder number field
&optional type
) t
)
54 (declare-function elmo-msgdb-overview-get-entity
"ext:elmo" (&rest unknown
) t
)
55 ;; Backward compatibility to old version of wl
56 (declare-function wl
"ext:wl" () t
)
57 (declare-function wl-summary-buffer-msgdb
"ext:wl-folder" (&rest unknown
) t
)
58 (declare-function wl-folder-get-elmo-folder
"ext:wl-folder"
59 (entity &optional no-cache
))
60 (declare-function wl-summary-goto-folder-subr
"ext:wl-summary"
61 (&optional name scan-type other-window sticky interactive
63 (declare-function wl-summary-jump-to-msg-by-message-id
"ext:wl-summary"
65 (declare-function wl-summary-line-from
"ext:wl-summary" ())
66 (declare-function wl-summary-line-subject
"ext:wl-summary" ())
67 (declare-function wl-summary-message-number
"ext:wl-summary" ())
68 (declare-function wl-summary-redisplay
"ext:wl-summary" (&optional arg
))
69 (declare-function wl-summary-registered-temp-mark
"ext:wl-action" (number))
70 (declare-function wl-folder-goto-folder-subr
"ext:wl-folder"
71 (&optional folder sticky
))
72 (declare-function wl-thread-open-all
"ext:wl-thread" ())
74 (defvar wl-summary-buffer-elmo-folder
)
75 (defvar wl-summary-buffer-folder-name
)
77 ;; Install the link type
78 (org-add-link-type "wl" 'org-wl-open
)
79 (add-hook 'org-store-link-functions
'org-wl-store-link
)
82 (defun org-wl-store-link ()
83 "Store a link to a WL folder or message."
84 (when (eq major-mode
'wl-summary-mode
)
85 (let* ((msgnum (wl-summary-message-number))
86 (mark-info (wl-summary-registered-temp-mark msgnum
))
88 (if (and org-wl-link-to-refile-destination
90 (equal (nth 1 mark-info
) "o")) ; marked as refile
92 wl-summary-buffer-folder-name
))
93 (message-id (elmo-message-field wl-summary-buffer-elmo-folder
96 (if (fboundp 'elmo-message-entity
)
98 wl-summary-buffer-elmo-folder msgnum
)
99 (elmo-msgdb-overview-get-entity
100 msgnum
(wl-summary-buffer-msgdb))))
101 (from (wl-summary-line-from))
102 (to (let ((to-field (elmo-message-entity-field wl-message-entity
107 (subject (let (wl-thr-indent-string wl-parent-message-entity
)
108 (wl-summary-line-subject)))
110 (org-store-link-props :type
"wl" :from from
:to to
111 :subject subject
:message-id message-id
)
112 (setq message-id
(org-remove-angle-brackets message-id
))
113 (setq desc
(org-email-link-description))
114 (setq link
(org-make-link "wl:" folder-name
116 (org-add-link-props :link link
:description desc
)
119 (defun org-wl-open (path)
120 "Follow the WL message link specified by PATH."
122 (unless wl-init
(wl))
123 ;; XXX: The imap-uw's MH folder names start with "%#".
124 (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path
))
125 (error "Error in Wanderlust link"))
126 (let ((folder (match-string 1 path
))
127 (article (match-string 3 path
)))
128 (if (not (elmo-folder-exists-p (wl-folder-get-elmo-folder folder
)))
129 (error "No such folder: %s" folder
))
130 (let ((old-buf (current-buffer))
131 (old-point (point-marker)))
132 (wl-folder-goto-folder-subr folder
)
134 ;; XXX: `wl-folder-goto-folder-subr' moves point to the
135 ;; beginning of the current line. So, restore the point
136 ;; in the old buffer.
138 (goto-char old-point
))
140 (and (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets
142 (wl-summary-redisplay)))))
146 ;;; org-wl.el ends here