contrib/lisp/org-mac-link.el

   1 ;;; org-mac-link.el --- Insert org-mode links to items selected in various Mac apps
   2 ;;
   3 ;; Copyright (c) 2010-2014 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Anthony Lander <anthony.lander@gmail.com>
   6 ;;      John Wiegley <johnw@gnu.org>
   7 ;;      Christopher Suckling <suckling at gmail dot com>
   8 ;;      Daniil Frumin <difrumin@gmail.com>
   9 ;;      Alan Schmitt <alan.schmitt@polytechnique.org>
  10 ;;      Mike McLean <mike.mclean@pobox.com>
  11 ;;
  12 ;;
  13 ;; Version: 1.1
  14 ;; Keywords: org, mac, hyperlink
  15 ;;
  16 ;; Version: 1.2
  17 ;; Keywords: outlook
  18 ;; Author: Mike McLean <mike.mclean@pobox.com>
  19 ;; Add support for Microsoft Outlook for Mac as Org mode links
  20 ;;
  21 ;; This file is not part of GNU Emacs.
  22 ;;
  23 ;; This program is free software; you can redistribute it and/or modify
  24 ;; it under the terms of the GNU General Public License as published by
  25 ;; the Free Software Foundation; either version 3, or (at your option)
  26 ;; any later version.
  27 ;;
  28 ;; This program is distributed in the hope that it will be useful,
  29 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  30 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  31 ;; GNU General Public License for more details.
  32 ;;
  33 ;; You should have received a copy of the GNU General Public License
  34 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  35 ;;
  36 ;;; Commentary:
  37 ;;
  38 ;; This code allows you to grab either the current selected items, or
  39 ;; the frontmost url in various mac appliations, and insert them as
  40 ;; hyperlinks into the current org-mode document at point.
  41 ;;
  42 ;; This code is heavily based on, and indeed incorporates,
  43 ;; org-mac-message.el written by John Wiegley and Christopher
  44 ;; Suckling.
  45 ;;
  46 ;; Detailed comments for each application interface are inlined with
  47 ;; the code.  Here is a brief overview of how the code interacts with
  48 ;; each application:
  49 ;;
  50 ;; Finder.app - grab links to the selected files in the frontmost window
  51 ;; Mail.app - grab links to the selected messages in the message list
  52 ;; AddressBook.app - Grab links to the selected addressbook Cards
  53 ;; Firefox.app - Grab the url of the frontmost tab in the frontmost window
  54 ;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window
  55 ;; Safari.app - Grab the url of the frontmost tab in the frontmost window
  56 ;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window
  57 ;; Together.app - Grab links to the selected items in the library list
  58 ;; Skim.app - Grab a link to the selected page in the topmost pdf document
  59 ;; Microsoft Outlook.app - Grab a link to the selected message in the message list
  60 ;; DEVONthink Pro Office.app - Grab a link to the selected DEVONthink item(s); open DEVONthink item by reference
  61 ;;
  62 ;;
  63 ;; Installation:
  64 ;;
  65 ;; add (require 'org-mac-link) to your .emacs, and optionally bind a
  66 ;; key to activate the link grabber menu, like this:
  67 ;;
  68 ;; (add-hook 'org-mode-hook (lambda ()
  69 ;;   (define-key org-mode-map (kbd "C-c g") 'org-mac-grab-link)))
  70 ;;
  71 ;; Usage:
  72 ;;
  73 ;; Type C-c g (or whatever key you defined, as above), or type M-x
  74 ;; org-mac-grab-link RET to activate the link grabber.  This will present
  75 ;; you with a menu to choose an application from which to grab a link
  76 ;; to insert at point.  You may also type C-g to abort.
  77 ;;
  78 ;; Customizing:
  79 ;;
  80 ;; You may customize which applications appear in the grab menu by
  81 ;; customizing the group `org-mac-link'.  Changes take effect
  82 ;; immediately.
  83 ;;
  84 ;;
  85 ;;; Code:
  86
  87 (require 'org)
  88
  89 (defgroup org-mac-link nil
  90   "Options for grabbing links from Mac applications."
  91   :tag "Org Mac link"
  92   :group 'org-link)
  93
  94 (defcustom org-mac-grab-Finder-app-p t
  95   "Add menu option [F]inder to grab links from the Finder."
  96   :tag "Grab Finder.app links"
  97   :group 'org-mac-link
  98   :type 'boolean)
  99
 100 (defcustom org-mac-grab-Mail-app-p t
 101   "Add menu option [m]ail to grab links from Mail.app."
 102   :tag "Grab Mail.app links"
 103   :group 'org-mac-link
 104   :type 'boolean)
 105
 106 (defcustom org-mac-grab-Outlook-app-p t
 107   "Add menu option [o]utlook to grab links from Microsoft Outlook.app."
 108   :tag "Grab Microsoft Outlook.app links"
 109   :group 'org-mac-link
 110   :type 'boolean)
 111
 112 (defcustom org-mac-grab-devonthink-app-p t
 113   "Add menu option [d]EVONthink to grab links from DEVONthink Pro Office.app."
 114   :tag "Grab DEVONthink Pro Office.app links"
 115   :group 'org-mac-link
 116   :type 'boolean)
 117
 118 (defcustom org-mac-grab-Addressbook-app-p t
 119   "Add menu option [a]ddressbook to grab links from AddressBook.app."
 120   :tag "Grab AddressBook.app links"
 121   :group 'org-mac-link
 122   :type 'boolean)
 123
 124 (defcustom org-mac-grab-Safari-app-p t
 125   "Add menu option [s]afari to grab links from Safari.app."
 126   :tag "Grab Safari.app links"
 127   :group 'org-mac-link
 128   :type 'boolean)
 129
 130 (defcustom org-mac-grab-Firefox-app-p t
 131   "Add menu option [f]irefox to grab links from Firefox.app."
 132   :tag "Grab Firefox.app links"
 133   :group 'org-mac-link
 134   :type 'boolean)
 135
 136 (defcustom org-mac-grab-Firefox+Vimperator-p nil
 137   "Add menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin."
 138   :tag "Grab Vimperator/Firefox.app links"
 139   :group 'org-mac-link
 140   :type 'boolean)
 141
 142 (defcustom org-mac-grab-Chrome-app-p t
 143   "Add menu option [c]hrome to grab links from Google Chrome.app."
 144   :tag "Grab Google Chrome.app links"
 145   :group 'org-mac-link
 146   :type 'boolean)
 147
 148 (defcustom org-mac-grab-Together-app-p nil
 149   "Add menu option [t]ogether to grab links from Together.app."
 150   :tag "Grab Together.app links"
 151   :group 'org-mac-link
 152   :type 'boolean)
 153
 154 (defcustom org-mac-grab-Skim-app-p
 155   (< 0 (length (shell-command-to-string
 156                 "mdfind kMDItemCFBundleIdentifier == 'net.sourceforge.skim-app.skim'")))
 157   "Add menu option [S]kim to grab page links from Skim.app."
 158   :tag "Grab Skim.app page links"
 159   :group 'org-mac-link
 160   :type 'boolean)
 161
 162 (defcustom org-mac-Skim-highlight-selection-p nil
 163   "Highlight the active selection when grabbing a link from Skim.app."
 164   :tag "Highlight selection in Skim.app"
 165   :group 'org-mac-link
 166   :type 'boolean)
 167
 168 (defgroup org-mac-flagged-mail nil
 169   "Options foring linking to flagged Mail.app messages."
 170   :tag "Org Mail.app"
 171   :group 'org-link)
 172
 173 (defcustom org-mac-mail-account nil
 174   "The Mail.app account in which to search for flagged messages."
 175   :group 'org-mac-flagged-mail
 176   :type 'string)
 177
 178 \f
 179 ;; In mac.c, removed in Emacs 23.
 180 (declare-function do-applescript "org-mac-message" (script))
 181 (unless (fboundp 'do-applescript)
 182   ;; Need to fake this using shell-command-to-string
 183   (defun do-applescript (script)
 184     (let (start cmd return)
 185       (while (string-match "\n" script)
 186         (setq script (replace-match "\r" t t script)))
 187       (while (string-match "'" script start)
 188         (setq start (+ 2 (match-beginning 0))
 189               script (replace-match "\\'" t t script)))
 190       (setq cmd (concat "osascript -e '" script "'"))
 191       (setq return (shell-command-to-string cmd))
 192       (concat "\"" (org-trim return) "\""))))
 193
 194 (defun org-mac-grab-link ()
 195   "Prompt for an application to grab a link from.
 196 When done, go grab the link, and insert it at point."
 197   (interactive)
 198   (let* ((descriptors
 199           `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
 200             ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
 201             ("d" "EVONthink Pro Office" org-mac-devonthink-item-insert-selected
 202              ,org-mac-grab-devonthink-app-p)
 203             ("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-app-p)
 204             ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
 205             ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
 206             ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
 207             ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
 208             ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
 209             ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)
 210             ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)))
 211          (menu-string (make-string 0 ?x))
 212          input)
 213
 214     ;; Create the menu string for the keymap
 215     (mapc '(lambda (descriptor)
 216             (when (elt descriptor 3)
 217               (setf menu-string (concat menu-string
 218                                         "[" (elt descriptor 0) "]"
 219                                         (elt descriptor 1) " "))))
 220           descriptors)
 221     (setf (elt menu-string (- (length menu-string) 1)) ?:)
 222
 223     ;; Prompt the user, and grab the link
 224     (message menu-string)
 225     (setq input (read-char-exclusive))
 226     (mapc '(lambda (descriptor)
 227             (let ((key (elt (elt descriptor 0) 0))
 228                   (active (elt descriptor 3))
 229                   (grab-function (elt descriptor 2)))
 230               (when (and active (eq input key))
 231                 (call-interactively grab-function))))
 232           descriptors)))
 233
 234 (defun org-mac-paste-applescript-links (as-link-list)
 235   "Paste in a list of links from an applescript handler.
 236 The links are of the form <link>::split::<name>."
 237   (let* ((noquote-as-link-list
 238           (if (string-prefix-p "\"" as-link-list)
 239               (substring as-link-list 1 -1)
 240             as-link-list))
 241          (link-list
 242           (mapcar (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x)
 243                                   (setq x (match-string 1 x)))
 244                     x)
 245                   (split-string noquote-as-link-list "[\r\n]+")))
 246          split-link URL description orglink orglink-insert rtn orglink-list)
 247     (while link-list
 248       (setq split-link (split-string (pop link-list) "::split::"))
 249       (setq URL (car split-link))
 250       (setq description (cadr split-link))
 251       (when (not (string= URL ""))
 252         (setq orglink (org-make-link-string URL description))
 253         (push orglink orglink-list)))
 254     (setq rtn (mapconcat 'identity orglink-list "\n"))
 255     (kill-new rtn)
 256     rtn))
 257
 258 \f
 259 ;; Handle links from Firefox.app
 260 ;;
 261 ;; This code allows you to grab the current active url from the main
 262 ;; Firefox.app window, and insert it as a link into an org-mode
 263 ;; document. Unfortunately, firefox does not expose an applescript
 264 ;; dictionary, so this is necessarily introduces some limitations.
 265 ;;
 266 ;; The applescript to grab the url from Firefox.app uses the System
 267 ;; Events application to give focus to the firefox application, select
 268 ;; the contents of the url bar, and copy it. It then uses the title of
 269 ;; the window as the text of the link. There is no way to grab links
 270 ;; from other open tabs, and further, if there is more than one window
 271 ;; open, it is not clear which one will be used (though emperically it
 272 ;; seems that it is always the last active window).
 273
 274 (defun org-as-mac-firefox-get-frontmost-url ()
 275   (let ((result
 276          (do-applescript
 277           (concat
 278            "set oldClipboard to the clipboard\n"
 279            "set frontmostApplication to path to frontmost application\n"
 280            "tell application \"Firefox\"\n"
 281            "    activate\n"
 282            "    delay 0.15\n"
 283            "    tell application \"System Events\"\n"
 284            "            keystroke \"l\" using {command down}\n"
 285            "            keystroke \"a\" using {command down}\n"
 286            "            keystroke \"c\" using {command down}\n"
 287            "    end tell\n"
 288            "    delay 0.15\n"
 289            "    set theUrl to the clipboard\n"
 290            "    set the clipboard to oldClipboard\n"
 291            "    set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
 292            "end tell\n"
 293            "activate application (frontmostApplication as text)\n"
 294            "set links to {}\n"
 295            "copy theResult to the end of links\n"
 296            "return links as string\n"))))
 297     (car (split-string result "[\r\n]+" t))))
 298
 299 (defun org-mac-firefox-get-frontmost-url ()
 300   (interactive)
 301   (message "Applescript: Getting Firefox url...")
 302   (let* ((url-and-title (org-as-mac-firefox-get-frontmost-url))
 303          (split-link (split-string url-and-title "::split::"))
 304          (URL (car split-link))
 305          (description (cadr split-link))
 306          (org-link))
 307     (when (not (string= URL ""))
 308       (setq org-link (org-make-link-string URL description)))
 309     (kill-new org-link)
 310     org-link))
 311
 312 (defun org-mac-firefox-insert-frontmost-url ()
 313   (interactive)
 314   (insert (org-mac-firefox-get-frontmost-url)))
 315
 316 \f
 317 ;; Handle links from Google Firefox.app running the Vimperator extension
 318 ;; Grab the frontmost url from Firefox+Vimperator. Same limitations are
 319 ;; Firefox
 320
 321 (defun org-as-mac-vimperator-get-frontmost-url ()
 322   (let ((result
 323          (do-applescript
 324           (concat
 325            "set oldClipboard to the clipboard\n"
 326            "set frontmostApplication to path to frontmost application\n"
 327            "tell application \"Firefox\"\n"
 328            "    activate\n"
 329            "    delay 0.15\n"
 330            "    tell application \"System Events\"\n"
 331            "            keystroke \"y\"\n"
 332            "    end tell\n"
 333            "    delay 0.15\n"
 334            "    set theUrl to the clipboard\n"
 335            "    set the clipboard to oldClipboard\n"
 336            "    set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
 337            "end tell\n"
 338            "activate application (frontmostApplication as text)\n"
 339            "set links to {}\n"
 340            "copy theResult to the end of links\n"
 341            "return links as string\n"))))
 342     (replace-regexp-in-string
 343      "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
 344
 345 (defun org-mac-vimperator-get-frontmost-url ()
 346   (interactive)
 347   (message "Applescript: Getting Vimperator url...")
 348   (let* ((url-and-title (org-as-mac-vimperator-get-frontmost-url))
 349          (split-link (split-string url-and-title "::split::"))
 350          (URL (car split-link))
 351          (description (cadr split-link))
 352          (org-link))
 353     (when (not (string= URL ""))
 354       (setq org-link (org-make-link-string URL description)))
 355     (kill-new org-link)
 356     org-link))
 357
 358 (defun org-mac-vimperator-insert-frontmost-url ()
 359   (interactive)
 360   (insert (org-mac-vimperator-get-frontmost-url)))
 361
 362 \f
 363 ;; Handle links from Google Chrome.app
 364 ;; Grab the frontmost url from Google Chrome. Same limitations as
 365 ;; Firefox because Chrome doesn't publish an Applescript dictionary
 366
 367 (defun org-as-mac-chrome-get-frontmost-url ()
 368   (let ((result
 369          (do-applescript
 370           (concat
 371            "set frontmostApplication to path to frontmost application\n"
 372            "tell application \"Google Chrome\"\n"
 373            "    set theUrl to get URL of active tab of first window\n"
 374            "    set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
 375            "end tell\n"
 376            "activate application (frontmostApplication as text)\n"
 377            "set links to {}\n"
 378            "copy theResult to the end of links\n"
 379            "return links as string\n"))))
 380     (replace-regexp-in-string
 381      "^\"\\|\"$" "" (car (split-string result "[\r\n]+" t)))))
 382
 383 (defun org-mac-chrome-get-frontmost-url ()
 384   (interactive)
 385   (message "Applescript: Getting Chrome url...")
 386   (let* ((url-and-title (org-as-mac-chrome-get-frontmost-url))
 387          (split-link (split-string url-and-title "::split::"))
 388          (URL (car split-link))
 389          (description (cadr split-link))
 390          (org-link))
 391     (when (not (string= URL ""))
 392       (setq org-link (org-make-link-string URL description)))
 393     (kill-new org-link)
 394     org-link))
 395
 396 (defun org-mac-chrome-insert-frontmost-url ()
 397   (interactive)
 398   (insert (org-mac-chrome-get-frontmost-url)))
 399
 400 \f
 401 ;; Handle links from Safari.app
 402 ;; Grab the frontmost url from Safari.
 403
 404 (defun org-as-mac-safari-get-frontmost-url ()
 405   (do-applescript
 406    (concat
 407     "tell application \"Safari\"\n"
 408     "   set theUrl to URL of document 1\n"
 409     "   set theName to the name of the document 1\n"
 410     "   return theUrl & \"::split::\" & theName & \"\n\"\n"
 411     "end tell\n")))
 412
 413 (defun org-mac-safari-get-frontmost-url ()
 414   (interactive)
 415   (message "Applescript: Getting Safari url...")
 416   (org-mac-paste-applescript-links
 417    (org-as-mac-safari-get-frontmost-url)))
 418
 419 (defun org-mac-safari-insert-frontmost-url ()
 420   (interactive)
 421   (insert (org-mac-safari-get-frontmost-url)))
 422
 423 \f
 424 ;; Handle links from together.app
 425
 426 (org-add-link-type "x-together-item" 'org-mac-together-item-open)
 427
 428 (defun org-mac-together-item-open (uid)
 429   "Open UID, which is a reference to an item in Together."
 430   (shell-command (concat "open -a Together \"x-together-item:" uid "\"")))
 431
 432 (defun as-get-selected-together-items ()
 433   (do-applescript
 434    (concat
 435     "tell application \"Together\"\n"
 436     "   set theLinkList to {}\n"
 437     "   set theSelection to selected items\n"
 438     "   repeat with theItem in theSelection\n"
 439     "           set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
 440     "           copy theLink to end of theLinkList\n"
 441     "   end repeat\n"
 442     "   return theLinkList as string\n"
 443     "end tell")))
 444
 445 (defun org-mac-together-get-selected ()
 446   (interactive)
 447   (message "Applescript: Getting Togther items...")
 448   (org-mac-paste-applescript-links (as-get-selected-together-items)))
 449
 450 (defun org-mac-together-insert-selected ()
 451   (interactive)
 452   (insert (org-mac-together-get-selected)))
 453
 454 \f
 455 ;; Handle links from Finder.app
 456
 457 (defun as-get-selected-finder-items ()
 458   (do-applescript
 459    (concat
 460     "tell application \"Finder\"\n"
 461     " set theSelection to the selection\n"
 462     " set links to {}\n"
 463     " repeat with theItem in theSelection\n"
 464     " set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
 465     " copy theLink to the end of links\n"
 466     " end repeat\n"
 467     " return links as string\n"
 468     "end tell\n")))
 469
 470 (defun org-mac-finder-item-get-selected ()
 471   (interactive)
 472   (message "Applescript: Getting Finder items...")
 473   (org-mac-paste-applescript-links (as-get-selected-finder-items)))
 474
 475 (defun org-mac-finder-insert-selected ()
 476   (interactive)
 477   (insert (org-mac-finder-item-get-selected)))
 478
 479 \f
 480 ;; Handle links from AddressBook.app
 481
 482 (org-add-link-type "addressbook" 'org-mac-addressbook-item-open)
 483
 484 (defun org-mac-addressbook-item-open (uid)
 485   "Open UID, which is a reference to an item in the addressbook."
 486   (shell-command (concat "open \"addressbook:" uid "\"")))
 487
 488 (defun as-get-selected-addressbook-items ()
 489   (do-applescript
 490    (concat
 491     "tell application \"Address Book\"\n"
 492     "   set theSelection to the selection\n"
 493     "   set links to {}\n"
 494     "   repeat with theItem in theSelection\n"
 495     "           set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
 496     "           copy theLink to the end of links\n"
 497     "   end repeat\n"
 498     "   return links as string\n"
 499     "end tell\n")))
 500
 501 (defun org-mac-addressbook-item-get-selected ()
 502   (interactive)
 503   (message "Applescript: Getting Address Book items...")
 504   (org-mac-paste-applescript-links (as-get-selected-addressbook-items)))
 505
 506 (defun org-mac-addressbook-insert-selected ()
 507   (interactive)
 508   (insert (org-mac-addressbook-item-get-selected)))
 509
 510 \f
 511 ;; Handle links from Skim.app
 512 ;;
 513 ;; Original code & idea by Christopher Suckling (org-mac-protocol)
 514
 515 (org-add-link-type "skim" 'org-mac-skim-open)
 516
 517 (defun org-mac-skim-open (uri)
 518   "Visit page of pdf in Skim"
 519   (let* ((page (when (string-match "::\\(.+\\)\\'" uri)
 520                  (match-string 1 uri)))
 521          (document (substring uri 0 (match-beginning 0))))
 522     (do-applescript
 523      (concat
 524       "tell application \"Skim\"\n"
 525       "activate\n"
 526       "set theDoc to \"" document "\"\n"
 527       "set thePage to " page "\n"
 528       "open theDoc\n"
 529       "go document 1 to page thePage of document 1\n"
 530       "end tell"))))
 531
 532 (defun as-get-skim-page-link ()
 533   (do-applescript
 534    (concat
 535     "tell application \"Skim\"\n"
 536     "set theDoc to front document\n"
 537     "set theTitle to (name of theDoc)\n"
 538     "set thePath to (path of theDoc)\n"
 539     "set thePage to (get index for current page of theDoc)\n"
 540     "set theSelection to selection of theDoc\n"
 541     "set theContent to contents of (get text for theSelection)\n"
 542     "if theContent is missing value then\n"
 543     "    set theContent to theTitle & \", p. \" & thePage\n"
 544     (when org-mac-Skim-highlight-selection-p
 545       (concat
 546        "else\n"
 547        "    tell theDoc\n"
 548        "        set theNote to make note with properties {type:highlight note, selection:theSelection}\n"
 549        "         set text of theNote to (get text for theSelection)\n"
 550        "    end tell\n"))
 551     "end if\n"
 552     "set theLink to \"skim://\" & thePath & \"::\" & thePage & "
 553     "\"::split::\" & theContent\n"
 554     "end tell\n"
 555     "return theLink as string\n")))
 556
 557 (defun org-mac-skim-get-page ()
 558   (interactive)
 559   (message "Applescript: Getting Skim page link...")
 560   (let* ((link-and-descr (as-get-skim-page-link))
 561          (split-link (split-string link-and-descr "::split::"))
 562          (link (car split-link))
 563          (description (cadr split-link))
 564          (org-link))
 565     (when (not (string= link ""))
 566       (setq org-link (org-make-link-string link description)))
 567     (kill-new org-link)
 568     org-link))
 569
 570 (defun org-mac-skim-insert-page ()
 571   (interactive)
 572   (insert (org-mac-skim-get-page)))
 573
 574 \f
 575 ;; Handle links from Microsoft Outlook.app
 576
 577 (org-add-link-type "mac-outlook" 'org-mac-outlook-message-open)
 578
 579 (defun org-mac-outlook-message-open (msgid)
 580   "Open a message in Outlook"
 581   (do-applescript
 582    (concat
 583     "tell application \"Microsoft Outlook\"\n"
 584     (format "open message id %s\n" (substring-no-properties msgid))
 585     "activate\n"
 586     "end tell")))
 587
 588 (defun org-as-get-selected-outlook-mail ()
 589   "AppleScript to create links to selected messages in Microsoft Outlook.app."
 590   (do-applescript
 591    (concat
 592     "tell application \"Microsoft Outlook\"\n"
 593     "set msgCount to count current messages\n"
 594     "if (msgCount < 1) then\n"
 595     "return\n"
 596     "end if\n"
 597     "set theLinkList to {}\n"
 598     "set theSelection to (get current messages)\n"
 599     "repeat with theMessage in theSelection\n"
 600     "set theID to id of theMessage as string\n"
 601     "set theURL to \"mac-outlook:\" & theID\n"
 602     "set theSubject to subject of theMessage\n"
 603     "set theLink to theURL & \"::split::\" & theSubject & \"\n\"\n"
 604     "copy theLink to end of theLinkList\n"
 605     "end repeat\n"
 606     "return theLinkList as string\n"
 607     "end tell")))
 608
 609 (defun org-sh-get-flagged-outlook-mail ()
 610   "Shell commands to create links to flagged messages in Microsoft Outlook.app."
 611   (mapconcat
 612    (lambda (x) ""
 613      (concat
 614       "mac-outlook:"
 615       (mapconcat
 616        (lambda (y) "" y)
 617        (split-string
 618         (shell-command-to-string
 619          (format "mdls -raw -name com_microsoft_outlook_recordID -name kMDItemDisplayName \"%s\"" x))
 620         "\000")
 621        "::split::")
 622       "\n"))
 623    (with-temp-buffer
 624      (let ((coding-system-for-read (or file-name-coding-system 'utf-8))
 625            (coding-system-for-write 'utf-8))
 626        (shell-command
 627         "mdfind com_microsoft_outlook_flagged==1"
 628         (current-buffer)))
 629      (split-string
 630       (buffer-string) "\n" t))
 631    ""))
 632
 633 (defun org-mac-outlook-message-get-links (&optional select-or-flag)
 634   "Create links to the messages currently selected or flagged in Microsoft Outlook.app.
 635 This will use AppleScript to get the message-id and the subject of the
 636 messages in Microsoft Outlook.app and make a link out of it.
 637 When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
 638 the default).  When SELECT-OR-FLAG is \"f\", get the flagged messages.
 639 The Org-syntax text will be pushed to the kill ring, and also returned."
 640   (interactive "sLink to (s)elected or (f)lagged messages: ")
 641   (setq select-or-flag (or select-or-flag "s"))
 642   (message "Org Mac Outlook: searching mailboxes...")
 643   (let* ((as-link-list
 644           (if (string= select-or-flag "s")
 645               (org-as-get-selected-outlook-mail)
 646             (if (string= select-or-flag "f")
 647                 (org-sh-get-flagged-outlook-mail)
 648               (error "Please select \"s\" or \"f\""))))
 649          (link-list
 650           (mapcar
 651            (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
 652            (split-string as-link-list "[\r\n]+")))
 653          split-link URL description orglink orglink-insert rtn orglink-list)
 654     (while link-list
 655       (setq split-link (split-string (pop link-list) "::split::"))
 656       (setq URL (car split-link))
 657       (setq description (cadr split-link))
 658       (when (not (string= URL ""))
 659         (setq orglink (org-make-link-string URL description))
 660         (push orglink orglink-list)))
 661     (setq rtn (mapconcat 'identity orglink-list "\n"))
 662     (kill-new rtn)
 663     rtn))
 664
 665 (defun org-mac-outlook-message-insert-selected ()
 666   "Insert a link to the messages currently selected in Microsoft Outlook.app.
 667 This will use AppleScript to get the message-id and the subject
 668 of the active mail in Microsoft Outlook.app and make a link out
 669 of it."
 670   (interactive)
 671   (insert (org-mac-outlook-message-get-links "s")))
 672
 673 (defun org-mac-outlook-message-insert-flagged (org-buffer org-heading)
 674   "Asks for an org buffer and a heading within it, and replace message links.
 675 If heading exists, delete all mac-outlook:// links within
 676 heading's first level.  If heading doesn't exist, create it at
 677 point-max.  Insert list of mac-outlook:// links to flagged mail
 678 after heading."
 679   (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
 680   (with-current-buffer org-buffer
 681     (goto-char (point-min))
 682     (let ((isearch-forward t)
 683           (message-re "\\[\\[\\(mac-outlook:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
 684       (if (org-goto-local-search-headings org-heading nil t)
 685           (if (not (eobp))
 686               (progn
 687                 (save-excursion
 688                   (while (re-search-forward
 689                           message-re (save-excursion (outline-next-heading)) t)
 690                     (delete-region (match-beginning 0) (match-end 0)))
 691                   (insert "\n" (org-mac-outlook-message-get-links "f")))
 692                 (flush-lines "^$" (point) (outline-next-heading)))
 693             (insert "\n" (org-mac-outlook-message-get-links "f")))
 694         (goto-char (point-max))
 695         (insert "\n")
 696         (org-insert-heading nil t)
 697         (insert org-heading "\n" (org-mac-outlook-message-get-links "f"))))))
 698
 699 \f
 700 ;; Handle links from DEVONthink Pro Office.app
 701
 702 (org-add-link-type "x-devonthink-item" 'org-devonthink-item-open)
 703
 704 (defun org-devonthink-item-open (uid)
 705   "Open UID, which is a reference to an item in DEVONthink Pro Office."
 706   (shell-command (concat "open \"x-devonthink-item:" uid "\"")))
 707
 708 (defun org-as-get-selected-devonthink-item ()
 709   "AppleScript to create links to selected items in DEVONthink Pro Office.app."
 710   (do-applescript
 711    (concat
 712     "set theLinkList to {}\n"
 713     "tell application \"DEVONthink Pro\"\n"
 714     "set selectedRecords to selection\n"
 715     "set selectionCount to count of selectedRecords\n"
 716     "if (selectionCount < 1) then\n"
 717     "return\n"
 718     "end if\n"
 719     "repeat with theRecord in selectedRecords\n"
 720     "set theID to uuid of theRecord\n"
 721     "set theURL to \"x-devonthink-item:\" & theID\n"
 722     "set theSubject to name of theRecord\n"
 723     "set theLink to theURL & \"::split::\" & theSubject & \"\n\"\n"
 724     "copy theLink to end of theLinkList\n"
 725     "end repeat\n"
 726     "end tell\n"
 727     "return theLinkList as string"
 728     )))
 729
 730 (defun org-mac-devonthink-get-links ()
 731   "Create links to the item(s) currently selected in DEVONthink Pro Office.
 732 This will use AppleScript to get the `uuid' and the `name' of the
 733 selected items in DEVONthink Pro Office.app and make links out of
 734 it/them. This function will push the Org-syntax text to the kill
 735 ring, and also return it."
 736   (message "Org Mac DEVONthink: looking for selected items...")
 737   (let* ((as-link-list (org-as-get-selected-devonthink-item))
 738          (link-list (if as-link-list
 739                         (mapcar
 740                          (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x)
 741                                          (setq x (match-string 1 x)))
 742                            x)
 743                          (split-string as-link-list "[\r\n]+"))
 744                       nil))
 745          orglink-list)
 746     (while link-list
 747       (let* ((current-item (pop link-list)))
 748         (message "current item: %s" current-item)
 749         (when (and current-item (not (string= current-item "")))
 750           (let* ((split-link (split-string current-item "::split::"))
 751                  (orglink (org-make-link-string
 752                            (url-encode-url (car split-link))
 753                            (cadr split-link))))
 754             (push orglink orglink-list)))))
 755     (kill-new (mapconcat 'identity orglink-list "\n"))))
 756
 757 (defun org-mac-devonthink-item-insert-selected ()
 758   "Insert a link to the item(s) currently selected in DEVONthink Pro Office.
 759 This will use AppleScript to get the `uuid'(s) and the name(s) of the
 760 selected items in DEVONthink Pro Office and make link(s) out of it/them."
 761   (interactive)
 762   (insert (org-mac-devonthink-get-links)))
 763
 764 \f
 765 ;; Handle links from Mail.app
 766
 767 (org-add-link-type "message" 'org-mac-message-open)
 768
 769 (defun org-mac-message-open (message-id)
 770   "Visit the message with MESSAGE-ID.
 771 This will use the command `open' with the message URL."
 772   (start-process (concat "open message:" message-id) nil
 773                  "open" (concat "message://<" (substring message-id 2) ">")))
 774
 775 (defun org-as-get-selected-mail ()
 776   "AppleScript to create links to selected messages in Mail.app."
 777   (do-applescript
 778    (concat
 779     "tell application \"Mail\"\n"
 780     "set theLinkList to {}\n"
 781     "set theSelection to selection\n"
 782     "repeat with theMessage in theSelection\n"
 783     "set theID to message id of theMessage\n"
 784     "set theSubject to subject of theMessage\n"
 785     "set theLink to \"message://\" & theID & \"::split::\" & theSubject\n"
 786     "if (theLinkList is not equal to {}) then\n"
 787     "set theLink to \"\n\" & theLink\n"
 788     "end if\n"
 789     "copy theLink to end of theLinkList\n"
 790     "end repeat\n"
 791     "return theLinkList as string\n"
 792     "end tell")))
 793
 794 (defun org-as-get-flagged-mail ()
 795   "AppleScript to create links to flagged messages in Mail.app."
 796   (unless org-mac-mail-account
 797     (error "You must set org-mac-mail-account"))
 798   (do-applescript
 799    (concat
 800     ;; Get links
 801     "tell application \"Mail\"\n"
 802     "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
 803     "set theLinkList to {}\n"
 804     "repeat with aMailbox in theMailboxes\n"
 805     "set theSelection to (every message in aMailbox whose flagged status = true)\n"
 806     "repeat with theMessage in theSelection\n"
 807     "set theID to message id of theMessage\n"
 808     "set theSubject to subject of theMessage\n"
 809     "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
 810     "copy theLink to end of theLinkList\n"
 811     "end repeat\n"
 812     "end repeat\n"
 813     "return theLinkList as string\n"
 814     "end tell")))
 815
 816 (defun org-mac-message-get-links (&optional select-or-flag)
 817   "Create links to the messages currently selected or flagged in Mail.app.
 818 This will use AppleScript to get the message-id and the subject of the
 819 messages in Mail.app and make a link out of it.
 820 When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
 821 the default).  When SELECT-OR-FLAG is \"f\", get the flagged messages.
 822 The Org-syntax text will be pushed to the kill ring, and also returned."
 823   (interactive "sLink to (s)elected or (f)lagged messages: ")
 824   (setq select-or-flag (or select-or-flag "s"))
 825   (message "AppleScript: searching mailboxes...")
 826   (org-mac-paste-applescript-links
 827    (cond
 828     ((string= select-or-flag "s") (org-as-get-selected-mail))
 829     ((string= select-or-flag "f") (org-as-get-flagged-mail))
 830     (t (error "Please select \"s\" or \"f\"")))))
 831
 832 (defun org-mac-message-insert-selected ()
 833   "Insert a link to the messages currently selected in Mail.app.
 834 This will use AppleScript to get the message-id and the subject of the
 835 active mail in Mail.app and make a link out of it."
 836   (interactive)
 837   (insert (org-mac-message-get-links "s")))
 838
 839 ;; The following line is for backward compatibility
 840 (defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
 841
 842 (defun org-mac-message-insert-flagged (org-buffer org-heading)
 843   "Asks for an org buffer and a heading within it, and replace message links.
 844 If heading exists, delete all message:// links within heading's first
 845 level.  If heading doesn't exist, create it at point-max.  Insert
 846 list of message:// links to flagged mail after heading."
 847   (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
 848   (with-current-buffer org-buffer
 849     (goto-char (point-min))
 850     (let ((isearch-forward t)
 851           (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
 852       (if (org-goto-local-search-headings org-heading nil t)
 853           (if (not (eobp))
 854               (progn
 855                 (save-excursion
 856                   (while (re-search-forward
 857                           message-re (save-excursion (outline-next-heading)) t)
 858                     (delete-region (match-beginning 0) (match-end 0)))
 859                   (insert "\n" (org-mac-message-get-links "f")))
 860                 (flush-lines "^$" (point) (outline-next-heading)))
 861             (insert "\n" (org-mac-message-get-links "f")))
 862         (goto-char (point-max))
 863         (insert "\n")
 864         (org-insert-heading nil t)
 865         (insert org-heading "\n" (org-mac-message-get-links "f"))))))
 866
 867 \f
 868 (provide 'org-mac-link)
 869
 870 ;;; org-mac-link.el ends here