Re: Dealing with inter-org links vs #+include

[Ihor Radchenko]

Brett Viren <bv@bnl.gov> writes:

> I want what may be two conflicting things:
>
> - Produce a monolithic HTML export of an main org file that #+include:'s
>   other org files.
>
> - Have links in the other org files that are valid both when the
>   monolith is exported to HTML and when visiting the individual org
>   files in Emacs.

I can see the rationale, but it is tricky.

> === a.org ===
> * A
>
> This is A.
> === b.org ===
> * B
>
> This is B.  Links:
> - [[file:a.org::*A][A by file with headline]].
> - [[A][A by headline only]].
>   
> === main.org ===
> ...
> * Includes
>
> #+include: a.org
> #+include: b.org

In this scenario, it indeed makes sense to replace links to a.org and
b.org with internal links.

However, someone who is exporting multiple files, including a.org/b.org
may actually want to keep links to a.org/b.org. In particular, when only
portions of a.org/b.org are included (like a single src block or certain
lines).

> * Links
>
> - A :: [[file:a.org]]
>
> - B :: [[file:b.org]]

And this is actually a scenario where it also makes more sense to keep
the links to a.org/b.org. If we follow your suggestion, these would be

> - A :: [[file:main.org]]
>
> - B :: [[file:main.org]]

which would look confusing.

For reference, I am attaching a patch that blindly converts links to
included files into links to the top-level includer. However, the patch
will fail for partially included files where the portions the links are
referencing are not actually included. It will also replace A:: and B::
links in the above example. So, it is not suitable for inclusion in Org
- we need some better idea how to handle other possible scenarios.

Suggestions welcome!
(For now, I do not see how we can handle the described scenarios
cleanly)

diff --git a/lisp/ox.el b/lisp/ox.el
index 480c484d4..1d6f4dff5 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -3392,7 +3392,17 @@ (defun org-export-expand-include-keyword (&optional 
included dir footnotes inclu
                    (goto-char (point-max))
                    (maphash (lambda (k v)
                               (insert (format "\n[fn:%s] %s\n" k v)))
-                            footnotes))))))))))))
+                            footnotes))))))))))
+    ;; Replace all the links to included files with links
+    ;; to top-level includer.
+    (unless included
+      (org-with-wide-buffer
+       (org-export--map-links
+        (lambda (link)
+          (org-export--update-included-link-file
+           (buffer-file-name (buffer-base-buffer))
+           (hash-table-keys file-prefix)
+           link)))))))
 
 (defun org-export-parse-include-value (value &optional dir)
   "Extract the various parameters from #+include: VALUE.
@@ -3606,15 +3616,17 @@ (defun org-export--inclusion-absolute-lines (file 
location only-contents lines)
                       (while (< (point) end) (cl-incf counter) (forward-line))
                       counter))))))))
 
-(defun org-export--update-included-link (file-dir includer-dir)
+(defun org-export--update-included-link (file-dir includer-dir &optional link)
   "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.
 
+Optional argument LINK, when non-nil, holds the link object.
+
 Move point after the link."
-  (let* ((link (org-element-link-parser))
+  (let* ((link (or 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)
@@ -3633,6 +3645,80 @@ (defun org-export--update-included-link (file-dir 
includer-dir)
                       (org-element-property :end link))
        (insert (org-element-interpret-data new-link))))))
 
+(defun org-export--update-included-link-file (new-file files &optional link)
+  "Replace file link paths to FILES with NEW-FILE.
+
+Absolute paths are replaced with NEW-FILE.  Relative paths are
+replaced with NEW-FILE relative to `default-directory'.
+
+FILES are assumed to be absolute paths.
+
+Optional argument LINK, when non-nil, holds the link object.
+
+Move point after the link."
+  (let* ((link (or link (org-element-link-parser)))
+        (path (org-element-property :path link)))
+    (if (or (not (string= "file" (org-element-property :type link)))
+            (not (member (expand-file-name path) files)))
+        (goto-char (org-element-property :end link))
+      (let ((new-path
+             (if (file-name-absolute-p path)
+                 new-file (file-relative-name new-file)))
+           (new-link (org-element-copy link)))
+        (if (equal new-path path)
+            (goto-char (org-element-property :end link))
+          (if (not (org-element-property :search-option link))
+              (org-element-put-property new-link :path new-path)
+            ;; Internal link to included file.  Do not keep file
+            ;; type as `org-export-resolve-link' will look into the
+            ;; original file version without INCLUDE keywords
+            ;; expanded.
+            (org-element-put-property new-link :type "fuzzy")
+            (org-element-put-property
+             new-link :path
+             (org-element-property :search-option link)))
+         (when (org-element-property :contents-begin link)
+           (org-element-adopt new-link
+             (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))
+         (insert (org-element-interpret-data new-link)))))))
+
+(defun org-export--map-links (func)
+  "Apply FUNC on every link in accessible part of current Org buffer.
+FUNC is called with a single argument - link object, with point at the
+beginning of a link.
+
+Also look for links within link's description.  Org doesn't support
+such construct, but `org-export-insert-image-links' may activate them."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((regexp (concat org-link-plain-re "\\|" org-link-angle-re)))
+      (while (re-search-forward org-link-any-re nil t)
+        (let ((link (save-excursion
+                     (forward-char -1)
+                     (save-match-data (org-element-context)))))
+         (when (org-element-type-p link '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
+                      (funcall func (org-element-link-parser)))
+                   (goto-char (match-beginning 0)))))
+             ;; Update current link, if necessary.
+             (goto-char begin)
+              (funcall func link))))))))
+
 (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.
@@ -3682,35 +3768,12 @@ (defun org-export--prepare-file-contents
       (let ((file-dir (file-name-directory file))
            (includer-dir (file-name-directory includer)))
        (unless (file-equal-p file-dir includer-dir)
-         (goto-char (point-min))
          (unless (eq major-mode 'org-mode)
            (let ((org-inhibit-startup t)) (org-mode))) ;set regexps
-         (let ((regexp (concat org-link-plain-re "\\|" org-link-angle-re)))
-           (while (re-search-forward org-link-any-re nil t)
-             (let ((link (save-excursion
-                           (forward-char -1)
-                           (save-match-data (org-element-context)))))
-               (when (org-element-type-p link '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))))))))))
+          (org-export--map-links
+           (lambda (link)
+             (org-export--update-included-link
+             file-dir includer-dir link))))))
     ;; 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.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>