From 6e1f120818582695da9018f2111156b00c87104a Mon Sep 17 00:00:00 2001 From: Roshan Shariff Date: Fri, 4 Aug 2023 22:10:25 -0600 Subject: [PATCH v2] org-macs: Fix incorrect use of relative paths in org-compile-file * org-macs.el (org-compile-file, org-compile-file-commands): Resolve symlinks in default-directory before computing relative source path 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, like a shell. Unfortunately, this breaks when DEFAULT-DIRECTORY is a symlink and SOURCE 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 SOURCE is /var/tmp/test.org, so 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 resolve symlinks in DEFAULT-DIRECTORY before computing the relative path of SOURCE. If SOURCE is already relative, it is used as-is. The absolute path is processed by `expand-file-name`, avoiding bug [1]. [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 | 45 +++++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index e102f01c3..dc5dbeab5 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -1607,15 +1607,18 @@ 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." (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 (concat (file-name-sans-extension source) "." ext)) + (relname (if (file-name-absolute-p source) + (let ((pwd (file-truename default-directory))) + (file-relative-name source pwd)) + source)) (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 relname))) ((stringp command) (shell-command command log-buf))))) ;; Check for process failure. Output file is expected to be ;; located in the same directory as SOURCE. @@ -1649,33 +1652,35 @@ the SOURCE file. If PROCESS is a list of commands, each of them is called using `shell-command'. By default, in each command, %b, %f, %F, %o and -%O are replaced with, respectively, SOURCE base name, name, full -name, directory and absolute output file name. It is possible, -however, to use more place-holders by specifying them in optional -argument SPEC, as an alist following the pattern +%O are replaced with, respectively, SOURCE base name, relative +file name, absolute file name, relative directory and absolute +output file name. It is possible, however, to use more +place-holders by specifying them in optional argument SPEC, as an +alist following the pattern (CHARACTER . REPLACEMENT-STRING). 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." - (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)) + (let* ((basename (file-name-base source)) + ;; Resolve symlinks in default-directory to correctly handle + ;; absolute source paths or relative paths with .. + (pwd (file-truename default-directory)) + (absname (expand-file-name source pwd)) + (relname (if (file-name-absolute-p source) + (file-relative-name source pwd) + source)) + (relpath (or (file-name-directory relname) "./")) + (output (concat (file-name-sans-extension absname) "." 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 full-name)) - (?o . ,(shell-quote-argument out-dir)) + `((?b . ,(shell-quote-argument basename)) + (?f . ,(shell-quote-argument relname)) + (?F . ,(shell-quote-argument absname)) + (?o . ,(shell-quote-argument relpath)) (?O . ,(shell-quote-argument output)))))) (mapcar (lambda (command) (format-spec command spec)) process))) (_ (error "No valid command to process %S%s" source err-msg))))) base-commit: c7e1f78326581e8d994feaee69d725d3e073f89f -- 2.41.0