Merge branch 'maint'
[org-mode.git] / lisp / org-protocol.el
blob82543567456b67c7d86d67fbe9d5c3d32ab75ceb
1 ;;; org-protocol.el --- Intercept Calls from Emacsclient to Trigger Custom Actions -*- lexical-binding: t; -*-
2 ;;
3 ;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
4 ;;
5 ;; Authors: Bastien Guerry <bzg@gnu.org>
6 ;; Daniel M German <dmg AT uvic DOT org>
7 ;; Sebastian Rose <sebastian_rose AT gmx DOT de>
8 ;; Ross Patterson <me AT rpatterson DOT net>
9 ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de>
10 ;; Keywords: org, emacsclient, wp
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;;; Commentary:
30 ;; Intercept calls from emacsclient to trigger custom actions.
32 ;; This is done by advising `server-visit-files' to scan the list of filenames
33 ;; for `org-protocol-the-protocol' and sub-protocols defined in
34 ;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'.
36 ;; Any application that supports calling external programs with an URL
37 ;; as argument may be used with this functionality.
40 ;; Usage:
41 ;; ------
43 ;; 1.) Add this to your init file (.emacs probably):
45 ;; (add-to-list 'load-path "/path/to/org-protocol/")
46 ;; (require 'org-protocol)
48 ;; 3.) Ensure emacs-server is up and running.
49 ;; 4.) Try this from the command line (adjust the URL as needed):
51 ;; $ emacsclient \
52 ;; org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title
54 ;; 5.) Optionally add custom sub-protocols and handlers:
56 ;; (setq org-protocol-protocol-alist
57 ;; '(("my-protocol"
58 ;; :protocol "my-protocol"
59 ;; :function my-protocol-handler-function)))
61 ;; A "sub-protocol" will be found in URLs like this:
63 ;; org-protocol://sub-protocol?key=val&key2=val2
65 ;; If it works, you can now setup other applications for using this feature.
68 ;; As of March 2009 Firefox users follow the steps documented on
69 ;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here:
70 ;; http://www.opera.com/support/kb/view/535/
73 ;; Documentation
74 ;; -------------
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:
81 ;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps
82 ;; URLs to local filenames defined in `org-protocol-project-alist'.
84 ;; * `org-protocol-store-link' stores an Org link (if Org is present) and
85 ;; pushes the browsers URL to the `kill-ring' for yanking. This handler is
86 ;; triggered through the sub-protocol \"store-link\".
88 ;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If
89 ;; Org is loaded, Emacs will pop-up a capture buffer and fill the
90 ;; template with the data provided. I.e. the browser's URL is inserted as an
91 ;; Org-link of which the page title will be the description part. If text
92 ;; was select in the browser, that text will be the body of the entry.
94 ;; You may use the same bookmark URL for all those standard handlers and just
95 ;; adjust the sub-protocol used:
97 ;; location.href='org-protocol://sub-protocol?url='+
98 ;; encodeURIComponent(location.href)+'&title='+
99 ;; encodeURIComponent(document.title)+'&body='+
100 ;; encodeURIComponent(window.getSelection())
102 ;; The handler for the sub-protocol \"capture\" detects an optional template
103 ;; char that, if present, triggers the use of a special template.
104 ;; Example:
106 ;; location.href='org-protocol://capture?template=x'+ ...
108 ;; uses template ?x.
110 ;; Note that using double slashes is optional from org-protocol.el's point of
111 ;; view because emacsclient squashes the slashes to one.
114 ;; provides: 'org-protocol
116 ;;; Code:
118 (require 'org)
120 (declare-function org-publish-get-project-from-filename "ox-publish"
121 (filename &optional up))
122 (declare-function server-edit "server" (&optional arg))
124 (defvar org-capture-link-is-already-stored)
126 (defgroup org-protocol nil
127 "Intercept calls from emacsclient to trigger custom actions.
129 This is done by advising `server-visit-files' to scan the list of filenames
130 for `org-protocol-the-protocol' and sub-protocols defined in
131 `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'."
132 :version "22.1"
133 :group 'convenience
134 :group 'org)
137 ;;; Variables:
139 (defconst org-protocol-protocol-alist-default
140 '(("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t)
141 ("org-store-link" :protocol "store-link" :function org-protocol-store-link)
142 ("org-open-source" :protocol "open-source" :function org-protocol-open-source))
143 "Default protocols to use.
144 See `org-protocol-protocol-alist' for a description of this variable.")
146 (defconst org-protocol-the-protocol "org-protocol"
147 "This is the protocol to detect if org-protocol.el is loaded.
148 `org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold
149 the sub-protocols that trigger the required action. You will have to define
150 just one protocol handler OS-wide (MS-Windows) or per application (Linux).
151 That protocol handler should call emacsclient.")
153 ;;; User variables:
155 (defcustom org-protocol-reverse-list-of-files t
156 "Non-nil means re-reverse the list of filenames passed on the command line.
157 The filenames passed on the command line are passed to the emacs-server in
158 reverse order. Set to t (default) to re-reverse the list, i.e. use the
159 sequence on the command line. If nil, the sequence of the filenames is
160 unchanged."
161 :group 'org-protocol
162 :type 'boolean)
164 (defcustom org-protocol-project-alist nil
165 "Map URLs to local filenames for `org-protocol-open-source' (open-source).
167 Each element of this list must be of the form:
169 (module-name :property value property: value ...)
171 where module-name is an arbitrary name. All the values are strings.
173 Possible properties are:
175 :online-suffix - the suffix to strip from the published URLs
176 :working-suffix - the replacement for online-suffix
177 :base-url - the base URL, e.g. http://www.example.com/project/
178 Last slash required.
179 :working-directory - the local working directory. This is, what base-url will
180 be replaced with.
181 :redirects - A list of cons cells, each of which maps a regular
182 expression to match to a path relative to :working-directory.
184 Example:
186 (setq org-protocol-project-alist
187 \\='((\"http://orgmode.org/worg/\"
188 :online-suffix \".php\"
189 :working-suffix \".org\"
190 :base-url \"http://orgmode.org/worg/\"
191 :working-directory \"/home/user/org/Worg/\")
192 (\"http://localhost/org-notes/\"
193 :online-suffix \".html\"
194 :working-suffix \".org\"
195 :base-url \"http://localhost/org/\"
196 :working-directory \"/home/user/org/\"
197 :rewrites ((\"org/?$\" . \"index.php\")))))
199 The last line tells `org-protocol-open-source' to open
200 /home/user/org/index.php, if the URL cannot be mapped to an existing
201 file, and ends with either \"org\" or \"org/\".
203 Consider using the interactive functions `org-protocol-create' and
204 `org-protocol-create-for-org' to help you filling this variable with valid contents."
205 :group 'org-protocol
206 :type 'alist)
208 (defcustom org-protocol-protocol-alist nil
209 "Register custom handlers for org-protocol.
211 Each element of this list must be of the form:
213 (module-name :protocol protocol :function func :kill-client nil)
215 protocol - protocol to detect in a filename without trailing
216 colon and slashes. See rfc1738 section 2.1 for more
217 on this. If you define a protocol \"my-protocol\",
218 `org-protocol-check-filename-for-protocol' will search
219 filenames for \"org-protocol:/my-protocol\" and
220 trigger your action for every match. `org-protocol'
221 is defined in `org-protocol-the-protocol'. Double and
222 triple slashes are compressed to one by emacsclient.
224 function - function that handles requests with protocol and takes
225 one argument. If a new-style link (key=val&key2=val2)
226 is given, the argument will be a property list with
227 the values from the link. If an old-style link is
228 given (val1/val2), the argument will be the filename
229 with all protocols stripped.
231 If the function returns nil, emacsclient and -server
232 do nothing. Any non-nil return value is considered a
233 valid filename and thus passed to the server.
235 `org-protocol.el' provides some support for handling
236 old-style filenames, if you follow the conventions
237 used for the standard handlers in
238 `org-protocol-protocol-alist-default'. See
239 `org-protocol-parse-parameters'.
241 kill-client - If t, kill the client immediately, once the sub-protocol is
242 detected. This is necessary for actions that can be interrupted by
243 `C-g' to avoid dangling emacsclients. Note that all other command
244 line arguments but the this one will be discarded. Greedy handlers
245 still receive the whole list of arguments though.
247 Here is an example:
249 (setq org-protocol-protocol-alist
250 \\='((\"my-protocol\"
251 :protocol \"my-protocol\"
252 :function my-protocol-handler-function)
253 (\"your-protocol\"
254 :protocol \"your-protocol\"
255 :function your-protocol-handler-function)))"
256 :group 'org-protocol
257 :type '(alist))
259 (defcustom org-protocol-default-template-key nil
260 "The default template key to use.
261 This is usually a single character string but can also be a
262 string with two characters."
263 :group 'org-protocol
264 :type '(choice (const nil) (string)))
266 (defcustom org-protocol-data-separator "/+\\|\\?"
267 "The default data separator to use.
268 This should be a single regexp string."
269 :group 'org-protocol
270 :version "24.4"
271 :package-version '(Org . "8.0")
272 :type 'string)
274 ;;; Helper functions:
276 (defun org-protocol-sanitize-uri (uri)
277 "Sanitize slashes to double-slashes in URI.
278 Emacsclient compresses double and triple slashes."
279 (when (string-match "^\\([a-z]+\\):/" uri)
280 (let* ((splitparts (split-string uri "/+")))
281 (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
282 uri)
284 (defun org-protocol-split-data (data &optional unhexify separator)
285 "Split the DATA argument for an org-protocol handler function.
286 If UNHEXIFY is non-nil, hex-decode each split part. If UNHEXIFY
287 is a function, use that function to decode each split part. The
288 string is split at each occurrence of SEPARATOR (regexp). If no
289 SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The
290 results of that splitting are returned as a list."
291 (let* ((sep (or separator "/+\\|\\?"))
292 (split-parts (split-string data sep)))
293 (if unhexify
294 (if (fboundp unhexify)
295 (mapcar unhexify split-parts)
296 (mapcar 'org-link-unescape split-parts))
297 split-parts)))
299 (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
300 "Transform PARAM-LIST into a flat list for greedy handlers.
302 Greedy handlers might receive a list like this from emacsclient:
303 \((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
304 where \"/dir/\" is the absolute path to emacsclient's working directory. This
305 function transforms it into a flat list using `org-protocol-flatten' and
306 transforms the elements of that list as follows:
308 If STRIP-PATH is non-nil, remove the \"/dir/\" prefix from all members of
309 param-list.
311 If REPLACEMENT is string, replace the \"/dir/\" prefix with it.
313 The first parameter, the one that contains the protocols, is always changed.
314 Everything up to the end of the protocols is stripped.
316 Note, that this function will always behave as if
317 `org-protocol-reverse-list-of-files' was set to t and the returned list will
318 reflect that. emacsclient's first parameter will be the first one in the
319 returned list."
320 (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
321 param-list
322 (reverse param-list))))
323 (trigger (car l))
324 (len 0)
326 ret)
327 (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger)
328 (setq dir (match-string 1 trigger))
329 (setq len (length dir))
330 (setcar l (concat dir (match-string 3 trigger))))
331 (if strip-path
332 (progn
333 (dolist (e l ret)
334 (setq ret
335 (append ret
336 (list
337 (if (stringp e)
338 (if (stringp replacement)
339 (setq e (concat replacement (substring e len)))
340 (setq e (substring e len)))
341 e)))))
342 ret)
343 l)))
345 (defun org-protocol-flatten (list)
346 "Transform LIST into a flat list.
348 Greedy handlers might receive a list like this from emacsclient:
349 \((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
350 where \"/dir/\" is the absolute path to emacsclients working directory.
351 This function transforms it into a flat list."
352 (if (null list) ()
353 (if (listp list)
354 (append (org-protocol-flatten (car list)) (org-protocol-flatten (cdr list)))
355 (list list))))
357 (defun org-protocol-parse-parameters (info &optional new-style default-order)
358 "Return a property list of parameters from INFO.
359 If NEW-STYLE is non-nil, treat INFO as a query string (ex:
360 url=URL&title=TITLE). If old-style links are used (ex:
361 org-protocol://store-link/url/title), assign them to attributes
362 following DEFAULT-ORDER.
364 If no DEFAULT-ORDER is specified, return the list of values.
366 If INFO is already a property list, return it unchanged."
367 (if (listp info)
368 info
369 (if new-style
370 (let ((data (org-protocol-convert-query-to-plist info))
371 result)
372 (while data
373 (setq result
374 (append
375 result
376 (list
377 (pop data)
378 (org-link-unescape (pop data))))))
379 result)
380 (let ((data (org-protocol-split-data info t org-protocol-data-separator)))
381 (if default-order
382 (org-protocol-assign-parameters data default-order)
383 data)))))
385 (defun org-protocol-assign-parameters (data default-order)
386 "Return a property list of parameters from DATA.
387 Key names are taken from DEFAULT-ORDER, which should be a list of
388 symbols. If DEFAULT-ORDER is shorter than the number of values
389 specified, the rest of the values are treated as :key value pairs."
390 (let (result)
391 (while default-order
392 (setq result
393 (append result
394 (list (pop default-order)
395 (pop data)))))
396 (while data
397 (setq result
398 (append result
399 (list (intern (concat ":" (pop data)))
400 (pop data)))))
401 result))
403 ;;; Standard protocol handlers:
405 (defun org-protocol-store-link (fname)
406 "Process an org-protocol://store-link style url.
407 Additionally store a browser URL as an org link. Also pushes the
408 link's URL to the `kill-ring'.
410 Parameters: url, title (optional), body (optional)
412 Old-style links such as org-protocol://store-link://URL/TITLE are
413 also recognized.
415 The location for a browser's bookmark has to look like this:
417 javascript:location.href = \\
418 \\='org-protocol://store-link?url=\\=' + \\
419 encodeURIComponent(location.href) + \\='&title=\\=' + \\
420 encodeURIComponent(document.title);
422 Don't use `escape()'! Use `encodeURIComponent()' instead. The
423 title of the page could contain slashes and the location
424 definitely will.
426 The sub-protocol used to reach this function is set in
427 `org-protocol-protocol-alist'.
429 FNAME should be a property list. If not, an old-style link of the
430 form URL/TITLE can also be used."
431 (let* ((splitparts (org-protocol-parse-parameters fname nil '(:url :title)))
432 (uri (org-protocol-sanitize-uri (plist-get splitparts :url)))
433 (title (plist-get splitparts :title)))
434 (when (boundp 'org-stored-links)
435 (push (list uri title) org-stored-links))
436 (kill-new uri)
437 (message "`%s' to insert new org-link, `%s' to insert `%s'"
438 (substitute-command-keys "`\\[org-insert-link]'")
439 (substitute-command-keys "`\\[yank]'")
440 uri))
441 nil)
443 (defun org-protocol-capture (info)
444 "Process an org-protocol://capture style url with INFO.
446 The sub-protocol used to reach this function is set in
447 `org-protocol-protocol-alist'.
449 This function detects an URL, title and optional text, separated
450 by `/'. The location for a browser's bookmark looks like this:
452 javascript:location.href = \\='org-protocol://capture?url=\\='+ \\
453 encodeURIComponent(location.href) + \\='&title=\\=' \\
454 encodeURIComponent(document.title) + \\='&body=\\=' + \\
455 encodeURIComponent(window.getSelection())
457 By default, it uses the character `org-protocol-default-template-key',
458 which should be associated with a template in `org-capture-templates'.
459 You may specify the template with a template= query parameter, like this:
461 javascript:location.href = \\='org-protocol://capture?template=b\\='+ ...
463 Now template ?b will be used."
464 (if (and (boundp 'org-stored-links)
465 (org-protocol-do-capture info))
466 (message "Item captured."))
467 nil)
469 (defun org-protocol-convert-query-to-plist (query)
470 "Convert QUERY key=value pairs in the URL to a property list."
471 (if query
472 (apply 'append (mapcar (lambda (x)
473 (let ((c (split-string x "=")))
474 (list (intern (concat ":" (car c))) (cadr c))))
475 (split-string query "&")))))
477 (defun org-protocol-do-capture (info)
478 "Perform the actual capture based on INFO."
479 (let* ((temp-parts (org-protocol-parse-parameters info))
480 (parts
481 (cond
482 ((and (listp info) (symbolp (car info))) info)
483 ((= (length (car temp-parts)) 1) ;; First parameter is exactly one character long
484 (org-protocol-assign-parameters temp-parts '(:template :url :title :body)))
486 (org-protocol-assign-parameters temp-parts '(:url :title :body)))))
487 (template (or (plist-get parts :template)
488 org-protocol-default-template-key))
489 (url (and (plist-get parts :url) (org-protocol-sanitize-uri (plist-get parts :url))))
490 (type (and url (if (string-match "^\\([a-z]+\\):" url)
491 (match-string 1 url))))
492 (title (or (plist-get parts :title) ""))
493 (region (or (plist-get parts :body) ""))
494 (orglink (if url
495 (org-make-link-string
496 url (if (string-match "[^[:space:]]" title) title url))
497 title))
498 (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link
499 (setq org-stored-links
500 (cons (list url title) org-stored-links))
501 (org-store-link-props :type type
502 :link url
503 :description title
504 :annotation orglink
505 :initial region
506 :query parts)
507 (raise-frame)
508 (funcall 'org-capture nil template)))
510 (defun org-protocol-open-source (fname)
511 "Process an org-protocol://open-source?url= style URL with FNAME.
513 Change a filename by mapping URLs to local filenames as set
514 in `org-protocol-project-alist'.
516 The location for a browser's bookmark should look like this:
518 javascript:location.href = \\='org-protocol://open-source?url=\\=' + \\
519 encodeURIComponent(location.href)"
520 ;; As we enter this function for a match on our protocol, the return value
521 ;; defaults to nil.
522 (let ((result nil)
523 (f (plist-get (org-protocol-parse-parameters fname nil '(:url)) :url)))
524 (catch 'result
525 (dolist (prolist org-protocol-project-alist)
526 (let* ((base-url (plist-get (cdr prolist) :base-url))
527 (wsearch (regexp-quote base-url)))
529 (when (string-match wsearch f)
530 (let* ((wdir (plist-get (cdr prolist) :working-directory))
531 (strip-suffix (plist-get (cdr prolist) :online-suffix))
532 (add-suffix (plist-get (cdr prolist) :working-suffix))
533 ;; Strip "[?#].*$" if `f' is a redirect with another
534 ;; ending than strip-suffix here:
535 (f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f)))
536 (start-pos (+ (string-match wsearch f1) (length base-url)))
537 (end-pos (string-match
538 (regexp-quote strip-suffix) f1))
539 ;; We have to compare redirects without suffix below:
540 (f2 (concat wdir (substring f1 start-pos end-pos)))
541 (the-file (concat f2 add-suffix)))
543 ;; Note: the-file may still contain `%C3' et al here because browsers
544 ;; tend to encode `&auml;' in URLs to `%25C3' - `%25' being `%'.
545 ;; So the results may vary.
547 ;; -- start redirects --
548 (unless (file-exists-p the-file)
549 (message "File %s does not exist.\nTesting for rewritten URLs." the-file)
550 (let ((rewrites (plist-get (cdr prolist) :rewrites)))
551 (when rewrites
552 (message "Rewrites found: %S" rewrites)
553 (dolist (rewrite rewrites)
554 ;; Try to match a rewritten URL and map it to
555 ;; a real file. Compare redirects without
556 ;; suffix.
557 (when (string-match-p (car rewrite) f2)
558 (throw 'result (concat wdir (cdr rewrite))))))))
559 ;; -- end of redirects --
561 (if (file-readable-p the-file)
562 (throw 'result the-file))
563 (if (file-exists-p the-file)
564 (message "%s: permission denied!" the-file)
565 (message "%s: no such file or directory." the-file))))))
566 result)))
569 ;;; Core functions:
571 (defun org-protocol-check-filename-for-protocol (fname restoffiles _client)
572 "Check if `org-protocol-the-protocol' and a valid protocol are used in FNAME.
573 Sub-protocols are registered in `org-protocol-protocol-alist' and
574 `org-protocol-protocol-alist-default'. This is how the matching is done:
576 (string-match \"protocol:/+sub-protocol\\\\(://\\\\|\\\\?\\\\)\" ...)
578 protocol and sub-protocol are regexp-quoted.
580 Old-style links such as \"protocol://sub-protocol://param1/param2\" are
581 also recognized.
583 If a matching protocol is found, the protocol is stripped from
584 fname and the result is passed to the protocol function as the
585 first parameter. The second parameter will be non-nil if FNAME
586 uses key=val&key2=val2-type arguments, or nil if FNAME uses
587 val/val2-type arguments. If the function returns nil, the
588 filename is removed from the list of filenames passed from
589 emacsclient to the server. If the function returns a non-nil
590 value, that value is passed to the server as filename.
592 If the handler function is greedy, RESTOFFILES will also be passed to it.
594 CLIENT is ignored."
595 (let ((sub-protocols (append org-protocol-protocol-alist
596 org-protocol-protocol-alist-default)))
597 (catch 'fname
598 (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol)
599 ":/+")))
600 (when (string-match the-protocol fname)
601 (dolist (prolist sub-protocols)
602 (let ((proto
603 (concat the-protocol
604 (regexp-quote (plist-get (cdr prolist) :protocol))
605 "\\(:/+\\|\\?\\)")))
606 (when (string-match proto fname)
607 (let* ((func (plist-get (cdr prolist) :function))
608 (greedy (plist-get (cdr prolist) :greedy))
609 (split (split-string fname proto))
610 (result (if greedy restoffiles (cadr split)))
611 (new-style (string= (match-string 1 fname) "?")))
612 (when (plist-get (cdr prolist) :kill-client)
613 (message "Greedy org-protocol handler. Killing client.")
614 (server-edit))
615 (when (fboundp func)
616 (unless greedy
617 (throw 'fname
618 (if new-style
619 (funcall func (org-protocol-parse-parameters
620 result new-style))
621 (warn "Please update your Org Protocol handler \
622 to deal with new-style links.")
623 (funcall func result))))
624 ;; Greedy protocol handlers are responsible for
625 ;; parsing their own filenames.
626 (funcall func result)
627 (throw 'fname t))))))))
628 fname)))
630 (defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
631 "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'."
632 (let ((flist (if org-protocol-reverse-list-of-files
633 (reverse (ad-get-arg 0))
634 (ad-get-arg 0)))
635 (client (ad-get-arg 1)))
636 (catch 'greedy
637 (dolist (var flist)
638 ;; `\' to `/' on windows. FIXME: could this be done any better?
639 (let ((fname (expand-file-name (car var))))
640 (setq fname (org-protocol-check-filename-for-protocol
641 fname (member var flist) client))
642 (if (eq fname t) ;; greedy? We need the t return value.
643 (progn
644 (ad-set-arg 0 nil)
645 (throw 'greedy t))
646 (if (stringp fname) ;; probably filename
647 (setcar var fname)
648 (ad-set-arg 0 (delq var (ad-get-arg 0))))))))))
650 ;;; Org specific functions:
652 (defun org-protocol-create-for-org ()
653 "Create a Org protocol project for the current file's project.
654 The visited file needs to be part of a publishing project in
655 `org-publish-project-alist' for this to work. The function
656 delegates most of the work to `org-protocol-create'."
657 (interactive)
658 (require 'ox-publish)
659 (let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
660 (if all (org-protocol-create (cdr all))
661 (message "%s"
662 (substitute-command-keys
663 "Not in an Org project. \
664 Did you mean `\\[org-protocol-create]'?")))))
666 (defun org-protocol-create (&optional project-plist)
667 "Create a new org-protocol project interactively.
668 An org-protocol project is an entry in
669 `org-protocol-project-alist' which is used by
670 `org-protocol-open-source'. Optionally use PROJECT-PLIST to
671 initialize the defaults for this project. If PROJECT-PLIST is
672 the cdr of an element in `org-publish-project-alist', reuse
673 :base-directory, :html-extension and :base-extension."
674 (interactive)
675 (let ((working-dir (expand-file-name
676 (or (plist-get project-plist :base-directory)
677 default-directory)))
678 (base-url "http://orgmode.org/worg/")
679 (strip-suffix (or (plist-get project-plist :html-extension) ".html"))
680 (working-suffix (if (plist-get project-plist :base-extension)
681 (concat "." (plist-get project-plist :base-extension))
682 ".org"))
683 (insert-default-directory t)
684 (minibuffer-allow-text-properties nil))
686 (setq base-url (read-string "Base URL of published content: " base-url nil base-url t))
687 (or (string-suffix-p "/" base-url)
688 (setq base-url (concat base-url "/")))
690 (setq working-dir
691 (expand-file-name
692 (read-directory-name "Local working directory: " working-dir working-dir t)))
693 (or (string-suffix-p "/" working-dir)
694 (setq working-dir (concat working-dir "/")))
696 (setq strip-suffix
697 (read-string
698 (concat "Extension to strip from published URLs (" strip-suffix "): ")
699 strip-suffix nil strip-suffix t))
701 (setq working-suffix
702 (read-string
703 (concat "Extension of editable files (" working-suffix "): ")
704 working-suffix nil working-suffix t))
706 (when (yes-or-no-p "Save the new org-protocol-project to your init file? ")
707 (setq org-protocol-project-alist
708 (cons `(,base-url . (:base-url ,base-url
709 :working-directory ,working-dir
710 :online-suffix ,strip-suffix
711 :working-suffix ,working-suffix))
712 org-protocol-project-alist))
713 (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist))))
715 (provide 'org-protocol)
717 ;;; org-protocol.el ends here