diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-11-26 10:46:53 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-11-26 10:46:53 +0100 |
commit | 6aac798f2556041113d72d79ddc68d7d27017e38 (patch) | |
tree | b9078e1a81ad8bee27e05bec6f588bb98580829f | |
parent | 1d8126385cf979cfaade0e6a82040884bd6af56b (diff) | |
download | org-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.el | 19 | ||||
-rw-r--r-- | lisp/ox-publish.el | 15 | ||||
-rw-r--r-- | testing/lisp/test-ox-publish.el | 27 |
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 |