branch: externals/tramp-hlo
commit a7daa1217cad0135e933a3dc88cf6a7e2ef548a4
Author: Joe Sadusk <[email protected]>
Commit: Joe Sadusk <[email protected]>
Address review comments. Add full docstrings, add macro for advice function
setup, remove unnecessary group
---
tramp-hlo.el | 200 ++++++++++++++++++++++++++++++++++++++---------------------
1 file changed, 128 insertions(+), 72 deletions(-)
diff --git a/tramp-hlo.el b/tramp-hlo.el
index 6f1fe35841..d330007876 100644
--- a/tramp-hlo.el
+++ b/tramp-hlo.el
@@ -12,10 +12,6 @@
;;; Code
-(defgroup tramp-hlo nil
- "High level operations as tramp handlers"
- :group 'tools)
-
(require 'tramp-sh)
(defconst tramp-hlo-test-files-in-dir-script
@@ -36,7 +32,7 @@ else
echo \\)
fi
"
- "Script to check for dir-locals in a remote dir"
+ "Script to check for `dir-locals' in a remote dir."
)
(defconst tramp-hlo-list-parents-script
@@ -114,99 +110,148 @@ 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 ,file)))
+ ((tramp-sh-file-name-handler-p vec)))
+
+ (progn ,@body)
+ (,@fallback)
+ )
+ )
+
+
(defun tramp-hlo-dir-locals--all-files (orig-fun directory &optional
base-el-only)
- "Tramp version of dir-locals--all-files"
- (let ((connection (file-remote-p directory)))
- (if connection
- (let* ((localdir (directory-file-name (file-local-name directory)))
- (file-1 dir-locals-file)
- (file-2 (when (string-match "\\.el\\'" file-1)
- (replace-match "-2.el" t nil file-1)))
- (vec (tramp-dissect-file-name directory))
+ "Tramp optimized version of dir-locals--all-files.
+Return a list of all readable dir-locals files in the directory
+represented by VEC.
+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)
+ (let* ((localdir (directory-file-name (tramp-file-name-localname vec)))
+ (file-1 dir-locals-file)
+ (file-2 (when (string-match "\\.el\\'" file-1)
+ (replace-match "-2.el" t nil file-1)))
+ )
+ (tramp-maybe-send-script vec tramp-hlo-test-files-in-dir-script
"test_files_in_dir")
+ (mapcar (lambda (name) (tramp-make-tramp-file-name vec name))
+ (tramp-send-command-and-read
+ vec
+ (if base-el-only
+ (format "test_files_in_dir %s %s"
+ localdir file-1)
+ (format "test_files_in_dir %s %s %s"
+ localdir file-1 file-2)
+ )
)
- (tramp-maybe-send-script vec tramp-hlo-test-files-in-dir-script
"test_files_in_dir")
- (mapcar (lambda (name) (concat connection name))
- (tramp-send-command-and-read
- vec
- (if base-el-only
- (format "test_files_in_dir %s %s"
- localdir file-1)
- (format "test_files_in_dir %s %s %s"
- localdir file-1 file-2)
- )
- )
- )
- )
- (funcall orig-fun directory)
+ )
)
)
)
-(defun tramp-hlo-locate-dominating-file-pred (connection vec file pred)
- "Implementation of tramp-hlo-locate-dominating-file for a name predicate"
+(defun tramp-hlo-locate-dominating-file-pred (vec pred)
+ "Implementation of tramp-hlo-locate-dominating-file for a name predicate.
+Starting at the file represented by VEC, look up directory hierarchy for
+directory identified by PRED.
+Stop at the first parent directory matched, and return the directory. Return
nil
+if not found.
+PRED takes one argument, a directory, and returns a non-nil value if that
+directory is the one for which we're looking."
(tramp-maybe-send-script vec tramp-hlo-list-parents-script "list_parents")
(let* ((command (format "list_parents %s" (nth 6 vec)))
(parents (tramp-send-command-and-read vec command))
)
- (while (and parents (not (funcall pred (concat connection (car parents)))))
+ (while (and parents (not (funcall pred (tramp-make-tramp-file-name vec
(car parents)))))
(pop parents)
)
(if parents
- (concat connection (car parents))
+ (tramp-make-tramp-file-name vec (car parents))
nil)
)
)
-(defun tramp-hlo-locate-dominating-file-list (connection vec file names)
- "Implementation of tramp-hlo-locate-dominating-file for a list of names"
+(defun tramp-hlo-locate-dominating-file-list (vec names)
+ "Implementation of tramp-hlo-locate-dominating-file for a list of names.
+Starting at the file represented by VEC, look up directory hierarchy for
+directory containing any files in list NAMES.
+Stop at the first parent directory matched, and return the directory. Return
nil
+if not found."
(tramp-maybe-send-script vec tramp-hlo-locate-dominating-file-multi-script
"locate_dominating_file_multi")
(let* ((localfile (nth 6 vec))
(quoted-names (mapcar (lambda (name) (format "\"%s\"" name)) names))
(quoted-names-str (string-join names " "))
(command (format "locate_dominating_file_multi %s %s" localfile
quoted-names-str))
(local-dominating (tramp-send-command-and-read vec command)))
- (mapcar (lambda (result) (concat connection result)) local-dominating)
+ (mapcar (lambda (result) (tramp-make-tramp-file-name vec result))
local-dominating)
)
)
(defun tramp-hlo-locate-dominating-file (orig-fun file name)
- "Tramp version of locate-dominating-file"
- (let ((connection (file-remote-p file)))
- (if connection
- (let ((vec (tramp-dissect-file-name file)))
- (if (functionp name)
- (tramp-hlo-locate-dominating-file-pred connection vec file name)
- (let* ((names (if (listp name) name (list name)))
- (file-list (tramp-hlo-locate-dominating-file-list
connection vec file names)))
- (if file-list
- (file-name-directory (car file-list))
- nil
- )
- )
- )
- )
- (funcall orig-fun file name)
- )
- )
- )
-
-(defun tramp-hlo-find-dominating-files (file names)
- "Tramp specific function to find multiple dominating files"
- (let ((connection (file-remote-p file)))
- (if connection
- (let ((vec (tramp-dissect-file-name file)))
- (tramp-hlo-locate-dominating-file-list connection vec file names)
- )
- )
- )
+ "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
+serve as the starting point for searching the hierarchy of directories.
+Stop at the first parent directory containing a file NAME,
+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)
+ (if (functionp name)
+ (tramp-hlo-locate-dominating-file-pred vec name)
+ (let* ((names (if (listp name) name (list name)))
+ (file-list (tramp-hlo-locate-dominating-file-list vec names)))
+ (if file-list
+ (file-name-directory (car file-list))
+ nil
+ )
+ )
+ )
+ )
)
(defun tramp-hlo-dir-locals-find-file (orig-fun file)
- "Tramp implementation of dir-locals-find-file"
- (let ((connection (file-remote-p file)))
- (if connection
- (let* ((locals-files (tramp-hlo-find-dominating-files
(file-name-directory file)
- '(".dir-locals.el"
".dir-locals-2.el")))
+ "Tramp implementation of `dir-locals-find-file'.
+Find the directory-local variables for FILE.
+This searches upward in the directory tree from FILE.
+It stops at the first directory that has been registered in
+`dir-locals-directory-cache' or contains a `dir-locals-file'.
+If it finds an entry in the cache, it checks that it is valid.
+A cache entry with no modification time element (normally, one that
+has been assigned directly using `dir-locals-set-directory-class', not
+set from a file) is always valid.
+A cache entry based on a `dir-locals-file' is valid if the modification
+time stored in the cache matches the current file modification time.
+If not, the cache entry is cleared so that the file will be re-read.
+
+This function returns either:
+ - nil (no directory local variables found),
+ - 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.
+
+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.
@@ -253,15 +298,26 @@ echo \\)
locals-dir)
;; No cache entry.
locals-dir))
- (funcall orig-fun file)
)
- )
)
-(defun configure-tramp-hlo ()
+(defun setup-tramp-hlo ()
+ "Setup tramp high-level functions.
+Adds advice functions with tramp implementations for the following emacs
+built-in functions:
+- `dir-locals--all-files'
+- `locate-dominating-file'
+- `dir-locals-find-file'"
(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)
)
-(provide 'tramp-hlo)
+(defun remove-tramp-hlo ()
+ "Remove tramp high-level functions.
+Remove tramp advice functions for high-level emacs built-in functions."
+ (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)
+ )
+
