Commit | Line | Data |
---|---|---|
c8d0cf5c | 1 | ;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. |
153ae947 | 2 | ;; |
ba318903 | 3 | ;; Copyright (C) 2008-2014 Free Software Foundation, Inc. |
153ae947 | 4 | ;; |
271672fa | 5 | ;; Authors: Bastien Guerry <bzg@gnu.org> |
dfd98937 BG |
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> | |
c8d0cf5c CD |
9 | ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> |
10 | ;; Keywords: org, emacsclient, wp | |
c8d0cf5c CD |
11 | |
12 | ;; This file is part of GNU Emacs. | |
13 | ;; | |
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. | |
18 | ||
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. | |
23 | ||
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/>. | |
26 | ||
27 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
28 | ;;; Commentary: | |
29 | ;; | |
30 | ;; Intercept calls from emacsclient to trigger custom actions. | |
31 | ;; | |
86fbb8ca CD |
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 | |
c8d0cf5c CD |
34 | ;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'. |
35 | ;; | |
36 | ;; Any application that supports calling external programs with an URL | |
37 | ;; as argument may be used with this functionality. | |
38 | ;; | |
39 | ;; | |
40 | ;; Usage: | |
41 | ;; ------ | |
42 | ;; | |
43 | ;; 1.) Add this to your init file (.emacs probably): | |
44 | ;; | |
45 | ;; (add-to-list 'load-path "/path/to/org-protocol/") | |
46 | ;; (require 'org-protocol) | |
47 | ;; | |
48 | ;; 3.) Ensure emacs-server is up and running. | |
49 | ;; 4.) Try this from the command line (adjust the URL as needed): | |
50 | ;; | |
51 | ;; $ emacsclient \ | |
52 | ;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title | |
53 | ;; | |
54 | ;; 5.) Optionally add custom sub-protocols and handlers: | |
55 | ;; | |
56 | ;; (setq org-protocol-protocol-alist | |
57 | ;; '(("my-protocol" | |
58 | ;; :protocol "my-protocol" | |
86fbb8ca | 59 | ;; :function my-protocol-handler-function))) |
c8d0cf5c CD |
60 | ;; |
61 | ;; A "sub-protocol" will be found in URLs like this: | |
62 | ;; | |
63 | ;; org-protocol://sub-protocol://data | |
64 | ;; | |
65 | ;; If it works, you can now setup other applications for using this feature. | |
66 | ;; | |
67 | ;; | |
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/ | |
71 | ;; | |
72 | ;; | |
73 | ;; Documentation | |
74 | ;; ------------- | |
75 | ;; | |
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 | |
79 | ;; applications: | |
80 | ;; | |
81 | ;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps | |
82 | ;; URLs to local filenames defined in `org-protocol-project-alist'. | |
83 | ;; | |
84 | ;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and | |
86fbb8ca | 85 | ;; pushes the browsers URL to the `kill-ring' for yanking. This handler is |
c8d0cf5c CD |
86 | ;; triggered through the sub-protocol \"store-link\". |
87 | ;; | |
86fbb8ca CD |
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 | |
c8d0cf5c CD |
92 | ;; was select in the browser, that text will be the body of the entry. |
93 | ;; | |
94 | ;; You may use the same bookmark URL for all those standard handlers and just | |
95 | ;; adjust the sub-protocol used: | |
96 | ;; | |
97 | ;; location.href='org-protocol://sub-protocol://'+ | |
98 | ;; encodeURIComponent(location.href)+'/'+ | |
99 | ;; encodeURIComponent(document.title)+'/'+ | |
100 | ;; encodeURIComponent(window.getSelection()) | |
101 | ;; | |
86fbb8ca | 102 | ;; The handler for the sub-protocol \"capture\" detects an optional template |
c8d0cf5c CD |
103 | ;; char that, if present, triggers the use of a special template. |
104 | ;; Example: | |
105 | ;; | |
106 | ;; location.href='org-protocol://sub-protocol://x/'+ ... | |
107 | ;; | |
108 | ;; use template ?x. | |
109 | ;; | |
8bfe682a CD |
110 | ;; Note, that using double slashes is optional from org-protocol.el's point of |
111 | ;; view because emacsclient squashes the slashes to one. | |
c8d0cf5c CD |
112 | ;; |
113 | ;; | |
114 | ;; provides: 'org-protocol | |
115 | ;; | |
116 | ;;; Code: | |
117 | ||
118 | (require 'org) | |
119 | (eval-when-compile | |
120 | (require 'cl)) | |
121 | ||
c8d0cf5c CD |
122 | (declare-function org-publish-get-project-from-filename "org-publish" |
123 | (filename &optional up)) | |
9d459fc5 | 124 | (declare-function server-edit "server" (&optional arg)) |
c8d0cf5c | 125 | |
a89c8ef0 | 126 | (define-obsolete-function-alias |
3ab2c837 BG |
127 | 'org-protocol-unhex-compound 'org-link-unescape-compound |
128 | "2011-02-17") | |
129 | ||
a89c8ef0 | 130 | (define-obsolete-function-alias |
3ab2c837 BG |
131 | 'org-protocol-unhex-string 'org-link-unescape |
132 | "2011-02-17") | |
133 | ||
a89c8ef0 | 134 | (define-obsolete-function-alias |
3ab2c837 BG |
135 | 'org-protocol-unhex-single-byte-sequence |
136 | 'org-link-unescape-single-byte-sequence | |
137 | "2011-02-17") | |
c8d0cf5c CD |
138 | |
139 | (defgroup org-protocol nil | |
140 | "Intercept calls from emacsclient to trigger custom actions. | |
141 | ||
27e428e7 PE |
142 | This is done by advising `server-visit-files' to scan the list of filenames |
143 | for `org-protocol-the-protocol' and sub-protocols defined in | |
c8d0cf5c CD |
144 | `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'." |
145 | :version "22.1" | |
146 | :group 'convenience | |
147 | :group 'org) | |
148 | ||
149 | ||
150 | ;;; Variables: | |
151 | ||
152 | (defconst org-protocol-protocol-alist-default | |
271672fa | 153 | '(("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t) |
c8d0cf5c CD |
154 | ("org-store-link" :protocol "store-link" :function org-protocol-store-link) |
155 | ("org-open-source" :protocol "open-source" :function org-protocol-open-source)) | |
156 | "Default protocols to use. | |
157 | See `org-protocol-protocol-alist' for a description of this variable.") | |
158 | ||
c8d0cf5c CD |
159 | (defconst org-protocol-the-protocol "org-protocol" |
160 | "This is the protocol to detect if org-protocol.el is loaded. | |
86fbb8ca CD |
161 | `org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold |
162 | the sub-protocols that trigger the required action. You will have to define | |
163 | just one protocol handler OS-wide (MS-Windows) or per application (Linux). | |
164 | That protocol handler should call emacsclient.") | |
c8d0cf5c | 165 | |
c8d0cf5c CD |
166 | ;;; User variables: |
167 | ||
168 | (defcustom org-protocol-reverse-list-of-files t | |
3ab2c837 | 169 | "Non-nil means re-reverse the list of filenames passed on the command line. |
86fbb8ca CD |
170 | The filenames passed on the command line are passed to the emacs-server in |
171 | reverse order. Set to t (default) to re-reverse the list, i.e. use the | |
172 | sequence on the command line. If nil, the sequence of the filenames is | |
c8d0cf5c CD |
173 | unchanged." |
174 | :group 'org-protocol | |
175 | :type 'boolean) | |
176 | ||
c8d0cf5c | 177 | (defcustom org-protocol-project-alist nil |
3ab2c837 | 178 | "Map URLs to local filenames for `org-protocol-open-source' (open-source). |
c8d0cf5c CD |
179 | |
180 | Each element of this list must be of the form: | |
181 | ||
182 | (module-name :property value property: value ...) | |
183 | ||
8223b1d2 | 184 | where module-name is an arbitrary name. All the values are strings. |
c8d0cf5c CD |
185 | |
186 | Possible properties are: | |
187 | ||
188 | :online-suffix - the suffix to strip from the published URLs | |
189 | :working-suffix - the replacement for online-suffix | |
190 | :base-url - the base URL, e.g. http://www.example.com/project/ | |
191 | Last slash required. | |
8223b1d2 | 192 | :working-directory - the local working directory. This is, what base-url will |
c8d0cf5c | 193 | be replaced with. |
5dec9555 CD |
194 | :redirects - A list of cons cells, each of which maps a regular |
195 | expression to match to a path relative to :working-directory. | |
c8d0cf5c CD |
196 | |
197 | Example: | |
198 | ||
199 | (setq org-protocol-project-alist | |
200 | '((\"http://orgmode.org/worg/\" | |
201 | :online-suffix \".php\" | |
202 | :working-suffix \".org\" | |
203 | :base-url \"http://orgmode.org/worg/\" | |
204 | :working-directory \"/home/user/org/Worg/\") | |
205 | (\"http://localhost/org-notes/\" | |
206 | :online-suffix \".html\" | |
207 | :working-suffix \".org\" | |
208 | :base-url \"http://localhost/org/\" | |
5dec9555 CD |
209 | :working-directory \"/home/user/org/\" |
210 | :rewrites ((\"org/?$\" . \"index.php\"))))) | |
211 | ||
212 | The last line tells `org-protocol-open-source' to open | |
213 | /home/user/org/index.php, if the URL cannot be mapped to an existing | |
214 | file, and ends with either \"org\" or \"org/\". | |
c8d0cf5c CD |
215 | |
216 | Consider using the interactive functions `org-protocol-create' and | |
217 | `org-protocol-create-for-org' to help you filling this variable with valid contents." | |
218 | :group 'org-protocol | |
219 | :type 'alist) | |
220 | ||
c8d0cf5c | 221 | (defcustom org-protocol-protocol-alist nil |
8c8b834f | 222 | "Register custom handlers for org-protocol. |
c8d0cf5c CD |
223 | |
224 | Each element of this list must be of the form: | |
225 | ||
226 | (module-name :protocol protocol :function func :kill-client nil) | |
227 | ||
228 | protocol - protocol to detect in a filename without trailing colon and slashes. | |
229 | See rfc1738 section 2.1 for more on this. | |
230 | If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol' | |
231 | will search filenames for \"org-protocol:/my-protocol:/\" | |
232 | and trigger your action for every match. `org-protocol' is defined in | |
8223b1d2 | 233 | `org-protocol-the-protocol'. Double and triple slashes are compressed |
c8d0cf5c CD |
234 | to one by emacsclient. |
235 | ||
236 | function - function that handles requests with protocol and takes exactly one | |
8223b1d2 BG |
237 | argument: the filename with all protocols stripped. If the function |
238 | returns nil, emacsclient and -server do nothing. Any non-nil return | |
c8d0cf5c CD |
239 | value is considered a valid filename and thus passed to the server. |
240 | ||
241 | `org-protocol.el provides some support for handling those filenames, | |
242 | if you stay with the conventions used for the standard handlers in | |
8223b1d2 | 243 | `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. |
c8d0cf5c CD |
244 | |
245 | kill-client - If t, kill the client immediately, once the sub-protocol is | |
8223b1d2 BG |
246 | detected. This is necessary for actions that can be interrupted by |
247 | `C-g' to avoid dangling emacsclients. Note, that all other command | |
c8d0cf5c CD |
248 | line arguments but the this one will be discarded, greedy handlers |
249 | still receive the whole list of arguments though. | |
250 | ||
251 | Here is an example: | |
252 | ||
253 | (setq org-protocol-protocol-alist | |
254 | '((\"my-protocol\" | |
255 | :protocol \"my-protocol\" | |
86fbb8ca | 256 | :function my-protocol-handler-function) |
c8d0cf5c CD |
257 | (\"your-protocol\" |
258 | :protocol \"your-protocol\" | |
86fbb8ca | 259 | :function your-protocol-handler-function)))" |
c8d0cf5c CD |
260 | :group 'org-protocol |
261 | :type '(alist)) | |
262 | ||
afe98dfa | 263 | (defcustom org-protocol-default-template-key nil |
3ab2c837 BG |
264 | "The default template key to use. |
265 | This is usually a single character string but can also be a | |
266 | string with two characters." | |
c8d0cf5c | 267 | :group 'org-protocol |
271672fa | 268 | :type '(choice (const nil) (string))) |
c8d0cf5c | 269 | |
271672fa | 270 | (defcustom org-protocol-data-separator "/+\\|\\?" |
8223b1d2 BG |
271 | "The default data separator to use. |
272 | This should be a single regexp string." | |
273 | :group 'org-protocol | |
271672fa BG |
274 | :version "24.4" |
275 | :package-version '(Org . "8.0") | |
8223b1d2 BG |
276 | :type 'string) |
277 | ||
c8d0cf5c CD |
278 | ;;; Helper functions: |
279 | ||
280 | (defun org-protocol-sanitize-uri (uri) | |
86fbb8ca | 281 | "emacsclient compresses double and triple slashes. |
c8d0cf5c CD |
282 | Slashes are sanitized to double slashes here." |
283 | (when (string-match "^\\([a-z]+\\):/" uri) | |
284 | (let* ((splitparts (split-string uri "/+"))) | |
285 | (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/"))))) | |
286 | uri) | |
287 | ||
3ab2c837 BG |
288 | (defun org-protocol-split-data (data &optional unhexify separator) |
289 | "Split what an org-protocol handler function gets as only argument. | |
290 | DATA is that one argument. DATA is split at each occurrence of | |
291 | SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is | |
86fbb8ca | 292 | nil, assume \"/+\". The results of that splitting are returned |
3ab2c837 BG |
293 | as a list. If UNHEXIFY is non-nil, hex-decode each split part. |
294 | If UNHEXIFY is a function, use that function to decode each split | |
86fbb8ca | 295 | part." |
271672fa | 296 | (let* ((sep (or separator "/+\\|\\?")) |
c8d0cf5c CD |
297 | (split-parts (split-string data sep))) |
298 | (if unhexify | |
299 | (if (fboundp unhexify) | |
300 | (mapcar unhexify split-parts) | |
3ab2c837 | 301 | (mapcar 'org-link-unescape split-parts)) |
c8d0cf5c CD |
302 | split-parts))) |
303 | ||
c8d0cf5c | 304 | (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) |
d1f18ec0 | 305 | "Greedy handlers might receive a list like this from emacsclient: |
3ab2c837 | 306 | '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") |
d1f18ec0 | 307 | where \"/dir/\" is the absolute path to emacsclients working directory. This |
3ab2c837 | 308 | function transforms it into a flat list using `org-protocol-flatten' and |
c8d0cf5c CD |
309 | transforms the elements of that list as follows: |
310 | ||
311 | If strip-path is non-nil, remove the \"/dir/\" prefix from all members of | |
312 | param-list. | |
313 | ||
314 | If replacement is string, replace the \"/dir/\" prefix with it. | |
315 | ||
316 | The first parameter, the one that contains the protocols, is always changed. | |
317 | Everything up to the end of the protocols is stripped. | |
318 | ||
319 | Note, that this function will always behave as if | |
320 | `org-protocol-reverse-list-of-files' was set to t and the returned list will | |
8223b1d2 | 321 | reflect that. I.e. emacsclients first parameter will be the first one in the |
c8d0cf5c | 322 | returned list." |
8223b1d2 BG |
323 | (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files |
324 | param-list | |
325 | (reverse param-list)))) | |
326 | (trigger (car l)) | |
327 | (len 0) | |
328 | dir | |
329 | ret) | |
330 | (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger) | |
331 | (setq dir (match-string 1 trigger)) | |
332 | (setq len (length dir)) | |
333 | (setcar l (concat dir (match-string 3 trigger)))) | |
334 | (if strip-path | |
335 | (progn | |
336 | (dolist (e l ret) | |
337 | (setq ret | |
338 | (append ret | |
339 | (list | |
340 | (if (stringp e) | |
341 | (if (stringp replacement) | |
342 | (setq e (concat replacement (substring e len))) | |
343 | (setq e (substring e len))) | |
344 | e))))) | |
345 | ret) | |
346 | l))) | |
c8d0cf5c | 347 | |
c8d0cf5c | 348 | (defun org-protocol-flatten (l) |
d1f18ec0 | 349 | "Greedy handlers might receive a list like this from emacsclient: |
c8d0cf5c | 350 | '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") |
d1f18ec0 JB |
351 | where \"/dir/\" is the absolute path to emacsclients working directory. |
352 | This function transforms it into a flat list." | |
c8d0cf5c CD |
353 | (if (null l) () |
354 | (if (listp l) | |
8223b1d2 | 355 | (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) |
c8d0cf5c CD |
356 | (list l)))) |
357 | ||
3ab2c837 | 358 | |
c8d0cf5c CD |
359 | ;;; Standard protocol handlers: |
360 | ||
361 | (defun org-protocol-store-link (fname) | |
86fbb8ca | 362 | "Process an org-protocol://store-link:// style url. |
8223b1d2 | 363 | Additionally store a browser URL as an org link. Also pushes the |
86fbb8ca | 364 | link's URL to the `kill-ring'. |
c8d0cf5c CD |
365 | |
366 | The location for a browser's bookmark has to look like this: | |
367 | ||
368 | javascript:location.href='org-protocol://store-link://'+ \\ | |
369 | encodeURIComponent(location.href) | |
370 | encodeURIComponent(document.title)+'/'+ \\ | |
371 | ||
8223b1d2 | 372 | Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page |
c8d0cf5c CD |
373 | could contain slashes and the location definitely will. |
374 | ||
375 | The sub-protocol used to reach this function is set in | |
376 | `org-protocol-protocol-alist'." | |
8223b1d2 | 377 | (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator)) |
c8d0cf5c CD |
378 | (uri (org-protocol-sanitize-uri (car splitparts))) |
379 | (title (cadr splitparts)) | |
380 | orglink) | |
381 | (if (boundp 'org-stored-links) | |
8223b1d2 | 382 | (setq org-stored-links (cons (list uri title) org-stored-links))) |
c8d0cf5c CD |
383 | (kill-new uri) |
384 | (message "`%s' to insert new org-link, `%s' to insert `%s'" | |
385 | (substitute-command-keys"\\[org-insert-link]") | |
386 | (substitute-command-keys"\\[yank]") | |
387 | uri)) | |
388 | nil) | |
389 | ||
3ab2c837 | 390 | (defun org-protocol-capture (info) |
86fbb8ca CD |
391 | "Process an org-protocol://capture:// style url. |
392 | ||
c8d0cf5c CD |
393 | The sub-protocol used to reach this function is set in |
394 | `org-protocol-protocol-alist'. | |
395 | ||
271672fa BG |
396 | This function detects an URL, title and optional text, separated |
397 | by '/'. The location for a browser's bookmark looks like this: | |
c8d0cf5c | 398 | |
86fbb8ca | 399 | javascript:location.href='org-protocol://capture://'+ \\ |
c8d0cf5c CD |
400 | encodeURIComponent(location.href)+'/' \\ |
401 | encodeURIComponent(document.title)+'/'+ \\ | |
402 | encodeURIComponent(window.getSelection()) | |
403 | ||
404 | By default, it uses the character `org-protocol-default-template-key', | |
86fbb8ca | 405 | which should be associated with a template in `org-capture-templates'. |
c8d0cf5c CD |
406 | But you may prepend the encoded URL with a character and a slash like so: |
407 | ||
86fbb8ca | 408 | javascript:location.href='org-protocol://capture://b/'+ ... |
c8d0cf5c CD |
409 | |
410 | Now template ?b will be used." | |
c8d0cf5c | 411 | (if (and (boundp 'org-stored-links) |
271672fa | 412 | (org-protocol-do-capture info)) |
3ab2c837 | 413 | (message "Item captured.")) |
c8d0cf5c CD |
414 | nil) |
415 | ||
271672fa BG |
416 | (defun org-protocol-convert-query-to-plist (query) |
417 | "Convert query string that is part of url to property list." | |
418 | (if query | |
419 | (apply 'append (mapcar (lambda (x) | |
420 | (let ((c (split-string x "="))) | |
421 | (list (intern (concat ":" (car c))) (cadr c)))) | |
422 | (split-string query "&"))))) | |
423 | ||
424 | (defun org-protocol-do-capture (info) | |
425 | "Support `org-capture'." | |
8223b1d2 | 426 | (let* ((parts (org-protocol-split-data info t org-protocol-data-separator)) |
3ab2c837 | 427 | (template (or (and (>= 2 (length (car parts))) (pop parts)) |
86fbb8ca CD |
428 | org-protocol-default-template-key)) |
429 | (url (org-protocol-sanitize-uri (car parts))) | |
430 | (type (if (string-match "^\\([a-z]+\\):" url) | |
431 | (match-string 1 url))) | |
3ab2c837 | 432 | (title (or (cadr parts) "")) |
86fbb8ca CD |
433 | (region (or (caddr parts) "")) |
434 | (orglink (org-make-link-string | |
435 | url (if (string-match "[^[:space:]]" title) title url))) | |
271672fa BG |
436 | (query (or (org-protocol-convert-query-to-plist (cadddr parts)) "")) |
437 | (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link | |
86fbb8ca CD |
438 | (setq org-stored-links |
439 | (cons (list url title) org-stored-links)) | |
440 | (kill-new orglink) | |
441 | (org-store-link-props :type type | |
442 | :link url | |
443 | :description title | |
444 | :annotation orglink | |
271672fa BG |
445 | :initial region |
446 | :query query) | |
86fbb8ca | 447 | (raise-frame) |
271672fa | 448 | (funcall 'org-capture nil template))) |
86fbb8ca | 449 | |
c8d0cf5c CD |
450 | (defun org-protocol-open-source (fname) |
451 | "Process an org-protocol://open-source:// style url. | |
452 | ||
453 | Change a filename by mapping URLs to local filenames as set | |
454 | in `org-protocol-project-alist'. | |
455 | ||
456 | The location for a browser's bookmark should look like this: | |
457 | ||
458 | javascript:location.href='org-protocol://open-source://'+ \\ | |
459 | encodeURIComponent(location.href)" | |
c8d0cf5c CD |
460 | ;; As we enter this function for a match on our protocol, the return value |
461 | ;; defaults to nil. | |
462 | (let ((result nil) | |
3ab2c837 | 463 | (f (org-link-unescape fname))) |
c8d0cf5c CD |
464 | (catch 'result |
465 | (dolist (prolist org-protocol-project-alist) | |
466 | (let* ((base-url (plist-get (cdr prolist) :base-url)) | |
467 | (wsearch (regexp-quote base-url))) | |
468 | ||
469 | (when (string-match wsearch f) | |
470 | (let* ((wdir (plist-get (cdr prolist) :working-directory)) | |
471 | (strip-suffix (plist-get (cdr prolist) :online-suffix)) | |
472 | (add-suffix (plist-get (cdr prolist) :working-suffix)) | |
5dec9555 CD |
473 | ;; Strip "[?#].*$" if `f' is a redirect with another |
474 | ;; ending than strip-suffix here: | |
475 | (f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f))) | |
476 | (start-pos (+ (string-match wsearch f1) (length base-url))) | |
c8d0cf5c | 477 | (end-pos (string-match |
5dec9555 CD |
478 | (regexp-quote strip-suffix) f1)) |
479 | ;; We have to compare redirects without suffix below: | |
480 | (f2 (concat wdir (substring f1 start-pos end-pos))) | |
481 | (the-file (concat f2 add-suffix))) | |
482 | ||
483 | ;; Note: the-file may still contain `%C3' et al here because browsers | |
484 | ;; tend to encode `ä' in URLs to `%25C3' - `%25' being `%'. | |
485 | ;; So the results may vary. | |
486 | ||
487 | ;; -- start redirects -- | |
488 | (unless (file-exists-p the-file) | |
489 | (message "File %s does not exist.\nTesting for rewritten URLs." the-file) | |
490 | (let ((rewrites (plist-get (cdr prolist) :rewrites))) | |
491 | (when rewrites | |
492 | (message "Rewrites found: %S" rewrites) | |
493 | (mapc | |
494 | (lambda (rewrite) | |
495 | "Try to match a rewritten URL and map it to a real file." | |
496 | ;; Compare redirects without suffix: | |
497 | (if (string-match (car rewrite) f2) | |
498 | (throw 'result (concat wdir (cdr rewrite))))) | |
499 | rewrites)))) | |
500 | ;; -- end of redirects -- | |
501 | ||
c8d0cf5c CD |
502 | (if (file-readable-p the-file) |
503 | (throw 'result the-file)) | |
504 | (if (file-exists-p the-file) | |
505 | (message "%s: permission denied!" the-file) | |
506 | (message "%s: no such file or directory." the-file)))))) | |
507 | result))) | |
508 | ||
509 | ||
510 | ;;; Core functions: | |
511 | ||
512 | (defun org-protocol-check-filename-for-protocol (fname restoffiles client) | |
513 | "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname. | |
514 | Sub-protocols are registered in `org-protocol-protocol-alist' and | |
515 | `org-protocol-protocol-alist-default'. | |
516 | This is, how the matching is done: | |
517 | ||
518 | (string-match \"protocol:/+sub-protocol:/+\" ...) | |
519 | ||
520 | protocol and sub-protocol are regexp-quoted. | |
521 | ||
86fbb8ca | 522 | If a matching protocol is found, the protocol is stripped from fname and the |
8223b1d2 | 523 | result is passed to the protocols function as the only parameter. If the |
c8d0cf5c CD |
524 | function returns nil, the filename is removed from the list of filenames |
525 | passed from emacsclient to the server. | |
526 | If the function returns a non nil value, that value is passed to the server | |
527 | as filename." | |
3ab2c837 BG |
528 | (let ((sub-protocols (append org-protocol-protocol-alist |
529 | org-protocol-protocol-alist-default))) | |
c8d0cf5c CD |
530 | (catch 'fname |
531 | (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) | |
532 | (when (string-match the-protocol fname) | |
533 | (dolist (prolist sub-protocols) | |
3ab2c837 BG |
534 | (let ((proto (concat the-protocol |
535 | (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) | |
c8d0cf5c CD |
536 | (when (string-match proto fname) |
537 | (let* ((func (plist-get (cdr prolist) :function)) | |
538 | (greedy (plist-get (cdr prolist) :greedy)) | |
bbd240ce PE |
539 | (split (split-string fname proto)) |
540 | (result (if greedy restoffiles (cadr split)))) | |
c8d0cf5c | 541 | (when (plist-get (cdr prolist) :kill-client) |
8223b1d2 | 542 | (message "Greedy org-protocol handler. Killing client.") |
c8d0cf5c CD |
543 | (server-edit)) |
544 | (when (fboundp func) | |
545 | (unless greedy | |
546 | (throw 'fname (funcall func result))) | |
547 | (funcall func result) | |
548 | (throw 'fname t)))))))) | |
549 | ;; (message "fname: %s" fname) | |
550 | fname))) | |
551 | ||
c8d0cf5c CD |
552 | (defadvice server-visit-files (before org-protocol-detect-protocol-server activate) |
553 | "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'." | |
554 | (let ((flist (if org-protocol-reverse-list-of-files | |
555 | (reverse (ad-get-arg 0)) | |
556 | (ad-get-arg 0))) | |
557 | (client (ad-get-arg 1))) | |
558 | (catch 'greedy | |
559 | (dolist (var flist) | |
8223b1d2 | 560 | ;; `\' to `/' on windows. FIXME: could this be done any better? |
3ab2c837 BG |
561 | (let ((fname (expand-file-name (car var)))) |
562 | (setq fname (org-protocol-check-filename-for-protocol | |
563 | fname (member var flist) client)) | |
c8d0cf5c CD |
564 | (if (eq fname t) ;; greedy? We need the `t' return value. |
565 | (progn | |
566 | (ad-set-arg 0 nil) | |
567 | (throw 'greedy t)) | |
568 | (if (stringp fname) ;; probably filename | |
569 | (setcar var fname) | |
3ab2c837 | 570 | (ad-set-arg 0 (delq var (ad-get-arg 0)))))))))) |
c8d0cf5c CD |
571 | |
572 | ;;; Org specific functions: | |
573 | ||
574 | (defun org-protocol-create-for-org () | |
575 | "Create a org-protocol project for the current file's Org-mode project. | |
271672fa BG |
576 | The visited file needs to be part of a publishing project in |
577 | `org-publish-project-alist' for this to work. The function | |
578 | delegates most of the work to `org-protocol-create'." | |
c8d0cf5c CD |
579 | (interactive) |
580 | (require 'org-publish) | |
c8d0cf5c CD |
581 | (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) |
582 | (if all (org-protocol-create (cdr all)) | |
8223b1d2 | 583 | (message "Not in an org-project. Did mean %s?" |
c8d0cf5c CD |
584 | (substitute-command-keys"\\[org-protocol-create]"))))) |
585 | ||
3ab2c837 | 586 | (defun org-protocol-create (&optional project-plist) |
c8d0cf5c | 587 | "Create a new org-protocol project interactively. |
271672fa BG |
588 | An org-protocol project is an entry in |
589 | `org-protocol-project-alist' which is used by | |
590 | `org-protocol-open-source'. Optionally use PROJECT-PLIST to | |
591 | initialize the defaults for this project. If PROJECT-PLIST is | |
592 | the cdr of an element in `org-publish-project-alist', reuse | |
c8d0cf5c CD |
593 | :base-directory, :html-extension and :base-extension." |
594 | (interactive) | |
3ab2c837 BG |
595 | (let ((working-dir (expand-file-name |
596 | (or (plist-get project-plist :base-directory) | |
597 | default-directory))) | |
c8d0cf5c CD |
598 | (base-url "http://orgmode.org/worg/") |
599 | (strip-suffix (or (plist-get project-plist :html-extension) ".html")) | |
600 | (working-suffix (if (plist-get project-plist :base-extension) | |
601 | (concat "." (plist-get project-plist :base-extension)) | |
602 | ".org")) | |
c8d0cf5c | 603 | (worglet-buffer nil) |
c8d0cf5c CD |
604 | (insert-default-directory t) |
605 | (minibuffer-allow-text-properties nil)) | |
606 | ||
607 | (setq base-url (read-string "Base URL of published content: " base-url nil base-url t)) | |
608 | (if (not (string-match "\\/$" base-url)) | |
609 | (setq base-url (concat base-url "/"))) | |
610 | ||
611 | (setq working-dir | |
612 | (expand-file-name | |
613 | (read-directory-name "Local working directory: " working-dir working-dir t))) | |
614 | (if (not (string-match "\\/$" working-dir)) | |
615 | (setq working-dir (concat working-dir "/"))) | |
616 | ||
617 | (setq strip-suffix | |
618 | (read-string | |
3ab2c837 | 619 | (concat "Extension to strip from published URLs (" strip-suffix "): ") |
8223b1d2 | 620 | strip-suffix nil strip-suffix t)) |
c8d0cf5c CD |
621 | |
622 | (setq working-suffix | |
623 | (read-string | |
3ab2c837 | 624 | (concat "Extension of editable files (" working-suffix "): ") |
8223b1d2 | 625 | working-suffix nil working-suffix t)) |
c8d0cf5c | 626 | |
5dec9555 | 627 | (when (yes-or-no-p "Save the new org-protocol-project to your init file? ") |
c8d0cf5c CD |
628 | (setq org-protocol-project-alist |
629 | (cons `(,base-url . (:base-url ,base-url | |
8223b1d2 BG |
630 | :working-directory ,working-dir |
631 | :online-suffix ,strip-suffix | |
632 | :working-suffix ,working-suffix)) | |
c8d0cf5c CD |
633 | org-protocol-project-alist)) |
634 | (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist)))) | |
635 | ||
636 | (provide 'org-protocol) | |
26bd9e87 | 637 | |
c8d0cf5c | 638 | ;;; org-protocol.el ends here |