replacing cl concatenate with concat
[org-mode.git] / contrib / lisp / org-mac-link-grabber.el
blobb422bfbb85bcf62ff5ca69abb5341d1a51745e76
1 ;;; org-mac-link-grabber.el --- Grab links and url from various mac
2 ;;; application and insert them as links into org-mode documents
3 ;;
4 ;; Copyright (c) 2010-2012 Free Software Foundation, Inc.
5 ;;
6 ;; Author: Anthony Lander <anthony.lander@gmail.com>
7 ;; Version: 1.0.1
8 ;; Keywords: org, mac, hyperlink
9 ;;
10 ;; This file is not part of GNU Emacs.
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
15 ;; any later version.
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program; if not, write to the Free Software
24 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;;; Commentary:
28 ;; This code allows you to grab either the current selected items, or
29 ;; the frontmost url in various mac appliations, and insert them as
30 ;; hyperlinks into the current org-mode document at point.
32 ;; This code is heavily based on, and indeed requires,
33 ;; org-mac-message.el written by John Weigley and Christopher
34 ;; Suckling.
36 ;; Detailed comments for each application interface are inlined with
37 ;; the code. Here is a brief overview of how the code interacts with
38 ;; each application:
40 ;; Finder.app - grab links to the selected files in the frontmost window
41 ;; Mail.app - grab links to the selected messages in the message list
42 ;; AddressBook.app - Grab links to the selected addressbook Cards
43 ;; Firefox.app - Grab the url of the frontmost tab in the frontmost window
44 ;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window
45 ;; Safari.app - Grab the url of the frontmost tab in the frontmost window
46 ;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window
47 ;; Together.app - Grab links to the selected items in the library list
50 ;; Installation:
52 ;; add (require 'org-mac-link-grabber) to your .emacs, and optionally
53 ;; bind a key to activate the link grabber menu, like this:
55 ;; (add-hook 'org-mode-hook (lambda ()
56 ;; (define-key org-mode-map (kbd "C-c g") 'omlg-grab-link)))
59 ;; Usage:
61 ;; Type C-c g (or whatever key you defined, as above), or type M-x
62 ;; omlg-grab-link RET to activate the link grabber. This will present
63 ;; you with a menu to choose an application from which to grab a link
64 ;; to insert at point. You may also type C-g to abort.
66 ;; Customizing:
68 ;; You may customize which applications appear in the grab menu by
69 ;; customizing the group org-mac-link-grabber. Changes take effect
70 ;; immediately.
73 ;;; Code:
75 (require 'org)
76 (require 'org-mac-message)
78 (defgroup org-mac-link-grabber nil
79 "Options concerning grabbing links from external Mac
80 applications and inserting them in org documents"
81 :tag "Org Mac link grabber"
82 :group 'org-link)
84 (defcustom org-mac-grab-Finder-app-p t
85 "Enable menu option [F]inder to grab links from the Finder"
86 :tag "Grab Finder.app links"
87 :group 'org-mac-link-grabber
88 :type 'boolean)
90 (defcustom org-mac-grab-Mail-app-p t
91 "Enable menu option [m]ail to grab links from Mail.app"
92 :tag "Grab Mail.app links"
93 :group 'org-mac-link-grabber
94 :type 'boolean)
96 (defcustom org-mac-grab-Addressbook-app-p t
97 "Enable menu option [a]ddressbook to grab links from AddressBook.app"
98 :tag "Grab AddressBook.app links"
99 :group 'org-mac-link-grabber
100 :type 'boolean)
102 (defcustom org-mac-grab-Safari-app-p t
103 "Enable menu option [s]afari to grab links from Safari.app"
104 :tag "Grab Safari.app links"
105 :group 'org-mac-link-grabber
106 :type 'boolean)
108 (defcustom org-mac-grab-Firefox-app-p t
109 "Enable menu option [f]irefox to grab links from Firefox.app"
110 :tag "Grab Firefox.app links"
111 :group 'org-mac-link-grabber
112 :type 'boolean)
114 (defcustom org-mac-grab-Firefox+Vimperator-p nil
115 "Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin"
116 :tag "Grab Vimperator/Firefox.app links"
117 :group 'org-mac-link-grabber
118 :type 'boolean)
120 (defcustom org-mac-grab-Chrome-app-p t
121 "Enable menu option [f]irefox to grab links from Google Chrome.app"
122 :tag "Grab Google Chrome.app links"
123 :group 'org-mac-link-grabber
124 :type 'boolean)
126 (defcustom org-mac-grab-Together-app-p nil
127 "Enable menu option [t]ogether to grab links from Together.app"
128 :tag "Grab Together.app links"
129 :group 'org-mac-link-grabber
130 :type 'boolean)
133 (defun omlg-grab-link ()
134 "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
135 (interactive)
136 (let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
137 ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
138 ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
139 ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
140 ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
141 ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
142 ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
143 ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)))
144 (menu-string (make-string 0 ?x))
145 input)
147 ;; Create the menu string for the keymap
148 (mapc '(lambda (descriptor)
149 (when (elt descriptor 3)
150 (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
151 descriptors)
152 (setf (elt menu-string (- (length menu-string) 1)) ?:)
154 ;; Prompt the user, and grab the link
155 (message menu-string)
156 (setq input (read-char-exclusive))
157 (mapc '(lambda (descriptor)
158 (let ((key (elt (elt descriptor 0) 0))
159 (active (elt descriptor 3))
160 (grab-function (elt descriptor 2)))
161 (when (and active (eq input key))
162 (call-interactively grab-function))))
163 descriptors)))
165 (defalias 'omgl-grab-link 'omlg-grab-link
166 "Renamed, and this alias will be obsolete next revision.")
168 (defun org-mac-paste-applescript-links (as-link-list)
169 "Paste in a list of links from an applescript handler. The
170 links are of the form <link>::split::<name>"
171 (let* ((link-list
172 (mapcar
173 (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
174 (split-string as-link-list "[\r\n]+")))
175 split-link URL description orglink orglink-insert rtn orglink-list)
176 (while link-list
177 (setq split-link (split-string (pop link-list) "::split::"))
178 (setq URL (car split-link))
179 (setq description (cadr split-link))
180 (when (not (string= URL ""))
181 (setq orglink (org-make-link-string URL description))
182 (push orglink orglink-list)))
183 (setq rtn (mapconcat 'identity orglink-list "\n"))
184 (kill-new rtn)
185 rtn))
189 ;; Handle links from Firefox.app
191 ;; This code allows you to grab the current active url from the main
192 ;; Firefox.app window, and insert it as a link into an org-mode
193 ;; document. Unfortunately, firefox does not expose an applescript
194 ;; dictionary, so this is necessarily introduces some limitations.
196 ;; The applescript to grab the url from Firefox.app uses the System
197 ;; Events application to give focus to the firefox application, select
198 ;; the contents of the url bar, and copy it. It then uses the title of
199 ;; the window as the text of the link. There is no way to grab links
200 ;; from other open tabs, and further, if there is more than one window
201 ;; open, it is not clear which one will be used (though emperically it
202 ;; seems that it is always the last active window).
204 (defun as-mac-firefox-get-frontmost-url ()
205 (let ((result (do-applescript
206 (concat
207 "set oldClipboard to the clipboard\n"
208 "set frontmostApplication to path to frontmost application\n"
209 "tell application \"Firefox\"\n"
210 " activate\n"
211 " delay 0.15\n"
212 " tell application \"System Events\"\n"
213 " keystroke \"l\" using command down\n"
214 " keystroke \"c\" using command down\n"
215 " end tell\n"
216 " delay 0.15\n"
217 " set theUrl to the clipboard\n"
218 " set the clipboard to oldClipboard\n"
219 " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
220 "end tell\n"
221 "activate application (frontmostApplication as text)\n"
222 "set links to {}\n"
223 "copy theResult to the end of links\n"
224 "return links as string\n"))))
225 (car (split-string result "[\r\n]+" t))))
227 (defun org-mac-firefox-get-frontmost-url ()
228 (interactive)
229 (message "Applescript: Getting Firefox url...")
230 (let* ((url-and-title (as-mac-firefox-get-frontmost-url))
231 (split-link (split-string url-and-title "::split::"))
232 (URL (car split-link))
233 (description (cadr split-link))
234 (org-link))
235 (when (not (string= URL ""))
236 (setq org-link (org-make-link-string URL description)))
237 (kill-new org-link)
238 org-link))
240 (defun org-mac-firefox-insert-frontmost-url ()
241 (interactive)
242 (insert (org-mac-firefox-get-frontmost-url)))
245 ;; Handle links from Google Firefox.app running the Vimperator extension
246 ;; Grab the frontmost url from Firefox+Vimperator. Same limitations are
247 ;; Firefox
249 (defun as-mac-vimperator-get-frontmost-url ()
250 (let ((result (do-applescript
251 (concat
252 "set oldClipboard to the clipboard\n"
253 "set frontmostApplication to path to frontmost application\n"
254 "tell application \"Firefox\"\n"
255 " activate\n"
256 " delay 0.15\n"
257 " tell application \"System Events\"\n"
258 " keystroke \"y\"\n"
259 " end tell\n"
260 " delay 0.15\n"
261 " set theUrl to the clipboard\n"
262 " set the clipboard to oldClipboard\n"
263 " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
264 "end tell\n"
265 "activate application (frontmostApplication as text)\n"
266 "set links to {}\n"
267 "copy theResult to the end of links\n"
268 "return links as string\n"))))
269 (replace-regexp-in-string "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
272 (defun org-mac-vimperator-get-frontmost-url ()
273 (interactive)
274 (message "Applescript: Getting Vimperator url...")
275 (let* ((url-and-title (as-mac-vimperator-get-frontmost-url))
276 (split-link (split-string url-and-title "::split::"))
277 (URL (car split-link))
278 (description (cadr split-link))
279 (org-link))
280 (when (not (string= URL ""))
281 (setq org-link (org-make-link-string URL description)))
282 (kill-new org-link)
283 org-link))
285 (defun org-mac-vimperator-insert-frontmost-url ()
286 (interactive)
287 (insert (org-mac-vimperator-get-frontmost-url)))
290 ;; Handle links from Google Chrome.app
291 ;; Grab the frontmost url from Google Chrome. Same limitations are
292 ;; Firefox because Chrome doesn't publish an Applescript dictionary
294 (defun as-mac-chrome-get-frontmost-url ()
295 (let ((result (do-applescript
296 (concat
297 "set oldClipboard to the clipboard\n"
298 "set frontmostApplication to path to frontmost application\n"
299 "tell application \"Google Chrome\"\n"
300 " activate\n"
301 " delay 0.15\n"
302 " tell application \"System Events\"\n"
303 " keystroke \"l\" using command down\n"
304 " keystroke \"c\" using command down\n"
305 " end tell\n"
306 " delay 0.15\n"
307 " set theUrl to the clipboard\n"
308 " set the clipboard to oldClipboard\n"
309 " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
310 "end tell\n"
311 "activate application (frontmostApplication as text)\n"
312 "set links to {}\n"
313 "copy theResult to the end of links\n"
314 "return links as string\n"))))
315 (car (split-string result "[\r\n]+" t))))
317 (defun org-mac-chrome-get-frontmost-url ()
318 (interactive)
319 (message "Applescript: Getting Chrome url...")
320 (let* ((url-and-title (as-mac-chrome-get-frontmost-url))
321 (split-link (split-string url-and-title "::split::"))
322 (URL (car split-link))
323 (description (cadr split-link))
324 (org-link))
325 (when (not (string= URL ""))
326 (setq org-link (org-make-link-string URL description)))
327 (kill-new org-link)
328 org-link))
330 (defun org-mac-chrome-insert-frontmost-url ()
331 (interactive)
332 (insert (org-mac-chrome-get-frontmost-url)))
335 ;; Handle links from Safari.app
336 ;; Grab the frontmost url from Safari.
338 (defun as-mac-safari-get-frontmost-url ()
339 (let ((result (do-applescript
340 (concat
341 "tell application \"Safari\"\n"
342 " set theUrl to URL of document 1\n"
343 " set theName to the name of the document 1\n"
344 " return theUrl & \"::split::\" & theName & \"\n\"\n"
345 "end tell\n"))))
346 (car (split-string result "[\r\n]+" t))))
348 (defun org-mac-safari-get-frontmost-url ()
349 (interactive)
350 (message "Applescript: Getting Safari url...")
351 (let* ((url-and-title (as-mac-safari-get-frontmost-url))
352 (split-link (split-string url-and-title "::split::"))
353 (URL (car split-link))
354 (description (cadr split-link))
355 (org-link))
356 (when (not (string= URL ""))
357 (setq org-link (org-make-link-string URL description)))
358 (kill-new org-link)
359 org-link))
361 (defun org-mac-safari-insert-frontmost-url ()
362 (interactive)
363 (insert (org-mac-safari-get-frontmost-url)))
368 ;; Handle links from together.app
372 (org-add-link-type "x-together-item" 'org-mac-together-item-open)
374 (defun org-mac-together-item-open (uid)
375 "Open the given uid, which is a reference to an item in Together"
376 (shell-command (concat "open -a Together \"x-together-item:" uid "\"")))
378 (defun as-get-selected-together-items ()
379 (do-applescript
380 (concat
381 "tell application \"Together\"\n"
382 " set theLinkList to {}\n"
383 " set theSelection to selected items\n"
384 " repeat with theItem in theSelection\n"
385 " set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
386 " copy theLink to end of theLinkList\n"
387 " end repeat\n"
388 " return theLinkList as string\n"
389 "end tell")))
391 (defun org-mac-together-get-selected ()
392 (interactive)
393 (message "Applescript: Getting Togther items...")
394 (org-mac-paste-applescript-links (as-get-selected-together-items)))
396 (defun org-mac-together-insert-selected ()
397 (interactive)
398 (insert (org-mac-together-get-selected)))
403 ;; Handle links from Finder.app
407 (defun as-get-selected-finder-items ()
408 (do-applescript
409 (concat
410 "tell application \"Finder\"\n"
411 " set theSelection to the selection\n"
412 " set links to {}\n"
413 " repeat with theItem in theSelection\n"
414 " set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
415 " copy theLink to the end of links\n"
416 " end repeat\n"
417 " return links as string\n"
418 "end tell\n")))
420 (defun org-mac-finder-item-get-selected ()
421 (interactive)
422 (message "Applescript: Getting Finder items...")
423 (org-mac-paste-applescript-links (as-get-selected-finder-items)))
425 (defun org-mac-finder-insert-selected ()
426 (interactive)
427 (insert (org-mac-finder-item-get-selected)))
432 ;; Handle links from AddressBook.app
436 (org-add-link-type "addressbook" 'org-mac-addressbook-item-open)
438 (defun org-mac-addressbook-item-open (uid)
439 "Open the given uid, which is a reference to an item in Together"
440 (shell-command (concat "open \"addressbook:" uid "\"")))
442 (defun as-get-selected-addressbook-items ()
443 (do-applescript
444 (concat
445 "tell application \"Address Book\"\n"
446 " set theSelection to the selection\n"
447 " set links to {}\n"
448 " repeat with theItem in theSelection\n"
449 " set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
450 " copy theLink to the end of links\n"
451 " end repeat\n"
452 " return links as string\n"
453 "end tell\n")))
455 (defun org-mac-addressbook-item-get-selected ()
456 (interactive)
457 (message "Applescript: Getting Address Book items...")
458 (org-mac-paste-applescript-links (as-get-selected-addressbook-items)))
460 (defun org-mac-addressbook-insert-selected ()
461 (interactive)
462 (insert (org-mac-addressbook-item-get-selected)))
465 (provide 'org-mac-link-grabber)
467 ;;; org-mac-link-grabber.el ends here