branch: externals/tramp-hlo
commit e1269f11511db0f8b6b27435e55a65d32cbfb92b
Author: Joe Sadusk <[email protected]>
Commit: Joe Sadusk <[email protected]>
Fixed tramp-hlo-dir-locals-find-file to use a larger script and do
everything in a single roundtrip, and made use of tramp-add-external-operation
---
tramp-hlo.el | 259 ++++++++++++++++++++++++++++++++++++++---------------------
1 file changed, 167 insertions(+), 92 deletions(-)
diff --git a/tramp-hlo.el b/tramp-hlo.el
index 470d4d88b9..67933d893d 100644
--- a/tramp-hlo.el
+++ b/tramp-hlo.el
@@ -110,26 +110,78 @@ echo \\)
"Script to find several dominating files on a remote host"
)
-(defmacro tramp-hlo-advice (file fallback &rest body)
- "Setup macro for `tramp-hlo' advice functions.
-Creates a scaffold to make an advice function to add a tramp implementation to
-a high level function. FILE is a filename that might be a remote file with a
-tramp-sh backend. If so, execute the BODY of the macro, otherwise run the
-FALLBACK expression. If executing BODY, the dissected FILE will be in scope as
-`vec'."
- `(if-let* ((non-essential t)
- (vec (ignore-errors
- (tramp-dissect-file-name (expand-file-name ,file))))
- ((tramp-sh-file-name-handler-p vec))
- (non-essential nil)
- )
- (progn ,@body)
- (,@fallback)
- )
- )
+(defconst tramp-hlo-dir-locals-find-file-cache-update-script
+ "
+FILE=$1
+shift
+NAMES=$1
+shift
+CACHEDIRS=$@
+STAT_FORMAT=\"%%Y\"
+STAT_FORMAT=\"${STAT_FORMAT#?}\"
+if [ -e \"$FILE\" ]; then
+ FILE=\"$(realpath $FILE)\"
+ TEST=\"$(dirname $FILE )\"
+ echo \"(\"
+ echo \":file \\\"$FILE\\\" \"
+ FOUND=\"\"
+ while [ ! -z \"$TEST\" ] && [ -z \"$FOUND\" ]; do
+ for NAME in $NAMES; do
+ if [ -f \"$TEST/$NAME\" ]; then
+ DOMINATING_DIR=\"$TEST\"
+ MTIME=\"$(stat -c \"$STAT_FORMAT\" \"$TEST/$NAME\")\"
+ FOUND=\"$FOUND ( \\\"$NAME\\\" . $MTIME ) \"
+ fi
+ done
+ if [ -z \"$FOUND\" ]; then
+ if [ \"$TEST\" = \"/\" ]; then
+ TEST=\"\"
+ else
+ TEST=\"${TEST%/*}\"
+ if [ -z \"$TEST\" ]; then
+ TEST=\"/\"
+ fi
+ fi
+ fi
+ done
+
+ if [ ! -z \"$FOUND\" ]; then
+ echo \":locals (\\\"$DOMINATING_DIR\\\" $FOUND )\"
+ fi
+
+ DOMINATING_DIR_LEN=$(expr length \"$DOMINATING_DIR\")
+ FOUND_CACHEDIR=\"\"
+ FOUND_CACHEDIR_LEN=0
+ for CACHEDIR in $CACHEDIRS; do
+ CACHEDIR_LEN=$(expr length \"$CACHEDIR\")
+
+ if [ -d \"$CACHEDIR\" ] && [ \"$CACHEDIR_LEN\" -gt
\"$FOUND_CACHEDIR_LEN\" ] && [ \"${FILE#$CACHEDIR}\" != \"$FILE\" ]; then
+ FOUND_CACHEDIR=$CACHEDIR
+ FOUND_CACHEDIR_LEN=$CACHEDIR_LEN
+ fi
+ done
+
+ if [ ! -z \"$FOUND_CACHEDIR\" ]; then
+ echo \":cache ( \\\"$FOUND_CACHEDIR\\\" \"
+ for NAME in $NAMES; do
+ if [ -f \"$FOUND_CACHEDIR/$NAME\" ]; then
+ MTIME=\"$(stat -c \"$STAT_FORMAT\" \"$FOUND_CACHEDIR/$NAME\")\"
+ echo \"( \\\"$NAME\\\" . $MTIME ) \"
+ fi
+ done
+ echo \")\"
+ fi
+
+ echo \")\"
+ return 0
+else
+ return 1
+fi"
+ "Support script for `dir-locals-find-file'"
+)
-(defun tramp-hlo-dir-locals--all-files (orig-fun directory &optional
base-el-only)
+(defun tramp-hlo-dir-locals--all-files (directory &optional base-el-only)
"Tramp optimized version of `dir-locals--all-files'.
Return a list of all readable dir-locals files in the directory
represented by VEC.
@@ -137,10 +189,8 @@ The returned list is sorted by increasing priority. That
is,
values specified in the last file should take precedence over
those in the first.
-The optional argument BASE-EL-ONLY will only consider the base dir locals file.
-This is intended as an advice function, with ORIG-FUN as the fallback
function."
- (tramp-hlo-advice directory
- (funcall orig-fun directory)
+The optional argument BASE-EL-ONLY will only consider the base dir locals
file."
+ (with-parsed-tramp-file-name directory vec
(let* ((localdir (directory-file-name (tramp-file-name-localname vec)))
(file-1 dir-locals-file)
(file-2 (when (string-match "\\.el\\'" file-1)
@@ -199,7 +249,7 @@ if not found."
)
)
-(defun tramp-hlo-locate-dominating-file (orig-fun file name)
+(defun tramp-hlo-locate-dominating-file (file name)
"Tramp version of `locate-dominating-file'
Starting at FILE, look up directory hierarchy for directory containing NAME.
FILE can be a file or a directory. If it's a file, its directory will
@@ -209,10 +259,8 @@ and return the directory. Return nil if not found.
Instead of a string, NAME can also be a predicate taking one argument
\(a directory) and returning a non-nil value if that directory is the one for
which we're looking. The predicate will be called with every file/directory
-the function needs to examine, starting with FILE.
-This is intended as an advice function, with ORIG-FUN as the fallback
function."
- (tramp-hlo-advice file
- (funcall orig-fun file name)
+the function needs to examine, starting with FILE."
+ (with-parsed-tramp-file-name file vec
(if (functionp name)
(tramp-hlo-locate-dominating-file-pred vec name)
(let* ((names (if (listp name) name (list name)))
@@ -226,7 +274,46 @@ This is intended as an advice function, with ORIG-FUN as
the fallback function."
)
)
-(defun tramp-hlo-dir-locals-find-file (orig-fun file)
+(defun tramp-hlo-dir-locals-find-file-cache-update (file cache)
+ "Prepare inputs and run support script for `tramp-hlo-dir-locals-find-file'
+Perform the equivalent of `expand-file-name', `locate-dominating-file' and
+`file-attribute-modification-time' in one tramp operation.
+The operations performed are:
+ - Expand the filename of FILE
+ - Locate the dominating directory-locals files for the directory containing
+ FILE
+ - Resolve the mtime for all directory-locals files located
+ - Find cache directories from CACHE which is equivalent to
+ `dir-locals-directory-cache' that are on the same remote as FILE
+ - Find the highest level cache directory located under the expanded path of
+ FILE, if it exists
+ - Resolve the mtime of all directory-locals files under the cache directory
+
+This function returns a plist with the fields:
+ - `:file' containing the expanded filename of FILE
+ - `:locals' containing a list with the located dir-locals directory under
FILE
+ and a dotted pair list of dir-locals files under that directory with their
+ mtime
+ - `:cache' containing the most appropriate cache directory under FILE with a
+ dotted pair list of dir-locals file and mtime
+`:locals' and `:cache' are optional fields, and are missing if not found."
+ (with-parsed-tramp-file-name file vec
+ (tramp-maybe-send-script vec
tramp-hlo-dir-locals-find-file-cache-update-script
"dir_locals_find_file_cache_update")
+ (let* (
+ (file-connection (file-remote-p file))
+ (cache-dirs (mapcar #'car cache))
+ (cache-remotes (mapcar 'file-remote-p cache-dirs))
+ (same-remote-cache-dirs (seq-filter (lambda (cache-dir) (string=
file-connection (file-remote-p cache-dir))) cache-dirs))
+ (same-remotes (mapcar (lambda (cache-dir) (string= file-connection
(file-remote-p cache-dir))) cache-dirs))
+ (cache-dirs-local (mapcar #'file-local-name same-remote-cache-dirs))
+ (cache-dirs-quoted (mapcar #'tramp-shell-quote-argument
cache-dirs-local))
+ (cache-dirs-string (string-join cache-dirs-quoted " "))
+ (command (format "dir_locals_find_file_cache_update %s
\".dir-locals.el .dir-locals2.el\" %s" (tramp-file-local-name file)
cache-dirs-string))
+ )
+ (tramp-send-command-and-read vec command))))
+
+
+(defun tramp-hlo-dir-locals-find-file (file)
"Tramp implementation of `dir-locals-find-file'.
Find the directory-local variables for FILE.
This searches upward in the directory tree from FILE.
@@ -245,86 +332,74 @@ This function returns either:
- the matching entry from `dir-locals-directory-cache' (a list),
- or the full path to the directory (a string) containing at
least one `dir-locals-file' in the case of no valid cache
- entry.
+ entry."
+ (let* (
+ (file-connection (file-remote-p file))
+ (cache-update (tramp-hlo-dir-locals-find-file-cache-update file
dir-locals-directory-cache))
+ (file (concat file-connection (plist-get cache-update :file)))
+ (locals-dir-update (plist-get cache-update :locals))
+ (locals-dir (if locals-dir-update (concat file-connection (car
locals-dir-update))))
+ (cache-dir-update (plist-get cache-update :cache))
+ (cache-dir (if cache-dir-update (concat file-connection (car
cache-dir-update))))
+ (dir-elt (if cache-dir-update (seq-find (lambda (elt) (string= (car
elt) cache-dir)) dir-locals-directory-cache)))
+ )
+ (if (and dir-elt
+ (or (null locals-dir)
+ (<= (length locals-dir)
+ (length (car dir-elt)))))
+ ;; Found a potential cache entry. Check validity.
+ ;; A cache entry with no MTIME is assumed to always be valid
+ ;; (ie, set directly, not from a dir-locals file).
+ ;; Note, we don't bother to check that there is a matching class
+ ;; element in dir-locals-class-alist, since that's done by
+ ;; dir-locals-set-directory-class.
+ (if (or (null (nth 2 dir-elt))
+ (let ((cached-files (cdr cache-dir-update)))
+ ;; The entry MTIME should match the most recent
+ ;; MTIME among matching files.
+ (and cached-files
+ (time-equal-p
+ (nth 2 dir-elt)
+ (let ((latest 0))
+ (dolist (f cached-files latest)
+ (let ((f-time
+ (seconds-to-time (cdr f))))
+ (if (time-less-p latest f-time)
+ (setq latest f-time)))))))))
+ ;; This cache entry is OK.
+ dir-elt
+ ;; This cache entry is invalid; clear it.
+ (setq dir-locals-directory-cache
+ (delq dir-elt dir-locals-directory-cache))
+ ;; Return the first existing dir-locals file. Might be the same
+ ;; as dir-elt's, might not (eg latter might have been deleted).
+ locals-dir)
+ ;; No cache entry.
+ locals-dir)))
-This is intended as an advice function, with ORIG-FUN as the fallback
function."
- (tramp-hlo-advice file
- (funcall orig-fun file)
- (let* ((locals-files (tramp-hlo-locate-dominating-file-list
- vec
- '(".dir-locals.el" ".dir-locals-2.el")))
- (locals-dir (if locals-files (file-name-directory (car
locals-files)) nil))
- dir-elt)
- ;; `locate-dominating-file' may have abbreviated the name.
- (when locals-dir
- (setq locals-dir (expand-file-name locals-dir)))
- ;; Find the best cached value in `dir-locals-directory-cache'.
- (dolist (elt dir-locals-directory-cache)
- (when (and (string-prefix-p (car elt) file
- (memq system-type
- '(windows-nt cygwin ms-dos)))
- (> (length (car elt)) (length (car dir-elt))))
- (setq dir-elt elt)))
- (if (and dir-elt
- (or (null locals-dir)
- (<= (length locals-dir)
- (length (car dir-elt)))))
- ;; Found a potential cache entry. Check validity.
- ;; A cache entry with no MTIME is assumed to always be valid
- ;; (ie, set directly, not from a dir-locals file).
- ;; Note, we don't bother to check that there is a matching class
- ;; element in dir-locals-class-alist, since that's done by
- ;; dir-locals-set-directory-class.
- (if (or (null (nth 2 dir-elt))
- (let ((cached-files (dir-locals--all-files (car
dir-elt))))
- ;; The entry MTIME should match the most recent
- ;; MTIME among matching files.
- (and cached-files
- (time-equal-p
- (nth 2 dir-elt)
- (let ((latest 0))
- (dolist (f cached-files latest)
- (let ((f-time
- (file-attribute-modification-time
- (file-attributes f))))
- (if (time-less-p latest f-time)
- (setq latest f-time)))))))))
- ;; This cache entry is OK.
- dir-elt
- ;; This cache entry is invalid; clear it.
- (setq dir-locals-directory-cache
- (delq dir-elt dir-locals-directory-cache))
- ;; Return the first existing dir-locals file. Might be the same
- ;; as dir-elt's, might not (eg latter might have been deleted).
- locals-dir)
- ;; No cache entry.
- locals-dir))
- )
- )
(defun setup-tramp-hlo ()
"Setup tramp high-level functions.
-Adds advice functions with tramp implementations for the following emacs
-built-in functions:
+Adds tramp external operations for the following emacs built-in functions:
- `dir-locals--all-files'
- `locate-dominating-file'
- `dir-locals-find-file'"
(interactive)
- (advice-add 'dir-locals--all-files :around #'tramp-hlo-dir-locals--all-files)
- (advice-add 'locate-dominating-file :around
#'tramp-hlo-locate-dominating-file)
- (advice-add 'dir-locals-find-file :around #'tramp-hlo-dir-locals-find-file)
+ (tramp-add-external-operation 'dir-locals--all-files
#'tramp-hlo-dir-locals--all-files 'tramp-sh)
+ (tramp-add-external-operation 'locate-dominating-file
#'tramp-hlo-locate-dominating-file 'tramp-sh)
+ (tramp-add-external-operation 'dir-locals-find-file
#'tramp-hlo-dir-locals-find-file 'tramp-sh)
)
(defun remove-tramp-hlo ()
"Remove tramp high-level functions.
-Remove tramp advice functions for the following emacs built-in functions:
+Remove tramp external operations for the following emacs built-in functions:
- `dir-locals--all-files'
- `locate-dominating-file'
- `dir-locals-find-file'"
(interactive)
- (advice-remove 'dir-locals--all-files #'tramp-hlo-dir-locals--all-files)
- (advice-remove 'locate-dominating-file #'tramp-hlo-locate-dominating-file)
- (advice-remove 'dir-locals-find-file #'tramp-hlo-dir-locals-find-file)
+ (tramp-remove-external-operation 'dir-locals--all-files 'tramp-sh)
+ (tramp-remove-external-operation 'locate-dominating-file 'tramp-sh)
+ (tramp-remove-external-operation 'dir-locals-find-file 'tramp-sh)
)
(provide 'tramp-hlo)
