From mboxrd@z Thu Jan 1 00:00:00 1970 From: Sebastian Rose Subject: Proposal: org-protocol handles redirects (finally) Date: Fri, 13 Nov 2009 18:56:34 +0100 Message-ID: <87pr7mwbot.fsf@gmx.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1N90OA-0005y3-WC for emacs-orgmode@gnu.org; Fri, 13 Nov 2009 12:56:51 -0500 Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1N90O5-0005ti-UY for emacs-orgmode@gnu.org; Fri, 13 Nov 2009 12:56:50 -0500 Received: from [199.232.76.173] (port=55843 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1N90O5-0005tQ-KD for emacs-orgmode@gnu.org; Fri, 13 Nov 2009 12:56:45 -0500 Received: from mail.gmx.net ([213.165.64.20]:58967) by monty-python.gnu.org with smtp (Exim 4.60) (envelope-from ) id 1N90O4-0002cf-M1 for emacs-orgmode@gnu.org; Fri, 13 Nov 2009 12:56:45 -0500 List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Emacs-orgmode mailing list --=-=-= 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 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=org-protocol-handle-redirects.patch 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 --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ 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 --=-=-=--