Commit | Line | Data |
---|---|---|
c8d0cf5c | 1 | ;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode |
eb3a8c91 | 2 | |
114f9c96 | 3 | ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. |
eb3a8c91 GM |
4 | |
5 | ;; Author: John Wiegley <johnw@gnu.org> | |
c8d0cf5c CD |
6 | ;; Christopher Suckling <suckling at gmail dot com> |
7 | ||
5dec9555 | 8 | ;; Version: 6.33x |
0fc0f178 | 9 | ;; Keywords: outlines, hypermedia, calendar, wp |
eb3a8c91 | 10 | |
0fc0f178 | 11 | ;; This file is part of GNU Emacs. |
eb3a8c91 | 12 | |
b1fc2b50 | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
0fc0f178 | 14 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
0fc0f178 CD |
17 | |
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
eb3a8c91 | 25 | |
20908596 | 26 | ;;; Commentary: |
c8d0cf5c | 27 | ;; This file implements links to Apple Mail.app messages from within Org-mode. |
20908596 CD |
28 | ;; Org-mode does not load this module by default - if you would actually like |
29 | ;; this to happen then configure the variable `org-modules'. | |
30 | ||
c8d0cf5c CD |
31 | ;; If you would like to create links to all flagged messages in an |
32 | ;; Apple Mail.app account, please customize the variable | |
33 | ;; `org-mac-mail-account' and then call one of the following functions: | |
34 | ||
35 | ;; (org-mac-message-insert-selected) copies a formatted list of links to | |
36 | ;; the kill ring. | |
37 | ||
38 | ;; (org-mac-message-insert-selected) inserts at point links to any | |
39 | ;; messages selected in Mail.app. | |
40 | ||
41 | ;; (org-mac-message-insert-flagged) searches within an org-mode buffer | |
42 | ;; for a specific heading, creating it if it doesn't exist. Any | |
43 | ;; message:// links within the first level of the heading are deleted | |
44 | ;; and replaced with links to flagged messages. | |
45 | ||
eb3a8c91 | 46 | ;;; Code: |
0fc0f178 CD |
47 | |
48 | (require 'org) | |
49 | ||
c8d0cf5c CD |
50 | (defgroup org-mac-flagged-mail nil |
51 | "Options concerning linking to flagged Mail.app messages" | |
52 | :tag "Org Mail.app" | |
53 | :group 'org-link) | |
54 | ||
55 | (defcustom org-mac-mail-account "customize" | |
56 | "The Mail.app account in which to search for flagged messages" | |
57 | :group 'org-mac-flagged-mail | |
58 | :type 'string) | |
59 | ||
0fc0f178 CD |
60 | (org-add-link-type "message" 'org-mac-message-open) |
61 | ||
46a44648 | 62 | ;; In mac.c, removed in Emacs 23. |
79e43d6e | 63 | (declare-function do-applescript "org-mac-message" (script)) |
0fc0f178 CD |
64 | (unless (fboundp 'do-applescript) |
65 | ;; Need to fake this using shell-command-to-string | |
66 | (defun do-applescript (script) | |
67 | (let (start cmd return) | |
68 | (while (string-match "\n" script) | |
69 | (setq script (replace-match "\r" t t script))) | |
70 | (while (string-match "'" script start) | |
71 | (setq start (+ 2 (match-beginning 0)) | |
72 | script (replace-match "\\'" t t script))) | |
73 | (setq cmd (concat "osascript -e '" script "'")) | |
74 | (setq return (shell-command-to-string cmd)) | |
75 | (concat "\"" (org-trim return) "\"")))) | |
76 | ||
77 | (defun org-mac-message-open (message-id) | |
20908596 CD |
78 | "Visit the message with the given MESSAGE-ID. |
79 | This will use the command `open' with the message URL." | |
0fc0f178 CD |
80 | (start-process (concat "open message:" message-id) nil |
81 | "open" (concat "message://<" (substring message-id 2) ">"))) | |
82 | ||
c8d0cf5c CD |
83 | (defun as-get-selected-mail () |
84 | "AppleScript to create links to selected messages in Mail.app" | |
85 | (do-applescript | |
86 | (concat | |
87 | "tell application \"Mail\"\n" | |
88 | "set theLinkList to {}\n" | |
89 | "set theSelection to selection\n" | |
90 | "repeat with theMessage in theSelection\n" | |
91 | "set theID to message id of theMessage\n" | |
92 | "set theSubject to subject of theMessage\n" | |
93 | "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" | |
94 | "copy theLink to end of theLinkList\n" | |
95 | "end repeat\n" | |
96 | "return theLinkList as string\n" | |
97 | "end tell"))) | |
98 | ||
99 | (defun as-get-flagged-mail () | |
100 | "AppleScript to create links to flagged messages in Mail.app" | |
101 | (do-applescript | |
102 | (concat | |
103 | ;; Is Growl installed? | |
104 | "tell application \"System Events\"\n" | |
105 | "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n" | |
106 | "if (count of growlHelpers) > 0 then\n" | |
107 | "set growlHelperApp to item 1 of growlHelpers\n" | |
108 | "else\n" | |
109 | "set growlHelperApp to \"\"\n" | |
110 | "end if\n" | |
111 | "end tell\n" | |
112 | ||
113 | ;; Get links | |
114 | "tell application \"Mail\"\n" | |
115 | "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n" | |
116 | "set theLinkList to {}\n" | |
117 | "repeat with aMailbox in theMailboxes\n" | |
118 | "set theSelection to (every message in aMailbox whose flagged status = true)\n" | |
119 | "repeat with theMessage in theSelection\n" | |
120 | "set theID to message id of theMessage\n" | |
121 | "set theSubject to subject of theMessage\n" | |
122 | "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" | |
123 | "copy theLink to end of theLinkList\n" | |
124 | ||
125 | ;; Report progress through Growl | |
126 | ;; This "double tell" idiom is described in detail at | |
127 | ;; http://macscripter.net/viewtopic.php?id=24570 The | |
128 | ;; script compiler needs static knowledge of the | |
129 | ;; growlHelperApp. Hmm, since we're compiling | |
130 | ;; on-the-fly here, this is likely to be way less | |
131 | ;; portable than I'd hoped. It'll work when the name | |
132 | ;; is still "GrowlHelperApp", though. | |
133 | "if growlHelperApp is not \"\" then\n" | |
134 | "tell application \"GrowlHelperApp\"\n" | |
135 | "tell application growlHelperApp\n" | |
136 | "set the allNotificationsList to {\"FlaggedMail\"}\n" | |
137 | "set the enabledNotificationsList to allNotificationsList\n" | |
138 | "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n" | |
139 | "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n" | |
140 | "end tell\n" | |
141 | "end tell\n" | |
142 | "end if\n" | |
143 | "end repeat\n" | |
144 | "end repeat\n" | |
145 | "return theLinkList as string\n" | |
146 | "end tell"))) | |
147 | ||
148 | (defun org-mac-message-get-links (&optional select-or-flag) | |
149 | "Create links to the messages currently selected or flagged in Mail.app. | |
150 | This will use AppleScript to get the message-id and the subject of the | |
151 | messages in Mail.app and make a link out of it. | |
152 | When SELECT-OR-FLAG is \"s\", get the selected messages (this is also | |
153 | the default). When SELECT-OR-FLAG is \"f\", get the flagged messages. | |
154 | The Org-syntax text will be pushed to the kill ring, and also returned." | |
155 | (interactive "sLink to (s)elected or (f)lagged messages: ") | |
156 | (setq select-or-flag (or select-or-flag "s")) | |
157 | (message "AppleScript: searching mailboxes...") | |
158 | (let* ((as-link-list | |
159 | (if (string= select-or-flag "s") | |
160 | (as-get-selected-mail) | |
161 | (if (string= select-or-flag "f") | |
162 | (as-get-flagged-mail) | |
163 | (error "Please select \"s\" or \"f\"")))) | |
164 | (link-list | |
165 | (mapcar | |
166 | (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x) | |
167 | (split-string as-link-list "[\r\n]+"))) | |
168 | split-link URL description orglink orglink-insert rtn orglink-list) | |
169 | (while link-list | |
170 | (setq split-link (split-string (pop link-list) "::split::")) | |
171 | (setq URL (car split-link)) | |
172 | (setq description (cadr split-link)) | |
173 | (when (not (string= URL "")) | |
174 | (setq orglink (org-make-link-string URL description)) | |
175 | (push orglink orglink-list))) | |
176 | (setq rtn (mapconcat 'identity orglink-list "\n")) | |
177 | (kill-new rtn) | |
178 | rtn)) | |
179 | ||
180 | (defun org-mac-message-insert-selected () | |
181 | "Insert a link to the messages currently selected in Mail.app. | |
0fc0f178 | 182 | This will use applescript to get the message-id and the subject of the |
c8d0cf5c | 183 | active mail in Mail.app and make a link out of it." |
0fc0f178 | 184 | (interactive) |
c8d0cf5c CD |
185 | (insert (org-mac-message-get-links "s"))) |
186 | ||
187 | ;; The following line is for backward compatibility | |
188 | (defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected) | |
189 | ||
190 | (defun org-mac-message-insert-flagged (org-buffer org-heading) | |
191 | "Asks for an org buffer and a heading within it, and replace message links. | |
192 | If heading exists, delete all message:// links within heading's first | |
193 | level. If heading doesn't exist, create it at point-max. Insert | |
194 | list of message:// links to flagged mail after heading." | |
195 | (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ") | |
81ad75af | 196 | (with-current-buffer org-buffer |
c8d0cf5c CD |
197 | (goto-char (point-min)) |
198 | (let ((isearch-forward t) | |
199 | (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]")) | |
200 | (if (org-goto-local-search-headings org-heading nil t) | |
201 | (if (not (eobp)) | |
202 | (progn | |
203 | (save-excursion | |
204 | (while (re-search-forward | |
205 | message-re (save-excursion (outline-next-heading)) t) | |
206 | (delete-region (match-beginning 0) (match-end 0))) | |
207 | (insert "\n" (org-mac-message-get-links "f"))) | |
208 | (flush-lines "^$" (point) (outline-next-heading))) | |
209 | (insert "\n" (org-mac-message-get-links "f"))) | |
210 | (goto-char (point-max)) | |
211 | (insert "\n") | |
212 | (org-insert-heading) | |
213 | (insert org-heading "\n" (org-mac-message-get-links "f")))))) | |
0fc0f178 CD |
214 | |
215 | (provide 'org-mac-message) | |
216 | ||
b7b8d8ed | 217 | ;; arch-tag: 3806d0c1-abe1-4db6-9c31-f3ed7d4a9b32 |
b349f79f | 218 | |
0fc0f178 | 219 | ;;; org-mac-message.el ends here |