Proposal: org-protocol handles redirects (finally)

[Sebastian Rose <sebastian_rose@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 1713 bytes --]

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



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-protocol-handle-redirects.patch --]
[-- Type: text/x-diff, Size: 4205 bytes --]

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

[-- Attachment #3: Type: text/plain, Size: 204 bytes --]

_______________________________________________
Emacs-orgmode mailing list
Remember: use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode