Forráskód Böngészése

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.
Nicolas Goaziou 10 éve
szülő
commit
f85a961c23
2 módosított fájl, 25 hozzáadás és 0 törlés
  1. 12 0
      lisp/ox.el
  2. 13 0
      testing/lisp/test-ox.el

+ 12 - 0
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
 ;;

+ 13 - 0
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