summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-11-26 10:46:53 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-11-26 10:46:53 +0100
commit6aac798f2556041113d72d79ddc68d7d27017e38 (patch)
treeb9078e1a81ad8bee27e05bec6f588bb98580829f
parent1d8126385cf979cfaade0e6a82040884bd6af56b (diff)
downloadorg-mode-6aac798f2556041113d72d79ddc68d7d27017e38.tar.gz
Fix publishing links to absolute file names belonging to project
* lisp/ox-publish.el (org-publish-file-relative-name): New function. * lisp/ox-html.el (org-html-link): Use new function. * testing/lisp/test-ox-publish.el (test-org-publish/file-relative-name): New test.
-rw-r--r--lisp/ox-html.el19
-rw-r--r--lisp/ox-publish.el15
-rw-r--r--testing/lisp/test-ox-publish.el27
3 files changed, 48 insertions, 13 deletions
diff --git a/lisp/ox-html.el b/lisp/ox-html.el
index 3073727..3f8dac6 100644
--- a/lisp/ox-html.el
+++ b/lisp/ox-html.el
@@ -2976,16 +2976,17 @@ INFO is a plist holding contextual information. See
((member type '("http" "https" "ftp" "mailto" "news"))
(url-encode-url (org-link-unescape (concat type ":" raw-path))))
((string= type "file")
- ;; Treat links to ".org" files as ".html", if needed.
+ ;; During publishing, turn absolute file names belonging
+ ;; to base directory into relative file names. Otherwise,
+ ;; append "file" protocol to absolute file name.
(setq raw-path
- (funcall link-org-files-as-html-maybe raw-path info))
- ;; If file path is absolute, prepend it with protocol
- ;; component - "file://".
- (cond
- ((file-name-absolute-p raw-path)
- (setq raw-path (org-export-file-uri raw-path)))
- ((and home use-abs-url)
- (setq raw-path (concat (file-name-as-directory home) raw-path))))
+ (org-export-file-uri
+ (org-publish-file-relative-name raw-path info)))
+ ;; Possibly append `:html-link-home' to relative file
+ ;; name.
+ (unless (file-name-absolute-p raw-path)
+ (setq raw-path (concat (file-name-as-directory home) raw-path)))
+ (setq raw-path (funcall link-org-files-as-html-maybe raw-path info))
;; Add search option, if any. A search option can be
;; relative to a custom-id, a headline title, a name or
;; a target.
diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el
index b6d79f9..c2416db 100644
--- a/lisp/ox-publish.el
+++ b/lisp/ox-publish.el
@@ -349,7 +349,6 @@ You can overwrite this default per project in your
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Timestamp-related functions
(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
@@ -392,7 +391,6 @@ If there is no timestamp, create one."
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Getting project information out of `org-publish-project-alist'
(defun org-publish-property (property project &optional default)
@@ -525,7 +523,6 @@ publishing FILENAME."
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Tools for publishing functions in back-ends
(defun org-publish-org-to (backend filename extension plist &optional pub-dir)
@@ -899,7 +896,6 @@ representation for the files to include, as returned by
(org-list-to-org list)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Interactive publishing functions
;;;###autoload
@@ -1170,6 +1166,17 @@ references with `org-export-get-reference'."
(org-publish-cache-set-file-property filename :crossrefs crossrefs)
(org-export-format-reference new))))))
+(defun org-publish-file-relative-name (filename info)
+ "Convert FILENAME to be relative to current project's base directory.
+INFO is the plist containing the current export state. The
+function does not change relative file names."
+ (let ((base (plist-get info :base-directory)))
+ (if (and base
+ (file-name-absolute-p filename)
+ (file-in-directory-p filename base))
+ (file-relative-name filename base)
+ filename)))
+
;;; Caching functions
diff --git a/testing/lisp/test-ox-publish.el b/testing/lisp/test-ox-publish.el
index 921e69e..55fa431 100644
--- a/testing/lisp/test-ox-publish.el
+++ b/testing/lisp/test-ox-publish.el
@@ -450,6 +450,33 @@ Unless set otherwise in PROPERTIES, `:base-directory' is set to
("p" :base-directory ,base))))
(car (org-publish-get-project-from-filename file t))))))
+(ert-deftest test-org-publish/file-relative-name ()
+ "Test `org-publish-file-relative-name' specifications."
+ ;; Turn absolute file names into relative ones if file belongs to
+ ;; base directory.
+ (should
+ (equal "a.org"
+ (let* ((base (expand-file-name "examples/pub/" org-test-dir))
+ (file (expand-file-name "a.org" base)))
+ (org-publish-file-relative-name file `(:base-directory ,base)))))
+ (should
+ (equal "pub/a.org"
+ (let* ((base (expand-file-name "examples/" org-test-dir))
+ (file (expand-file-name "pub/a.org" base)))
+ (org-publish-file-relative-name file `(:base-directory ,base)))))
+ ;; Absolute file names that do not belong to base directory are
+ ;; unchanged.
+ (should
+ (equal "/name.org"
+ (let ((base (expand-file-name "examples/pub/" org-test-dir)))
+ (org-publish-file-relative-name "/name.org"
+ `(:base-directory ,base)))))
+ ;; Relative file names are unchanged.
+ (should
+ (equal "a.org"
+ (let ((base (expand-file-name "examples/pub/" org-test-dir)))
+ (org-publish-file-relative-name "a.org" `(:base-directory ,base))))))
+
(provide 'test-ox-publish)
;;; test-ox-publish.el ends here