org-protocol: Allow key=val&key2=val2-style URLs
* lisp/org-protocol.el: Update documentation. (org-protocol-store-link, org-protocol-capture, org-protocol-open-source): Accept new-style links. (org-protocol-check-filename-for-protocol): Update documentation. (org-protocol-parse-parameters, org-protocol-assign-parameters): New functions. This allows the use of org-protocol on KDE 5 and makes org-protocol links more URI-like. New-style links are of the form: org-protocol://store-link?title=TITLE&url=URL * testing/lisp/test-org-protocol.el: New file.
This commit is contained in:
parent
5aa12cd122
commit
25eb14bc2c
19
etc/ORG-NEWS
19
etc/ORG-NEWS
|
@ -77,6 +77,25 @@ using previous syntax:
|
|||
#+END_SRC
|
||||
|
||||
** New features
|
||||
*** New org-protocol key=value syntax
|
||||
|
||||
Org-protocol can now handle query-style parameters such as:
|
||||
|
||||
#+begin_example
|
||||
org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title
|
||||
org-protocol://capture?template=x&title=Hello&body=World&url=http:%2F%2Fexample.com
|
||||
#+end_example
|
||||
|
||||
Old-style links such as
|
||||
: org-protocol://store-link:/http:%2F%2Flocalhost%2Findex.html/The%20title
|
||||
continue to be supported.
|
||||
|
||||
If you have defined your own handler functions for
|
||||
~org-protocol-protocol-alist~, change them to accept either a property
|
||||
list (for new-style links) or a string (for old-style links). Use
|
||||
~org-protocol-parse-parameters~ to convert old-style links into
|
||||
property lists.
|
||||
|
||||
*** Org linter
|
||||
~org-lint~ can check syntax and report common issues in Org documents.
|
||||
*** New option ~date-tree-last~ for ~org-agenda-insert-diary-strategy~
|
||||
|
|
|
@ -49,7 +49,7 @@
|
|||
;; 4.) Try this from the command line (adjust the URL as needed):
|
||||
;;
|
||||
;; $ emacsclient \
|
||||
;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title
|
||||
;; org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title
|
||||
;;
|
||||
;; 5.) Optionally add custom sub-protocols and handlers:
|
||||
;;
|
||||
|
@ -60,7 +60,7 @@
|
|||
;;
|
||||
;; A "sub-protocol" will be found in URLs like this:
|
||||
;;
|
||||
;; org-protocol://sub-protocol://data
|
||||
;; org-protocol://sub-protocol?key=val&key2=val2
|
||||
;;
|
||||
;; If it works, you can now setup other applications for using this feature.
|
||||
;;
|
||||
|
@ -94,20 +94,20 @@
|
|||
;; You may use the same bookmark URL for all those standard handlers and just
|
||||
;; adjust the sub-protocol used:
|
||||
;;
|
||||
;; location.href='org-protocol://sub-protocol://'+
|
||||
;; encodeURIComponent(location.href)+'/'+
|
||||
;; encodeURIComponent(document.title)+'/'+
|
||||
;; location.href='org-protocol://sub-protocol?url='+
|
||||
;; encodeURIComponent(location.href)+'&title='+
|
||||
;; encodeURIComponent(document.title)+'&body='+
|
||||
;; encodeURIComponent(window.getSelection())
|
||||
;;
|
||||
;; The handler for the sub-protocol \"capture\" detects an optional template
|
||||
;; char that, if present, triggers the use of a special template.
|
||||
;; Example:
|
||||
;;
|
||||
;; location.href='org-protocol://sub-protocol://x/'+ ...
|
||||
;; location.href='org-protocol://capture?template=x'+ ...
|
||||
;;
|
||||
;; use template ?x.
|
||||
;; uses template ?x.
|
||||
;;
|
||||
;; Note, that using double slashes is optional from org-protocol.el's point of
|
||||
;; Note that using double slashes is optional from org-protocol.el's point of
|
||||
;; view because emacsclient squashes the slashes to one.
|
||||
;;
|
||||
;;
|
||||
|
@ -225,27 +225,36 @@ Each element of this list must be of the form:
|
|||
|
||||
(module-name :protocol protocol :function func :kill-client nil)
|
||||
|
||||
protocol - protocol to detect in a filename without trailing colon and slashes.
|
||||
See rfc1738 section 2.1 for more on this.
|
||||
If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol'
|
||||
will search filenames for \"org-protocol:/my-protocol:/\"
|
||||
and trigger your action for every match. `org-protocol' is defined in
|
||||
`org-protocol-the-protocol'. Double and triple slashes are compressed
|
||||
to one by emacsclient.
|
||||
protocol - protocol to detect in a filename without trailing
|
||||
colon and slashes. See rfc1738 section 2.1 for more
|
||||
on this. If you define a protocol \"my-protocol\",
|
||||
`org-protocol-check-filename-for-protocol' will search
|
||||
filenames for \"org-protocol:/my-protocol\" and
|
||||
trigger your action for every match. `org-protocol'
|
||||
is defined in `org-protocol-the-protocol'. Double and
|
||||
triple slashes are compressed to one by emacsclient.
|
||||
|
||||
function - function that handles requests with protocol and takes exactly one
|
||||
argument: the filename with all protocols stripped. If the function
|
||||
returns nil, emacsclient and -server do nothing. Any non-nil return
|
||||
value is considered a valid filename and thus passed to the server.
|
||||
function - function that handles requests with protocol and takes
|
||||
one argument. If a new-style link (key=val&key2=val2)
|
||||
is given, the argument will be a property list with
|
||||
the values from the link. If an old-style link is
|
||||
given (val1/val2), the argument will be the filename
|
||||
with all protocols stripped.
|
||||
|
||||
`org-protocol.el provides some support for handling those filenames,
|
||||
if you stay with the conventions used for the standard handlers in
|
||||
`org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
|
||||
If the function returns nil, emacsclient and -server
|
||||
do nothing. Any non-nil return value is considered a
|
||||
valid filename and thus passed to the server.
|
||||
|
||||
`org-protocol.el' provides some support for handling
|
||||
old-style filenames, if you follow the conventions
|
||||
used for the standard handlers in
|
||||
`org-protocol-protocol-alist-default'. See
|
||||
`org-protocol-parse-parameters'.
|
||||
|
||||
kill-client - If t, kill the client immediately, once the sub-protocol is
|
||||
detected. This is necessary for actions that can be interrupted by
|
||||
`C-g' to avoid dangling emacsclients. Note, that all other command
|
||||
line arguments but the this one will be discarded, greedy handlers
|
||||
`C-g' to avoid dangling emacsclients. Note that all other command
|
||||
line arguments but the this one will be discarded. Greedy handlers
|
||||
still receive the whole list of arguments though.
|
||||
|
||||
Here is an example:
|
||||
|
@ -269,7 +278,7 @@ string with two characters."
|
|||
|
||||
(defcustom org-protocol-data-separator "/+\\|\\?"
|
||||
"The default data separator to use.
|
||||
This should be a single regexp string."
|
||||
This should be a single regexp string."
|
||||
:group 'org-protocol
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0")
|
||||
|
@ -278,21 +287,20 @@ string with two characters."
|
|||
;;; Helper functions:
|
||||
|
||||
(defun org-protocol-sanitize-uri (uri)
|
||||
"emacsclient compresses double and triple slashes.
|
||||
Slashes are sanitized to double slashes here."
|
||||
"Sanitize slashes to double-slashes in URI.
|
||||
Emacsclient compresses double and triple slashes."
|
||||
(when (string-match "^\\([a-z]+\\):/" uri)
|
||||
(let* ((splitparts (split-string uri "/+")))
|
||||
(setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
|
||||
uri)
|
||||
|
||||
(defun org-protocol-split-data (data &optional unhexify separator)
|
||||
"Split what an org-protocol handler function gets as only argument.
|
||||
DATA is that one argument. DATA is split at each occurrence of
|
||||
SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
|
||||
nil, assume \"/+\". The results of that splitting are returned
|
||||
as a list. If UNHEXIFY is non-nil, hex-decode each split part.
|
||||
If UNHEXIFY is a function, use that function to decode each split
|
||||
part."
|
||||
"Split the DATA argument for an org-protocol handler function.
|
||||
If UNHEXIFY is non-nil, hex-decode each split part. If UNHEXIFY
|
||||
is a function, use that function to decode each split part. The
|
||||
string is split at each occurrence of SEPARATOR (regexp). If no
|
||||
SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The
|
||||
results of that splitting are returned as a list."
|
||||
(let* ((sep (or separator "/+\\|\\?"))
|
||||
(split-parts (split-string data sep)))
|
||||
(if unhexify
|
||||
|
@ -302,23 +310,25 @@ part."
|
|||
split-parts)))
|
||||
|
||||
(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
|
||||
"Greedy handlers might receive a list like this from emacsclient:
|
||||
((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
|
||||
where \"/dir/\" is the absolute path to emacsclients working directory. This
|
||||
"Transform PARAM-LIST into a flat list for greedy handlers.
|
||||
|
||||
Greedy handlers might receive a list like this from emacsclient:
|
||||
\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
|
||||
where \"/dir/\" is the absolute path to emacsclient's working directory. This
|
||||
function transforms it into a flat list using `org-protocol-flatten' and
|
||||
transforms the elements of that list as follows:
|
||||
|
||||
If strip-path is non-nil, remove the \"/dir/\" prefix from all members of
|
||||
If STRIP-PATH is non-nil, remove the \"/dir/\" prefix from all members of
|
||||
param-list.
|
||||
|
||||
If replacement is string, replace the \"/dir/\" prefix with it.
|
||||
If REPLACEMENT is string, replace the \"/dir/\" prefix with it.
|
||||
|
||||
The first parameter, the one that contains the protocols, is always changed.
|
||||
Everything up to the end of the protocols is stripped.
|
||||
|
||||
Note, that this function will always behave as if
|
||||
`org-protocol-reverse-list-of-files' was set to t and the returned list will
|
||||
reflect that. I.e. emacsclients first parameter will be the first one in the
|
||||
reflect that. emacsclient's first parameter will be the first one in the
|
||||
returned list."
|
||||
(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
|
||||
param-list
|
||||
|
@ -345,38 +355,95 @@ returned list."
|
|||
ret)
|
||||
l)))
|
||||
|
||||
(defun org-protocol-flatten (l)
|
||||
"Greedy handlers might receive a list like this from emacsclient:
|
||||
((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
|
||||
(defun org-protocol-flatten (list)
|
||||
"Transform LIST into a flat list.
|
||||
|
||||
Greedy handlers might receive a list like this from emacsclient:
|
||||
\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
|
||||
where \"/dir/\" is the absolute path to emacsclients working directory.
|
||||
This function transforms it into a flat list."
|
||||
(if (null l) ()
|
||||
(if (listp l)
|
||||
(append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
|
||||
(list l))))
|
||||
(if (null list) ()
|
||||
(if (listp list)
|
||||
(append (org-protocol-flatten (car list)) (org-protocol-flatten (cdr list)))
|
||||
(list list))))
|
||||
|
||||
(defun org-protocol-parse-parameters (info &optional new-style default-order)
|
||||
"Return a property list of parameters from INFO.
|
||||
If NEW-STYLE is non-nil, treat INFO as a query string (ex:
|
||||
url=URL&title=TITLE). If old-style links are used (ex:
|
||||
org-protocol://store-link/url/title), assign them to attributes
|
||||
following DEFAULT-ORDER.
|
||||
|
||||
If no DEFAULT-ORDER is specified, return the list of values.
|
||||
|
||||
If INFO is already a property list, return it unchanged."
|
||||
(if (listp info)
|
||||
info
|
||||
(if new-style
|
||||
(let ((data (org-protocol-convert-query-to-plist info))
|
||||
result)
|
||||
(while data
|
||||
(setq result
|
||||
(append
|
||||
result
|
||||
(list
|
||||
(pop data)
|
||||
(org-link-unescape (pop data))))))
|
||||
result)
|
||||
(let ((data (org-protocol-split-data info t org-protocol-data-separator)))
|
||||
(if default-order
|
||||
(org-protocol-assign-parameters data default-order)
|
||||
data)))))
|
||||
|
||||
(defun org-protocol-assign-parameters (data default-order)
|
||||
"Return a property list of parameters from DATA.
|
||||
Key names are taken from DEFAULT-ORDER, which should be a list of
|
||||
symbols. If DEFAULT-ORDER is shorter than the number of values
|
||||
specified, the rest of the values are treated as :key value pairs."
|
||||
(let (result)
|
||||
(while default-order
|
||||
(setq result
|
||||
(append result
|
||||
(list (pop default-order)
|
||||
(pop data)))))
|
||||
(while data
|
||||
(setq result
|
||||
(append result
|
||||
(list (intern (concat ":" (pop data)))
|
||||
(pop data)))))
|
||||
result))
|
||||
|
||||
;;; Standard protocol handlers:
|
||||
|
||||
(defun org-protocol-store-link (fname)
|
||||
"Process an org-protocol://store-link:// style url.
|
||||
"Process an org-protocol://store-link style url.
|
||||
Additionally store a browser URL as an org link. Also pushes the
|
||||
link's URL to the `kill-ring'.
|
||||
|
||||
Parameters: url, title (optional), body (optional)
|
||||
|
||||
Old-style links such as org-protocol://store-link://URL/TITLE are
|
||||
also recognized.
|
||||
|
||||
The location for a browser's bookmark has to look like this:
|
||||
|
||||
javascript:location.href=\\='org-protocol://store-link://\\='+ \\
|
||||
encodeURIComponent(location.href)
|
||||
encodeURIComponent(document.title)+\\='/\\='+ \\
|
||||
javascript:location.href = \\
|
||||
\\='org-protocol://store-link?url=\\=' + \\
|
||||
encodeURIComponent(location.href) + \\='&title=\\=' + \\
|
||||
encodeURIComponent(document.title);
|
||||
|
||||
Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
|
||||
could contain slashes and the location definitely will.
|
||||
Don't use `escape()'! Use `encodeURIComponent()' instead. The
|
||||
title of the page could contain slashes and the location
|
||||
definitely will.
|
||||
|
||||
The sub-protocol used to reach this function is set in
|
||||
`org-protocol-protocol-alist'."
|
||||
(let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator))
|
||||
(uri (org-protocol-sanitize-uri (car splitparts)))
|
||||
(title (cadr splitparts))
|
||||
`org-protocol-protocol-alist'.
|
||||
|
||||
FNAME should be a property list. If not, an old-style link of the
|
||||
form URL/TITLE can also be used."
|
||||
(let* ((splitparts (org-protocol-parse-parameters fname nil '(:url :title)))
|
||||
(uri (org-protocol-sanitize-uri (plist-get splitparts :url)))
|
||||
(title (plist-get splitparts :title))
|
||||
orglink)
|
||||
(if (boundp 'org-stored-links)
|
||||
(setq org-stored-links (cons (list uri title) org-stored-links)))
|
||||
|
@ -388,7 +455,7 @@ The sub-protocol used to reach this function is set in
|
|||
nil)
|
||||
|
||||
(defun org-protocol-capture (info)
|
||||
"Process an org-protocol://capture:// style url.
|
||||
"Process an org-protocol://capture style url with INFO.
|
||||
|
||||
The sub-protocol used to reach this function is set in
|
||||
`org-protocol-protocol-alist'.
|
||||
|
@ -396,16 +463,16 @@ The sub-protocol used to reach this function is set in
|
|||
This function detects an URL, title and optional text, separated
|
||||
by `/'. The location for a browser's bookmark looks like this:
|
||||
|
||||
javascript:location.href=\\='org-protocol://capture://\\='+ \\
|
||||
encodeURIComponent(location.href)+\\='/\\=' \\
|
||||
encodeURIComponent(document.title)+\\='/\\='+ \\
|
||||
javascript:location.href = \\='org-protocol://capture?url=\\='+ \\
|
||||
encodeURIComponent(location.href) + \\='&title=\\=' \\
|
||||
encodeURIComponent(document.title) + \\='&body=\\=' + \\
|
||||
encodeURIComponent(window.getSelection())
|
||||
|
||||
By default, it uses the character `org-protocol-default-template-key',
|
||||
which should be associated with a template in `org-capture-templates'.
|
||||
But you may prepend the encoded URL with a character and a slash like so:
|
||||
You may specify the template with a template= query parameter, like this:
|
||||
|
||||
javascript:location.href=\\='org-protocol://capture://b/\\='+ ...
|
||||
javascript:location.href = \\='org-protocol://capture?template=b\\='+ ...
|
||||
|
||||
Now template ?b will be used."
|
||||
(if (and (boundp 'org-stored-links)
|
||||
|
@ -414,7 +481,7 @@ Now template ?b will be used."
|
|||
nil)
|
||||
|
||||
(defun org-protocol-convert-query-to-plist (query)
|
||||
"Convert query string that is part of url to property list."
|
||||
"Convert QUERY key=value pairs in the URL to a property list."
|
||||
(if query
|
||||
(apply 'append (mapcar (lambda (x)
|
||||
(let ((c (split-string x "=")))
|
||||
|
@ -422,18 +489,26 @@ Now template ?b will be used."
|
|||
(split-string query "&")))))
|
||||
|
||||
(defun org-protocol-do-capture (info)
|
||||
"Support `org-capture'."
|
||||
(let* ((parts (org-protocol-split-data info t org-protocol-data-separator))
|
||||
(template (or (and (>= 2 (length (car parts))) (pop parts))
|
||||
"Perform the actual capture based on INFO."
|
||||
(let* ((temp-parts (org-protocol-parse-parameters info))
|
||||
(parts
|
||||
(cond
|
||||
((and (listp info) (symbolp (car info))) info)
|
||||
((= (length (car temp-parts)) 1) ;; First parameter is exactly one character long
|
||||
(org-protocol-assign-parameters temp-parts '(:template :url :title :body)))
|
||||
(t
|
||||
(org-protocol-assign-parameters temp-parts '(:url :title :body)))))
|
||||
(template (or (plist-get parts :template)
|
||||
org-protocol-default-template-key))
|
||||
(url (org-protocol-sanitize-uri (car parts)))
|
||||
(type (if (string-match "^\\([a-z]+\\):" url)
|
||||
(match-string 1 url)))
|
||||
(title (or (cadr parts) ""))
|
||||
(region (or (caddr parts) ""))
|
||||
(orglink (org-make-link-string
|
||||
url (if (string-match "[^[:space:]]" title) title url)))
|
||||
(query (or (org-protocol-convert-query-to-plist (cadddr parts)) ""))
|
||||
(url (and (plist-get parts :url) (org-protocol-sanitize-uri (plist-get parts :url))))
|
||||
(type (and url (if (string-match "^\\([a-z]+\\):" url)
|
||||
(match-string 1 url))))
|
||||
(title (or (plist-get parts :title) ""))
|
||||
(region (or (plist-get parts :body) ""))
|
||||
(orglink (if url
|
||||
(org-make-link-string
|
||||
url (if (string-match "[^[:space:]]" title) title url))
|
||||
title))
|
||||
(org-capture-link-is-already-stored t)) ;; avoid call to org-store-link
|
||||
(setq org-stored-links
|
||||
(cons (list url title) org-stored-links))
|
||||
|
@ -443,24 +518,24 @@ Now template ?b will be used."
|
|||
:description title
|
||||
:annotation orglink
|
||||
:initial region
|
||||
:query query)
|
||||
:query parts)
|
||||
(raise-frame)
|
||||
(funcall 'org-capture nil template)))
|
||||
|
||||
(defun org-protocol-open-source (fname)
|
||||
"Process an org-protocol://open-source:// style url.
|
||||
"Process an org-protocol://open-source?url= style URL with FNAME.
|
||||
|
||||
Change a filename by mapping URLs to local filenames as set
|
||||
in `org-protocol-project-alist'.
|
||||
|
||||
The location for a browser's bookmark should look like this:
|
||||
|
||||
javascript:location.href=\\='org-protocol://open-source://\\='+ \\
|
||||
javascript:location.href = \\='org-protocol://open-source?url=\\=' + \\
|
||||
encodeURIComponent(location.href)"
|
||||
;; As we enter this function for a match on our protocol, the return value
|
||||
;; defaults to nil.
|
||||
(let ((result nil)
|
||||
(f (org-link-unescape fname)))
|
||||
(f (plist-get (org-protocol-parse-parameters fname nil '(:url)) :url)))
|
||||
(catch 'result
|
||||
(dolist (prolist org-protocol-project-alist)
|
||||
(let* ((base-url (plist-get (cdr prolist) :base-url))
|
||||
|
@ -510,21 +585,29 @@ The location for a browser's bookmark should look like this:
|
|||
;;; Core functions:
|
||||
|
||||
(defun org-protocol-check-filename-for-protocol (fname restoffiles client)
|
||||
"Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname.
|
||||
"Check if `org-protocol-the-protocol' and a valid protocol are used in FNAME.
|
||||
Sub-protocols are registered in `org-protocol-protocol-alist' and
|
||||
`org-protocol-protocol-alist-default'.
|
||||
This is, how the matching is done:
|
||||
`org-protocol-protocol-alist-default'. This is how the matching is done:
|
||||
|
||||
(string-match \"protocol:/+sub-protocol:/+\" ...)
|
||||
(string-match \"protocol:/+sub-protocol\\\\(://\\\\|\\\\?\\\\)\" ...)
|
||||
|
||||
protocol and sub-protocol are regexp-quoted.
|
||||
|
||||
If a matching protocol is found, the protocol is stripped from fname and the
|
||||
result is passed to the protocols function as the only parameter. If the
|
||||
function returns nil, the filename is removed from the list of filenames
|
||||
passed from emacsclient to the server.
|
||||
If the function returns a non nil value, that value is passed to the server
|
||||
as filename."
|
||||
Old-style links such as \"protocol://sub-protocol://param1/param2\" are
|
||||
also recognized.
|
||||
|
||||
If a matching protocol is found, the protocol is stripped from
|
||||
fname and the result is passed to the protocol function as the
|
||||
first parameter. The second parameter will be non-nil if FNAME
|
||||
uses key=val&key2=val2-type arguments, or nil if FNAME uses
|
||||
val/val2-type arguments. If the function returns nil, the
|
||||
filename is removed from the list of filenames passed from
|
||||
emacsclient to the server. If the function returns a non-nil
|
||||
value, that value is passed to the server as filename.
|
||||
|
||||
If the handler function is greedy, RESTOFFILES will also be passed to it.
|
||||
|
||||
CLIENT is ignored."
|
||||
(let ((sub-protocols (append org-protocol-protocol-alist
|
||||
org-protocol-protocol-alist-default)))
|
||||
(catch 'fname
|
||||
|
@ -532,21 +615,27 @@ as filename."
|
|||
(when (string-match the-protocol fname)
|
||||
(dolist (prolist sub-protocols)
|
||||
(let ((proto (concat the-protocol
|
||||
(regexp-quote (plist-get (cdr prolist) :protocol)) ":/+")))
|
||||
(regexp-quote (plist-get (cdr prolist) :protocol)) "\\(:/+\\|\\?\\)")))
|
||||
(when (string-match proto fname)
|
||||
(let* ((func (plist-get (cdr prolist) :function))
|
||||
(greedy (plist-get (cdr prolist) :greedy))
|
||||
(split (split-string fname proto))
|
||||
(result (if greedy restoffiles (cadr split))))
|
||||
(result (if greedy restoffiles (cadr split)))
|
||||
(new-style (string= (match-string 1 fname) "?")))
|
||||
(when (plist-get (cdr prolist) :kill-client)
|
||||
(message "Greedy org-protocol handler. Killing client.")
|
||||
(server-edit))
|
||||
(when (fboundp func)
|
||||
(unless greedy
|
||||
(throw 'fname (funcall func result)))
|
||||
(funcall func result)
|
||||
(throw 'fname
|
||||
(condition-case err
|
||||
(funcall func (org-protocol-parse-parameters result new-style))
|
||||
('error
|
||||
(warn "Please update your org protocol handler to deal with new-style links.")
|
||||
(funcall func result)))))
|
||||
;; Greedy protocol handlers are responsible for parsing their own filenames
|
||||
(funcall func result)
|
||||
(throw 'fname t))))))))
|
||||
;; (message "fname: %s" fname)
|
||||
fname)))
|
||||
|
||||
(defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
|
||||
|
|
|
@ -0,0 +1,191 @@
|
|||
;;; test-org-protocol.el --- tests for org-protocol.el -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (c) Sacha Chua
|
||||
;; Authors: Sacha Chua
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(unless (featurep 'org-protocol)
|
||||
(signal 'missing-test-dependency "Support for org-protocol"))
|
||||
|
||||
(ert-deftest test-org-protocol/org-protocol-parse-parameters ()
|
||||
"Test `org-protocol-parse-parameters' specifications."
|
||||
;; Ignore lists
|
||||
(let ((data (org-protocol-parse-parameters '(:url "abc" :title "def") nil)))
|
||||
(should (string= (plist-get data :url) "abc"))
|
||||
(should (string= (plist-get data :title) "def")))
|
||||
;; Parse new-style links
|
||||
(let ((data (org-protocol-parse-parameters "url=abc&title=def" t)))
|
||||
(should (string= (plist-get data :url) "abc"))
|
||||
(should (string= (plist-get data :title) "def")))
|
||||
;; Parse old-style links
|
||||
(let ((data (org-protocol-parse-parameters "abc/def" nil '(:url :title))))
|
||||
(should (string= (plist-get data :url) "abc"))
|
||||
(should (string= (plist-get data :title) "def")))
|
||||
;; Parse old-style links even without keys
|
||||
(let ((data (org-protocol-parse-parameters "b/abc/def" nil)))
|
||||
(should (equal data '("b" "abc" "def"))))
|
||||
;; Parse old-style links with key/val pairs
|
||||
(let ((data (org-protocol-parse-parameters "b/abc/extrakey/extraval" nil '(:param1 :param2))))
|
||||
(should (string= (plist-get data :param1) "b"))
|
||||
(should (string= (plist-get data :param2) "abc"))
|
||||
(should (string= (plist-get data :extrakey) "extraval"))))
|
||||
|
||||
(ert-deftest test-org-protocol/org-protocol-store-link ()
|
||||
"Test `org-protocol-store-link' specifications."
|
||||
;; Old link style
|
||||
(let ((uri "/some/directory/org-protocol:/store-link:/URL/TITLE"))
|
||||
(should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
|
||||
(should (equal (car org-stored-links) '("URL" "TITLE"))))
|
||||
;; URL encoded
|
||||
(let ((uri (format "/some/directory/org-protocol:/store-link:/%s/TITLE"
|
||||
(url-hexify-string "http://example.com"))))
|
||||
(should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
|
||||
(should (equal (car org-stored-links) '("http://example.com" "TITLE"))))
|
||||
;; Handle multiple slashes, old link style
|
||||
(let ((uri "/some/directory/org-protocol://store-link://URL2//TITLE2"))
|
||||
(should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
|
||||
(should (equal (car org-stored-links) '("URL2" "TITLE2"))))
|
||||
;; New link style
|
||||
(let ((uri "/some/directory/org-protocol://store-link?url=URL3&title=TITLE3"))
|
||||
(should (null (org-protocol-check-filename-for-protocol uri (list uri) nil)))
|
||||
(should (equal (car org-stored-links) '("URL3" "TITLE3")))))
|
||||
|
||||
(ert-deftest test-org-protocol/org-protocol-capture ()
|
||||
"Test `org-protocol-capture' specifications."
|
||||
(let* ((org-protocol-default-template-key "t")
|
||||
(temp-file-name (make-temp-file "org-protocol-test"))
|
||||
(org-capture-templates
|
||||
`(("t" "Test" entry (file ,temp-file-name) "** TODO\n\n%i\n\n%a\n" :kill-buffer t)
|
||||
("x" "With params" entry (file ,temp-file-name) "** SOMEDAY\n\n%i\n\n%a\n" :kill-buffer t)
|
||||
("X" "Just the template" entry (file ,temp-file-name) "** Hello World\n\n%i\n\nGoodbye World\n" :kill-buffer t)))
|
||||
(test-urls
|
||||
'(
|
||||
;; Old style:
|
||||
;; - multiple slashes
|
||||
("/some/directory/org-protocol:/capture:/URL/TITLE"
|
||||
. "** TODO\n\n\n\n[[URL][TITLE]]\n")
|
||||
;; - body specification
|
||||
("/some/directory/org-protocol:/capture:/URL/TITLE/BODY"
|
||||
. "** TODO\n\nBODY\n\n[[URL][TITLE]]\n")
|
||||
;; - template
|
||||
("/some/directory/org-protocol:/capture:/x/URL/TITLE/BODY"
|
||||
. "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
|
||||
;; - query parameters, not sure how to include them in template
|
||||
("/some/directory/org-protocol:/capture:/x/URL/TITLE/BODY/from/example"
|
||||
. "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
|
||||
;; New style:
|
||||
;; - multiple slashes
|
||||
("/some/directory/org-protocol:/capture?url=NEWURL&title=TITLE"
|
||||
. "** TODO\n\n\n\n[[NEWURL][TITLE]]\n")
|
||||
;; - body specification
|
||||
("/some/directory/org-protocol:/capture?url=NEWURL&title=TITLE&body=BODY"
|
||||
. "** TODO\n\nBODY\n\n[[NEWURL][TITLE]]\n")
|
||||
;; - template
|
||||
("/some/directory/org-protocol:/capture?template=x&url=NEWURL&title=TITLE&body=BODY"
|
||||
. "** SOMEDAY\n\nBODY\n\n[[NEWURL][TITLE]]\n")
|
||||
;; - no url specified
|
||||
("/some/directory/org-protocol:/capture?template=x&title=TITLE&body=BODY"
|
||||
. "** SOMEDAY\n\nBODY\n\nTITLE\n")
|
||||
;; - no title specified
|
||||
("/some/directory/org-protocol:/capture?template=x&url=NEWURL&body=BODY"
|
||||
. "** SOMEDAY\n\nBODY\n\n[[NEWURL][NEWURL]]\n")
|
||||
;; - just the template
|
||||
("/some/directory/org-protocol:/capture?template=X"
|
||||
. "** Hello World\n\n\n\nGoodbye World\n")
|
||||
;; - query parameters, not sure how to include them in template
|
||||
("/some/directory/org-protocol:/capture?template=x&url=URL&title=TITLE&body=BODY&from=example"
|
||||
. "** SOMEDAY\n\nBODY\n\n[[URL][TITLE]]\n")
|
||||
)))
|
||||
;; Old link style
|
||||
(mapc
|
||||
(lambda (test-case)
|
||||
(let ((uri (car test-case)))
|
||||
(org-protocol-check-filename-for-protocol uri (list uri) nil)
|
||||
(should (string= (buffer-string) (cdr test-case)))
|
||||
(org-capture-kill)))
|
||||
test-urls)
|
||||
(delete-file temp-file-name)))
|
||||
|
||||
(ert-deftest test-org-protocol/org-protocol-open-source ()
|
||||
"Test org-protocol://open-source links."
|
||||
(let* ((temp-file-name1 (make-temp-file "org-protocol-test1"))
|
||||
(temp-file-name2 (make-temp-file "org-protocol-test2"))
|
||||
(org-protocol-project-alist
|
||||
`((test1
|
||||
:base-url "http://example.com/"
|
||||
:online-suffix ".html"
|
||||
:working-directory ,(file-name-directory temp-file-name1))
|
||||
(test2
|
||||
:base-url "http://another.example.com/"
|
||||
:online-suffix ".js"
|
||||
:working-directory ,(file-name-directory temp-file-name2))
|
||||
))
|
||||
(test-cases
|
||||
(list
|
||||
;; Old-style URLs
|
||||
(cons
|
||||
(concat "/some/directory/org-protocol:/open-source:/"
|
||||
(url-hexify-string
|
||||
(concat "http://example.com/" (file-name-nondirectory temp-file-name1) ".html")))
|
||||
temp-file-name1)
|
||||
(cons
|
||||
(concat "/some/directory/org-protocol:/open-source:/"
|
||||
(url-hexify-string
|
||||
(concat "http://another.example.com/" (file-name-nondirectory temp-file-name2) ".js")))
|
||||
temp-file-name2)
|
||||
;; New-style URLs
|
||||
(cons
|
||||
(concat "/some/directory/org-protocol:/open-source?url="
|
||||
(url-hexify-string
|
||||
(concat "http://example.com/" (file-name-nondirectory temp-file-name1) ".html")))
|
||||
temp-file-name1)
|
||||
(cons
|
||||
(concat "/some/directory/org-protocol:/open-source?url="
|
||||
(url-hexify-string
|
||||
(concat "http://another.example.com/" (file-name-nondirectory temp-file-name2) ".js")))
|
||||
temp-file-name2))))
|
||||
(mapc (lambda (test-case)
|
||||
(should (string=
|
||||
(org-protocol-check-filename-for-protocol
|
||||
(car test-case)
|
||||
(list (car test-case)) nil)
|
||||
(cdr test-case))))
|
||||
test-cases)
|
||||
(delete-file temp-file-name1)
|
||||
(delete-file temp-file-name2)))
|
||||
|
||||
(defun test-org-protocol/org-protocol-greedy-handler (fname)
|
||||
;; fname should be a list of parsed items
|
||||
(should (listp fname))
|
||||
nil)
|
||||
|
||||
(ert-deftest test-org-protocol/org-protocol-with-greedy-handler ()
|
||||
"Check that greedy handlers are called with all the filenames."
|
||||
(let ((org-protocol-protocol-alist
|
||||
'(("protocol-a" :protocol "greedy" :function test-org-protocol/org-protocol-greedy-handler :kill-client t :greedy t))))
|
||||
;; Neither of these should signal errors
|
||||
(let ((uri "/some/dir/org-protocol://greedy?a=b&c=d")
|
||||
(uri2 "/some/dir/org-protocol://greedy?e=f&g=h"))
|
||||
(org-protocol-check-filename-for-protocol uri (list uri uri2) nil))))
|
||||
|
||||
|
||||
;; TODO: Verify greedy protocol handling
|
||||
;;; test-org-protocol.el ends here
|
Loading…
Reference in New Issue