Hi,
here is a little patch for org-protocol.el, I always wanted to
have. It
enhances `org-protocol-open-source' to handle rewritten URLs to some
extend.
I tested it successfully with my projects here and on the web and it's
exactly what I've been missing.
If you find it breaks something, or know it how it could be
implemented
better, report back.
* This is how it works:
Each project in `org-protocol-project-alist' may now have a new
element `:rewrites'. `:rewrites' is a list of cons cells, that maps
regular expressions to relative paths.
* Example:
(setq org-protocol-project-alist
'(("http://fairposter.de/";
:base-url "http://example-web-shop.de/";
:working-directory "/path/to/working/directory/"
:online-suffix ".php"
:working-suffix ".php"
:rewrites (("example-web-shop.de/cars/" . "products.php")
("example-web-shop.de/$" . "index.php")
))
;; .... more projects here
))
Today, if I visit http://www.example-web-shop.de/, the URL would
not match a path to any of the files below my working directory.
Tomorrow, /path/to/working/directory/index.php is opened, because
there's
a matching rewrite.
Today, a rewritten URL like
http://example-web-shop.de/cars/lamborghini/Gallardo_LP560-4_MY09
would not match a path to any of the files below my working
directory, because URLS like `..../cars/' would be rewritten on the
server and served through http://example-web-shop.de/products.php.
Tomorrow, that URL will be mapped to
/path/to/working/directory/products.php, because there's a matching
rewrite defined.
Best wishes
Sebastian
diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el
index 30d2dd3..a2bc6af 100644
--- a/lisp/org-protocol.el
+++ b/lisp/org-protocol.el
@@ -185,6 +185,8 @@ Possible properties are:
Last slash required.
:working-directory - the local working directory. This is, what
base-url will
be replaced with.
+ :redirects - A list of cons cells, each of which maps a
regular
+ expression to match to a path relative
to :working-directory.
Example:
@@ -198,7 +200,12 @@ Example:
:online-suffix \".html\"
:working-suffix \".org\"
:base-url \"http://localhost/org/\";
- :working-directory \"/home/user/org/\")))
+ :working-directory \"/home/user/org/\"
+ :rewrites ((\"org/?$\" . \"index.php\")))))
+
+ The last line tells `org-protocol-open-source' to open
+ /home/user/org/index.php, if the URL cannot be mapped to an
existing
+ file, and ends with either \"org\" or \"org/\".
Consider using the interactive functions `org-protocol-create' and
`org-protocol-create-for-org' to help you filling this variable with
valid contents."
@@ -504,10 +511,35 @@ The location for a browser's bookmark should
look like this:
(let* ((wdir (plist-get (cdr prolist) :working-directory))
(strip-suffix (plist-get (cdr prolist) :online-
suffix))
(add-suffix (plist-get (cdr prolist) :working-
suffix))
- (start-pos (+ (string-match wsearch f) (length
base-url)))
+ ;; Strip "[?#].*$" if `f' is a redirect with another
+ ;; ending than strip-suffix here:
+ (f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f)))
+ (start-pos (+ (string-match wsearch f1) (length
base-url)))
(end-pos (string-match
- (concat (regexp-quote strip-suffix) "\\
([?#].*\\)?$") f))
- (the-file (concat wdir (substring f start-pos
end-pos) add-suffix)))
+ (regexp-quote strip-suffix) f1))
+ ;; We have to compare redirects without suffix below:
+ (f2 (concat wdir (substring f1 start-pos end-pos)))
+ (the-file (concat f2 add-suffix)))
+
+ ;; Note: the-file may still contain `%C3' et al here because
browsers
+ ;; tend to encode `ä' in URLs to `%25C3' - `%25' being `
%'.
+ ;; So the results may vary.
+
+ ;; -- start redirects --
+ (unless (file-exists-p the-file)
+ (message "File %s does not exist.\nTesting for rewritten URLs."
the-file)
+ (let ((rewrites (plist-get (cdr prolist) :rewrites)))
+ (when rewrites
+ (message "Rewrites found: %S" rewrites)
+ (mapc
+ (lambda (rewrite)
+ "Try to match a rewritten URL and map it to a real file."
+ ;; Compare redirects without suffix:
+ (if (string-match (car rewrite) f2)
+ (throw 'result (concat wdir (cdr rewrite)))))
+ rewrites))))
+ ;; -- end of redirects --
+
(if (file-readable-p the-file)
(throw 'result the-file))
(if (file-exists-p the-file)
@@ -596,7 +628,7 @@ most of the work."
"Create a new org-protocol project interactively.
An org-protocol project is an entry in `org-protocol-project-alist'
which is used by `org-protocol-open-source'.
-Optionally use project-plist to initialize the defaults for this
worglet. If
+Optionally use project-plist to initialize the defaults for this
project. If
project-plist is the CDR of an element in `org-publish-project-
alist', reuse
:base-directory, :html-extension and :base-extension."
(interactive)
@@ -632,7 +664,7 @@ project-plist is the CDR of an element in `org-
publish-project-alist', reuse
(concat "Extension of editable files ("working-suffix"): ")
working-suffix nil working-suffix t))
- (when (yes-or-no-p "Save the new worglet to your init file? ")
+ (when (yes-or-no-p "Save the new org-protocol-project to your
init file? ")
(setq org-protocol-project-alist
(cons `(,base-url . (:base-url ,base-url
:working-directory ,working-dir
_______________________________________________
Emacs-orgmode mailing list
Remember: use `Reply All' to send replies to the list.
address@hidden
http://lists.gnu.org/mailman/listinfo/emacs-orgmode