contrib/lisp/org-mac-link.el: Fix formatting

This commit is contained in:
Bastien Guerry 2014-06-14 14:47:37 +02:00
parent c57ecf260d
commit 23496c5e4e
1 changed files with 257 additions and 270 deletions

View File

@ -3,13 +3,12 @@
;;
;; Copyright (c) 2010-2014 Free Software Foundation, Inc.
;;
;; Authors:
;; Anthony Lander <anthony.lander@gmail.com>
;; John Wiegley <johnw@gnu.org>
;; Christopher Suckling <suckling at gmail dot com>
;; Daniil Frumin <difrumin@gmail.com>
;; Alan Schmitt <alan.schmitt@polytechnique.org>
;; Mike McLean <mike.mclean@pobox.com>
;; Author: Anthony Lander <anthony.lander@gmail.com>
;; John Wiegley <johnw@gnu.org>
;; Christopher Suckling <suckling at gmail dot com>
;; Daniil Frumin <difrumin@gmail.com>
;; Alan Schmitt <alan.schmitt@polytechnique.org>
;; Mike McLean <mike.mclean@pobox.com>
;;
;;
;; Version: 1.1
@ -89,67 +88,66 @@
(require 'org)
(defgroup org-mac-link nil
"Options concerning grabbing links from external Mac
applications and inserting them in org documents"
"Options for grabbing links from Mac applications."
:tag "Org Mac link"
:group 'org-link)
(defcustom org-mac-grab-Finder-app-p t
"Enable menu option [F]inder to grab links from the Finder"
"Add menu option [F]inder to grab links from the Finder."
:tag "Grab Finder.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Mail-app-p t
"Enable menu option [m]ail to grab links from Mail.app"
"Add menu option [m]ail to grab links from Mail.app."
:tag "Grab Mail.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Outlook-app-p t
"Enable menu option [o]utlook to grab links from Microsoft Outlook.app"
"Add menu option [o]utlook to grab links from Microsoft Outlook.app."
:tag "Grab Microsoft Outlook.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-devonthink-app-p t
"Enable menu option [d]EVONthink to grab links from DEVONthink Pro Office.app"
"Add menu option [d]EVONthink to grab links from DEVONthink Pro Office.app."
:tag "Grab DEVONthink Pro Office.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Addressbook-app-p t
"Enable menu option [a]ddressbook to grab links from AddressBook.app"
"Add menu option [a]ddressbook to grab links from AddressBook.app."
:tag "Grab AddressBook.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Safari-app-p t
"Enable menu option [s]afari to grab links from Safari.app"
"Add menu option [s]afari to grab links from Safari.app."
:tag "Grab Safari.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Firefox-app-p t
"Enable menu option [f]irefox to grab links from Firefox.app"
"Add menu option [f]irefox to grab links from Firefox.app."
:tag "Grab Firefox.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Firefox+Vimperator-p nil
"Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin"
"Add menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin."
:tag "Grab Vimperator/Firefox.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Chrome-app-p t
"Enable menu option [c]hrome to grab links from Google Chrome.app"
"Add menu option [c]hrome to grab links from Google Chrome.app."
:tag "Grab Google Chrome.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Together-app-p nil
"Enable menu option [t]ogether to grab links from Together.app"
"Add menu option [t]ogether to grab links from Together.app."
:tag "Grab Together.app links"
:group 'org-mac-link
:type 'boolean)
@ -157,19 +155,19 @@ applications and inserting them in org documents"
(defcustom org-mac-grab-Skim-app-p
(< 0 (length (shell-command-to-string
"mdfind kMDItemCFBundleIdentifier == 'net.sourceforge.skim-app.skim'")))
"Enable menu option [S]kim to grab page links from Skim.app"
"Add menu option [S]kim to grab page links from Skim.app."
:tag "Grab Skim.app page links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-Skim-highlight-selection-p nil
"Highlight (using notes) the selection (if present) when grabbing the a link from Skim.app"
"Highlight the active selection when grabbing a link from Skim.app."
:tag "Highlight selection in Skim.app"
:group 'org-mac-link
:type 'boolean)
(defgroup org-mac-flagged-mail nil
"Options concerning linking to flagged Mail.app messages."
"Options foring linking to flagged Mail.app messages."
:tag "Org Mail.app"
:group 'org-link)
@ -194,28 +192,32 @@ applications and inserting them in org documents"
(setq return (shell-command-to-string cmd))
(concat "\"" (org-trim return) "\""))))
(defun org-mac-grab-link ()
"Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
"Prompt for an application to grab a link from.
When done, go grab the link, and insert it at point."
(interactive)
(let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
("d" "EVONthink Pro Office" org-mac-devonthink-item-insert-selected ,org-mac-grab-devonthink-app-p)
("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-app-p)
("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)
("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)))
(let* ((descriptors
`(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
("d" "EVONthink Pro Office" org-mac-devonthink-item-insert-selected
,org-mac-grab-devonthink-app-p)
("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-app-p)
("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)
("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)))
(menu-string (make-string 0 ?x))
input)
;; Create the menu string for the keymap
(mapc '(lambda (descriptor)
(when (elt descriptor 3)
(setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
(setf menu-string (concat menu-string
"[" (elt descriptor 0) "]"
(elt descriptor 1) " "))))
descriptors)
(setf (elt menu-string (- (length menu-string) 1)) ?:)
@ -231,12 +233,13 @@ applications and inserting them in org documents"
descriptors)))
(defun org-mac-paste-applescript-links (as-link-list)
"Paste in a list of links from an applescript handler. The
links are of the form <link>::split::<name>"
"Paste in a list of links from an applescript handler.
The links are of the form <link>::split::<name>."
(let* ((link-list
(mapcar
(lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
(split-string as-link-list "[\r\n]+")))
(mapcar (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x)
(setq x (match-string 1 x)))
x)
(split-string as-link-list "[\r\n]+")))
split-link URL description orglink orglink-insert rtn orglink-list)
(while link-list
(setq split-link (split-string (pop link-list) "::split::"))
@ -250,7 +253,6 @@ applications and inserting them in org documents"
rtn))
;; Handle links from Firefox.app
;;
;; This code allows you to grab the current active url from the main
@ -267,27 +269,28 @@ applications and inserting them in org documents"
;; seems that it is always the last active window).
(defun org-as-mac-firefox-get-frontmost-url ()
(let ((result (do-applescript
(concat
"set oldClipboard to the clipboard\n"
"set frontmostApplication to path to frontmost application\n"
"tell application \"Firefox\"\n"
" activate\n"
" delay 0.15\n"
" tell application \"System Events\"\n"
" keystroke \"l\" using {command down}\n"
" keystroke \"a\" using {command down}\n"
" keystroke \"c\" using {command down}\n"
" end tell\n"
" delay 0.15\n"
" set theUrl to the clipboard\n"
" set the clipboard to oldClipboard\n"
" set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
"end tell\n"
"activate application (frontmostApplication as text)\n"
"set links to {}\n"
"copy theResult to the end of links\n"
"return links as string\n"))))
(let ((result
(do-applescript
(concat
"set oldClipboard to the clipboard\n"
"set frontmostApplication to path to frontmost application\n"
"tell application \"Firefox\"\n"
" activate\n"
" delay 0.15\n"
" tell application \"System Events\"\n"
" keystroke \"l\" using {command down}\n"
" keystroke \"a\" using {command down}\n"
" keystroke \"c\" using {command down}\n"
" end tell\n"
" delay 0.15\n"
" set theUrl to the clipboard\n"
" set the clipboard to oldClipboard\n"
" set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
"end tell\n"
"activate application (frontmostApplication as text)\n"
"set links to {}\n"
"copy theResult to the end of links\n"
"return links as string\n"))))
(car (split-string result "[\r\n]+" t))))
(defun org-mac-firefox-get-frontmost-url ()
@ -313,27 +316,28 @@ applications and inserting them in org documents"
;; Firefox
(defun org-as-mac-vimperator-get-frontmost-url ()
(let ((result (do-applescript
(concat
"set oldClipboard to the clipboard\n"
"set frontmostApplication to path to frontmost application\n"
"tell application \"Firefox\"\n"
" activate\n"
" delay 0.15\n"
" tell application \"System Events\"\n"
" keystroke \"y\"\n"
" end tell\n"
" delay 0.15\n"
" set theUrl to the clipboard\n"
" set the clipboard to oldClipboard\n"
" set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
"end tell\n"
"activate application (frontmostApplication as text)\n"
"set links to {}\n"
"copy theResult to the end of links\n"
"return links as string\n"))))
(replace-regexp-in-string "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
(let ((result
(do-applescript
(concat
"set oldClipboard to the clipboard\n"
"set frontmostApplication to path to frontmost application\n"
"tell application \"Firefox\"\n"
" activate\n"
" delay 0.15\n"
" tell application \"System Events\"\n"
" keystroke \"y\"\n"
" end tell\n"
" delay 0.15\n"
" set theUrl to the clipboard\n"
" set the clipboard to oldClipboard\n"
" set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
"end tell\n"
"activate application (frontmostApplication as text)\n"
"set links to {}\n"
"copy theResult to the end of links\n"
"return links as string\n"))))
(replace-regexp-in-string
"\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
(defun org-mac-vimperator-get-frontmost-url ()
(interactive)
@ -358,19 +362,20 @@ applications and inserting them in org documents"
;; Firefox because Chrome doesn't publish an Applescript dictionary
(defun org-as-mac-chrome-get-frontmost-url ()
(let ((result (do-applescript
(concat
"set frontmostApplication to path to frontmost application\n"
"tell application \"Google Chrome\"\n"
" set theUrl to get URL of active tab of first window\n"
" set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
"end tell\n"
"activate application (frontmostApplication as text)\n"
"set links to {}\n"
"copy theResult to the end of links\n"
"return links as string\n"))))
(replace-regexp-in-string "^\"\\|\"$" ""
(car (split-string result "[\r\n]+" t)))))
(let ((result
(do-applescript
(concat
"set frontmostApplication to path to frontmost application\n"
"tell application \"Google Chrome\"\n"
" set theUrl to get URL of active tab of first window\n"
" set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
"end tell\n"
"activate application (frontmostApplication as text)\n"
"set links to {}\n"
"copy theResult to the end of links\n"
"return links as string\n"))))
(replace-regexp-in-string
"^\"\\|\"$" "" (car (split-string result "[\r\n]+" t)))))
(defun org-mac-chrome-get-frontmost-url ()
(interactive)
@ -394,13 +399,14 @@ applications and inserting them in org documents"
;; Grab the frontmost url from Safari.
(defun org-as-mac-safari-get-frontmost-url ()
(let ((result (do-applescript
(concat
"tell application \"Safari\"\n"
" set theUrl to URL of document 1\n"
" set theName to the name of the document 1\n"
" return theUrl & \"::split::\" & theName & \"\n\"\n"
"end tell\n"))))
(let ((result
(do-applescript
(concat
"tell application \"Safari\"\n"
" set theUrl to URL of document 1\n"
" set theName to the name of the document 1\n"
" return theUrl & \"::split::\" & theName & \"\n\"\n"
"end tell\n"))))
(car (split-string result "[\r\n]+" t))))
(defun org-mac-safari-get-frontmost-url ()
@ -421,30 +427,26 @@ applications and inserting them in org documents"
(insert (org-mac-safari-get-frontmost-url)))
;;
;;
;; Handle links from together.app
;;
;;
(org-add-link-type "x-together-item" 'org-mac-together-item-open)
(defun org-mac-together-item-open (uid)
"Open the given uid, which is a reference to an item in Together"
"Open UID, which is a reference to an item in Together."
(shell-command (concat "open -a Together \"x-together-item:" uid "\"")))
(defun as-get-selected-together-items ()
(do-applescript
(concat
"tell application \"Together\"\n"
" set theLinkList to {}\n"
" set theSelection to selected items\n"
" repeat with theItem in theSelection\n"
" set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
" copy theLink to end of theLinkList\n"
" end repeat\n"
" return theLinkList as string\n"
"end tell")))
(concat
"tell application \"Together\"\n"
" set theLinkList to {}\n"
" set theSelection to selected items\n"
" repeat with theItem in theSelection\n"
" set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
" copy theLink to end of theLinkList\n"
" end repeat\n"
" return theLinkList as string\n"
"end tell")))
(defun org-mac-together-get-selected ()
(interactive)
@ -454,26 +456,22 @@ applications and inserting them in org documents"
(defun org-mac-together-insert-selected ()
(interactive)
(insert (org-mac-together-get-selected)))
;;
;;
;; Handle links from Finder.app
;;
;;
(defun as-get-selected-finder-items ()
(do-applescript
(concat
"tell application \"Finder\"\n"
" set theSelection to the selection\n"
" set links to {}\n"
" repeat with theItem in theSelection\n"
" set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
" copy theLink to the end of links\n"
" end repeat\n"
" return links as string\n"
"end tell\n")))
(concat
"tell application \"Finder\"\n"
" set theSelection to the selection\n"
" set links to {}\n"
" repeat with theItem in theSelection\n"
" set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
" copy theLink to the end of links\n"
" end repeat\n"
" return links as string\n"
"end tell\n")))
(defun org-mac-finder-item-get-selected ()
(interactive)
@ -485,30 +483,26 @@ applications and inserting them in org documents"
(insert (org-mac-finder-item-get-selected)))
;;
;;
;; Handle links from AddressBook.app
;;
;;
(org-add-link-type "addressbook" 'org-mac-addressbook-item-open)
(defun org-mac-addressbook-item-open (uid)
"Open the given uid, which is a reference to an item in Together"
"Open UID, which is a reference to an item in the addressbook."
(shell-command (concat "open \"addressbook:" uid "\"")))
(defun as-get-selected-addressbook-items ()
(do-applescript
(concat
"tell application \"Address Book\"\n"
" set theSelection to the selection\n"
" set links to {}\n"
" repeat with theItem in theSelection\n"
" set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
" copy theLink to the end of links\n"
" end repeat\n"
" return links as string\n"
"end tell\n")))
(concat
"tell application \"Address Book\"\n"
" set theSelection to the selection\n"
" set links to {}\n"
" repeat with theItem in theSelection\n"
" set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
" copy theLink to the end of links\n"
" end repeat\n"
" return links as string\n"
"end tell\n")))
(defun org-mac-addressbook-item-get-selected ()
(interactive)
@ -519,8 +513,7 @@ applications and inserting them in org documents"
(interactive)
(insert (org-mac-addressbook-item-get-selected)))
;;
;;
;; Handle links from Skim.app
;;
;; Original code & idea by Christopher Suckling (org-mac-protocol)
@ -533,40 +526,39 @@ applications and inserting them in org documents"
(match-string 1 uri)))
(document (substring uri 0 (match-beginning 0))))
(do-applescript
(concat
"tell application \"Skim\"\n"
"activate\n"
"set theDoc to \"" document "\"\n"
"set thePage to " page "\n"
"open theDoc\n"
"go document 1 to page thePage of document 1\n"
"end tell"))))
(concat
"tell application \"Skim\"\n"
"activate\n"
"set theDoc to \"" document "\"\n"
"set thePage to " page "\n"
"open theDoc\n"
"go document 1 to page thePage of document 1\n"
"end tell"))))
(defun as-get-skim-page-link ()
(do-applescript
(concat
"tell application \"Skim\"\n"
"set theDoc to front document\n"
"set theTitle to (name of theDoc)\n"
"set thePath to (path of theDoc)\n"
"set thePage to (get index for current page of theDoc)\n"
"set theSelection to selection of theDoc\n"
"set theContent to contents of (get text for theSelection)\n"
"if theContent is missing value then\n"
" set theContent to theTitle & \", p. \" & thePage\n"
(when org-mac-Skim-highlight-selection-p
(concat
"tell application \"Skim\"\n"
"set theDoc to front document\n"
"set theTitle to (name of theDoc)\n"
"set thePath to (path of theDoc)\n"
"set thePage to (get index for current page of theDoc)\n"
"set theSelection to selection of theDoc\n"
"set theContent to contents of (get text for theSelection)\n"
"if theContent is missing value then\n"
" set theContent to theTitle & \", p. \" & thePage\n"
(when org-mac-Skim-highlight-selection-p
(concat
"else\n"
" tell theDoc\n"
" set theNote to make note with properties {type:highlight note, selection:theSelection}\n"
" set text of theNote to (get text for theSelection)\n"
" end tell\n"))
"end if\n"
"set theLink to \"skim://\" & thePath & \"::\" & thePage & "
"\"::split::\" & theContent\n"
"end tell\n"
"return theLink as string\n")))
"else\n"
" tell theDoc\n"
" set theNote to make note with properties {type:highlight note, selection:theSelection}\n"
" set text of theNote to (get text for theSelection)\n"
" end tell\n"))
"end if\n"
"set theLink to \"skim://\" & thePath & \"::\" & thePage & "
"\"::split::\" & theContent\n"
"end tell\n"
"return theLink as string\n")))
(defun org-mac-skim-get-page ()
(interactive)
@ -585,12 +577,8 @@ applications and inserting them in org documents"
(interactive)
(insert (org-mac-skim-get-page)))
;;
;;
;; Handle links from Microsoft Outlook.app
;;
(org-add-link-type "mac-outlook" 'org-mac-outlook-message-open)
@ -599,9 +587,9 @@ applications and inserting them in org documents"
(do-applescript
(concat
"tell application \"Microsoft Outlook\"\n"
(format "open message id %s\n" (substring-no-properties msgid))
"activate\n"
"end tell")))
(format "open message id %s\n" (substring-no-properties msgid))
"activate\n"
"end tell")))
(defun org-as-get-selected-outlook-mail ()
"AppleScript to create links to selected messages in Microsoft Outlook.app."
@ -682,16 +670,18 @@ The Org-syntax text will be pushed to the kill ring, and also returned."
(defun org-mac-outlook-message-insert-selected ()
"Insert a link to the messages currently selected in Microsoft Outlook.app.
This will use AppleScript to get the message-id and the subject of the
active mail in Microsoft Outlook.app and make a link out of it."
This will use AppleScript to get the message-id and the subject
of the active mail in Microsoft Outlook.app and make a link out
of it."
(interactive)
(insert (org-mac-outlook-message-get-links "s")))
(defun org-mac-outlook-message-insert-flagged (org-buffer org-heading)
"Asks for an org buffer and a heading within it, and replace message links.
If heading exists, delete all mac-outlook:// links within heading's first
level. If heading doesn't exist, create it at point-max. Insert
list of mac-outlook:// links to flagged mail after heading."
If heading exists, delete all mac-outlook:// links within
heading's first level. If heading doesn't exist, create it at
point-max. Insert list of mac-outlook:// links to flagged mail
after heading."
(interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
(with-current-buffer org-buffer
(goto-char (point-min))
@ -712,17 +702,13 @@ list of mac-outlook:// links to flagged mail after heading."
(org-insert-heading nil t)
(insert org-heading "\n" (org-mac-outlook-message-get-links "f"))))))
;;
;;
;; Handle links from DEVONthink Pro Office.app
;;
(org-add-link-type "x-devonthink-item" 'org-devonthink-item-open)
(defun org-devonthink-item-open (uid)
"Open the given uid, which is a reference to an item in DEVONthink Pro Office"
"Open UID, which is a reference to an item in DEVONthink Pro Office."
(shell-command (concat "open \"x-devonthink-item:" uid "\"")))
(defun org-as-get-selected-devonthink-item ()
@ -757,7 +743,9 @@ ring, and also return it."
(let* ((as-link-list (org-as-get-selected-devonthink-item))
(link-list (if as-link-list
(mapcar
(lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
(lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x)
(setq x (match-string 1 x)))
x)
(split-string as-link-list "[\r\n]+"))
nil))
orglink-list)
@ -766,7 +754,9 @@ ring, and also return it."
(message "current item: %s" current-item)
(when (and current-item (not (string= current-item "")))
(let* ((split-link (split-string current-item "::split::"))
(orglink (org-make-link-string (url-encode-url (car split-link)) (cadr split-link))))
(orglink (org-make-link-string
(url-encode-url (car split-link))
(cadr split-link))))
(push orglink orglink-list)))))
(kill-new (mapconcat 'identity orglink-list "\n"))))
@ -778,15 +768,12 @@ selected items in DEVONthink Pro Office and make link(s) out of it/them."
(insert (org-mac-devonthink-get-links)))
;;
;;
;; Handle links from Mail.app
;;
(org-add-link-type "message" 'org-mac-message-open)
(defun org-mac-message-open (message-id)
"Visit the message with the given MESSAGE-ID.
"Visit the message with MESSAGE-ID.
This will use the command `open' with the message URL."
(start-process (concat "open message:" message-id) nil
"open" (concat "message://<" (substring message-id 2) ">")))
@ -794,70 +781,70 @@ This will use the command `open' with the message URL."
(defun org-as-get-selected-mail ()
"AppleScript to create links to selected messages in Mail.app."
(do-applescript
(concat
"tell application \"Mail\"\n"
"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"
"if (theLinkList is not equal to {}) then\n"
"set theLink to \"\n\" & theLink\n"
"end if\n"
"copy theLink to end of theLinkList\n"
"end repeat\n"
"return theLinkList as string\n"
"end tell")))
(concat
"tell application \"Mail\"\n"
"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"
"if (theLinkList is not equal to {}) then\n"
"set theLink to \"\n\" & theLink\n"
"end if\n"
"copy theLink to end of theLinkList\n"
"end repeat\n"
"return theLinkList as string\n"
"end tell")))
(defun org-as-get-flagged-mail ()
"AppleScript to create links to flagged messages in Mail.app."
(do-applescript
(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"
(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"
;; 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")))
;; 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")))
(defun org-mac-message-get-links (&optional select-or-flag)
"Create links to the messages currently selected or flagged in Mail.app.
@ -872,9 +859,9 @@ The Org-syntax text will be pushed to the kill ring, and also returned."
(let* ((as-link-list
(if (string= select-or-flag "s")
(org-as-get-selected-mail)
(if (string= select-or-flag "f")
(org-as-get-flagged-mail)
(error "Please select \"s\" or \"f\""))))
(if (string= select-or-flag "f")
(org-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)
@ -920,11 +907,11 @@ list of message:// links to flagged mail after heading."
(delete-region (match-beginning 0) (match-end 0)))
(insert "\n" (org-mac-message-get-links "f")))
(flush-lines "^$" (point) (outline-next-heading)))
(insert "\n" (org-mac-message-get-links "f")))
(goto-char (point-max))
(insert "\n")
(org-insert-heading nil t)
(insert org-heading "\n" (org-mac-message-get-links "f"))))))
(insert "\n" (org-mac-message-get-links "f")))
(goto-char (point-max))
(insert "\n")
(org-insert-heading nil t)
(insert org-heading "\n" (org-mac-message-get-links "f"))))))
(provide 'org-mac-link)