1 ;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions.
3 ;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
5 ;; Author: Bastien Guerry <bzg AT gnu DOT org>
6 ;; Daniel M German <dmg AT uvic DOT org>
7 ;; Sebastian Rose <sebastian_rose AT gmx DOT de>
8 ;; Ross Patterson <me AT rpatterson DOT net>
9 ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
10 ;; Keywords: org, emacsclient, wp
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;; Intercept calls from emacsclient to trigger custom actions.
32 ;; This is done by advising `server-visit-files' to scan the list of filenames
33 ;; for `org-protocol-the-protocol' and sub-protocols defined in
34 ;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'.
36 ;; Any application that supports calling external programs with an URL
37 ;; as argument may be used with this functionality.
43 ;; 1.) Add this to your init file (.emacs probably):
45 ;; (add-to-list 'load-path "/path/to/org-protocol/")
46 ;; (require 'org-protocol)
48 ;; 3.) Ensure emacs-server is up and running.
49 ;; 4.) Try this from the command line (adjust the URL as needed):
52 ;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title
54 ;; 5.) Optionally add custom sub-protocols and handlers:
56 ;; (setq org-protocol-protocol-alist
58 ;; :protocol "my-protocol"
59 ;; :function my-protocol-handler-function)))
61 ;; A "sub-protocol" will be found in URLs like this:
63 ;; org-protocol://sub-protocol://data
65 ;; If it works, you can now setup other applications for using this feature.
68 ;; As of March 2009 Firefox users follow the steps documented on
69 ;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here:
70 ;; http://www.opera.com/support/kb/view/535/
76 ;; org-protocol.el comes with and installs handlers to open sources of published
77 ;; online content, store and insert the browser's URLs and cite online content
78 ;; by clicking on a bookmark in Firefox, Opera and probably other browsers and
81 ;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps
82 ;; URLs to local filenames defined in `org-protocol-project-alist'.
84 ;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and
85 ;; pushes the browsers URL to the `kill-ring' for yanking. This handler is
86 ;; triggered through the sub-protocol \"store-link\".
88 ;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If
89 ;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the
90 ;; template with the data provided. I.e. the browser's URL is inserted as an
91 ;; Org-link of which the page title will be the description part. If text
92 ;; was select in the browser, that text will be the body of the entry.
94 ;; * Call `org-protocol-remember' by using the sub-protocol \"remember\".
95 ;; This is provided for backward compatibility.
96 ;; You may read `org-capture' as `org-remember' throughout this file if
97 ;; you still use `org-remember'.
99 ;; You may use the same bookmark URL for all those standard handlers and just
100 ;; adjust the sub-protocol used:
102 ;; location.href='org-protocol://sub-protocol://'+
103 ;; encodeURIComponent(location.href)+'/'+
104 ;; encodeURIComponent(document.title)+'/'+
105 ;; encodeURIComponent(window.getSelection())
107 ;; The handler for the sub-protocol \"capture\" detects an optional template
108 ;; char that, if present, triggers the use of a special template.
111 ;; location.href='org-protocol://sub-protocol://x/'+ ...
115 ;; Note, that using double slashes is optional from org-protocol.el's point of
116 ;; view because emacsclient squashes the slashes to one.
119 ;; provides: 'org-protocol
127 (declare-function org-publish-get-project-from-filename
"org-publish"
128 (filename &optional up
))
129 (declare-function server-edit
"server" (&optional arg
))
131 (define-obsolete-function-alias
132 'org-protocol-unhex-compound
'org-link-unescape-compound
135 (define-obsolete-function-alias
136 'org-protocol-unhex-string
'org-link-unescape
139 (define-obsolete-function-alias
140 'org-protocol-unhex-single-byte-sequence
141 'org-link-unescape-single-byte-sequence
144 (defgroup org-protocol nil
145 "Intercept calls from emacsclient to trigger custom actions.
147 This is done by advising `server-visit-files' to scan the list of filenames
148 for `org-protocol-the-protocol' and sub-protocols defined in
149 `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'."
157 (defconst org-protocol-protocol-alist-default
158 '(("org-remember" :protocol
"remember" :function org-protocol-remember
:kill-client t
)
159 ("org-capture" :protocol
"capture" :function org-protocol-capture
:kill-client t
)
160 ("org-store-link" :protocol
"store-link" :function org-protocol-store-link
)
161 ("org-open-source" :protocol
"open-source" :function org-protocol-open-source
))
162 "Default protocols to use.
163 See `org-protocol-protocol-alist' for a description of this variable.")
165 (defconst org-protocol-the-protocol
"org-protocol"
166 "This is the protocol to detect if org-protocol.el is loaded.
167 `org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold
168 the sub-protocols that trigger the required action. You will have to define
169 just one protocol handler OS-wide (MS-Windows) or per application (Linux).
170 That protocol handler should call emacsclient.")
174 (defcustom org-protocol-reverse-list-of-files t
175 "Non-nil means re-reverse the list of filenames passed on the command line.
176 The filenames passed on the command line are passed to the emacs-server in
177 reverse order. Set to t (default) to re-reverse the list, i.e. use the
178 sequence on the command line. If nil, the sequence of the filenames is
183 (defcustom org-protocol-project-alist nil
184 "Map URLs to local filenames for `org-protocol-open-source' (open-source).
186 Each element of this list must be of the form:
188 (module-name :property value property: value ...)
190 where module-name is an arbitrary name. All the values are strings.
192 Possible properties are:
194 :online-suffix - the suffix to strip from the published URLs
195 :working-suffix - the replacement for online-suffix
196 :base-url - the base URL, e.g. http://www.example.com/project/
198 :working-directory - the local working directory. This is, what base-url will
200 :redirects - A list of cons cells, each of which maps a regular
201 expression to match to a path relative to :working-directory.
205 (setq org-protocol-project-alist
206 '((\"http://orgmode.org/worg/\"
207 :online-suffix \".php\"
208 :working-suffix \".org\"
209 :base-url \"http://orgmode.org/worg/\"
210 :working-directory \"/home/user/org/Worg/\")
211 (\"http://localhost/org-notes/\"
212 :online-suffix \".html\"
213 :working-suffix \".org\"
214 :base-url \"http://localhost/org/\"
215 :working-directory \"/home/user/org/\"
216 :rewrites ((\"org/?$\" . \"index.php\")))))
218 The last line tells `org-protocol-open-source' to open
219 /home/user/org/index.php, if the URL cannot be mapped to an existing
220 file, and ends with either \"org\" or \"org/\".
222 Consider using the interactive functions `org-protocol-create' and
223 `org-protocol-create-for-org' to help you filling this variable with valid contents."
227 (defcustom org-protocol-protocol-alist nil
228 "* Register custom handlers for org-protocol.
230 Each element of this list must be of the form:
232 (module-name :protocol protocol :function func :kill-client nil)
234 protocol - protocol to detect in a filename without trailing colon and slashes.
235 See rfc1738 section 2.1 for more on this.
236 If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol'
237 will search filenames for \"org-protocol:/my-protocol:/\"
238 and trigger your action for every match. `org-protocol' is defined in
239 `org-protocol-the-protocol'. Double and triple slashes are compressed
240 to one by emacsclient.
242 function - function that handles requests with protocol and takes exactly one
243 argument: the filename with all protocols stripped. If the function
244 returns nil, emacsclient and -server do nothing. Any non-nil return
245 value is considered a valid filename and thus passed to the server.
247 `org-protocol.el provides some support for handling those filenames,
248 if you stay with the conventions used for the standard handlers in
249 `org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
251 kill-client - If t, kill the client immediately, once the sub-protocol is
252 detected. This is necessary for actions that can be interrupted by
253 `C-g' to avoid dangling emacsclients. Note, that all other command
254 line arguments but the this one will be discarded, greedy handlers
255 still receive the whole list of arguments though.
259 (setq org-protocol-protocol-alist
261 :protocol \"my-protocol\"
262 :function my-protocol-handler-function)
264 :protocol \"your-protocol\"
265 :function your-protocol-handler-function)))"
269 (defcustom org-protocol-default-template-key nil
270 "The default template key to use.
271 This is usually a single character string but can also be a
272 string with two characters."
276 ;;; Helper functions:
278 (defun org-protocol-sanitize-uri (uri)
279 "emacsclient compresses double and triple slashes.
280 Slashes are sanitized to double slashes here."
281 (when (string-match "^\\([a-z]+\\):/" uri
)
282 (let* ((splitparts (split-string uri
"/+")))
283 (setq uri
(concat (car splitparts
) "//" (mapconcat 'identity
(cdr splitparts
) "/")))))
286 (defun org-protocol-split-data (data &optional unhexify separator
)
287 "Split what an org-protocol handler function gets as only argument.
288 DATA is that one argument. DATA is split at each occurrence of
289 SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
290 nil, assume \"/+\". The results of that splitting are returned
291 as a list. If UNHEXIFY is non-nil, hex-decode each split part.
292 If UNHEXIFY is a function, use that function to decode each split
294 (let* ((sep (or separator
"/+"))
295 (split-parts (split-string data sep
)))
297 (if (fboundp unhexify
)
298 (mapcar unhexify split-parts
)
299 (mapcar 'org-link-unescape split-parts
))
302 (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement
)
303 "Greedy handlers might receive a list like this from emacsclient:
304 '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
305 where \"/dir/\" is the absolute path to emacsclients working directory. This
306 function transforms it into a flat list using `org-protocol-flatten' and
307 transforms the elements of that list as follows:
309 If strip-path is non-nil, remove the \"/dir/\" prefix from all members of
312 If replacement is string, replace the \"/dir/\" prefix with it.
314 The first parameter, the one that contains the protocols, is always changed.
315 Everything up to the end of the protocols is stripped.
317 Note, that this function will always behave as if
318 `org-protocol-reverse-list-of-files' was set to t and the returned list will
319 reflect that. I.e. emacsclients first parameter will be the first one in the
321 (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
323 (reverse param-list
))))
328 (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger
)
329 (setq dir
(match-string 1 trigger
))
330 (setq len
(length dir
))
331 (setcar l
(concat dir
(match-string 3 trigger
))))
339 (if (stringp replacement
)
340 (setq e
(concat replacement
(substring e len
)))
341 (setq e
(substring e len
)))
346 (defun org-protocol-flatten (l)
347 "Greedy handlers might receive a list like this from emacsclient:
348 '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
349 where \"/dir/\" is the absolute path to emacsclients working directory.
350 This function transforms it into a flat list."
353 (append (org-protocol-flatten (car l
)) (org-protocol-flatten (cdr l
)))
357 ;;; Standard protocol handlers:
359 (defun org-protocol-store-link (fname)
360 "Process an org-protocol://store-link:// style url.
361 Additionally store a browser URL as an org link. Also pushes the
362 link's URL to the `kill-ring'.
364 The location for a browser's bookmark has to look like this:
366 javascript:location.href='org-protocol://store-link://'+ \\
367 encodeURIComponent(location.href)
368 encodeURIComponent(document.title)+'/'+ \\
370 Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
371 could contain slashes and the location definitely will.
373 The sub-protocol used to reach this function is set in
374 `org-protocol-protocol-alist'."
375 (let* ((splitparts (org-protocol-split-data fname t
))
376 (uri (org-protocol-sanitize-uri (car splitparts
)))
377 (title (cadr splitparts
))
379 (if (boundp 'org-stored-links
)
380 (setq org-stored-links
(cons (list uri title
) org-stored-links
)))
382 (message "`%s' to insert new org-link, `%s' to insert `%s'"
383 (substitute-command-keys"\\[org-insert-link]")
384 (substitute-command-keys"\\[yank]")
388 (defun org-protocol-remember (info)
389 "Process an org-protocol://remember:// style url.
391 The location for a browser's bookmark has to look like this:
393 javascript:location.href='org-protocol://remember://'+ \\
394 encodeURIComponent(location.href)+'/' \\
395 encodeURIComponent(document.title)+'/'+ \\
396 encodeURIComponent(window.getSelection())
398 See the docs for `org-protocol-capture' for more information."
400 (if (and (boundp 'org-stored-links
)
401 (fboundp 'org-capture
)
402 (org-protocol-do-capture info
'org-remember
))
403 (message "Item remembered."))
406 (defun org-protocol-capture (info)
407 "Process an org-protocol://capture:// style url.
409 The sub-protocol used to reach this function is set in
410 `org-protocol-protocol-alist'.
412 This function detects an URL, title and optional text, separated by '/'
413 The location for a browser's bookmark has to look like this:
415 javascript:location.href='org-protocol://capture://'+ \\
416 encodeURIComponent(location.href)+'/' \\
417 encodeURIComponent(document.title)+'/'+ \\
418 encodeURIComponent(window.getSelection())
420 By default, it uses the character `org-protocol-default-template-key',
421 which should be associated with a template in `org-capture-templates'.
422 But you may prepend the encoded URL with a character and a slash like so:
424 javascript:location.href='org-protocol://capture://b/'+ ...
426 Now template ?b will be used."
427 (if (and (boundp 'org-stored-links
)
428 (fboundp 'org-capture
)
429 (org-protocol-do-capture info
'org-capture
))
430 (message "Item captured."))
433 (defun org-protocol-do-capture (info capture-func
)
434 "Support `org-capture' and `org-remember' alike.
435 CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
436 (let* ((parts (org-protocol-split-data info t
))
437 (template (or (and (>= 2 (length (car parts
))) (pop parts
))
438 org-protocol-default-template-key
))
439 (url (org-protocol-sanitize-uri (car parts
)))
440 (type (if (string-match "^\\([a-z]+\\):" url
)
441 (match-string 1 url
)))
442 (title (or (cadr parts
) ""))
443 (region (or (caddr parts
) ""))
444 (orglink (org-make-link-string
445 url
(if (string-match "[^[:space:]]" title
) title url
)))
446 (org-capture-link-is-already-stored t
) ;; avoid call to org-store-link
447 remember-annotation-functions
)
448 (setq org-stored-links
449 (cons (list url title
) org-stored-links
))
451 (org-store-link-props :type type
457 (funcall capture-func nil template
)))
459 (defun org-protocol-open-source (fname)
460 "Process an org-protocol://open-source:// style url.
462 Change a filename by mapping URLs to local filenames as set
463 in `org-protocol-project-alist'.
465 The location for a browser's bookmark should look like this:
467 javascript:location.href='org-protocol://open-source://'+ \\
468 encodeURIComponent(location.href)"
469 ;; As we enter this function for a match on our protocol, the return value
472 (f (org-link-unescape fname
)))
474 (dolist (prolist org-protocol-project-alist
)
475 (let* ((base-url (plist-get (cdr prolist
) :base-url
))
476 (wsearch (regexp-quote base-url
)))
478 (when (string-match wsearch f
)
479 (let* ((wdir (plist-get (cdr prolist
) :working-directory
))
480 (strip-suffix (plist-get (cdr prolist
) :online-suffix
))
481 (add-suffix (plist-get (cdr prolist
) :working-suffix
))
482 ;; Strip "[?#].*$" if `f' is a redirect with another
483 ;; ending than strip-suffix here:
484 (f1 (substring f
0 (string-match "\\([\\?#].*\\)?$" f
)))
485 (start-pos (+ (string-match wsearch f1
) (length base-url
)))
486 (end-pos (string-match
487 (regexp-quote strip-suffix
) f1
))
488 ;; We have to compare redirects without suffix below:
489 (f2 (concat wdir
(substring f1 start-pos end-pos
)))
490 (the-file (concat f2 add-suffix
)))
492 ;; Note: the-file may still contain `%C3' et al here because browsers
493 ;; tend to encode `ä' in URLs to `%25C3' - `%25' being `%'.
494 ;; So the results may vary.
496 ;; -- start redirects --
497 (unless (file-exists-p the-file
)
498 (message "File %s does not exist.\nTesting for rewritten URLs." the-file
)
499 (let ((rewrites (plist-get (cdr prolist
) :rewrites
)))
501 (message "Rewrites found: %S" rewrites
)
504 "Try to match a rewritten URL and map it to a real file."
505 ;; Compare redirects without suffix:
506 (if (string-match (car rewrite
) f2
)
507 (throw 'result
(concat wdir
(cdr rewrite
)))))
509 ;; -- end of redirects --
511 (if (file-readable-p the-file
)
512 (throw 'result the-file
))
513 (if (file-exists-p the-file
)
514 (message "%s: permission denied!" the-file
)
515 (message "%s: no such file or directory." the-file
))))))
521 (defun org-protocol-check-filename-for-protocol (fname restoffiles client
)
522 "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname.
523 Sub-protocols are registered in `org-protocol-protocol-alist' and
524 `org-protocol-protocol-alist-default'.
525 This is, how the matching is done:
527 (string-match \"protocol:/+sub-protocol:/+\" ...)
529 protocol and sub-protocol are regexp-quoted.
531 If a matching protocol is found, the protocol is stripped from fname and the
532 result is passed to the protocols function as the only parameter. If the
533 function returns nil, the filename is removed from the list of filenames
534 passed from emacsclient to the server.
535 If the function returns a non nil value, that value is passed to the server
537 (let ((sub-protocols (append org-protocol-protocol-alist
538 org-protocol-protocol-alist-default
)))
540 (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol
) ":/+")))
541 (when (string-match the-protocol fname
)
542 (dolist (prolist sub-protocols
)
543 (let ((proto (concat the-protocol
544 (regexp-quote (plist-get (cdr prolist
) :protocol
)) ":/+")))
545 (when (string-match proto fname
)
546 (let* ((func (plist-get (cdr prolist
) :function
))
547 (greedy (plist-get (cdr prolist
) :greedy
))
548 (split (split-string fname proto
))
549 (result (if greedy restoffiles
(cadr split
))))
550 (when (plist-get (cdr prolist
) :kill-client
)
551 (message "Greedy org-protocol handler. Killing client.")
555 (throw 'fname
(funcall func result
)))
556 (funcall func result
)
557 (throw 'fname t
))))))))
558 ;; (message "fname: %s" fname)
561 (defadvice server-visit-files
(before org-protocol-detect-protocol-server activate
)
562 "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'."
563 (let ((flist (if org-protocol-reverse-list-of-files
564 (reverse (ad-get-arg 0))
566 (client (ad-get-arg 1)))
569 ;; `\' to `/' on windows. FIXME: could this be done any better?
570 (let ((fname (expand-file-name (car var
))))
571 (setq fname
(org-protocol-check-filename-for-protocol
572 fname
(member var flist
) client
))
573 (if (eq fname t
) ;; greedy? We need the `t' return value.
577 (if (stringp fname
) ;; probably filename
579 (ad-set-arg 0 (delq var
(ad-get-arg 0))))))))))
581 ;;; Org specific functions:
583 (defun org-protocol-create-for-org ()
584 "Create a org-protocol project for the current file's Org-mode project.
585 This works, if the file visited is part of a publishing project in
586 `org-publish-project-alist'. This function calls `org-protocol-create' to do
589 (require 'org-publish
)
590 (let ((all (or (org-publish-get-project-from-filename buffer-file-name
))))
591 (if all
(org-protocol-create (cdr all
))
592 (message "Not in an org-project. Did mean %s?"
593 (substitute-command-keys"\\[org-protocol-create]")))))
595 (defun org-protocol-create (&optional project-plist
)
596 "Create a new org-protocol project interactively.
597 An org-protocol project is an entry in `org-protocol-project-alist'
598 which is used by `org-protocol-open-source'.
599 Optionally use project-plist to initialize the defaults for this project. If
600 project-plist is the CDR of an element in `org-publish-project-alist', reuse
601 :base-directory, :html-extension and :base-extension."
603 (let ((working-dir (expand-file-name
604 (or (plist-get project-plist
:base-directory
)
606 (base-url "http://orgmode.org/worg/")
607 (strip-suffix (or (plist-get project-plist
:html-extension
) ".html"))
608 (working-suffix (if (plist-get project-plist
:base-extension
)
609 (concat "." (plist-get project-plist
:base-extension
))
612 (insert-default-directory t
)
613 (minibuffer-allow-text-properties nil
))
615 (setq base-url
(read-string "Base URL of published content: " base-url nil base-url t
))
616 (if (not (string-match "\\/$" base-url
))
617 (setq base-url
(concat base-url
"/")))
621 (read-directory-name "Local working directory: " working-dir working-dir t
)))
622 (if (not (string-match "\\/$" working-dir
))
623 (setq working-dir
(concat working-dir
"/")))
627 (concat "Extension to strip from published URLs (" strip-suffix
"): ")
628 strip-suffix nil strip-suffix t
))
632 (concat "Extension of editable files (" working-suffix
"): ")
633 working-suffix nil working-suffix t
))
635 (when (yes-or-no-p "Save the new org-protocol-project to your init file? ")
636 (setq org-protocol-project-alist
637 (cons `(,base-url .
(:base-url
,base-url
638 :working-directory
,working-dir
639 :online-suffix
,strip-suffix
640 :working-suffix
,working-suffix
))
641 org-protocol-project-alist
))
642 (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist
))))
644 (provide 'org-protocol
)
646 ;;; org-protocol.el ends here