From: Michael Albinus <michael.albinus@gmx.de>
Date: Fri, 17 Nov 2023 17:28:30 +0000 (+0100)
Subject: Make Tramp aware of completion-regexp-list
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b1b9082b3eab0e83deeee622e61ad3d577646950;p=emacs.git

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.
---

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