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