2009-04-06 04:43:51 +00:00
;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
2008-03-14 10:41:54 +00:00
2009-01-06 09:47:36 +00:00
;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
2008-03-14 10:41:54 +00:00
;; Author: John Wiegley <johnw@gnu.org>
2009-03-22 15:02:54 +00:00
;; Christopher Suckling <suckling at gmail dot com>
2009-03-27 09:54:43 +00:00
2009-04-21 18:26:27 +00:00
;; Version: 6.26c
2008-02-04 15:44:17 +00:00
;; Keywords: outlines, hypermedia, calendar, wp
2008-03-14 10:41:54 +00:00
2008-02-05 14:38:57 +00:00
;; This file is part of GNU Emacs.
2008-03-14 10:41:54 +00:00
2008-05-06 12:45:52 +00:00
;; GNU Emacs is free software: you can redistribute it and/or modify
2008-02-04 15:44:17 +00:00
;; it under the terms of the GNU General Public License as published by
2008-05-06 12:45:52 +00:00
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
2008-02-04 15:44:17 +00:00
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
2008-05-06 12:45:52 +00:00
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
2008-03-14 10:41:54 +00:00
2008-03-21 16:10:23 +00:00
;;; Commentary:
2009-04-06 04:43:51 +00:00
;; This file implements links to Apple Mail.app messages from within Org-mode.
2008-03-21 16:10:23 +00:00
;; Org-mode does not load this module by default - if you would actually like
;; this to happen then configure the variable `org-modules'.
2009-03-22 15:02:54 +00:00
;; If you would like to create links to all flagged messages in an
2009-04-06 04:43:51 +00:00
;; Apple Mail.app account, please customize the variable
;; `org-mac-mail-account' and then call one of the following functions:
2009-03-22 15:02:54 +00:00
2009-04-06 04:43:51 +00:00
;; (org-mac-message-insert-selected) copies a formatted list of links to
2009-03-22 15:02:54 +00:00
;; the kill ring.
2009-04-06 04:43:51 +00:00
;; (org-mac-message-insert-selected) inserts at point links to any
;; messages selected in Mail.app.
;; (org-mac-message-insert-flagged) searches within an org-mode buffer
2009-03-22 15:02:54 +00:00
;; for a specific heading, creating it if it doesn't exist. Any
;; message:// links within the first level of the heading are deleted
;; and replaced with links to flagged messages.
2008-03-14 10:41:54 +00:00
;;; Code:
2008-02-04 15:44:17 +00:00
( require 'org )
2009-03-22 15:02:54 +00:00
( defgroup org-mac-flagged-mail nil
" Options concerning linking to flagged Mail.app messages "
:tag " Org Mail.app "
:group 'org-link )
( defcustom org-mac-mail-account " customize "
" The Mail.app account in which to search for flagged messages "
:group 'org-mac-flagged-mail
:type 'string )
2008-02-04 15:44:17 +00:00
( org-add-link-type " message " 'org-mac-message-open )
2008-09-10 09:10:21 +00:00
;; In mac.c, removed in Emacs 23.
( declare-function do-applescript " org-mac-message " ( script ) )
2008-02-04 15:44:17 +00:00
( unless ( fboundp 'do-applescript )
;; Need to fake this using shell-command-to-string
( defun do-applescript ( script )
2008-02-05 14:38:57 +00:00
( let ( start cmd return )
2008-02-04 15:44:17 +00:00
( while ( string-match " \n " script )
( setq script ( replace-match " \r " t t script ) ) )
( while ( string-match " ' " script start )
2008-02-05 14:38:57 +00:00
( setq start ( + 2 ( match-beginning 0 ) )
2008-02-04 15:44:17 +00:00
script ( replace-match " \\ ' " t t script ) ) )
( setq cmd ( concat " osascript -e ' " script " ' " ) )
( setq return ( shell-command-to-string cmd ) )
( concat " \" " ( org-trim return ) " \" " ) ) ) )
( defun org-mac-message-open ( message-id )
2008-03-21 16:10:23 +00:00
" Visit the message with the given MESSAGE-ID.
This will use the command ` open ' with the message URL. "
2008-02-04 15:44:17 +00:00
( start-process ( concat " open message: " message-id ) nil
2008-02-05 06:09:43 +00:00
" open " ( concat " message://< " ( substring message-id 2 ) " > " ) ) )
2008-02-04 15:44:17 +00:00
2009-04-04 10:29:00 +00:00
( defun as-get-selected-mail ( )
" AppleScript to create links to selected messages in Mail.app "
( do-applescript
( concat
" tell application \" Mail \" \n "
2009-04-08 13:05:48 +00:00
" set theLinkList to {} \n "
" set theSelection to selection \n "
" repeat with theMessage in theSelection \n "
" set theID to message id of theMessage \n "
" set theSubject to subject of theMessage \n "
" set theLink to \" message:// \" & theID & \" ::split:: \" & theSubject & \" \n \" \n "
" copy theLink to end of theLinkList \n "
" end repeat \n "
" return theLinkList as string \n "
2009-04-04 10:29:00 +00:00
" end tell " ) ) )
( defun as-get-flagged-mail ( )
" AppleScript to create links to flagged messages in Mail.app "
( do-applescript
2009-04-08 13:05:48 +00:00
( concat
;; Is Growl installed?
" tell application \" System Events \" \n "
" set growlHelpers to the name of every process whose creator type contains \" GRRR \" \n "
" if (count of growlHelpers) > 0 then \n "
" set growlHelperApp to item 1 of growlHelpers \n "
" else \n "
" set growlHelperApp to \" \" \n "
" end if \n "
" end tell \n "
;; Get links
" tell application \" Mail \" \n "
" set theMailboxes to every mailbox of account \" " org-mac-mail-account " \" \n "
" set theLinkList to {} \n "
" repeat with aMailbox in theMailboxes \n "
" set theSelection to (every message in aMailbox whose flagged status = true) \n "
" repeat with theMessage in theSelection \n "
" set theID to message id of theMessage \n "
" set theSubject to subject of theMessage \n "
" set theLink to \" message:// \" & theID & \" ::split:: \" & theSubject & \" \n \" \n "
" copy theLink to end of theLinkList \n "
;; Report progress through Growl
;; This "double tell" idiom is described in detail at
;; http://macscripter.net/viewtopic.php?id=24570 The
;; script compiler needs static knowledge of the
;; growlHelperApp. Hmm, since we're compiling
;; on-the-fly here, this is likely to be way less
;; portable than I'd hoped. It'll work when the name
;; is still "GrowlHelperApp", though.
" if growlHelperApp is not \" \" then \n "
" tell application \" GrowlHelperApp \" \n "
" tell application growlHelperApp \n "
" set the allNotificationsList to { \" FlaggedMail \" } \n "
" set the enabledNotificationsList to allNotificationsList \n "
" register as application \" FlaggedMail \" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \" Mail \" \n "
" notify with name \" FlaggedMail \" title \" Importing flagged message \" description theSubject application name \" FlaggedMail \" \n "
" end tell \n "
" end tell \n "
" end if \n "
" end repeat \n "
" end repeat \n "
" return theLinkList as string \n "
" end tell " ) ) )
2009-04-04 10:29:00 +00:00
( defun org-mac-message-get-links ( select-or-flag )
" Create links to the messages currently selected or flagged in
Mail.app. This will use AppleScript to get the message-id and
the subject of the message in Mail.app and make a link out
of it. "
( interactive " sLink to (s)elected or (f)lagged messages: " )
( message " AppleScript: searching mailboxes... " )
( let* ( ( as-link-list
( if ( string= select-or-flag " s " )
( as-get-selected-mail )
( if ( string= select-or-flag " f " )
( as-get-flagged-mail )
( error " Please select \" s \" or \" f \" " ) ) ) )
( link-list
( mapcar
( lambda ( x ) ( if ( string-match " \\ ` \" \\ (.* \\ ) \" \\ ' " x ) ( setq x ( match-string 1 x ) ) ) x )
( split-string as-link-list " [ \r \n ]+ " ) ) )
2009-03-22 15:02:54 +00:00
split-link
URL
description
orglink
2009-04-04 10:29:00 +00:00
orglink-insert
2009-03-22 15:02:54 +00:00
( orglink-list nil ) )
( while link-list
2009-04-04 10:29:00 +00:00
( setq split-link ( split-string ( pop link-list ) " ::split:: " ) )
( setq URL ( car split-link ) )
( setq description ( cadr split-link ) )
( when ( not ( string= URL " " ) )
( setq orglink ( org-make-link-string URL description ) )
( push orglink orglink-list ) ) )
2009-03-22 15:02:54 +00:00
( with-temp-buffer
( while orglink-list
( insert ( concat ( pop orglink-list ) ) " \n " ) )
( kill-region ( point-min ) ( point-max ) )
2009-04-04 10:29:00 +00:00
( current-kill 0 ) ) )
( message " Messages copied to kill-ring " ) )
( defun org-mac-message-insert-selected ( )
2009-04-06 04:43:51 +00:00
" Insert a link to the messages currently selected in Mail.app.
2009-04-04 10:29:00 +00:00
This will use applescript to get the message-id and the subject of the
2009-04-06 04:43:51 +00:00
active mail in Mail.app and make a link out of it. "
2009-04-04 10:29:00 +00:00
( interactive )
( org-mac-message-get-links " s " )
( yank ) )
;; The following line is for backward compatibility
( defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected )
2009-03-22 15:02:54 +00:00
2009-04-04 10:29:00 +00:00
( defun org-mac-message-insert-flagged ( org-buffer org-heading )
2009-03-22 15:02:54 +00:00
" Asks for an org buffer and a heading within it. If heading
exists, delete all message:// links within heading 's first
level. If heading doesn 't exist, create it at point-max. Insert
list of message:// links to flagged mail after heading. "
( interactive " bBuffer in which to insert links: \n sHeading after which to insert links: " )
( save-excursion
( set-buffer org-buffer )
( goto-char ( point-min ) )
( let ( ( isearch-forward t )
2009-04-08 13:05:48 +00:00
( message-re " \\ [ \\ [ \\ (message: \\ ) \\ ([^]]+ \\ ) \\ ] \\ ( \\ [ \\ ([^]]+ \\ ) \\ ] \\ )? \\ ] " ) )
2009-03-22 15:02:54 +00:00
( if ( org-goto-local-search-headings org-heading nil t )
( if ( not ( eobp ) )
( progn
( save-excursion
( while ( re-search-forward message-re ( save-excursion ( outline-next-heading ) ) t )
( delete-region ( match-beginning 0 ) ( match-end 0 ) ) )
2009-04-08 13:05:48 +00:00
( insert " \n " )
2009-04-04 10:29:00 +00:00
( org-mac-message-get-links " f " )
2009-03-22 15:02:54 +00:00
( yank ) )
( flush-lines " ^$ " ( point ) ( outline-next-heading ) ) )
( insert " \n " )
2009-04-04 10:29:00 +00:00
( org-mac-message-get-links " f " )
2009-03-22 15:02:54 +00:00
( yank ) )
( goto-char ( point-max ) )
( insert " \n " )
( org-insert-heading )
( insert ( concat org-heading " \n " ) )
2009-04-04 10:29:00 +00:00
( org-mac-message-get-links " f " )
2009-03-22 15:02:54 +00:00
( yank ) ) ) ) )
2008-02-04 15:44:17 +00:00
( provide 'org-mac-message )
2008-03-14 10:37:35 +00:00
;; arch-tag: 3806d0c1-abe1-4db6-9c31-f3ed7d4a9b32
2008-04-29 05:15:41 +00:00
2008-02-04 15:44:17 +00:00
;;; org-mac-message.el ends here