Merge branch 'maint'

lisp/ox.el

@@ -3453,6 +3453,32 @@ Return a string of lines to be included in the format expected by
 		       (while (< (point) end) (cl-incf counter) (forward-line))
 		       counter))))))))
 
+(defun org-export--update-included-link (file-dir includer-dir)
+  "Update relative file name of link at point, if possible.
+
+FILE-DIR is the directory of the file being included.
+INCLUDER-DIR is the directory of the file where the inclusion is
+going to happen.
+
+Move point after the link."
+  (let* ((link (org-element-link-parser))
+	 (path (org-element-property :path link)))
+    (if (or (not (string= "file" (org-element-property :type link)))
+	    (file-remote-p path)
+	    (file-name-absolute-p path))
+	(goto-char (org-element-property :end link))
+      (let ((new-path (file-relative-name (expand-file-name path file-dir)
+					  includer-dir))
+	    (new-link (org-element-copy link))
+	    (contents (and (org-element-property :contents-begin link)
+			   (buffer-substring
+			    (org-element-property :contents-begin link)
+			    (org-element-property :contents-end link)))))
+	(org-element-put-property new-link :path new-path)
+	(delete-region (org-element-property :begin link)
+		       (org-element-property :end link))
+	(insert (org-element-link-interpreter new-link contents))))))
+
 (defun org-export--prepare-file-contents
     (file &optional lines ind minlevel id footnotes includer)
   "Prepare contents of FILE for inclusion and return it as a string.
@@ -3505,27 +3531,32 @@ is to happen."
 	  (goto-char (point-min))
 	  (unless (eq major-mode 'org-mode)
 	    (let ((org-inhibit-startup t)) (org-mode)))	;set regexps
-	  (while (re-search-forward org-any-link-re nil t)
-	    (let ((link (save-excursion (backward-char) (org-element-context))))
-	      (when (and (eq 'link (org-element-type link))
-			 (string= "file" (org-element-property :type link)))
-		(let ((old-path (org-element-property :path link)))
-		  (unless (or (file-remote-p old-path)
-			      (file-name-absolute-p old-path))
-		    (let ((new-path (file-relative-name
-				     (expand-file-name old-path file-dir)
-				     includer-dir)))
-		      (insert
-		       (let ((new (org-element-copy link)))
-			 (org-element-put-property new :path new-path)
-			 (when (org-element-property :contents-begin link)
-			   (org-element-adopt-elements new
-			     (buffer-substring
-			      (org-element-property :contents-begin link)
-			      (org-element-property :contents-end link))))
-			 (delete-region (org-element-property :begin link)
-					(org-element-property :end link))
-			 (org-element-interpret-data new))))))))))))
+	  (let ((regexp (concat org-plain-link-re "\\|" org-angle-link-re)))
+	    (while (re-search-forward org-any-link-re nil t)
+	      (let ((link (save-excursion
+			    (forward-char -1)
+			    (save-match-data (org-element-context)))))
+		(when (eq 'link (org-element-type link))
+		  ;; Look for file links within link's description.
+		  ;; Org doesn't support such construct, but
+		  ;; `org-export-insert-image-links' may activate
+		  ;; them.
+		  (let ((contents-begin
+			 (org-element-property :contents-begin link))
+			(begin (org-element-property :begin link)))
+		    (when contents-begin
+		      (save-excursion
+			(goto-char (org-element-property :contents-end link))
+			(while (re-search-backward regexp contents-begin t)
+			  (save-match-data
+			    (org-export--update-included-link
+			     file-dir includer-dir))
+			  (goto-char (match-beginning 0)))))
+		    ;; Update current link, if necessary.
+		    (when (string= "file" (org-element-property :type link))
+		      (goto-char begin)
+		      (org-export--update-included-link
+		       file-dir includer-dir))))))))))
     ;; Remove blank lines at beginning and end of contents.  The logic
     ;; behind that removal is that blank lines around include keyword
     ;; override blank lines in included file.

testing/lisp/test-ox.el

@@ -1363,7 +1363,7 @@ Footnotes[fn:2], foot[fn:test] and [fn:inline:inline footnote]
      (org-export-expand-include-keyword)
      (eq 3 (org-current-level)))))
 
-(ert-deftest test-org/expand-include/links ()
+(ert-deftest test-org-export/expand-include/links ()
   "Test links modifications when including files."
   ;; Preserve relative plain links.
   (should
@@ -3037,7 +3037,93 @@ Para2"
 	     (org-element-map
 		 (org-export-insert-image-links tree info '(("file" . "xxx")))
 		 'link
-	       (lambda (l) (org-element-property :type l)))))))
+	       (lambda (l) (org-element-property :type l))))))
+  ;; If an image link was included from another file, make sure to
+  ;; shift any relative path accordingly.
+  (should
+   (string-prefix-p
+    "file:org-includee-"
+    (let* ((subdir (make-temp-file "org-includee-" t))
+	   (includee (expand-file-name "includee.org" subdir))
+	   (includer (make-temp-file "org-includer-")))
+      (write-region "file:foo.png" nil includee)
+      (write-region (format "#+INCLUDE: %S"
+			    (file-relative-name includee
+						temporary-file-directory))
+		    nil includer)
+      (let ((buffer (find-file-noselect includer t)))
+	(unwind-protect
+	    (with-current-buffer buffer
+	      (org-export-as
+	       (org-export-create-backend
+		:transcoders
+		'((section . (lambda (_s c _i) c))
+		  (paragraph . (lambda (_p c _i) c))
+		  (link . (lambda (l c _i) (org-element-link-interpreter l c))))
+		:filters
+		'((:filter-parse-tree
+		   (lambda (d _b i) (org-export-insert-image-links d i)))))))
+	  (when (buffer-live-p buffer)
+	    (with-current-buffer buffer (set-buffer-modified-p nil))
+	    (kill-buffer buffer))
+	  (when (file-exists-p subdir) (delete-directory subdir t))
+	  (when (file-exists-p includer) (delete-file includer)))))))
+  (should
+   (string-match-p
+    "file:org-includee-.+?foo\\.png"
+    (let* ((subdir (make-temp-file "org-includee-" t))
+	   (includee (expand-file-name "includee.org" subdir))
+	   (includer (make-temp-file "org-includer-")))
+      (write-region "[[https://orgmode.org][file:foo.png]]" nil includee)
+      (write-region (format "#+INCLUDE: %S"
+			    (file-relative-name includee
+						temporary-file-directory))
+		    nil includer)
+      (let ((buffer (find-file-noselect includer t)))
+	(unwind-protect
+	    (with-current-buffer buffer
+	      (org-export-as
+	       (org-export-create-backend
+		:transcoders
+		'((section . (lambda (_s c _i) c))
+		  (paragraph . (lambda (_p c _i) c))
+		  (link . (lambda (l c _i) (org-element-link-interpreter l c))))
+		:filters
+		'((:filter-parse-tree
+		   (lambda (d _b i) (org-export-insert-image-links d i)))))))
+	  (when (buffer-live-p buffer)
+	    (with-current-buffer buffer (set-buffer-modified-p nil))
+	    (kill-buffer buffer))
+	  (when (file-exists-p subdir) (delete-directory subdir t))
+	  (when (file-exists-p includer) (delete-file includer)))))))
+  (should
+   (string-match-p
+    "file:org-includee.+?file:org-includee"
+    (let* ((subdir (make-temp-file "org-includee-" t))
+	   (includee (expand-file-name "includee.org" subdir))
+	   (includer (make-temp-file "org-includer-")))
+      (write-region "[[file:bar.png][file:foo.png]]" nil includee)
+      (write-region (format "#+INCLUDE: %S"
+			    (file-relative-name includee
+						temporary-file-directory))
+		    nil includer)
+      (let ((buffer (find-file-noselect includer t)))
+	(unwind-protect
+	    (with-current-buffer buffer
+	      (org-export-as
+	       (org-export-create-backend
+		:transcoders
+		'((section . (lambda (_s c _i) c))
+		  (paragraph . (lambda (_p c _i) c))
+		  (link . (lambda (l c _i) (org-element-link-interpreter l c))))
+		:filters
+		'((:filter-parse-tree
+		   (lambda (d _b i) (org-export-insert-image-links d i)))))))
+	  (when (buffer-live-p buffer)
+	    (with-current-buffer buffer (set-buffer-modified-p nil))
+	    (kill-buffer buffer))
+	  (when (file-exists-p subdir) (delete-directory subdir t))
+	  (when (file-exists-p includer) (delete-file includer))))))))
 
 (ert-deftest test-org-export/fuzzy-link ()
   "Test fuzzy links specifications."