From b1b9082b3eab0e83deeee622e61ad3d577646950 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 17 Nov 2023 18:28:30 +0100 Subject: [PATCH] Make Tramp aware of completion-regexp-list * lisp/net/tramp.el (tramp-skeleton-file-name-all-completions): New defmacro. (tramp-completion-handle-file-name-all-completions): * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions): * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-name-all-completions): Use it. --- lisp/net/tramp-adb.el | 21 ++--- lisp/net/tramp-crypt.el | 2 +- lisp/net/tramp-fuse.el | 27 +++--- lisp/net/tramp-gvfs.el | 4 +- lisp/net/tramp-sh.el | 108 ++++++++++++------------ lisp/net/tramp-smb.el | 17 ++-- lisp/net/tramp-sudoedit.el | 14 ++-- lisp/net/tramp.el | 165 ++++++++++++++++++++----------------- 8 files changed, 183 insertions(+), 175 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 3de4721ec77..acbf5ec01c6 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -435,7 +435,7 @@ Emacs dired can't find files." (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil @@ -450,17 +450,14 @@ Emacs dired can't find files." (file-name-as-directory f) f)) (with-current-buffer (tramp-get-buffer v) - (delete-dups - (append - ;; On some file systems like "sdcard", "." and ".." are - ;; not included. We fix this by `delete-dups'. - '("." "..") - (delq - nil - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n")))))))))))) + (append + ;; On some file systems like "sdcard", "." and ".." are + ;; not included. + '("." "..") + (mapcar + (lambda (l) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string (buffer-string) "\n" 'omit)))))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 79eafc5c12e..587b9db067a 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -739,7 +739,7 @@ absolute file names." (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (let* (completion-regexp-list diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index aadc64666a5..4b04f75ce96 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -102,22 +102,21 @@ (defun tramp-fuse-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (tramp-fuse-remove-hidden-files - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory + (tramp-fuse-remove-hidden-files (all-completions filename - (delete-dups - (append - (file-name-all-completions - filename (tramp-fuse-local-file-name directory)) - ;; Some storage systems do not return "." and "..". - (let (result) - (dolist (item '(".." ".") result) - (when (string-prefix-p filename item) - (catch 'match - (dolist (elt completion-regexp-list) - (unless (string-match-p elt item) (throw 'match nil))) - (setq result (cons (concat item "/") result)))))))))))) + (append + (file-name-all-completions + filename (tramp-fuse-local-file-name directory)) + ;; Some storage systems do not return "." and "..". + (let (result) + (dolist (item '(".." ".") result) + (when (string-prefix-p filename item) + (catch 'match + (dolist (elt completion-regexp-list) + (unless (string-match-p elt item) (throw 'match nil))) + (setq result (cons (concat item "/") result))))))))))) ;; This function isn't used. (defun tramp-fuse-handle-insert-directory diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 451c033a044..573d89c0c51 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1463,8 +1463,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (unless (tramp-compat-string-search "/" filename) - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory + (unless (tramp-compat-string-search "/" filename) (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 49acf8395c5..186ef12775a 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1848,60 +1848,60 @@ ID-FORMAT valid values are `string' and `integer'." ;; files. (defun tramp-sh-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name directory) nil - (when (and (not (tramp-compat-string-search "/" filename)) - (tramp-connectable-p v)) - (unless (tramp-compat-string-search "/" filename) - (ignore-error file-missing - (all-completions - filename - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files, including - ;; reliably tagging the directories with a trailing "/". - ;; Because I rock. --daniel@danann.net - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (setq result - (tramp-send-command-and-read - v (format "tramp_perl_file_name_all_completions %s" - (tramp-shell-quote-argument localname)) - 'noerror)) - ;; Cached values. - (dolist (elt result) - (tramp-set-file-property - v (cadr elt) "file-directory-p" (nth 2 elt)) - (tramp-set-file-property - v (cadr elt) "file-exists-p" (nth 3 elt)) - (tramp-set-file-property - v (cadr elt) "file-readable-p" (nth 4 elt))) - ;; Result. - (mapcar #'car result)) - - ;; Do it with ls. - (when (tramp-send-command-and-check - v (format (concat - "cd %s 2>&1 && %s -a 2>%s" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>%s;" - " then echo \"$f/\"; else echo \"$f\"; fi;" - " done") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - (tramp-get-remote-null-device v) - (tramp-get-test-command v) - (tramp-get-remote-null-device v))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - (while (zerop (forward-line -1)) - (push - (buffer-substring (point) (line-end-position)) result))) - result)))))))))) + (tramp-skeleton-file-name-all-completions filename directory + (with-parsed-tramp-file-name (expand-file-name directory) nil + (when (and (not (tramp-compat-string-search "/" filename)) + (tramp-connectable-p v)) + (unless (tramp-compat-string-search "/" filename) + (all-completions + filename + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including + ;; reliably tagging the directories with a trailing "/". + ;; Because I rock. --daniel@danann.net + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (setq result + (tramp-send-command-and-read + v (format "tramp_perl_file_name_all_completions %s" + (tramp-shell-quote-argument localname)) + 'noerror)) + ;; Cached values. + (dolist (elt result) + (tramp-set-file-property + v (cadr elt) "file-directory-p" (nth 2 elt)) + (tramp-set-file-property + v (cadr elt) "file-exists-p" (nth 3 elt)) + (tramp-set-file-property + v (cadr elt) "file-readable-p" (nth 4 elt))) + ;; Result. + (mapcar #'car result)) + + ;; Do it with ls. + (when (tramp-send-command-and-check + v (format (concat + "cd %s 2>&1 && %s -a 2>%s" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>%s;" + " then echo \"$f/\"; else echo \"$f\"; fi;" + " done") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + (tramp-get-remote-null-device v) + (tramp-get-test-command v) + (tramp-get-remote-null-device v))) + + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + (while (zerop (forward-line -1)) + (push + (buffer-substring (point) (line-end-position)) result))) + result)))))))))) ;; cp, mv and ln diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index ac1b29f08cd..e0622a26eeb 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -972,20 +972,19 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; files. (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (when (file-directory-p directory) (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" - (delete-dups - (mapcar - (lambda (x) - (list - (if (tramp-compat-string-search "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory))))))))) + (mapcar + (lambda (x) + (list + (if (tramp-compat-string-search "d" (nth 1 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + (tramp-smb-get-file-entries directory)))))))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 40e438435fc..87685c06c1f 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -489,7 +489,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (ignore-error file-missing + (tramp-skeleton-file-name-all-completions filename directory (all-completions filename (with-parsed-tramp-file-name (expand-file-name directory) nil @@ -503,13 +503,11 @@ the result will be a local, non-Tramp, file name." (if (ignore-errors (file-directory-p (expand-file-name f directory))) (file-name-as-directory f) f)) - (delq - nil - (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string - (tramp-get-buffer-string (tramp-get-connection-buffer v)) - "\n" 'omit))))))))) + (mapcar + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string + (tramp-get-buffer-string (tramp-get-connection-buffer v)) + "\n" 'omit)))))))) (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9cc319bef67..54f92cae98d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2741,6 +2741,23 @@ not in completion mode." (tramp-run-real-handler #'file-exists-p (list filename)))) +(defmacro tramp-skeleton-file-name-all-completions + (_filename _directory &rest body) + "Skeleton for `tramp-*-handle-filename-all-completions'. +BODY is the backend specific code." + (declare (indent 2) (debug t)) + `(ignore-error file-missing + (delete-dups (delq nil + (let* ((case-fold-search read-file-name-completion-ignore-case) + (regexp (mapconcat #'identity completion-regexp-list "\\|")) + (result ,@body)) + (if (consp completion-regexp-list) + ;; Discriminate over `completion-regexp-list'. + (mapcar + (lambda (x) (and (stringp x) (string-match-p regexp x) x)) + result) + result)))))) + (defvar tramp--last-hop-directory nil "Tracks the directory from which to run login programs.") @@ -2750,81 +2767,79 @@ not in completion mode." ;; completions. (defun tramp-completion-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for partial Tramp files." - (let ((fullname - (tramp-drop-volume-letter (expand-file-name filename directory))) - (directory (tramp-drop-volume-letter directory)) - tramp--last-hop-directory hop result result1) - - ;; Suppress hop from completion. - (when (string-match - (rx - (regexp tramp-prefix-regexp) - (group (+ (regexp tramp-remote-file-name-spec-regexp) - (regexp tramp-postfix-hop-regexp)))) - fullname) - (setq hop (match-string 1 fullname) - fullname (replace-match "" nil nil fullname 1) - tramp--last-hop-directory - (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) - - (let (;; When `tramp-syntax' is `simplified', we need a default method. - (tramp-default-method - (and (string-empty-p tramp-postfix-method-format) - tramp-default-method)) - (tramp-default-method-alist - (and (string-empty-p tramp-postfix-method-format) - tramp-default-method-alist)) - tramp-default-user tramp-default-user-alist - tramp-default-host tramp-default-host-alist) - - ;; Possible completion structures. - (dolist (elt (tramp-completion-dissect-file-name fullname)) - (let* ((method (tramp-file-name-method elt)) - (user (tramp-file-name-user elt)) - (host (tramp-file-name-host elt)) - (localname (tramp-file-name-localname elt)) - (m (tramp-find-method method user host)) - all-user-hosts) - - (unless localname ;; Nothing to complete. - - (if (or user host) - - ;; Method dependent user / host combinations. - (progn - (mapc - (lambda (x) - (setq all-user-hosts - (append all-user-hosts - (funcall (nth 0 x) (nth 1 x))))) - (tramp-get-completion-function m)) - - (setq result - (append result - (mapcar - (lambda (x) - (tramp-get-completion-user-host - method user host (nth 0 x) (nth 1 x))) - (delq nil all-user-hosts))))) - - ;; Possible methods. - (setq result - (append result (tramp-get-completion-methods m hop))))))) - - ;; Unify list, add hop, remove nil elements. - (dolist (elt result) - (when elt - (setq elt (replace-regexp-in-string - tramp-prefix-regexp (concat tramp-prefix-format hop) elt)) - (push (substring elt (length directory)) result1))) - - ;; Complete local parts. - (delete-dups - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))))) + (tramp-skeleton-file-name-all-completions filename directory + (let ((fullname + (tramp-drop-volume-letter (expand-file-name filename directory))) + (directory (tramp-drop-volume-letter directory)) + tramp--last-hop-directory hop result result1) + + ;; Suppress hop from completion. + (when (string-match + (rx + (regexp tramp-prefix-regexp) + (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) + fullname) + (setq hop (match-string 1 fullname) + fullname (replace-match "" nil nil fullname 1) + tramp--last-hop-directory + (tramp-make-tramp-file-name (tramp-dissect-hop-name hop)))) + + (let (;; When `tramp-syntax' is `simplified', we need a default method. + (tramp-default-method + (and (string-empty-p tramp-postfix-method-format) + tramp-default-method)) + (tramp-default-method-alist + (and (string-empty-p tramp-postfix-method-format) + tramp-default-method-alist)) + tramp-default-user tramp-default-user-alist + tramp-default-host tramp-default-host-alist) + + ;; Possible completion structures. + (dolist (elt (tramp-completion-dissect-file-name fullname)) + (let* ((method (tramp-file-name-method elt)) + (user (tramp-file-name-user elt)) + (host (tramp-file-name-host elt)) + (localname (tramp-file-name-localname elt)) + (m (tramp-find-method method user host)) + all-user-hosts) + + (unless localname ;; Nothing to complete. + (if (or user host) + ;; Method dependent user / host combinations. + (progn + (mapc + (lambda (x) + (setq all-user-hosts + (append all-user-hosts + (funcall (nth 0 x) (nth 1 x))))) + (tramp-get-completion-function m)) + + (setq result + (append result + (mapcar + (lambda (x) + (tramp-get-completion-user-host + method user host (nth 0 x) (nth 1 x))) + all-user-hosts)))) + + ;; Possible methods. + (setq result + (append result (tramp-get-completion-methods m hop))))))) + + ;; Add hop. + (dolist (elt result) + (when elt + (setq elt (replace-regexp-in-string + tramp-prefix-regexp (concat tramp-prefix-format hop) elt)) + (push (substring elt (length directory)) result1))) + + ;; Complete local parts. + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory)))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion -- 2.39.2