From f85a961c2306755b544dac00549f798410e0aa88 Mon Sep 17 00:00:00 2001
From: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Date: Mon, 20 Apr 2015 12:36:47 +0200
Subject: [PATCH] ox: Implement `org-export-file-uri'

* lisp/ox.el (org-export-file-uri): New function.
* testing/lisp/test-ox.el (test-org-export/file-uri): New test.
---
 lisp/ox.el              | 12 ++++++++++++
 testing/lisp/test-ox.el | 13 +++++++++++++
 2 files changed, 25 insertions(+)

diff --git a/lisp/ox.el b/lisp/ox.el
index d6dcc8262..846f379d8 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -3913,6 +3913,9 @@ meant to be translated with `org-export-data' or alike."
 ;; `org-export-resolve-coderef' associates a reference to a line
 ;; number in the element it belongs, or returns the reference itself
 ;; when the element isn't numbered.
+;;
+;; `org-export-file-uri' expands a filename as stored in :path value
+;;  of a "file" link into a file URI.
 
 (defun org-export-custom-protocol-maybe (link desc backend)
   "Try exporting LINK with a dedicated function.
@@ -4128,6 +4131,15 @@ has type \"radio\"."
 	     radio))
       info 'first-match)))
 
+(defun org-export-file-uri (filename)
+  "Return file URI associated to FILENAME."
+  (if (not (file-name-absolute-p filename)) filename
+    (concat "file:/"
+	    (and (not (org-file-remote-p filename)) "/")
+	    (if (org-string-match-p "\\`~" filename)
+		(expand-file-name filename)
+	      filename))))
+
 
 ;;;; For References
 ;;
diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el
index f92cf230c..386e02422 100644
--- a/testing/lisp/test-ox.el
+++ b/testing/lisp/test-ox.el
@@ -2657,6 +2657,19 @@ Another text. (ref:text)
        (org-element-map tree 'link
 	 (lambda (link) (org-export-resolve-radio-link link info)) info t)))))
 
+(ert-deftest test-org-export/file-uri ()
+  "Test `org-export-file-uri' specifications."
+  ;; Preserve relative filenames.
+  (should (equal "relative.org" (org-export-file-uri "relative.org")))
+  ;; Local files start with "file:///"
+  (should (equal "file:///local.org" (org-export-file-uri "/local.org")))
+  ;; Remote files start with "file://"
+  (should (equal "file://myself@some.where:papers/last.pdf"
+		 (org-export-file-uri "/myself@some.where:papers/last.pdf")))
+  ;; Expand filename starting with "~".
+  (should (equal (org-export-file-uri "~/file.org")
+		 (concat "file://" (expand-file-name "~/file.org")))))
+
 
 
 ;;; Src-block and example-block
-- 
2.11.4.GIT