lisp/org-mac-message.el

   1 ;;; org-mac-message.el --- 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 ;; 114 to 119.
  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 as-get-selected-mail ()
  85   "AppleScript to create links to selected messages in Mail.app"
  86   (do-applescript
  87    (concat
  88     "tell application \"Mail\"\n"
  89     "set theLinkList to {}\n"
  90     "set theSelection to selection\n"
  91     "repeat with theMessage in theSelection\n"
  92     "set theID to message id of theMessage\n"
  93     "set theSubject to subject of theMessage\n"
  94     "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
  95     "copy theLink to end of theLinkList\n"
  96     "end repeat\n"
  97     "return theLinkList as string\n"
  98     "end tell")))
  99
 100 (defun as-get-flagged-mail ()
 101   "AppleScript to create links to flagged messages in Mail.app"
 102   (do-applescript
 103            (concat
 104             "tell application \"Mail\"\n"
 105             "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
 106             "set theLinkList to {}\n"
 107             "repeat with aMailbox in theMailboxes\n"
 108             "set theSelection to (every message in aMailbox whose flagged status = true)\n"
 109             "repeat with theMessage in theSelection\n"
 110             "set theID to message id of theMessage\n"
 111             "set theSubject to subject of theMessage\n"
 112             "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
 113             "copy theLink to end of theLinkList\n"
 114             ;; "tell application \"GrowlHelperApp\"\n"
 115             ;; "set the allNotificationsList to {\"FlaggedMail\"}\n"
 116             ;; "set the enabledNotificationsList to allNotificationsList\n"
 117             ;; "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
 118             ;; "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
 119             ;; "end tell\n"
 120             "end repeat\n"
 121             "end repeat\n"
 122             "return theLinkList as string\n"
 123             "end tell")))
 124
 125 (defun org-mac-message-get-links (select-or-flag)
 126   "Create links to the messages currently selected or flagged in
 127 Mail.app.  This will use AppleScript to get the message-id and
 128 the subject of the message in Mail.app and make a link out
 129 of it."
 130   (interactive "sLink to (s)elected or (f)lagged messages: ")
 131   (message "AppleScript: searching mailboxes...")
 132   (let* ((as-link-list
 133           (if (string= select-or-flag "s")
 134               (as-get-selected-mail)
 135             (if (string= select-or-flag "f")
 136                 (as-get-flagged-mail)
 137               (error "Please select \"s\" or \"f\""))))
 138          (link-list
 139           (mapcar
 140            (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
 141            (split-string as-link-list "[\r\n]+")))
 142          split-link
 143          URL
 144          description
 145          orglink
 146          orglink-insert
 147          (orglink-list nil))
 148     (while link-list
 149       (setq split-link (split-string (pop link-list) "::split::"))
 150       (setq URL (car split-link))
 151       (setq description (cadr split-link))
 152       (when (not (string= URL ""))
 153         (setq orglink (org-make-link-string URL description))
 154         (push orglink orglink-list)))
 155     (with-temp-buffer
 156       (while orglink-list
 157         (insert (concat (pop orglink-list)) "\n"))
 158       (kill-region (point-min) (point-max))
 159       (current-kill 0)))
 160   (message "Messages copied to kill-ring"))
 161
 162 (defun org-mac-message-insert-selected ()
 163   "Insert a link to the messages currently selected in Apple Mail.
 164 This will use applescript to get the message-id and the subject of the
 165 active mail in AppleMail and make a link out of it."
 166   (interactive)
 167   (org-mac-message-get-links "s")
 168   (yank))
 169
 170 ;; The following line is for backward compatibility
 171 (defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
 172
 173 (defun org-mac-message-insert-flagged (org-buffer org-heading)
 174   "Asks for an org buffer and a heading within it. If heading
 175 exists, delete all message:// links within heading's first
 176 level. If heading doesn't exist, create it at point-max. Insert
 177 list of message:// links to flagged mail after heading."
 178   (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
 179   (save-excursion
 180     (set-buffer org-buffer)
 181     (goto-char (point-min))
 182     (let ((isearch-forward t)
 183           (message-re "\\[\\[\\(message:\\)?\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
 184       (if (org-goto-local-search-headings org-heading nil t)
 185           (if (not (eobp))
 186               (progn
 187                 (save-excursion
 188                   (while (re-search-forward message-re (save-excursion (outline-next-heading)) t)
 189
 190                     (delete-region (match-beginning 0) (match-end 0)))
 191                   (org-mac-message-get-links "f")
 192                   (yank))
 193                 (flush-lines "^$" (point) (outline-next-heading)))
 194             (insert "\n")
 195             (org-mac-message-get-links "f")
 196             (yank))
 197         (goto-char (point-max))
 198         (insert "\n")
 199         (org-insert-heading)
 200         (insert (concat org-heading "\n"))
 201         (org-mac-message-get-links "f")
 202         (yank)))))
 203
 204 (provide 'org-mac-message)
 205
 206 ;; arch-tag: 3806d0c1-abe1-4db6-9c31-f3ed7d4a9b32
 207
 208 ;;; org-mac-message.el ends here