forked from mirrors/org-mode
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
TINYCHANGE
This commit is contained in:
parent
c7e1f78326
commit
4ea9a98f85
|
@ -1607,15 +1607,20 @@ 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
|
be set to a buffer or a buffer name. `shell-command' then uses
|
||||||
it for output."
|
it for output."
|
||||||
(let* ((commands (org-compile-file-commands source process ext spec err-msg))
|
(let* ((commands (org-compile-file-commands source process ext spec err-msg))
|
||||||
(output (expand-file-name (concat (file-name-base source) "." ext)
|
(output (concat (file-name-sans-extension source) "." ext))
|
||||||
(file-name-directory source)))
|
;; Resolve symlinks in default-directory to correctly handle
|
||||||
|
;; absolute source paths or relative paths with ..
|
||||||
|
(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)))
|
(log-buf (and log-buf (get-buffer-create log-buf)))
|
||||||
(time (file-attribute-modification-time (file-attributes output))))
|
(time (file-attribute-modification-time (file-attributes output))))
|
||||||
(save-window-excursion
|
(save-window-excursion
|
||||||
(dolist (command commands)
|
(dolist (command commands)
|
||||||
(cond
|
(cond
|
||||||
((functionp command)
|
((functionp command)
|
||||||
(funcall command (shell-quote-argument (file-relative-name source))))
|
(funcall command (shell-quote-argument relname)))
|
||||||
((stringp command) (shell-command command log-buf)))))
|
((stringp command) (shell-command command log-buf)))))
|
||||||
;; Check for process failure. Output file is expected to be
|
;; Check for process failure. Output file is expected to be
|
||||||
;; located in the same directory as SOURCE.
|
;; located in the same directory as SOURCE.
|
||||||
|
@ -1649,33 +1654,35 @@ the SOURCE file.
|
||||||
|
|
||||||
If PROCESS is a list of commands, each of them is called using
|
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
|
`shell-command'. By default, in each command, %b, %f, %F, %o and
|
||||||
%O are replaced with, respectively, SOURCE base name, name, full
|
%O are replaced with, respectively, SOURCE base name, relative
|
||||||
name, directory and absolute output file name. It is possible,
|
file name, absolute file name, relative directory and absolute
|
||||||
however, to use more place-holders by specifying them in optional
|
output file name. It is possible, however, to use more
|
||||||
argument SPEC, as an alist following the pattern
|
place-holders by specifying them in optional argument SPEC, as an
|
||||||
|
alist following the pattern
|
||||||
|
|
||||||
(CHARACTER . REPLACEMENT-STRING).
|
(CHARACTER . REPLACEMENT-STRING).
|
||||||
|
|
||||||
Throw an error if PROCESS does not satisfy the described patterns.
|
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."
|
The error string will be appended with ERR-MSG, when it is a string."
|
||||||
(let* ((base-name (file-name-base source))
|
(let* ((basename (file-name-base source))
|
||||||
(full-name (file-truename source))
|
;; Resolve symlinks in default-directory to correctly handle
|
||||||
(relative-name (file-relative-name source))
|
;; absolute source paths or relative paths with ..
|
||||||
(out-dir (if (file-name-directory source)
|
(pwd (file-truename default-directory))
|
||||||
;; Expand "~". Shell expansion will be disabled
|
(absname (expand-file-name source pwd))
|
||||||
;; in the shell command call.
|
(relname (if (file-name-absolute-p source)
|
||||||
(file-name-directory full-name)
|
(file-relative-name source pwd)
|
||||||
"./"))
|
source))
|
||||||
(output (expand-file-name (concat (file-name-base source) "." ext) out-dir))
|
(relpath (or (file-name-directory relname) "./"))
|
||||||
|
(output (concat (file-name-sans-extension absname) "." ext))
|
||||||
(err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
|
(err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
|
||||||
(pcase process
|
(pcase process
|
||||||
((pred functionp) (list process))
|
((pred functionp) (list process))
|
||||||
((pred consp)
|
((pred consp)
|
||||||
(let ((spec (append spec
|
(let ((spec (append spec
|
||||||
`((?b . ,(shell-quote-argument base-name))
|
`((?b . ,(shell-quote-argument basename))
|
||||||
(?f . ,(shell-quote-argument relative-name))
|
(?f . ,(shell-quote-argument relname))
|
||||||
(?F . ,(shell-quote-argument full-name))
|
(?F . ,(shell-quote-argument absname))
|
||||||
(?o . ,(shell-quote-argument out-dir))
|
(?o . ,(shell-quote-argument relpath))
|
||||||
(?O . ,(shell-quote-argument output))))))
|
(?O . ,(shell-quote-argument output))))))
|
||||||
(mapcar (lambda (command) (format-spec command spec)) process)))
|
(mapcar (lambda (command) (format-spec command spec)) process)))
|
||||||
(_ (error "No valid command to process %S%s" source err-msg)))))
|
(_ (error "No valid command to process %S%s" source err-msg)))))
|
||||||
|
|
Loading…
Reference in New Issue