[PATCH] org-macs: Fix incorrect use of relative paths in org-compile-file

[Roshan Shariff]

* org-macs.el (org-compile-file, org-compile-file-commands): Avoid
converting the source path to be relative to the default-directory,
which breaks for absolute source paths when the current directory is a
symlink.

Commit 5a8a1d4ff [1] changed org-compile-file to use
`file-relative-name` for the source argument. This was intended to fix
bug [2] by expanding ~ directories in the source path, like a shell.

Unfortunately, this forced use of relative paths breaks when
default-directory is a symlink, and the source to be compiled has an
absolute path.

For example, on macOS Ventura, ~/Dropbox is a symlink to
~/Library/CloudStorage/Dropbox. Suppose `default-directory` is
/Users/username/Dropbox and you try to compile /var/tmp/test.org. Its
relative path is ../../../var/tmp/test.org. But the working directory
of a compilation process is actually ~/Library/CloudStorage/Dropbox,
relative to which the source path resolves to
"/Users/username/var/tmp/test.org". The process thus cannot find the
source file.

This commit changes `org-compile-file` and its helper function
`org-compile-file-commands` to avoid the use of relative
paths. Instead, to address bug [2], `expand-file-name` is used (only
on absolute paths) for ~ expansion. Otherwise, the source path is
passed unchanged to the compilation command. The `file-truename` of
the source directory is used to construct absolute source and output
paths if needed by the command.

[1] https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=5a8a1d4ff
[2] https://orgmode.org/list/25528.42190.53674.62381@gargle.gargle.HOWL
---
 lisp/org-macs.el | 39 +++++++++++++++++++++++++++------------
 1 file changed, 27 insertions(+), 12 deletions(-)

diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index e102f01c3..5d8f65193 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -1606,16 +1606,20 @@ filename.  Otherwise, it raises an error.
 When PROCESS is a list of commands, optional argument LOG-BUF can
 be set to a buffer or a buffer name.  `shell-command' then uses
 it for output."
+  (when (file-name-absolute-p source)
+    ;; Expand "~" and "~user" .  Shell expansion will be disabled
+    ;; in the shell command call.
+    (setq source (expand-file-name source)))
   (let* ((commands (org-compile-file-commands source process ext spec err-msg))
-         (output (expand-file-name (concat (file-name-base source) "." ext)
-                                   (file-name-directory source)))
+         (output (file-name-concat (file-name-directory source)
+                                   (concat (file-name-base source) "." ext)))
          (log-buf (and log-buf (get-buffer-create log-buf)))
          (time (file-attribute-modification-time (file-attributes output))))
     (save-window-excursion
       (dolist (command commands)
         (cond
          ((functionp command)
-          (funcall command (shell-quote-argument (file-relative-name source))))
+          (funcall command (shell-quote-argument source)))
          ((stringp command) (shell-command command log-buf)))))
     ;; Check for process failure.  Output file is expected to be
     ;; located in the same directory as SOURCE.
@@ -1658,22 +1662,33 @@ argument SPEC, as an alist following the pattern
 
 Throw an error if PROCESS does not satisfy the described patterns.
 The error string will be appended with ERR-MSG, when it is a string."
+  (when (file-name-absolute-p source)
+    ;; Expand "~" and "~user" .  Shell expansion will be disabled
+    ;; in the shell command call.
+    (setq source (expand-file-name source)))
   (let* ((base-name (file-name-base source))
-        (full-name (file-truename source))
-         (relative-name (file-relative-name source))
-        (out-dir (if (file-name-directory source)
-                      ;; Expand "~".  Shell expansion will be disabled
-                      ;; in the shell command call.
-                      (file-name-directory full-name)
-                    "./"))
-        (output (expand-file-name (concat (file-name-base source) "." ext) 
out-dir))
+        (out-dir (file-name-directory source))
+         ;; Don't use (expand-file-name SOURCE) for the absolute path,
+         ;; in case SOURCE starts with ../ and default-directory is a
+         ;; symlink.  Instead, resolve symlinks in the directory
+         ;; component of SOURCE...
+         (true-out-dir (file-truename out-dir))
+         ;; but use the original file name component of SOURCE in case
+         ;; it is a symlink; we want %f and %F to have the same file
+         ;; name component:
+        (full-name (file-name-concat true-out-dir
+                                      (file-name-nondirectory source)))
+         ;; The absolute path OUTPUT is the same as FULL-NAME, except
+         ;; with extension EXT:
+        (output (file-name-concat true-out-dir
+                                   (concat base-name "." ext)))
         (err-msg (if (stringp err-msg) (concat ".  " err-msg) "")))
     (pcase process
       ((pred functionp) (list process))
       ((pred consp)
        (let ((spec (append spec
                           `((?b . ,(shell-quote-argument base-name))
-                            (?f . ,(shell-quote-argument relative-name))
+                            (?f . ,(shell-quote-argument source))
                             (?F . ,(shell-quote-argument full-name))
                             (?o . ,(shell-quote-argument out-dir))
                             (?O . ,(shell-quote-argument output))))))

base-commit: 73cb528c24322fef2d05142d36bc48bb9dac962e
-- 
2.41.0