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.

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.

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

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