lisp/org-mac-message.el

   1 ;;; org-mac-message.el --- Support for links to Apple Mail messages from within Org-mode
   2
   3 ;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley <johnw@gnu.org>
   6 ;;         Christopher Suckling <suckling at gmail dot com>
   7
   8 ;; Version: 6.25b
   9 ;; Keywords: outlines, hypermedia, calendar, wp
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  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
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27 ;; This file implements links to Apple Mail messages from within Org-mode.
  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
  31 ;; If you would like to create links to all flagged messages in an
  32 ;; Apple Mail account, please customize the variable
  33 ;; org-mac-mail-account and then call one of the following functions:
  34
  35 ;; (org-mac-create-flagged-mail) copies a formatted list of links to
  36 ;; the kill ring.
  37
  38 ;; (org-mac-insert-flagged-mail) searches within an org-mode buffer
  39 ;; for a specific heading, creating it if it doesn't exist. Any
  40 ;; message:// links within the first level of the heading are deleted
  41 ;; and replaced with links to flagged messages.
  42
  43 ;; If you have Growl installed and would like more visual feedback
  44 ;; whilst AppleScript searches for messages, please uncomment lines
  45 ;; 125 to 130.
  46
  47 ;;; Code:
  48
  49 (require 'org)
  50
  51 (defgroup org-mac-flagged-mail nil
  52   "Options concerning linking to flagged Mail.app messages"
  53   :tag "Org Mail.app"
  54   :group 'org-link)
  55
  56 (defcustom org-mac-mail-account "customize"
  57   "The Mail.app account in which to search for flagged messages"
  58   :group 'org-mac-flagged-mail
  59   :type 'string)
  60
  61 (org-add-link-type "message" 'org-mac-message-open)
  62
  63 ;; In mac.c, removed in Emacs 23.
  64 (declare-function do-applescript "org-mac-message" (script))
  65 (unless (fboundp 'do-applescript)
  66   ;; Need to fake this using shell-command-to-string
  67   (defun do-applescript (script)
  68     (let (start cmd return)
  69       (while (string-match "\n" script)
  70         (setq script (replace-match "\r" t t script)))
  71       (while (string-match "'" script start)
  72         (setq start (+ 2 (match-beginning 0))
  73               script (replace-match "\\'" t t script)))
  74       (setq cmd (concat "osascript -e '" script "'"))
  75       (setq return (shell-command-to-string cmd))
  76       (concat "\"" (org-trim return) "\""))))
  77
  78 (defun org-mac-message-open (message-id)
  79   "Visit the message with the given MESSAGE-ID.
  80 This will use the command `open' with the message URL."
  81   (start-process (concat "open message:" message-id) nil
  82                  "open" (concat "message://<" (substring message-id 2) ">")))
  83
  84 (defun org-mac-message-insert-link ()
  85   "Insert a link to the messages currently selected in Apple Mail.
  86 This will use applescript to get the message-id and the subject of the
  87 active mail in AppleMail and make a link out of it."
  88   (interactive)
  89   (org-mac-message-get-link)
  90   (yank))
  91
  92 (defun org-mac-message-get-link ()
  93   "Insert a link to the messages currently selected in Apple Mail.
  94 This will use applescript to get the message-id and the subject of the
  95 active mail in AppleMail and make a link out of it."
  96   (let* ((as-link-list
  97           (do-applescript
  98            (concat
  99             "tell application \"Mail\"\n"
 100             "set theLinkList to {}\n"
 101             "set theSelection to selection\n"
 102             "repeat with theMessage in theSelection\n"
 103             "set theID to message id of theMessage\n"
 104             "set theSubject to subject of theMessage\n"
 105             "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
 106             "copy theLink to end of theLinkList\n"
 107             "end repeat\n"
 108             "return theLinkList as string\n"
 109             "end tell")))
 110          (link-list
 111           (mapcar
 112            (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
 113            (split-string as-link-list "[\r\n]+")))
 114          split-link
 115          URL
 116          description
 117          orglink
 118          orglink-insert
 119          (orglink-list nil))
 120     (while link-list
 121       (progn
 122         (setq split-link (split-string (pop link-list) "::split::"))
 123         (setq URL (car split-link))
 124         (setq description (cadr split-link))
 125         (if (not (string= URL ""))
 126             (progn
 127               (setq orglink (org-make-link-string URL description))
 128               (push orglink orglink-list)))))
 129     (with-temp-buffer
 130       (while orglink-list
 131         (insert (concat (pop orglink-list)) "\n"))
 132       (kill-region (point-min) (point-max))
 133       (current-kill 0))))
 134
 135 (defun org-mac-create-flagged-mail ()
 136   "Create links to flagged messages in a Mail.app account and
 137 copy them to the kill ring"
 138   (interactive)
 139   (message "AppleScript: searching mailboxes...")
 140   (let* ((as-link-list
 141           (do-applescript
 142            (concat
 143             "tell application \"Mail\"\n"
 144             "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
 145             "set theLinkList to {}\n"
 146             "repeat with aMailbox in theMailboxes\n"
 147             "set theSelection to (every message in aMailbox whose flagged status = true)\n"
 148             "repeat with theMessage in theSelection\n"
 149             "set theID to message id of theMessage\n"
 150             "set theSubject to subject of theMessage\n"
 151             "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
 152             "copy theLink to end of theLinkList\n"
 153             ;; "tell application \"GrowlHelperApp\"\n"
 154             ;; "set the allNotificationsList to {\"FlaggedMail\"}\n"
 155             ;; "set the enabledNotificationsList to allNotificationsList\n"
 156             ;; "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
 157             ;; "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
 158             ;; "end tell\n"
 159             "end repeat\n"
 160             "end repeat\n"
 161             "return theLinkList as string\n"
 162             "end tell")))
 163          (link-list (split-string as-link-list "\n"))
 164          split-link
 165          URL
 166          description
 167          orglink
 168          (orglink-list nil))
 169     (while link-list
 170       (progn
 171         (setq split-link (split-string (pop link-list) "::split::"))
 172         (setq URL (car split-link))
 173         (setq description (cadr split-link))
 174         (if (not (string= URL ""))
 175             (progn
 176               (setq orglink (org-make-link-string URL description))
 177               (push orglink orglink-list)))))
 178     (with-temp-buffer
 179       (while orglink-list
 180         (insert (concat (pop orglink-list)) "\n"))
 181       (kill-region (point-min) (point-max))
 182       (message "Flagged messages copied to kill ring"))))
 183
 184 (defun org-mac-insert-flagged-mail (org-buffer org-heading)
 185   "Asks for an org buffer and a heading within it. If heading
 186 exists, delete all message:// links within heading's first
 187 level. If heading doesn't exist, create it at point-max. Insert
 188 list of message:// links to flagged mail after heading."
 189   (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
 190   (save-excursion
 191     (set-buffer org-buffer)
 192     (goto-char (point-min))
 193     (let ((isearch-forward t)
 194           (message-re "\\[\\[\\(message:\\)?\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
 195       (if (org-goto-local-search-headings org-heading nil t)
 196           (if (not (eobp))
 197               (progn
 198                 (save-excursion
 199                   (while (re-search-forward message-re (save-excursion (outline-next-heading)) t)
 200
 201                     (delete-region (match-beginning 0) (match-end 0)))
 202                   (org-mac-create-flagged-mail)
 203                   (yank))
 204                 (flush-lines "^$" (point) (outline-next-heading)))
 205             (insert "\n")
 206             (org-mac-create-flagged-mail)
 207             (yank))
 208         (goto-char (point-max))
 209         (insert "\n")
 210         (org-insert-heading)
 211         (insert (concat org-heading "\n"))
 212         (org-mac-create-flagged-mail)
 213         (yank)))))
 214
 215 (provide 'org-mac-message)
 216
 217 ;; arch-tag: 3806d0c1-abe1-4db6-9c31-f3ed7d4a9b32
 218
 219 ;;; org-mac-message.el ends here