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