From: Michael Albinus Date: Fri, 26 Aug 2022 14:19:47 +0000 (+0200) Subject: Use `rx' in Tramp where possible X-Git-Tag: emacs-29.0.90~1893^2~16 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=be2e6228f8c9c57d2809bdd953d065ebfc63d4c4;p=emacs.git Use `rx' in Tramp where possible * lisp/net/tramp.el: * lisp/net/tramp-adb.el: * lisp/net/tramp-archive.el: * lisp/net/tramp-cache.el: * lisp/net/tramp-cmds.el: * lisp/net/tramp-compat.el: * lisp/net/tramp-crypt.el: * lisp/net/tramp-ftp.el: * lisp/net/tramp-fuse.el: * lisp/net/tramp-gvfs.el: * lisp/net/tramp-integration.el: * lisp/net/tramp-rclone.el: * lisp/net/tramp-sh.el: * lisp/net/tramp-smb.el: * lisp/net/tramp-sudoedit.el: Use `rx' where possible. * lisp/net/tramp-adb.el (tramp-adb-handle-set-file-times): Use `eval-when-compile'. (tramp-adb-maybe-open-connection): Use file-property for "/". Use `eval-when-compile'. * lisp/net/tramp-cmds.el (mm-7bit-chars): Declare. (tramp-reporter-dump-variable): Simplify point movement. * lisp/net/tramp-gvfs.el (tramp-dbus-function): Fix typo. (tramp-zeroconf-parse-device-names): Use `tramp-prefix-port-format'. * lisp/net/tramp-sh.el (tramp-open-shell, tramp-find-shell): Use `eval-when-compile'. Improve sanity check. * lisp/net/tramp.el (tramp-prefix-format, tramp-prefix-regexp) (tramp-method-regexp, tramp-postfix-method-format) (tramp-postfix-method-regexp, tramp-prefix-ipv6-format) (tramp-prefix-ipv6-regexp, tramp-postfix-ipv6-format) (tramp-postfix-ipv6-regexp, tramp-postfix-host-format) (tramp-postfix-host-regexp, tramp-remote-file-name-spec-regexp) (tramp-file-name-structure, tramp-file-name-regexp) (tramp-completion-method-regexp) (tramp-completion-file-name-regexp): Declare. (tramp-set-syntax): Set also `tramp-completion-method-regexp'. (tramp-volume-letter-regexp, tramp-completion-method-regexp-alist): New defconsts. (tramp-build-completion-method-regexp): New defun. (tramp-completion-method-regexp): New defvar. (tramp-completion-file-name-regexp-default) (tramp-completion-file-name-regexp-simplified) (tramp-completion-file-name-regexp-separate) (tramp-completion-file-name-regexp-alist): Remove. (tramp-build-completion-file-name-regexp): Rwrite. (tramp-make-tramp-file-name): Use `tramp-archive-method'. (tramp-handle-file-directory-p): Ignore errors. (tramp-handle-find-backup-file-name, tramp-handle-lock-file) (tramp-handle-make-auto-save-file-name): Use `eval-when-compile'. * test/lisp/net/tramp-archive-tests.el: * test/lisp/net/tramp-tests.el: Use `rx' where possible. (tramp-test01-file-name-syntax): Adapt test. --- diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index be231fcba63..b38b908edb0 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,7 +55,7 @@ It is used for TCP/IP devices." (defconst tramp-adb-method "adb" "When this method name is used, forward all calls to Android Debug Bridge.") -(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]" +(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") space) "Regexp used as prompt in almquist shell." :type 'regexp :version "28.1" @@ -63,31 +63,28 @@ It is used for TCP/IP devices." (eval-and-compile (defconst tramp-adb-ls-date-year-regexp - "[[:digit:]]\\{4\\}-[[:digit:]]\\{2\\}-[[:digit:]]\\{2\\}" + (rx (= 4 digit) "-" (= 2 digit) "-" (= 2 digit)) "Regexp for date year format in ls output.")) (eval-and-compile - (defconst tramp-adb-ls-date-time-regexp - "[[:digit:]]\\{2\\}:[[:digit:]]\\{2\\}" + (defconst tramp-adb-ls-date-time-regexp (rx (= 2 digit) ":" (= 2 digit)) "Regexp for date time format in ls output.")) (defconst tramp-adb-ls-date-regexp - (concat - "[[:space:]]" tramp-adb-ls-date-year-regexp - "[[:space:]]" tramp-adb-ls-date-time-regexp - "[[:space:]]") + (rx space (regexp tramp-adb-ls-date-year-regexp) + space (regexp tramp-adb-ls-date-time-regexp) + space) "Regexp for date format in ls output.") (defconst tramp-adb-ls-toolbox-regexp - (concat - "^[[:space:]]*\\([-.[:alpha:]]+\\)" ; \1 permissions - "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox) - "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username - "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group - "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size - "[[:space:]]+\\(" tramp-adb-ls-date-year-regexp - "[[:space:]]" tramp-adb-ls-date-time-regexp "\\)" ; \5 date - "[[:space:]]\\(.*\\)$") ; \6 filename + (rx bol (* space) (group (+ (any ".-" alpha))) ; \1 permissions + (? (+ space) (+ digit)) ; links (Android 7/toybox) + (* space) (group (+ (not space))) ; \2 username + (+ space) (group (+ (not space))) ; \3 group + (+ space) (group (+ digit)) ; \4 size + (+ space) (group (regexp tramp-adb-ls-date-year-regexp) + space (regexp tramp-adb-ls-date-time-regexp)) ; \5 date + space (group (* nonl)) eol) ; \6 filename "Regexp for ls output.") ;;;###tramp-autoload @@ -220,7 +217,8 @@ arguments to pass to the OPERATION." (delq nil (mapcar (lambda (line) - (when (string-match "^\\(\\S-+\\)[[:space:]]+device$" line) + (when (string-match + (rx bol (group (+ (not space))) (+ space) "device" eol) line) ;; Replace ":" by "#". `(nil ,(tramp-compat-string-replace ":" tramp-prefix-port-format (match-string 1 line))))) @@ -237,10 +235,10 @@ arguments to pass to the OPERATION." (goto-char (point-min)) (forward-line) (when (looking-at - (concat "[[:space:]]*[^[:space:]]+" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)")) + (rx (* space) (+ (not space)) + (+ space) (group (+ digit)) + (+ space) (group (+ digit)) + (+ space) (group (+ digit)))) ;; The values are given as 1k numbers, so we must change ;; them to number of bytes. (list (* 1024 (string-to-number (match-string 1))) @@ -280,10 +278,10 @@ arguments to pass to the OPERATION." (name (match-string 6)) (symlink-target (and is-symlink - (cadr (split-string name "\\( -> \\|\n\\)"))))) + (cadr (split-string name (rx (group (| " -> " "\n")))))))) (push (list (if is-symlink - (car (split-string name "\\( -> \\|\n\\)")) + (car (split-string name (rx (group (| " -> " "\n"))))) name) (or is-dir symlink-target) 1 ;link-count @@ -315,7 +313,7 @@ arguments to pass to the OPERATION." (tramp-shell-quote-argument localname))) ;; We insert also filename/. and filename/.., because "ls" ;; doesn't on some file systems, like "sdcard". - (unless (re-search-backward "\\.$" nil t) + (unless (re-search-backward (rx "." eol) nil t) (narrow-to-region (point-max) (point-max)) (tramp-adb-send-command v (format "%s -d -a -l %s %s | cat" @@ -325,9 +323,8 @@ arguments to pass to the OPERATION." (tramp-shell-quote-argument (tramp-compat-file-name-concat localname "..")))) (tramp-compat-replace-regexp-in-region - (regexp-quote - (tramp-compat-file-name-unquote - (file-name-as-directory localname))) + (rx (literal (tramp-compat-file-name-unquote + (file-name-as-directory localname)))) "" (point-min)) (widen))) (tramp-adb-sh-fix-ls-output) @@ -365,16 +362,12 @@ Emacs dired can't find files." (goto-char (point-min)) (while (search-forward-regexp - (eval-when-compile - (concat - "[[:space:]]" - "\\([[:space:]]" tramp-adb-ls-date-year-regexp "[[:space:]]\\)")) + (rx space (group space (regexp tramp-adb-ls-date-year-regexp) space)) nil t) (replace-match "0\\1" "\\1" nil) ;; Insert missing "/". (when (looking-at-p - (eval-when-compile - (concat tramp-adb-ls-date-time-regexp "[[:space:]]+$"))) + (rx (regexp tramp-adb-ls-date-time-regexp) (+ space) eol)) (end-of-line) (insert "/"))) ;; Sort entries. @@ -472,7 +465,8 @@ Emacs dired can't find files." (delq nil (mapcar - (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l)) + (lambda (l) + (and (not (string-match-p (rx bol (* space) eol) l)) l)) (split-string (buffer-string) "\n"))))))))))) (defun tramp-adb-handle-file-local-copy (filename) @@ -566,9 +560,10 @@ Emacs dired can't find files." ;; (introduced in POSIX.1-2008) fails. (tramp-adb-send-command-and-check v (format - (concat "touch -d %s %s %s 2>%s || " - "touch -d %s %s %s 2>%s || " - "touch -t %s %s %s") + (eval-when-compile + (concat "touch -d %s %s %s 2>%s || " + "touch -d %s %s %s 2>%s || " + "touch -t %s %s %s")) (format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t) nofollow quoted-name (tramp-get-remote-null-device v) (format-time-string "%Y-%m-%dT%H:%M:%S" time t) @@ -723,10 +718,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar result 0) (dolist (line signals) (when (string-match - (concat - "^[[:space:]]*\\([[:digit:]]+\\)" - "[[:space:]]+\\S-+[[:space:]]+" - "\\([[:alpha:]].*\\)$") + (rx bol (* space) (group (+ digit)) + (+ space) (+ (not space)) + (+ space) (group alpha (* nonl)) eol) line) (setcar (nthcdr (string-to-number (match-string 1 line)) result) @@ -924,7 +918,7 @@ implementation will be used." (i 0) p) - (when (string-match-p "[[:multibyte:]]" command) + (when (string-match-p (rx multibyte) command) (tramp-error v 'file-error "Cannot apply multi-byte command `%s'" command)) @@ -997,7 +991,7 @@ implementation will be used." (while (progn (goto-char (point-min)) - (not (re-search-forward "[\n]" nil t))) + (not (search-forward "\n" nil t))) (tramp-accept-process-output p 0)) (delete-region (point-min) (point))) ;; Provide error buffer. This shows only @@ -1125,7 +1119,7 @@ error and non-nil on success." (defun tramp-adb-send-command (vec command &optional neveropen nooutput) "Send the COMMAND to connection VEC." - (if (string-match-p "[[:multibyte:]]" command) + (if (string-match-p (rx multibyte) command) ;; Multibyte codepoints with four bytes are not supported at ;; least by toybox. @@ -1149,12 +1143,12 @@ error and non-nil on success." ;; We can't use stty to disable echo of command. stty is said ;; to be added to toybox 0.7.6. busybox shall have it, but this ;; isn't used any longer for Android. - (delete-matching-lines (regexp-quote command)) + (delete-matching-lines (rx (literal command))) ;; When the local machine is W32, there are still trailing ^M. ;; There must be a better solution by setting the correct coding ;; system, but this requires changes in core Tramp. (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) + (while (re-search-forward (rx (+ "\r") eol) nil t) (replace-match "" nil nil))))))) (defun tramp-adb-send-command-and-check (vec command &optional exit-status) @@ -1170,7 +1164,7 @@ the exit status." (format "%s; echo tramp_exit_status $?" command) "echo tramp_exit_status $?")) (with-current-buffer (tramp-get-connection-buffer vec) - (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+") + (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) (tramp-error vec 'file-error "Couldn't find exit status of `%s'" command)) (skip-chars-forward "^ ") @@ -1198,7 +1192,7 @@ FMT and ARGS are passed to `error'." (let ((inhibit-read-only t)) (goto-char (point-min)) ;; ADB terminal sends "^H" sequences. - (when (re-search-forward "<\b+" (line-end-position) t) + (when (re-search-forward (rx "<" (+ "\b")) (line-end-position) t) (forward-line 1) (delete-region (point-min) (point))) ;; Delete the prompt. @@ -1232,7 +1226,7 @@ connection if a previous connection has died for some reason." ;; Maybe we know already that "su" is not supported. We cannot ;; use a connection property, because we have not checked yet ;; whether it is still the same device. - (when (and user (not (tramp-get-file-property vec "" "su-command-p" t))) + (when (and user (not (tramp-get-file-property vec "/" "su-command-p" t))) (tramp-error vec 'file-error "Cannot switch to user `%s'" user)) (unless (process-live-p p) @@ -1272,7 +1266,7 @@ connection if a previous connection has died for some reason." ;; Change prompt. (tramp-set-connection-property - p "prompt" (regexp-quote (format "///%s#$" prompt))) + p "prompt" (rx "///" (literal prompt) "#$")) (tramp-adb-send-command vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt)) @@ -1290,10 +1284,11 @@ connection if a previous connection has died for some reason." (tramp-message vec 5 "Checking system information") (tramp-adb-send-command vec - (concat - "echo \\\"`getprop ro.product.model` " - "`getprop ro.product.version` " - "`getprop ro.build.version.release`\\\"")) + (eval-when-compile + (concat + "echo \\\"`getprop ro.product.model` " + "`getprop ro.product.version` " + "`getprop ro.build.version.release`\\\""))) (let ((old-getprop (tramp-get-connection-property vec "getprop")) (new-getprop (tramp-set-connection-property @@ -1317,7 +1312,7 @@ connection if a previous connection has died for some reason." (unless (tramp-adb-send-command-and-check vec nil) (delete-process p) ;; Do not flush, we need the nil value. - (tramp-set-file-property vec "" "su-command-p" nil) + (tramp-set-file-property vec "/" "su-command-p" nil) (tramp-error vec 'file-error "Cannot switch to user `%s'" user))) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 548999ca1d2..0d931b42da4 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -168,7 +168,8 @@ It must be supported by libarchive(3).") ;; -;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, lzma, ar, mtree, iso9660, compress. +;; read and write: tar, cpio, pax , gzip , zip, bzip2, xz, lzip, +;; lzma, ar, mtree, iso9660, compress. ;; read only: 7-Zip, mtree, xar, lha/lzh, rar, microsoft cab. ;;;###autoload @@ -183,14 +184,17 @@ It must be supported by libarchive(3).") ;;;###autoload (progn (defmacro tramp-archive-autoload-file-name-regexp () "Regular expression matching archive file names." - '(concat - "\\`" "\\(" ".+" "\\." - ;; Default suffixes ... - (regexp-opt tramp-archive-suffixes) - ;; ... with compression. - "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" - "\\)" ;; \1 - "\\(" "/" ".*" "\\)" "\\'"))) ;; \2 + '(rx bos + ;; \1 + (group + (+ nonl) + ;; Default suffixes ... + "." (regexp (regexp-opt tramp-archive-suffixes)) + ;; ... with compression. + (? "." (regexp (regexp-opt tramp-archive-compression-suffixes)))) + ;; \2 + (group "/" (* nonl)) + eos))) (put #'tramp-archive-autoload-file-name-regexp 'tramp-autoload t) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 289df2f9aad..6a3e60f7037 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -226,7 +226,8 @@ Return VALUE." (setq key (tramp-file-name-unify key file)) (dolist (property (hash-table-keys (tramp-get-hash-table key))) (when (string-match-p - "^\\(directory-\\|file-name-all-completions\\|file-entries\\)" + (rx + bos (| "directory-" "file-name-all-completions" "file-entries")) property) (tramp-flush-file-property key file property)))))) @@ -277,7 +278,7 @@ Remove also properties of all files in subdirectories." This is suppressed for temporary buffers." (save-match-data (unless (or (null (buffer-name)) - (string-match-p "^\\( \\|\\*\\)" (buffer-name))) + (string-match-p (rx bos (| " " "*")) (buffer-name))) (let ((bfn (if (stringp (buffer-file-name)) (buffer-file-name) default-directory)) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index b2a68fc5eba..a7ac1352665 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -34,6 +34,7 @@ (declare-function mml-mode "mml") (declare-function mml-insert-empty-tag "mml") (declare-function reporter-dump-variable "reporter") +(defvar mm-7bit-chars) (defvar reporter-eval-buffer) (defvar reporter-prompt-for-summary-p) @@ -502,7 +503,7 @@ This is needed if there are compatibility problems." ((dir (tramp-compat-funcall 'package-desc-dir (car (alist-get 'tramp (bound-and-true-p package-alist)))))) - (dolist (elc (directory-files dir 'full "\\.elc\\'")) + (dolist (elc (directory-files dir 'full (rx ".elc" eos))) (delete-file elc)) (with-current-buffer (get-buffer-create byte-compile-log-buffer) (let ((inhibit-read-only t)) @@ -604,7 +605,7 @@ buffer in your bug report. ;; There are non-7bit characters to be masked. (when (and (stringp val) (string-match-p - (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val)) + (rx-to-string `(not (any ,mm-7bit-chars))) val)) (with-current-buffer reporter-eval-buffer (set varsym `(decode-coding-string @@ -613,20 +614,21 @@ buffer in your bug report. 'raw-text))))) ;; Dump variable. - (reporter-dump-variable varsym mailbuf) + (goto-char (point-max)) + (save-excursion + (reporter-dump-variable varsym mailbuf)) (unless (hash-table-p val) ;; Remove string quotation. - (forward-line -1) (when (looking-at - (concat "\\(^.*\\)" "\"" ;; \1 " - "\\((base64-decode-string \\)" "\\\\" ;; \2 \ - "\\(\".*\\)" "\\\\" ;; \3 \ - "\\(\")\\)" "\"$")) ;; \4 " + (rx bol (group (* anychar)) "\"" ;; \1 " + (group "(base64-decode-string ") "\\" ;; \2 \ + (group "\"" (* anychar)) "\\" ;; \3 \ + (group "\")") "\"" eol)) ;; \4 " (replace-match "\\1\\2\\3\\4") (beginning-of-line) - (insert " ;; Variable encoded due to non-printable characters.\n")) - (forward-line 1)) + (insert " ;; Variable encoded due to non-printable characters.\n"))) + (goto-char (point-max)) ;; Reset VARSYM to old value. (with-current-buffer reporter-eval-buffer @@ -656,21 +658,27 @@ buffer in your bug report. (erase-buffer) (insert (format "\n;; %s\n(setq-local\n" (buffer-name buffer))) (lisp-indent-line) - (dolist - (varsym - (sort - (append - (mapcar - #'intern - (all-completions "tramp-" (buffer-local-variables buffer))) - ;; Non-tramp variables of interest. - '(connection-local-variables-alist default-directory)) - #'string<)) - (reporter-dump-variable varsym elbuf)) + (dolist (varsym + (sort + (append + (mapcar + #'intern + (all-completions "tramp-" (buffer-local-variables buffer))) + ;; Non-tramp variables of interest. + '(connection-local-variables-alist default-directory)) + #'string<)) + (reporter-dump-variable varsym elbuf)) (lisp-indent-line) (insert ")\n")) (insert-buffer-substring elbuf))) + ;; Beautify encoded values. + (goto-char (point-min)) + (while (re-search-forward + (rx "'" (group "(decode-coding-string")) nil 'noerror) + (replace-match "\\1")) + (goto-char (point-max)) + ;; Dump load-path shadows. (insert "\nload-path shadows:\n==================\n") (ignore-errors @@ -683,7 +691,7 @@ buffer in your bug report. (eq major-mode 'message-mode) (bound-and-true-p mml-mode)) - (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/") + (let ((tramp-buf-regexp (rx "*" (? "debug ") "tramp/")) (buffer-list (tramp-list-tramp-buffers)) (curbuf (current-buffer))) @@ -694,7 +702,7 @@ buffer in your bug report. (setq buffer-read-only nil) (goto-char (point-min)) (while (not (eobp)) - (if (re-search-forward tramp-buf-regexp (line-end-position) t) + (if (re-search-forward tramp-buf-regexp (line-end-position) t) (forward-line 1) (forward-line 0) (let ((start (point))) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 203d3ede98f..b7c0a3113ee 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -237,7 +237,7 @@ CONDITION can also be a list of error conditions." (lambda (from-string to-string in-string) (let (case-fold-search) (replace-regexp-in-string - (regexp-quote from-string) to-string in-string t t))))) + (rx (literal from-string)) to-string in-string t t))))) ;; Function `string-search' is new in Emacs 28.1. (defalias 'tramp-compat-string-search @@ -245,7 +245,7 @@ CONDITION can also be a list of error conditions." #'string-search (lambda (needle haystack &optional start-pos) (let (case-fold-search) - (string-match-p (regexp-quote needle) haystack start-pos))))) + (string-match-p (rx (literal needle)) haystack start-pos))))) ;; Function `make-lock-file-name' is new in Emacs 28.1. (defalias 'tramp-compat-make-lock-file-name diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 657437b283c..e7bb1ebe338 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -426,7 +426,7 @@ Otherwise, return NAME." (if (directory-name-p name) #'file-name-as-directory #'identity) (concat dir - (unless (string-match-p (rx (seq bos (opt "/") eos)) localname) + (unless (string-match-p (rx bos (? "/") eos) localname) (with-tramp-file-property crypt-vec localname (concat (symbol-name op) "-file-name") (unless (tramp-crypt-send-command @@ -437,7 +437,7 @@ Otherwise, return NAME." (if (eq op 'encrypt) "Encoding" "Decoding") name)) (with-current-buffer (tramp-get-connection-buffer crypt-vec) (goto-char (point-min)) - (buffer-substring (point-min) (line-end-position))))))) + (buffer-substring (point-min) (line-end-position))))))) ;; Nothing to do. name)) @@ -554,7 +554,7 @@ localname." (defun tramp-crypt-handle-access-file (filename string) "Like `access-file' for Tramp files." (let* ((encrypt-filename (tramp-crypt-encrypt-file-name filename)) - (encrypt-regexp (concat (regexp-quote encrypt-filename) "\\'")) + (encrypt-regexp (rx (literal encrypt-filename) eos)) tramp-crypt-enabled) (condition-case err (access-file encrypt-filename string) @@ -706,7 +706,7 @@ absolute file names." (mapcar (lambda (x) (replace-regexp-in-string - (concat "^" (regexp-quote directory)) "" + (rx bos (literal directory)) "" (tramp-crypt-decrypt-file-name x))) (directory-files (tramp-crypt-encrypt-file-name directory) 'full))))) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index dd7e0f9f342..ad736256cab 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -97,9 +97,9 @@ present for backward compatibility." ;; Add some defaults for `tramp-default-method-alist'. (add-to-list 'tramp-default-method-alist - (list "\\`ftp\\." nil tramp-ftp-method)) + (list (rx bos "ftp.") nil tramp-ftp-method)) (add-to-list 'tramp-default-method-alist - (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method)) + (list nil (rx bos (| "anonymous" "ftp") eos) tramp-ftp-method)) ;; Add completion function for FTP method. (tramp-set-completion-function diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index 486a3cc57b7..4b51af070aa 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -51,7 +51,7 @@ "Remove hidden files from FILES." (if tramp-fuse-remove-hidden-files (cl-remove-if - (lambda (x) (and (stringp x) (string-match-p "\\.fuse_hidden" x))) + (lambda (x) (and (stringp x) (string-match-p (rx ".fuse_hidden") x))) files) files)) @@ -69,10 +69,10 @@ (tramp-fuse-local-file-name directory)))))))) (if full ;; Massage the result. - (let ((local (concat - "^" (regexp-quote - (tramp-fuse-mount-point - (tramp-dissect-file-name directory))))) + (let ((local (rx bol + (literal + (tramp-fuse-mount-point + (tramp-dissect-file-name directory))))) (remote (directory-file-name (funcall (if (tramp-compat-file-name-quoted-p directory) @@ -179,8 +179,7 @@ It has the same meaning as `remote-file-name-inhibit-cache'.") (tramp-set-file-property vec "/" "mounted" (when (string-match - (format - "^\\(%s\\)\\s-" (regexp-quote (tramp-fuse-mount-spec vec))) + (rx bol (group (literal (tramp-fuse-mount-spec vec))) space) mount) (match-string 1 mount))))))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ca5e959bea5..9060f37ed57 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -410,9 +410,9 @@ It has been changed in GVFS 1.14.") ;; (defconst tramp-goa-identity-regexp - (concat "^" "\\(" tramp-user-regexp "\\)?" - "@" "\\(" tramp-host-regexp "\\)?" - "\\(?:" ":""\\(" tramp-port-regexp "\\)" "\\)?") + (rx bol (? (group (regexp tramp-user-regexp))) + "@" (? (group (regexp tramp-host-regexp))) + (? ":" (group (regexp tramp-port-regexp)))) "Regexp matching GNOME Online Accounts \"PresentationIdentity\" property.") (defconst tramp-goa-interface-mail "org.gnome.OnlineAccounts.Mail" @@ -712,13 +712,13 @@ It has been changed in GVFS 1.14.") (eval-and-compile (defconst tramp-gvfs-file-attributes-with-gvfs-ls-regexp - (concat "[[:blank:]]" (regexp-opt tramp-gvfs-file-attributes t) "=\\(.+?\\)") + (rx blank (group (regexp (regexp-opt tramp-gvfs-file-attributes))) + "=" (group (+? nonl))) "Regexp to parse GVFS file attributes with `gvfs-ls'.")) (defconst tramp-gvfs-file-attributes-with-gvfs-info-regexp - (concat "^[[:blank:]]*" - (regexp-opt tramp-gvfs-file-attributes t) - ":[[:blank:]]+\\(.*\\)$") + (rx bol (* blank) (group (regexp (regexp-opt tramp-gvfs-file-attributes))) + ":" (+ blank) (group (* nonl)) eol) "Regexp to parse GVFS file attributes with `gvfs-info'.") (defconst tramp-gvfs-file-system-attributes @@ -728,16 +728,16 @@ It has been changed in GVFS 1.14.") "GVFS file system attributes.") (defconst tramp-gvfs-file-system-attributes-regexp - (concat "^[[:blank:]]*" - (regexp-opt tramp-gvfs-file-system-attributes t) - ":[[:blank:]]+\\(.*\\)$") + (rx bol (* blank) + (group (regexp (regexp-opt tramp-gvfs-file-system-attributes))) + ":" (+ blank) (group (* nonl)) eol) "Regexp to parse GVFS file system attributes with `gvfs-info'.") (defconst tramp-gvfs-nextcloud-default-prefix "/remote.php/webdav" "Default prefix for owncloud / nextcloud methods.") (defconst tramp-gvfs-nextcloud-default-prefix-regexp - (concat (regexp-quote tramp-gvfs-nextcloud-default-prefix) "$") + (rx (literal tramp-gvfs-nextcloud-default-prefix) eol) "Regexp of default prefix for owncloud / nextcloud methods.") @@ -868,7 +868,7 @@ arguments to pass to the OPERATION." (defun tramp-gvfs-dbus-string-to-byte-array (string) "Like `dbus-string-to-byte-array' but add trailing \\0 if needed." (dbus-string-to-byte-array - (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature) (concat string (string 0)) string))) (defun tramp-gvfs-dbus-byte-array-to-string (byte-array) @@ -902,7 +902,7 @@ The call will be traced by Tramp with trace level 6." (let (result) (tramp-message vec 6 "%s" (cons func args)) (setq result (apply func args)) - (tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result)) + (tramp-message vec 6 "%s" (tramp-gvfs-stringify-dbus-message result)) result)) (put #'tramp-dbus-function 'tramp-suppress-trace t) @@ -1157,7 +1157,9 @@ file names." ;; Dissect NAME. (with-parsed-tramp-file-name name nil ;; If there is a default location, expand tilde. - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -1167,26 +1169,28 @@ file names." (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) - (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) + (string-prefix-p "~" localname)) (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; We do not pass "/..". - (if (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method) - (when (string-match "^/[^/]+\\(/\\.\\./?\\)" localname) + (if (string-match-p (rx bos (| "afp" (: "dav" (? "s")) "smb") eos) method) + (when (string-match + (rx bos "/" (+ (not (any "/"))) (group "/.." (? "/"))) + localname) (setq localname (replace-match "/" t t localname 1))) - (when (string-match "^/\\.\\./?" localname) + (when (string-match (rx bol "/.." (? "/")) localname) (setq localname (replace-match "/" t t localname)))) ;; There might be a double slash. Remove this. (while (string-match "//" localname) (setq localname (replace-match "/" t t localname))) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "/./" and "/../"), ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name - v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + v (if (string-prefix-p "~" localname) localname (tramp-run-real-handler #'expand-file-name (list localname))))))) @@ -1208,20 +1212,20 @@ file names." (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) (while (looking-at - (eval-when-compile - (concat "^\\(.+\\)[[:blank:]]" - "\\([[:digit:]]+\\)[[:blank:]]" - "(\\(.+?\\))" - tramp-gvfs-file-attributes-with-gvfs-ls-regexp))) + (rx bol (group (+ nonl)) blank + (group (+ digit)) blank + "(" (group (+? nonl)) ")" + (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp))) (let ((item (list (cons "type" (match-string 3)) (cons "standard::size" (match-string 2)) (cons "name" (match-string 1))))) (goto-char (1+ (match-end 3))) (while (looking-at - (concat - tramp-gvfs-file-attributes-with-gvfs-ls-regexp - "\\(" tramp-gvfs-file-attributes-with-gvfs-ls-regexp - "\\|" "$" "\\)")) + (rx (regexp tramp-gvfs-file-attributes-with-gvfs-ls-regexp) + (group + (| (regexp + tramp-gvfs-file-attributes-with-gvfs-ls-regexp) + eol)))) (push (cons (match-string 1) (match-string 2)) item) (goto-char (match-end 2))) ;; Add display name as head. @@ -1266,8 +1270,10 @@ If FILE-SYSTEM is non-nil, return file system attributes." (setq filename (directory-file-name (expand-file-name filename))) (with-parsed-tramp-file-name filename nil (setq localname (tramp-compat-file-name-unquote localname)) - (if (or (and (string-match-p "^\\(afp\\|davs?\\|smb\\)$" method) - (string-match-p "^/?\\([^/]+\\)$" localname)) + (if (or (and (string-match-p + (rx bol (| "afp" (: "dav" (? "s")) "smb") eol) method) + (string-match-p + (rx bol (? "/") (+ (not (any "/"))) eol) localname)) (string-equal localname "/")) (tramp-gvfs-get-root-attributes filename) (assoc @@ -1297,7 +1303,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." ;; Convert them to multibyte. (decode-coding-string (replace-regexp-in-string - "\\\\x\\([[:xdigit:]]\\{2\\}\\)" + (rx "\\x" (group (= 2 xdigit))) (lambda (x) (unibyte-string (string-to-number (match-string 1 x) 16))) res-symlink-target) @@ -1467,7 +1473,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (let* ((events (process-get proc 'events)) (rest-string (process-get proc 'rest-string)) (dd (tramp-get-default-directory (process-buffer proc))) - (ddu (regexp-quote (tramp-gvfs-url-file-name dd)))) + (ddu (rx (literal (tramp-gvfs-url-file-name dd))))) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) (tramp-message proc 6 "%S\n%s" proc string) @@ -1481,15 +1487,15 @@ If FILE-SYSTEM is non-nil, return file system attributes." "renamed to" "moved" string)) ;; https://bugs.launchpad.net/bugs/1742946 (when - (string-match-p "Monitoring not supported\\|No locations given" string) + (string-match-p + (rx (| "Monitoring not supported" "No locations given")) string) (delete-process proc)) (while (string-match - (eval-when-compile - (concat "^.+:" - "[[:space:]]\\(.+\\):" - "[[:space:]]" (regexp-opt tramp-gio-events t) - "\\([[:space:]]\\(.+\\)\\)?$")) + (rx bol (+ nonl) ":" + space (group (+ nonl)) ":" + space (group (regexp (regexp-opt tramp-gio-events))) + (? (group space (group (+ nonl)))) eol) string) (let ((file (match-string 1 string)) @@ -1499,11 +1505,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." ;; File names are returned as URL paths. We must convert them. (when (string-match ddu file) (setq file (replace-match dd nil nil file))) - (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" file) + (while (string-match-p (rx "%" (= 2 xdigit)) file) (setq file (url-unhex-string file))) (when (string-match ddu (or file1 "")) (setq file1 (replace-match dd nil nil file1))) - (while (string-match-p "%\\([[:xdigit:]]\\{2\\}\\)" (or file1 "")) + (while (string-match-p (rx "%" (= 2 xdigit)) (or file1 "")) (setq file1 (url-unhex-string file1))) ;; Remove watch when file or directory to be watched is deleted. (when (and (member action '(moved deleted)) @@ -1719,14 +1725,15 @@ ID-FORMAT valid values are `string' and `integer'." (defun tramp-gvfs-file-name (object-path) "Retrieve file name from D-Bus OBJECT-PATH." (dbus-unescape-from-identifier - (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) + (replace-regexp-in-string + (rx bol (* nonl) "/" (+ (not (any "/"))) eol) "\\1" object-path))) (defun tramp-gvfs-url-host (url) "Return the host name part of URL, a string. We cannot use `url-host', because `url-generic-parse-url' returns a downcased host name only." (and (stringp url) - (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url) + (string-match (rx bol (+ alnum) "://" (group (+ (not (any "/:"))))) url) (match-string 1 url))) @@ -1739,7 +1746,8 @@ a downcased host name only." (pw-prompt (format "%s for %s " - (if (string-match "\\([pP]assword\\|[pP]assphrase\\)" message) + (if (string-match + (rx (group (any "Pp") (| "assword" "assphrase"))) message) (capitalize (match-string 1 message)) "Password") filename)) @@ -1861,7 +1869,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (cadr (assoc "ssl" (cadr mount-spec))))) (uri (tramp-gvfs-dbus-byte-array-to-string (cadr (assoc "uri" (cadr mount-spec)))))) - (when (string-match "^\\(afp\\|smb\\)" method) + (when (string-match (rx bol (group (| "afp" "smb"))) method) (setq method (match-string 1 method))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) @@ -1961,7 +1969,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (or (cadr (assoc "share" (cadr mount-spec))) (cadr (assoc "volume" (cadr mount-spec))))))) - (when (string-match "^\\(afp\\|smb\\)" method) + (when (string-match (rx bol (group (| "afp" "smb"))) method) (setq method (match-string 1 method))) (when (and (string-equal "dav" method) (string-equal "true" ssl)) (setq method "davs")) @@ -1993,7 +2001,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (string-equal domain (tramp-file-name-domain vec)) (string-equal host (tramp-file-name-host vec)) (string-equal port (tramp-file-name-port vec)) - (string-match-p (concat "^/" (regexp-quote (or share ""))) + (string-match-p (rx bol "/" (literal (or share ""))) (tramp-file-name-unquote-localname vec))) ;; Set mountpoint and location. (tramp-set-file-property vec "/" "fuse-mountpoint" fuse-mountpoint) @@ -2019,7 +2027,7 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (defun tramp-gvfs-mount-spec-entry (key value) "Construct a mount-spec entry to be used in a mount_spec. It was \"a(say)\", but has changed to \"a{sv})\"." - (if (string-match-p "^(aya{sv})" tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx bol "(aya{sv})") tramp-gvfs-mountlocation-signature) (list :dict-entry key (list :variant (tramp-gvfs-dbus-string-to-byte-array value))) (list :struct key (tramp-gvfs-dbus-string-to-byte-array value)))) @@ -2037,9 +2045,11 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (port (if media (tramp-media-device-port media) (tramp-file-name-port vec))) (localname (tramp-file-name-unquote-localname vec)) - (share (when (string-match "^/?\\([^/]+\\)" localname) + (share (when (string-match + (rx bol (? "/") (group (+ (not (any "/"))))) localname) (match-string 1 localname))) - (ssl (if (string-match-p "^davs\\|^nextcloud" method) "true" "false")) + (ssl (if (string-match-p (rx bol (| "davs" "nextcloud")) method) + "true" "false")) (mount-spec `(:array ,@(cond @@ -2047,7 +2057,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (list (tramp-gvfs-mount-spec-entry "type" "smb-share") (tramp-gvfs-mount-spec-entry "server" host) (tramp-gvfs-mount-spec-entry "share" share))) - ((string-match-p "^dav\\|^nextcloud" method) + ((string-match-p (rx bol (| "davs" "nextcloud")) method) (list (tramp-gvfs-mount-spec-entry "type" "dav") (tramp-gvfs-mount-spec-entry "host" host) (tramp-gvfs-mount-spec-entry "ssl" ssl))) @@ -2061,7 +2071,7 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ((string-equal "nextcloud" method) (list (tramp-gvfs-mount-spec-entry "type" "owncloud") (tramp-gvfs-mount-spec-entry "host" host))) - ((string-match-p "^http" method) + ((string-match-p (rx bol "http") method) (list (tramp-gvfs-mount-spec-entry "type" "http") (tramp-gvfs-mount-spec-entry "uri" @@ -2078,8 +2088,8 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ,@(when port (list (tramp-gvfs-mount-spec-entry "port" port))))) (mount-pref - (if (and (string-match-p "^dav" method) - (string-match "^/?[^/]+" localname)) + (if (and (string-match-p (rx bol "dav") method) + (string-match (rx bol (? "/") (+ (not (any "/")))) localname)) (match-string 0 localname) (tramp-gvfs-get-remote-prefix vec)))) @@ -2166,7 +2176,7 @@ connection if a previous connection has died for some reason." (string-equal localname "/")) (tramp-user-error vec "Filename must contain an AFP volume")) - (when (and (string-match-p "davs?" method) + (when (and (string-match-p (rx "dav" (? "s")) method) (string-equal localname "/")) (tramp-user-error vec "Filename must contain a WebDAV share")) @@ -2216,7 +2226,7 @@ connection if a previous connection has died for some reason." ;; The call must be asynchronously, because of the "askPassword" ;; or "askQuestion" callbacks. - (if (string-match-p "(so)$" tramp-gvfs-mountlocation-signature) + (if (string-match-p (rx "(so)" eol) tramp-gvfs-mountlocation-signature) (with-tramp-dbus-call-method vec nil :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker tramp-gvfs-interface-mounttracker tramp-gvfs-mountlocation @@ -2446,7 +2456,7 @@ It checks for mounted media devices." (text (zeroconf-service-txt x)) user) (when port - (setq host (format "%s%s%d" host tramp-prefix-port-regexp port))) + (setq host (format "%s%s%d" host tramp-prefix-port-format port))) ;; A user is marked in a TXT field like "u=guest". (while text (when (string-match "u=\\(.+\\)$" (car text)) @@ -2462,7 +2472,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." (ignore-errors (split-string (shell-command-to-string (format "avahi-browse -trkp %s" service)) - "[\n\r]+" 'omit "^\\+;.*$")))) + (rx (+ (any "\r\n"))) 'omit (rx bol "+;" (* nonl) eol))))) (delete-dups (mapcar (lambda (x) @@ -2472,7 +2482,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." user) ;; A user is marked in a TXT field like "u=guest". (while text - (when (string-match "u=\\(.+\\)$" (car text)) + (when (string-match (rx "u=" (group (+ nonl)) eol) (car text)) (setq user (match-string 1 (car text)))) (setq text (cdr text))) (list user host))) diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 226113d8800..946f9725022 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -85,7 +85,8 @@ special handling of `substitute-in-file-name'." (defun tramp-rfn-eshadow-update-overlay-regexp () "An overlay covering the shadowed part of the filename." - (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format)) + (rx-to-string + `(: (* (not (any ,tramp-postfix-host-format "/~"))) (or "/" "~")))) (defun tramp-rfn-eshadow-update-overlay () "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. @@ -215,9 +216,13 @@ NAME must be equal to `tramp-current-connection'." ;; Create a pseudo mode `tramp-info-lookup-mode' for Tramp symbol lookup. (info-lookup-maybe-add-help :mode 'tramp-info-lookup-mode :topic 'symbol - :regexp "[^][()`'‘’,\" \t\n]+" - :doc-spec '(("(tramp)Function Index" nil "^ -+ .*: " "\\( \\|$\\)") - ("(tramp)Variable Index" nil "^ -+ .*: " "\\( \\|$\\)"))) + :regexp (rx (+ (not (any "\t\n \"'(),[]`‘’")))) + :doc-spec '(("(tramp)Function Index" nil + (rx bol " " (+ "-") " " (* nonl) ": ") + (rx (group (| " " eol)))) + ("(tramp)Variable Index" nil + (rx bol " " (+ "-") " " (* nonl) ": ") + (rx (group (| " " eol)))))) (add-hook 'tramp-integration-unload-hook diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 5bee5641bb1..435faf83294 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -186,7 +186,7 @@ arguments to pass to the OPERATION." (delq nil (mapcar (lambda (line) - (when (string-match "^\\(\\S-+\\):$" line) + (when (string-match (rx bol (group (+ (not space))) ":" eol) line) `(nil ,(match-string 1 line)))) (tramp-process-lines nil tramp-rclone-program "listremotes"))))) @@ -300,11 +300,11 @@ file names." (let (total used free) (goto-char (point-min)) (while (not (eobp)) - (when (looking-at "Total: [[:space:]]+\\([[:digit:]]+\\)") + (when (looking-at (rx "Total: " (+ space) (group (+ digit)))) (setq total (string-to-number (match-string 1)))) - (when (looking-at "Used: [[:space:]]+\\([[:digit:]]+\\)") + (when (looking-at (rx "Used: " (+ space) (group (+ digit)))) (setq used (string-to-number (match-string 1)))) - (when (looking-at "Free: [[:space:]]+\\([[:digit:]]+\\)") + (when (looking-at (rx "Free: " (+ space) (group (+ digit)))) (setq free (string-to-number (match-string 1)))) (forward-line)) (when used @@ -343,7 +343,7 @@ file names." (tramp-rclone-maybe-open-connection v) ;; TODO: This shall be handled by `expand-file-name'. (setq localname - (replace-regexp-in-string "^\\." "" (or localname ""))) + (replace-regexp-in-string (rx bol ".") "" (or localname ""))) (format "%s%s" (tramp-fuse-mounted-p v) localname))) ;; It is a local file name. filename)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ca08c6f0b3d..2489ac9aec9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -81,10 +81,10 @@ the default storage location, e.g. \"$HOME/.sh_history\"." (string :tag "Redirect to a file"))) ;;;###tramp-autoload -(defconst tramp-display-escape-sequence-regexp "\e[[:digit:];[]+m" +(defconst tramp-display-escape-sequence-regexp (rx "\e" (+ (any ";[" digit)) "m") "Terminal control escape sequences for display attributes.") -(defconst tramp-device-escape-sequence-regexp "\e[[:digit:][]+n" +(defconst tramp-device-escape-sequence-regexp (rx "\e" (+ (any "[" digit)) "n") "Terminal control escape sequences for device status.") ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for @@ -411,19 +411,19 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-default-method-alist `(,tramp-local-host-regexp - ,(format "\\`%s\\'" tramp-root-id-string) "su")) + ,(rx bos (literal tramp-root-id-string) eos) "su")) (add-to-list 'tramp-default-user-alist - `(,(concat "\\`" (regexp-opt '("su" "sudo" "doas" "ksu")) "\\'") + `(,(rx bos (regexp (regexp-opt '("su" "sudo" "doas" "ksu"))) eos) nil ,tramp-root-id-string)) ;; Do not add "ssh" based methods, otherwise ~/.ssh/config would be ignored. ;; Do not add "plink" based methods, they ask interactively for the user. (add-to-list 'tramp-default-user-alist - `(,(concat - "\\`" - (regexp-opt - '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")) - "\\'") + `(,(rx bos + (regexp + (regexp-opt + '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp"))) + eos) nil ,(user-login-name)))) ;;;###tramp-autoload @@ -518,8 +518,8 @@ The string is used in `tramp-methods'.") (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh)) (defcustom tramp-sh-extra-args - '(("/bash\\'" . "-noediting -norc -noprofile") - ("/zsh\\'" . "-f +Z -V")) + `((,(rx "/bash" eos) . "-noediting -norc -noprofile") + (,(rx "/zsh" eos) . "-f +Z -V")) "Alist specifying extra arguments to pass to the remote shell. Entries are (REGEXP . ARGS) where REGEXP is a regular expression matching the shell file name and ARGS is a string specifying the @@ -1188,7 +1188,7 @@ component is used as the target of the symlink." (tramp-shell-quote-argument localname))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (buffer-substring (point-min) (line-end-position)))) + (buffer-substring (point-min) (line-end-position)))) ;; Use Perl implementation. ((and (tramp-get-remote-perl v) @@ -1416,7 +1416,7 @@ component is used as the target of the symlink." (format "%s -ild %s" (tramp-get-ls-command v) (tramp-shell-quote-argument localname))) - (setq attr (buffer-substring (point) (line-end-position)))) + (setq attr (buffer-substring (point) (line-end-position)))) (tramp-set-file-property v localname "visited-file-modtime-ild" attr)) (setq last-coding-system-used coding-system-used) @@ -1460,7 +1460,7 @@ of." (tramp-get-ls-command v) (tramp-shell-quote-argument localname))) (with-current-buffer (tramp-get-buffer v) - (setq attr (buffer-substring (point) (line-end-position)))) + (setq attr (buffer-substring (point) (line-end-position)))) (equal attr (tramp-get-file-property @@ -1572,8 +1572,10 @@ ID-FORMAT valid values are `string' and `integer'." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):" - "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)"))) + (regexp (rx (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum)))))) (when (and (tramp-remote-selinux-p v) (tramp-send-command-and-check v (format @@ -1582,7 +1584,7 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-shell-quote-argument localname)))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (when (re-search-forward regexp (line-end-position) t) + (when (re-search-forward regexp (line-end-position) t) (setq context (list (match-string 1) (match-string 2) (match-string 3) (match-string 4)))))) ;; Return the context. @@ -1723,7 +1725,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; On BSD-derived systems files always inherit the ;; parent directory's group, so skip the group-gid ;; test. - (tramp-check-remote-uname v "BSD\\|DragonFly\\|Darwin") + (tramp-check-remote-uname v (rx (| "BSD" "DragonFly" "Darwin"))) (= (file-attribute-group-id attributes) (tramp-get-remote-gid v 'integer))))))))) @@ -1809,7 +1811,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; Check result code, found in last line of output. (forward-line -1) - (if (looking-at-p "^fail$") + (if (looking-at-p (rx bol "fail" eol)) (progn ;; Grab error message from line before last line ;; (it was put there by `cd 2>&1'). @@ -1817,12 +1819,12 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-error v 'file-error "tramp-sh-handle-file-name-all-completions: %s" - (buffer-substring (point) (line-end-position)))) + (buffer-substring (point) (line-end-position)))) ;; For peace of mind, if buffer doesn't end in `fail' ;; then it should end in `ok'. If neither are in the ;; buffer something went seriously wrong on the remote ;; side. - (unless (looking-at-p "^ok$") + (unless (looking-at-p (rx bol "ok" eol)) (tramp-error v 'file-error (concat "tramp-sh-handle-file-name-all-completions: " @@ -1830,7 +1832,7 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-shell-quote-argument localname) (buffer-string)))) (while (zerop (forward-line -1)) - (push (buffer-substring (point) (line-end-position)) result))) + (push (buffer-substring (point) (line-end-position)) result))) result)))))) ;; cp, mv and ln @@ -2550,7 +2552,7 @@ The method used must be an out-of-band method." (with-tramp-progress-reporter v 0 (format "Uncompressing %s" file) (when (tramp-send-command-and-check - v (if (string-match-p "%[io]" (nth 2 suffix)) + v (if (string-match-p (rx "%" (any "io")) (nth 2 suffix)) (replace-regexp-in-string "%i" (tramp-shell-quote-argument localname) (nth 2 suffix)) @@ -2659,7 +2661,9 @@ The method used must be an out-of-band method." (save-restriction (narrow-to-region beg-marker end-marker) ;; Check for "--dired" output. - (when (re-search-backward "^//DIRED//\\s-+\\(.+\\)$" nil 'noerror) + (when (re-search-backward + (rx bol "//DIRED//" (+ space) (group (+ nonl)) eol) + nil 'noerror) (let ((beg (match-beginning 1)) (end (match-end 0))) ;; Now read the numeric positions of file names. @@ -2731,7 +2735,7 @@ The method used must be an out-of-band method." ;; Try to insert the amount of free space. (goto-char (point-min)) ;; First find the line to put it on. - (when (and (re-search-forward "^\\([[:space:]]*total\\)" nil t) + (when (and (re-search-forward (rx bol (group (* space) "total")) nil t) ;; Emacs 29.1 or later. (not (fboundp 'dired--insert-disk-space))) (when-let ((available (get-free-disk-space "."))) @@ -2758,7 +2762,7 @@ the result will be a local, non-Tramp, file name." ;; by `file-name-absolute-p'. (if (and (eq system-type 'windows-nt) (string-match-p - (concat "^\\([[:alpha:]]:\\|" null-device "$\\)") name)) + (rx bol (| (: alpha ":") (: (literal null-device) eol))) name)) (tramp-run-real-handler #'expand-file-name (list name dir)) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) @@ -2774,7 +2778,9 @@ the result will be a local, non-Tramp, file name." ;; groks tilde expansion! The function `tramp-find-shell' is ;; supposed to find such a shell on the remote host. Please ;; tell me about it when this doesn't work on your system. - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -2785,7 +2791,7 @@ the result will be a local, non-Tramp, file name." ;; appropriate either, because ssh and companions might ;; use a user name from the config file. (when (and (zerop (length uname)) - (string-match-p "\\`su\\(do\\)?\\'" method)) + (string-match-p (rx bos "su" (? "do") eos) method)) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -2794,7 +2800,7 @@ the result will be a local, non-Tramp, file name." (while (string-match "//" localname) (setq localname (replace-match "/" t t localname))) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "/./" and "/../"), ;; unless there are tilde characters in file name. @@ -2802,9 +2808,9 @@ the result will be a local, non-Tramp, file name." ;; would be problems with UNC shares or Cygwin mounts. (let ((default-directory tramp-compat-temporary-file-directory)) (tramp-make-tramp-file-name - v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) - localname - (tramp-drop-volume-letter + v (tramp-drop-volume-letter + (if (string-prefix-p "~" localname) + localname (tramp-run-real-handler #'expand-file-name (list localname)))))))))) @@ -2884,11 +2890,12 @@ implementation will be used." ;; command. (heredoc (and (not (bufferp stderr)) (stringp program) - (string-match-p "sh$" program) + (string-match-p (rx "sh" eol) program) (= (length args) 2) (string-equal "-c" (car args)) ;; Don't if there is a quoted string. - (not (string-match-p "'\\|\"" (cadr args))) + (not + (string-match-p (rx (any "'\"")) (cadr args))) ;; Check, that /dev/tty is usable. (tramp-get-remote-dev-tty v))) ;; When PROGRAM is nil, we just provide a tty. @@ -3093,7 +3100,7 @@ implementation will be used." (let (signal-hook-function) (condition-case nil (dolist (sig (cdr signals)) - (unless (string-match-p "^[[:alnum:]+-]+$" sig) + (unless (string-match-p (rx bol (+ (any "+-" alnum)) eol) sig) (error nil))) (error (setq signals '(0))))) (dotimes (i 128) @@ -3124,8 +3131,8 @@ implementation will be used." (tramp-shell-quote-argument (format "kill -%d $$" i)))) (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) - (buffer-substring (line-beginning-position) - (line-end-position))))) + (buffer-substring (line-beginning-position) + (line-end-position))))) (if (string-empty-p res) (format "Signal %d" i) res))) @@ -3810,8 +3817,8 @@ Fall back to normal file name handler if no Tramp handler exists." (catch 'doesnt-work ;; https://bugs.launchpad.net/bugs/1742946 - (when - (string-match-p "Monitoring not supported\\|No locations given" string) + (when (string-match-p + (rx (| "Monitoring not supported" "No locations given")) string) (delete-process proc) (throw 'doesnt-work nil)) @@ -3829,9 +3836,11 @@ Fall back to normal file name handler if no Tramp handler exists." ((getenv "EMACS_EMBA_CI") 'GInotifyFileMonitor) ((eq system-type 'cygwin) 'GPollFileMonitor))) ;; TODO: What happens, if several monitor names are reported? - ((string-match "\ -Supported arguments for GIO_USE_FILE_MONITOR environment variable: -\\s-*\\([[:alpha:]]+\\) - 20" string) + ((string-match + (rx "Supported arguments for " + "GIO_USE_FILE_MONITOR environment variable:\n" + (* space) (group (+ alpha)) " - 20") + string) (setq pos (match-end 0)) (intern (format "G%sFileMonitor" (capitalize (match-string 1 string))))) @@ -3842,15 +3851,14 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: (setq string (tramp-compat-string-replace "\n\n" "\n" string)) (while (string-match - (eval-when-compile - (concat "^[^:]+:" - "[[:space:]]\\([^:]+\\):" - "[[:space:]]" (regexp-opt tramp-gio-events t) - "\\([[:space:]]\\([^:]+\\)\\)?$")) + (rx bol (+ (not (any ":"))) ":" space + (group (+ (not (any ":")))) ":" space + (group (regexp (regexp-opt tramp-gio-events))) + (? space (group (+ (not (any ":"))))) eol) string) (let* ((file (match-string 1 string)) - (file1 (match-string 4 string)) + (file1 (match-string 3 string)) (object (list proc @@ -3870,7 +3878,7 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: `(file-notify ,object file-notify-callback)))))) ;; Save rest of the string. - (while (string-match "^\n" string) + (while (string-match (rx bol "\n") string) (setq string (replace-match "" nil nil string))) (when (zerop (length string)) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) @@ -3883,9 +3891,8 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: (dolist (line (split-string string "[\n\r]+" 'omit)) ;; Check, whether there is a problem. (unless (string-match - (concat "^[^[:blank:]]+" - "[[:blank:]]+\\([^[:blank:]]+\\)" - "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") + (rx bol (+ (not blank)) (+ blank) (group (+ (not blank))) + (? (+ blank) (group (+ (not (any "\r\n")))))) line) (tramp-error proc 'file-notify-error line)) @@ -3897,7 +3904,7 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: (intern-soft (tramp-compat-string-replace "_" "-" (downcase x)))) (split-string (match-string 1 line) "," 'omit)) - (or (match-string 3 line) + (or (match-string 2 line) (file-name-nondirectory (process-get proc 'watch-name)))))) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at @@ -3921,10 +3928,10 @@ Supported arguments for GIO_USE_FILE_MONITOR environment variable: (goto-char (point-min)) (forward-line) (when (looking-at - (concat "\\(?:^/[^[:space:]]*[[:space:]]\\)?" - "[[:space:]]*\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)")) + (rx (? bol "/" (* (not space)) space) (* space) + (group (+ digit)) (+ space) + (group (+ digit)) (+ space) + (group (+ digit)))) (mapcar (lambda (d) (* d (tramp-get-connection-property v "df-blocksize" 0))) @@ -3946,49 +3953,51 @@ by \"2>/dev/null\", and \"%t\" is replaced by a temporary file name. If VEC is nil, the respective local commands are used. If there is a format specifier which cannot be expanded, this function returns nil." - (if (not (string-match-p "\\(^\\|[^%]\\)%[ahlnoprst]" script)) + (if (not (string-match-p + (rx (| bol (not (any "%"))) "%" (any "ahlnoprst")) script)) script (catch 'wont-work - (let ((awk (when (string-match-p "\\(^\\|[^%]\\)%a" script) + (let ((awk (when (string-match-p (rx (| bol (not (any "%"))) "%a") script) (or (if vec (tramp-get-remote-awk vec) (executable-find "awk")) (throw 'wont-work nil)))) - (hdmp (when (string-match-p "\\(^\\|[^%]\\)%h" script) + (hdmp (when (string-match-p (rx (| bol (not (any "%"))) "%h") script) (or (if vec (tramp-get-remote-hexdump vec) (executable-find "hexdump")) (throw 'wont-work nil)))) - (dev (when (string-match-p "\\(^\\|[^%]\\)%n" script) + (dev (when (string-match-p (rx (| bol (not (any "%"))) "%n") script) (or (if vec (concat "2>" (tramp-get-remote-null-device vec)) (if (eq system-type 'windows-nt) "" (concat "2>" null-device))) (throw 'wont-work nil)))) - (ls (when (string-match-p "\\(^\\|[^%]\\)%l" script) + (ls (when (string-match-p (rx (| bol (not (any "%"))) "%l") script) (format "%s %s" (or (tramp-get-ls-command vec) (throw 'wont-work nil)) (tramp-sh--quoting-style-options vec)))) - (od (when (string-match-p "\\(^\\|[^%]\\)%o" script) + (od (when (string-match-p (rx (| bol (not (any "%"))) "%o") script) (or (if vec (tramp-get-remote-od vec) (executable-find "od")) (throw 'wont-work nil)))) - (perl (when (string-match-p "\\(^\\|[^%]\\)%p" script) + (perl (when (string-match-p (rx (| bol (not (any "%"))) "%p") script) (or (if vec (tramp-get-remote-perl vec) (executable-find "perl")) (throw 'wont-work nil)))) - (readlink (when (string-match-p "\\(^\\|[^%]\\)%r" script) - (or - (if vec + (readlink (when (string-match-p + (rx (| bol (not (any "%"))) "%r") script) + (or + (if vec (tramp-get-remote-readlink vec) (executable-find "readlink")) (throw 'wont-work nil)))) - (stat (when (string-match-p "\\(^\\|[^%]\\)%s" script) + (stat (when (string-match-p (rx (| bol (not (any "%"))) "%s") script) (or (if vec (tramp-get-remote-stat vec) (executable-find "stat")) (throw 'wont-work nil)))) - (tmp (when (string-match-p "\\(^\\|[^%]\\)%t" script) + (tmp (when (string-match-p (rx (| bol (not (any "%"))) "%t") script) (or (if vec (tramp-file-local-name (tramp-make-tramp-temp-name vec)) @@ -4061,7 +4070,7 @@ This function expects to be in the right *tramp* buffer." (unless (or ignore-path (tramp-check-remote-uname vec tramp-sunos-unames)) (tramp-send-command vec (format "which \\%s | wc -w" progname)) (goto-char (point-min)) - (if (looking-at-p "^\\s-*1$") + (if (looking-at-p (rx bol (* space) "1" eol)) (setq result (concat "\\" progname)))) (unless result (when ignore-tilde @@ -4088,8 +4097,8 @@ This function expects to be in the right *tramp* buffer." (when (search-backward "tramp_executable " nil t) (skip-chars-forward "^ ") (skip-chars-forward " ") - (setq result (buffer-substring (point) (line-end-position))))) - result))) + (setq result (buffer-substring (point) (line-end-position))))) + result))) ;; On hydra.nixos.org, the $PATH environment variable is too long to ;; send it. This is likely not due to PATH_MAX, but PIPE_BUF. We @@ -4101,7 +4110,8 @@ whether it exists and if so, it is added to the environment variable PATH." (let ((command (format - "PATH=%s && export PATH" (string-join (tramp-get-remote-path vec) ":"))) + "PATH=%s && export PATH" + (string-join (tramp-get-remote-path vec) ":"))) (pipe-buf (with-tramp-connection-property vec "pipe-buf" (tramp-send-command-and-read @@ -4227,9 +4237,10 @@ file exists and nonzero exit status otherwise." ;; first. (tramp-send-command vec (format - (concat - "exec env TERM='%s' INSIDE_EMACS='%s' " - "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i") + (eval-when-compile + (concat + "exec env TERM='%s' INSIDE_EMACS='%s' " + "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s -i")) tramp-terminal-type (tramp-inside-emacs) (or (getenv-internal "ENV" tramp-remote-process-environment) "") (if (stringp tramp-histfile-override) @@ -4244,16 +4255,21 @@ file exists and nonzero exit status otherwise." ;; Sanity check. (tramp-barf-if-no-shell-prompt - (tramp-get-connection-process vec) 10 + (tramp-get-connection-process vec) 60 "Couldn't find remote shell prompt for %s" shell) (unless (tramp-check-for-regexp - (tramp-get-connection-process vec) (regexp-quote tramp-end-of-output)) + (tramp-get-connection-process vec) (rx (literal tramp-end-of-output))) + (tramp-wait-for-output (tramp-get-connection-process vec)) (tramp-message vec 5 "Setting shell prompt") (tramp-send-command vec (format "PS1=%s PS2='' PS3='' PROMPT_COMMAND=''" (tramp-shell-quote-argument tramp-end-of-output)) - t)) + t t) + (tramp-barf-if-no-shell-prompt + (tramp-get-connection-process vec) 60 + "Couldn't find remote shell prompt for %s" shell)) + (tramp-wait-for-output (tramp-get-connection-process vec)) ;; Check proper HISTFILE setting. We give up when not working. (when (and (stringp tramp-histfile-override) @@ -4284,7 +4300,8 @@ file exists and nonzero exit status otherwise." (tramp-send-command vec (format "echo ~%s" tramp-root-id-string) t) (if (or (string-match-p - (format "^~%s$" tramp-root-id-string) (buffer-string)) + (rx bol "~" (literal tramp-root-id-string) eol) + (buffer-string)) ;; The default shell (ksh93) of OpenSolaris ;; and Solaris is buggy. We've got reports ;; for "SunOS 5.10" and "SunOS 5.11" so far. @@ -4299,9 +4316,10 @@ file exists and nonzero exit status otherwise." default-shell (tramp-message vec 2 - (concat - "Couldn't find a remote shell which groks tilde " - "expansion, using `%s'") + (eval-when-compile + (concat + "Couldn't find a remote shell which groks tilde " + "expansion, using `%s'")) default-shell))) default-shell))) @@ -4322,8 +4340,9 @@ seconds. If not, it produces an error message with the given ERROR-ARGS." (condition-case nil (tramp-wait-for-regexp proc timeout - (format - "\\(%s\\|%s\\)\\'" shell-prompt-pattern tramp-shell-prompt-pattern)) + (rx (| (regexp shell-prompt-pattern) + (regexp tramp-shell-prompt-pattern)) + eos)) (error (delete-process proc) (apply #'tramp-error-with-buffer @@ -4392,7 +4411,8 @@ process to set up. VEC specifies the connection." (string-prefix-p "Darwin" uname) (cons 'utf-8-hfs 'utf-8-hfs)) (and (memq 'utf-8 (coding-system-list)) - (string-match-p "utf-?8" (tramp-get-remote-locale vec)) + (string-match-p + (rx "utf" (? "-") "8") (tramp-get-remote-locale vec)) (cons 'utf-8 'utf-8)) (process-coding-system proc) (cons 'undecided 'undecided))) @@ -4424,7 +4444,7 @@ process to set up. VEC specifies the connection." (t (tramp-message vec 5 "Checking remote host type for `send-process-string' bug") - (if (string-match-p "FreeBSD\\|DragonFly" uname) 500 0)))) + (if (string-match-p (rx (| "FreeBSD" "DragonFly")) uname) 500 0)))) ;; Set remote PATH variable. (tramp-set-remote-path vec) @@ -4456,7 +4476,7 @@ process to set up. VEC specifies the connection." (tramp-send-command vec "set +H" t)) ;; Disable tab expansion. - (if (string-match-p "BSD\\|DragonFly\\|Darwin" uname) + (if (string-match-p (rx (| "BSD" "DragonFly" "Darwin")) uname) (tramp-send-command vec "stty tabs" t) (tramp-send-command vec "stty tab0" t)) @@ -4682,7 +4702,7 @@ Goes through the list `tramp-local-coding-commands' and (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) - (unless (looking-at-p (regexp-quote magic)) + (unless (looking-at-p (rx (literal magic))) (throw 'wont-work-remote nil))) ;; `rem-enc' and `rem-dec' could be a string meanwhile. @@ -4768,7 +4788,7 @@ Goes through the list `tramp-inline-compress-commands'." nil t)) (throw 'next nil)) (goto-char (point-min)) - (unless (looking-at-p (regexp-quote magic)) + (unless (looking-at-p (rx (literal magic))) (throw 'next nil))) (tramp-message vec 5 @@ -4779,7 +4799,7 @@ Goes through the list `tramp-inline-compress-commands'." (throw 'next nil)) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (unless (looking-at-p (regexp-quote magic)) + (unless (looking-at-p (rx (literal magic))) (throw 'next nil))) (setq found t))) @@ -4868,7 +4888,7 @@ Goes through the list `tramp-inline-compress-commands'." (goto-char (point-min)) (unless (search-forward-regexp - "\\(illegal\\|unknown\\) option -- T" nil t) + (rx (| "illegal" "unknown") " option -- T") nil t) (setq tramp-scp-strict-file-name-checking "-T"))))))) tramp-scp-strict-file-name-checking))) @@ -4895,7 +4915,7 @@ Goes through the list `tramp-inline-compress-commands'." (goto-char (point-min)) (unless (search-forward-regexp - "\\(illegal\\|unknown\\) option -- O" nil t) + (rx (| "illegal" "unknown") " option -- O") nil t) (setq tramp-scp-force-scp-protocol "-O"))))))) tramp-scp-force-scp-protocol))) @@ -4918,7 +4938,7 @@ Goes through the list `tramp-inline-compress-commands'." (tramp-call-process vec1 "scp" nil t nil "-R") (goto-char (point-min)) (not (search-forward-regexp - "\\(illegal\\|unknown\\) option -- R" nil 'noerror))))) + (rx (| "illegal" "unknown") " option -- R") nil 'noerror))))) ;; Check, that RemoteCommand is not used. (with-tramp-connection-property @@ -4959,7 +4979,10 @@ Goes through the list `tramp-inline-compress-commands'." (line-beginning-position) (line-end-position)) string (and - (string-match "^[^# ]+ \\S-+ \\(\\S-+\\)$" string) + (string-match + (rx bol (+ (not (any " #"))) " " (+ (not space)) " " + (group (+ (not space))) eol) + string) (match-string 1 string)) found (and string @@ -5264,20 +5287,22 @@ function waits for output unless NOOUTPUT is set." ;; Busyboxes built with the EDITING_ASK_TERMINAL config ;; option send also escape sequences, which must be ;; ignored. - (regexp (format "[^#$\n]*%s\\(%s\\)?\r?$" - (regexp-quote tramp-end-of-output) - tramp-device-escape-sequence-regexp)) + (regexp (rx (* (not (any "#$\n"))) + (literal tramp-end-of-output) + (? (regexp tramp-device-escape-sequence-regexp)) + (? "\r") eol)) ;; Sometimes, the commands do not return a newline but a ;; null byte before the shell prompt, for example "git ;; ls-files -c -z ...". - (regexp1 (format "\\(^\\|\000\\)%s" regexp)) + (regexp1 (rx (| bol "\000") (regexp regexp))) (found (tramp-wait-for-regexp proc timeout regexp1))) (if found (let ((inhibit-read-only t)) ;; A simple-minded busybox has sent " ^H" sequences. ;; Delete them. (goto-char (point-min)) - (when (re-search-forward "^\\(.\b\\)+$" (line-end-position) t) + (when (re-search-forward + (rx bol (+ nonl "\b") eol) (line-end-position) t) (forward-line 1) (delete-region (point-min) (point))) ;; Delete the prompt. @@ -5308,7 +5333,9 @@ Optional argument EXIT-STATUS, if non-nil, triggers the return of the exit status." (let (cmd data) (if (and (stringp command) - (string-match (format ".*<<'%s'.*" tramp-end-of-heredoc) command)) + (string-match + (rx (* nonl) "<<'" (literal tramp-end-of-heredoc) "'" (* nonl)) + command)) (setq cmd (match-string 0 command) data (substring command (match-end 0))) (setq cmd command)) @@ -5324,7 +5351,7 @@ the exit status." (if subshell " )" "") data))) (with-current-buffer (tramp-get-connection-buffer vec) - (unless (tramp-search-regexp "tramp_exit_status [[:digit:]]+") + (unless (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) (tramp-error vec 'file-error "Couldn't find exit status of `%s'" command)) (skip-chars-forward "^ ") @@ -5369,7 +5396,7 @@ raises an error." (unless noerror signal-hook-function))) (read (current-buffer))) ;; Error handling. - (when (re-search-forward "\\S-" (line-end-position) t) + (when (re-search-forward (rx (not space)) (line-end-position) t) (error nil))) (error (unless noerror (tramp-error @@ -5399,7 +5426,7 @@ raises an error." ;; This does not work for MS Windows scp, if there are characters ;; to be quoted. OpenSSH 8 supports disabling of strict file name ;; checking in scp, we use it when available. - (unless (string-match-p "ftp$" method) + (unless (string-match-p (rx "ftp" eos) method) (setq localname (tramp-unquote-shell-quote-argument localname))) (cond ((tramp-get-method-parameter vec 'tramp-remote-copy-program) @@ -5477,7 +5504,7 @@ Nonexistent directories are removed from spec." (tramp-get-method-parameter vec 'tramp-remote-shell-args) " ") (tramp-shell-quote-argument tramp-end-of-heredoc)) - 'noerror (regexp-quote tramp-end-of-heredoc)) + 'noerror (rx (literal tramp-end-of-heredoc))) (progn (tramp-message vec 2 "Could not retrieve `tramp-own-remote-path'") @@ -5526,8 +5553,9 @@ Nonexistent directories are removed from spec." (with-current-buffer (tramp-get-connection-buffer vec) (while candidates (goto-char (point-min)) - (if (string-match-p (format "^%s\r?$" (regexp-quote (car candidates))) - (buffer-string)) + (if (string-match-p + (rx bol (literal (car candidates))"%s" (? "\r") eol) + (buffer-string)) (setq locale (car candidates) candidates nil) (setq candidates (cdr candidates))))) @@ -5557,7 +5585,7 @@ Nonexistent directories are removed from spec." "%s --color=never -al %s" result (tramp-get-remote-null-device vec))) (not (string-match-p - (regexp-quote "\e") + "\e" (tramp-get-buffer-string (tramp-get-buffer vec))))) (setq result (concat result " --color=never"))) @@ -5605,7 +5633,7 @@ Nonexistent directories are removed from spec." vec (format "( %s / -nt / )" (tramp-get-test-command vec))) (with-current-buffer (tramp-get-buffer vec) (goto-char (point-min)) - (when (looking-at-p (regexp-quote tramp-end-of-output)) + (when (looking-at-p (rx (literal tramp-end-of-output))) (format "%s %%s -nt %%s" (tramp-get-test-command vec))))) (progn (tramp-send-command @@ -5670,7 +5698,9 @@ Nonexistent directories are removed from spec." tmp (tramp-send-command-and-read vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror)) (unless (and (listp tmp) (stringp (car tmp)) - (string-match-p "^[\"`‘„”«「]/[\"'’“”»」]$" (car tmp)) + (string-match-p + (rx bol (any "\"`'‘„”«「") "/" (any "\"'’“”»」") eol) + (car tmp)) (integerp (cadr tmp))) (setq result nil))) result)))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index ba0a1d3598f..9e63d532626 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -53,7 +53,7 @@ ;;;###tramp-autoload (tramp--with-startup (add-to-list 'tramp-default-user-alist - `(,(concat "\\`" tramp-smb-method "\\'") nil nil)) + `(,(rx bos (literal tramp-smb-method) eos) nil nil)) ;; Add completion function for SMB method. (tramp-set-completion-function @@ -92,10 +92,15 @@ this variable \"client min protocol=NT1\"." "Version string of the SMB client.") (defconst tramp-smb-server-version - "Domain=\\[[^]]*\\] OS=\\[[^]]*\\] Server=\\[[^]]*\\]" + (rx "Domain=[" (* (not (any "]"))) "] " + "OS=[" (* (not (any "]"))) "] " + "Server=[" (* (not (any "]"))) "]") "Regexp of SMB server identification.") -(defconst tramp-smb-prompt "^\\(smb:\\|PS\\) .+> \\|^\\s-+Server\\s-+Comment$" +(defconst tramp-smb-prompt + (rx bol (| (: (| "smb:" "PS") " " (+ nonl) "> ") + (: (+ space) "Server" + (+ space) "Comment" eol))) "Regexp used as prompt in smbclient or powershell.") (defconst tramp-smb-wrong-passwd-regexp @@ -105,66 +110,63 @@ this variable \"client min protocol=NT1\"." "Regexp for login error strings of SMB servers.") (defconst tramp-smb-errors - (mapconcat - #'identity - `(;; Connection error / timeout / unknown command. - "Connection\\( to \\S-+\\)? failed" - "Read from server failed, maybe it closed the connection" - "Call timed out: server did not respond" - "\\S-+: command not found" - "Server doesn't support UNIX CIFS calls" - ,(regexp-opt - '(;; Samba. - "ERRDOS" - "ERRHRD" - "ERRSRV" - "ERRbadfile" - "ERRbadpw" - "ERRfilexists" - "ERRnoaccess" - "ERRnomem" - "ERRnosuchshare" - ;; See /usr/include/samba-4.0/core/ntstatus.h. - ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), - ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), - ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7), - ;; Windows 6.3 (Windows Server 2012, Windows 10). - "NT_STATUS_ACCESS_DENIED" - "NT_STATUS_ACCOUNT_LOCKED_OUT" - "NT_STATUS_BAD_NETWORK_NAME" - "NT_STATUS_CANNOT_DELETE" - "NT_STATUS_CONNECTION_DISCONNECTED" - "NT_STATUS_CONNECTION_REFUSED" - "NT_STATUS_CONNECTION_RESET" - "NT_STATUS_DIRECTORY_NOT_EMPTY" - "NT_STATUS_DUPLICATE_NAME" - "NT_STATUS_FILE_IS_A_DIRECTORY" - "NT_STATUS_HOST_UNREACHABLE" - "NT_STATUS_IMAGE_ALREADY_LOADED" - "NT_STATUS_INVALID_LEVEL" - "NT_STATUS_INVALID_PARAMETER" - "NT_STATUS_INVALID_PARAMETER_MIX" - "NT_STATUS_IO_TIMEOUT" - "NT_STATUS_LOGON_FAILURE" - "NT_STATUS_NETWORK_ACCESS_DENIED" - "NT_STATUS_NOT_IMPLEMENTED" - "NT_STATUS_NO_LOGON_SERVERS" - "NT_STATUS_NO_SUCH_FILE" - "NT_STATUS_NO_SUCH_USER" - "NT_STATUS_NOT_A_DIRECTORY" - "NT_STATUS_NOT_SUPPORTED" - "NT_STATUS_OBJECT_NAME_COLLISION" - "NT_STATUS_OBJECT_NAME_INVALID" - "NT_STATUS_OBJECT_NAME_NOT_FOUND" - "NT_STATUS_OBJECT_PATH_SYNTAX_BAD" - "NT_STATUS_PASSWORD_MUST_CHANGE" - "NT_STATUS_RESOURCE_NAME_NOT_FOUND" - "NT_STATUS_REVISION_MISMATCH" - "NT_STATUS_SHARING_VIOLATION" - "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" - "NT_STATUS_UNSUCCESSFUL" - "NT_STATUS_WRONG_PASSWORD"))) - "\\|") + (rx (| ;; Connection error / timeout / unknown command. + (: "Connection" (? " to " (+ (not space))) " failed") + "Read from server failed, maybe it closed the connection" + "Call timed out: server did not respond" + (: (+ (not space)) ": command not found") + "Server doesn't support UNIX CIFS calls" + (regexp (regexp-opt + '(;; Samba. + "ERRDOS" + "ERRHRD" + "ERRSRV" + "ERRbadfile" + "ERRbadpw" + "ERRfilexists" + "ERRnoaccess" + "ERRnomem" + "ERRnosuchshare" + ;; See /usr/include/samba-4.0/core/ntstatus.h. + ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), + ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003), + ;; Windows 6.0 (Windows Vista), Windows 6.1 (Windows 7), + ;; Windows 6.3 (Windows Server 2012, Windows 10). + "NT_STATUS_ACCESS_DENIED" + "NT_STATUS_ACCOUNT_LOCKED_OUT" + "NT_STATUS_BAD_NETWORK_NAME" + "NT_STATUS_CANNOT_DELETE" + "NT_STATUS_CONNECTION_DISCONNECTED" + "NT_STATUS_CONNECTION_REFUSED" + "NT_STATUS_CONNECTION_RESET" + "NT_STATUS_DIRECTORY_NOT_EMPTY" + "NT_STATUS_DUPLICATE_NAME" + "NT_STATUS_FILE_IS_A_DIRECTORY" + "NT_STATUS_HOST_UNREACHABLE" + "NT_STATUS_IMAGE_ALREADY_LOADED" + "NT_STATUS_INVALID_LEVEL" + "NT_STATUS_INVALID_PARAMETER" + "NT_STATUS_INVALID_PARAMETER_MIX" + "NT_STATUS_IO_TIMEOUT" + "NT_STATUS_LOGON_FAILURE" + "NT_STATUS_NETWORK_ACCESS_DENIED" + "NT_STATUS_NOT_IMPLEMENTED" + "NT_STATUS_NO_LOGON_SERVERS" + "NT_STATUS_NO_SUCH_FILE" + "NT_STATUS_NO_SUCH_USER" + "NT_STATUS_NOT_A_DIRECTORY" + "NT_STATUS_NOT_SUPPORTED" + "NT_STATUS_OBJECT_NAME_COLLISION" + "NT_STATUS_OBJECT_NAME_INVALID" + "NT_STATUS_OBJECT_NAME_NOT_FOUND" + "NT_STATUS_OBJECT_PATH_SYNTAX_BAD" + "NT_STATUS_PASSWORD_MUST_CHANGE" + "NT_STATUS_RESOURCE_NAME_NOT_FOUND" + "NT_STATUS_REVISION_MISMATCH" + "NT_STATUS_SHARING_VIOLATION" + "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" + "NT_STATUS_UNSUCCESSFUL" + "NT_STATUS_WRONG_PASSWORD"))))) "Regexp for possible error strings of SMB servers. Used instead of analyzing error codes of commands.") @@ -727,7 +729,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Dissect NAME. (with-parsed-tramp-file-name name nil ;; Tilde expansion if necessary. - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -737,17 +741,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) - (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) + (string-prefix-p "~" localname)) (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) (unless (tramp-run-real-handler #'file-name-absolute-p (list localname)) (setq localname (concat "/" localname))) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "/./" and "/../"), ;; unless there are tilde characters in file name. (tramp-make-tramp-file-name - v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + v (if (string-prefix-p "~" localname) localname (tramp-run-real-handler #'expand-file-name (list localname))))))) @@ -765,10 +769,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (widen) (tramp-message vec 10 "\n%s" (buffer-string)) (goto-char (point-min)) - (while (and (not (eobp)) (not (looking-at-p "^REVISION:"))) + (while (and (not (eobp)) (not (looking-at-p (rx bol "REVISION:")))) (forward-line) (delete-region (point-min) (point))) - (while (and (not (eobp)) (looking-at-p "^.+:.+")) + (while (and (not (eobp)) (looking-at-p (rx bol (+ nonl) ":" (+ nonl)))) (forward-line)) (delete-region (point) (point-max)) (throw 'tramp-action 'ok)))) @@ -882,29 +886,30 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (while (not (eobp)) (cond ((looking-at - (concat - "Size:\\s-+\\([[:digit:]]+\\)\\s-+" - "Blocks:\\s-+[[:digit:]]+\\s-+\\(\\w+\\)")) + (rx "Size:" (+ space) (group (+ digit)) (+ space) + "Blocks:" (+ space) (+ digit) (+ space) (group (+ wordchar)))) (setq size (string-to-number (match-string 1)) id (if (string-equal "directory" (match-string 2)) t (if (string-equal "symbolic" (match-string 2)) "")))) ((looking-at - "Inode:\\s-+\\([[:digit:]]+\\)\\s-+Links:\\s-+\\([[:digit:]]+\\)") + (rx "Inode:" (+ space) (group (+ digit)) (+ space) + "Links:" (+ space) (group (+ digit)))) (setq inode (string-to-number (match-string 1)) link (string-to-number (match-string 2)))) ((looking-at - (concat - "Access:\\s-+([[:digit:]]+/\\(\\S-+\\))\\s-+" - "Uid:\\s-+\\([[:digit:]]+\\)\\s-+" - "Gid:\\s-+\\([[:digit:]]+\\)")) + (rx "Access:" (+ space) + "(" (+ digit) "/" (group (+ (not space))) ")" (+ space) + "Uid:" (+ space) (group (+ digit)) (+ whitespace) + "Gid:" (+ space) (group (+ digit)))) (setq mode (match-string 1) uid (match-string 2) gid (match-string 3))) ((looking-at - (concat - "Access:\\s-+" - "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+" - "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)")) + (rx "Access:" (+ space) + (group (+ digit)) "-" (group (+ digit)) "-" + (group (+ digit)) (+ space) + (group (+ digit)) ":" (group (+ digit)) ":" + (group (+ digit)))) (setq atime (encode-time (string-to-number (match-string 6)) ;; sec @@ -914,10 +919,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-to-number (match-string 2)) ;; month (string-to-number (match-string 1))))) ;; year ((looking-at - (concat - "Modify:\\s-+" - "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+" - "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)")) + (rx "Modify:" (+ space) + (group (+ digit)) "-" (group (+ digit)) "-" + (group (+ digit)) (+ space) + (group (+ digit)) ":" (group (+ digit)) ":" + (group (+ digit)))) (setq mtime (encode-time (string-to-number (match-string 6)) ;; sec @@ -927,10 +933,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-to-number (match-string 2)) ;; month (string-to-number (match-string 1))))) ;; year ((looking-at - (concat - "Change:\\s-+" - "\\([[:digit:]]+\\)-\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\s-+" - "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)")) + (rx "Change:" (+ space) + (group (+ digit)) "-" (group (+ digit)) "-" + (group (+ digit)) (+ space) + (group (+ digit)) ":" (group (+ digit)) ":" + (group (+ digit)))) (setq ctime (encode-time (string-to-number (match-string 6)) ;; sec @@ -948,7 +955,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (format "readlink %s" (tramp-smb-shell-quote-localname vec)))) (goto-char (point-min)) - (and (looking-at ".+ -> \\(.+\\)") + (and (looking-at (rx (+ nonl) " -> " (group (+ nonl)))) (setq id (match-string 1)))) ;; Return the result. @@ -1003,14 +1010,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (goto-char (point-min)) (forward-line) (when (looking-at - (concat "[[:space:]]*\\([[:digit:]]+\\)" - " blocks of size \\([[:digit:]]+\\)" - "\\. \\([[:digit:]]+\\) blocks available")) + (rx (* space) (group (+ digit)) + " blocks of size " (group (+ digit)) + ". " (group (+ digit)) " blocks available")) (setq blocksize (string-to-number (match-string 2)) total (* blocksize (string-to-number (match-string 1))) avail (* blocksize (string-to-number (match-string 3))))) (forward-line) - (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)") + (when (looking-at (rx "Total number of bytes: " (group (+ digit)))) ;; The used number of bytes is not part of the result. ;; As side effect, we store it as file property. (tramp-set-file-property @@ -1061,11 +1068,11 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (/ (tramp-get-file-property v localname "used-bytes" 0) 1024)))) (when wildcard - (string-match "\\." base) + (string-match (rx ".") base) (setq base (replace-match "\\\\." nil nil base)) - (string-match "\\*" base) + (string-match (rx "*") base) (setq base (replace-match ".*" nil nil base)) - (string-match "\\?" base) + (string-match (rx "?") base) (setq base (replace-match ".?" nil nil base))) ;; Filter entries. @@ -1076,7 +1083,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Check for matching entries. (mapcar (lambda (x) - (when (string-match-p (format "^%s" base) (nth 0 x)) x)) + (when (string-match-p (rx bol (literal base)) (nth 0 x)) + x)) entries) ;; We just need the only and only entry FILENAME. (list (assoc base entries))))) @@ -1486,7 +1494,7 @@ component is used as the target of the symlink." ;; the function. No error is propagated outside, ;; due to the `ignore-errors' closure. (unless - (tramp-search-regexp "tramp_exit_status [[:digit:]]+") + (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) (tramp-error v 'file-error "Couldn't find exit status of `%s'" @@ -1577,7 +1585,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." filename (with-parsed-tramp-file-name filename nil ;; Ignore in LOCALNAME everything before "//". - (when (and (stringp localname) (string-match ".+?/\\(/\\|~\\)" localname)) + (when (and (stringp localname) + (string-match (rx (+? nonl) "/" (group (| "/" "~"))) localname)) (setq filename (concat (file-remote-p filename) (replace-match "\\1" nil nil localname))))) @@ -1623,7 +1632,8 @@ VEC or USER, or if there is no home directory, return nil." "Return the share name of LOCALNAME." (save-match-data (let ((localname (tramp-file-name-unquote-localname vec))) - (when (string-match "^/?\\([^/]+\\)/" localname) + (when (string-match + (rx bol (? "/") (group (+ (not (any "/")))) "/") localname) (match-string 1 localname))))) (defun tramp-smb-get-localname (vec) @@ -1633,7 +1643,8 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (let ((localname (tramp-file-name-unquote-localname vec))) (setq localname - (if (string-match "^/?[^/]+\\(/.*\\)" localname) + (if (string-match + (rx bol (? "/") (+ (not (any "/"))) (group "/" (* nonl))) localname) ;; There is a share, separated by "/". (if (not (tramp-smb-get-cifs-capabilities vec)) (mapconcat @@ -1641,16 +1652,17 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"." (match-string 1 localname) "") (match-string 1 localname)) ;; There is just a share. - (if (string-match "^/?\\([^/]+\\)$" localname) + (if (string-match + (rx bol (? "/") (group (+ (not (any "/")))) eol) localname) (match-string 1 localname) ""))) ;; Sometimes we have discarded `substitute-in-file-name'. - (when (string-match "\\(\\$\\$\\)\\(/\\|$\\)" localname) + (when (string-match (rx (group "$$") (group (| "/" eol))) localname) (setq localname (replace-match "$" nil nil localname 1))) ;; A trailing space is not supported. - (when (string-match-p " $" localname) + (when (string-match-p (rx " " eol) localname) (tramp-error vec 'file-error "Invalid file name %s" (tramp-make-tramp-file-name vec localname))) @@ -1769,7 +1781,8 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (if (not share) ;; Read share entries. - (when (string-match "^Disk|\\([^|]+\\)|" line) + (when (string-match + (rx bol "Disk|" (group (+ (not (any "|")))) "|") line) (setq localname (match-string 1 line) mode "dr-xr-xr-x" size 0)) @@ -1778,14 +1791,17 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-block nil ;; year. - (if (string-match "\\([[:digit:]]+\\)$" line) + (if (string-match (rx (group (+ digit)) eol) line) (setq year (string-to-number (match-string 1 line)) line (substring line 0 -5)) (cl-return)) ;; time. (if (string-match - "\\([[:digit:]]+\\):\\([[:digit:]]+\\):\\([[:digit:]]+\\)$" line) + (rx (group (+ digit)) ":" + (group (+ digit)) ":" + (group (+ digit)) eol) + line) (setq hour (string-to-number (match-string 1 line)) min (string-to-number (match-string 2 line)) sec (string-to-number (match-string 3 line)) @@ -1793,28 +1809,28 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-return)) ;; day. - (if (string-match "\\([[:digit:]]+\\)$" line) + (if (string-match (rx (group (+ digit)) eol) line) (setq day (string-to-number (match-string 1 line)) line (substring line 0 -3)) (cl-return)) ;; month. - (if (string-match "\\(\\w+\\)$" line) + (if (string-match (rx (group (+ wordchar)) eol) line) (setq month (match-string 1 line) line (substring line 0 -4)) (cl-return)) ;; weekday. - (if (string-match-p "\\(\\w+\\)$" line) + (if (string-match-p (rx (group (+ wordchar)) eol) line) (setq line (substring line 0 -5)) (cl-return)) ;; size. - (if (string-match "\\([[:digit:]]+\\)$" line) + (if (string-match (rx (group (+ digit)) eol) line) (let ((length (- (max 10 (1+ (length (match-string 1 line))))))) (setq size (string-to-number (match-string 1 line))) (when (string-match - "\\([ACDEHNORrsSTV]+\\)" (substring line length)) + (rx (+ (any "ACDEHNORSTVrs"))) (substring line length)) (setq length (+ length (match-end 0)))) (setq line (substring line 0 length))) (cl-return)) @@ -1823,7 +1839,7 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." ;; NONINDEXED, NORMAL, OFFLINE, READONLY, ;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID. - (if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line) + (if (string-match (rx (? (group (+ (any "ACDEHNORSTVrs")))) eol) line) (setq mode (or (match-string 1 line) "") mode (format @@ -1838,7 +1854,11 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (cl-return)) ;; localname. - (if (string-match "^\\s-+\\(\\S-\\(.*\\S-\\)?\\)\\s-*$" line) + (if (string-match + (rx bol (+ space) + (group (not space) (? (group (* nonl) (not space)))) + (* space) eol) + line) (setq localname (match-string 1 line)) (cl-return)))) @@ -1877,7 +1897,8 @@ are listed. Result is the list (LOCALNAME MODE SIZE MTIME)." (member "pathnames" (split-string - (buffer-substring (point) (line-end-position)) nil 'omit))))))))) + (buffer-substring (point) (line-end-position)) + nil 'omit))))))))) (defun tramp-smb-get-stat-capability (vec) "Check whether the SMB server supports the `stat' command." @@ -1927,7 +1948,7 @@ If ARGUMENT is non-nil, use it as argument for (setq tramp-smb-version (shell-command-to-string command)) (tramp-message vec 6 command) (tramp-message vec 6 "\n%s" tramp-smb-version) - (if (string-match "[ \t\n\r]+\\'" tramp-smb-version) + (if (string-match (rx (+ (any " \t\n\r")) eos) tramp-smb-version) (setq tramp-smb-version (replace-match "" nil nil tramp-smb-version)))) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 4e3b94277be..31720a605ec 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -215,7 +215,7 @@ arguments to pass to the OPERATION." (progn ;; Read the expression. (goto-char (point-min)) - (buffer-substring (point) (line-end-position))) + (buffer-substring (point) (line-end-position))) ":" 'omit)))) ;; The equivalent to `exec-directory'. `(,(tramp-file-local-name (expand-file-name default-directory))))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 643b5f35c0f..893afcdbbee 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -49,7 +49,8 @@ (tramp-password-previous-hop t))) (add-to-list 'tramp-default-user-alist - `("\\`sudoedit\\'" nil ,tramp-root-id-string)) + `(,(rx bos (literal tramp-sudoedit-method) eos) + nil ,tramp-root-id-string)) (tramp-set-completion-function tramp-sudoedit-method tramp-completion-function-alist-su)) @@ -374,7 +375,9 @@ the result will be a local, non-Tramp, file name." (setq localname "~")) (unless (file-name-absolute-p localname) (setq localname (format "~%s/%s" user localname))) - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -383,11 +386,11 @@ the result will be a local, non-Tramp, file name." (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../"). (tramp-make-tramp-file-name - v (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + v (if (string-prefix-p "~" localname) localname (tramp-run-real-handler #'expand-file-name (list localname)))))) @@ -470,7 +473,7 @@ the result will be a local, non-Tramp, file name." (delq nil (mapcar - (lambda (l) (and (not (string-match-p "^[[:space:]]*$" l)) l)) + (lambda (l) (and (not (string-match-p (rx bol (* space) eol) l)) l)) (split-string (tramp-get-buffer-string (tramp-get-connection-buffer v)) "\n" 'omit)))))))) @@ -504,15 +507,17 @@ the result will be a local, non-Tramp, file name." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-selinux-context" (let ((context '(nil nil nil nil)) - (regexp (concat "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\):" - "\\([[:alnum:]_]+\\):" "\\([[:alnum:]_]+\\)"))) + (regexp (rx (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum))) ":" + (group (+ (any "_" alnum)))))) (when (and (tramp-sudoedit-remote-selinux-p v) (tramp-sudoedit-send-command v "ls" "-d" "-Z" (tramp-compat-file-name-unquote localname))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (when (re-search-forward regexp (line-end-position) t) + (when (re-search-forward regexp (line-end-position) t) (setq context (list (match-string 1) (match-string 2) (match-string 3) (match-string 4)))))) ;; Return the context. @@ -530,9 +535,9 @@ the result will be a local, non-Tramp, file name." (goto-char (point-min)) (forward-line) (when (looking-at - (concat "[[:space:]]*\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)" - "[[:space:]]+\\([[:digit:]]+\\)")) + (rx (* space) (group (+ digit)) + (+ space) (group (+ digit)) + (+ space) (group (+ digit)))) (list (string-to-number (match-string 1)) ;; The second value is the used size. We need the ;; free size. @@ -841,7 +846,7 @@ In case there is no valid Lisp expression, it raises an error." (condition-case nil (prog1 (read (current-buffer)) ;; Error handling. - (when (re-search-forward "\\S-" (line-end-position) t) + (when (re-search-forward (rx (not space)) (line-end-position) t) (error nil))) (error (tramp-error vec 'file-error @@ -855,7 +860,7 @@ In case there is no valid Lisp expression, it raises an error." (tramp-message vec 6 "\n%s" (buffer-string)) (goto-char (point-max)) ;(delete-blank-lines) - (while (looking-back "[ \t\n]+" nil 'greedy) + (while (looking-back (rx (+ (any " \t\n"))) nil 'greedy) (delete-region (match-beginning 0) (point))) (when (> (point-max) (point-min)) (substring-no-properties (buffer-string)))))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 238ec50c40f..bb6eeaa7417 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -64,7 +64,8 @@ (declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) -;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ELPA package. +;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU +;; ELPA package. ;;;###autoload (when (featurep 'tramp-compat) ;;;###autoload (load "tramp-compat" 'noerror 'nomessage)) @@ -514,10 +515,10 @@ interpreted as a regular expression which always matches." ;; . (defcustom tramp-restricted-shell-hosts-alist (when (and (eq system-type 'windows-nt) - (not (string-match-p "sh$" tramp-encoding-shell))) - (list (format "\\`\\(%s\\|%s\\)\\'" - (regexp-quote (downcase tramp-system-name)) - (regexp-quote (upcase tramp-system-name))))) + (not (string-match-p (rx "sh" eol) tramp-encoding-shell))) + (list (rx bos (group (| (literal (downcase tramp-system-name)) + (literal (upcase tramp-system-name)))) + eos))) "List of hosts, which run a restricted shell. This is a list of regular expressions, which denote hosts running a restricted shell like \"rbash\". Those hosts can be used as @@ -528,12 +529,11 @@ host runs a restricted shell, it shall be added to this list, too." ;;;###tramp-autoload (defcustom tramp-local-host-regexp - (concat - "\\`" - (regexp-opt - `("localhost" "localhost4" "localhost6" ,tramp-system-name "127.0.0.1" "::1") - t) - "\\'") + (rx bos + (regexp (regexp-opt + `("localhost" "localhost4" "localhost6" + ,tramp-system-name "127.0.0.1" "::1"))) + eos) "Host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." :version "29.1" @@ -580,8 +580,9 @@ followed by an equal number of backspaces to erase them will usually suffice.") (defconst tramp-echoed-echo-mark-regexp - (format "%s\\(\b\\( \b\\)?\\)\\{%d\\}" - tramp-echo-mark-marker tramp-echo-mark-marker-length) + (rx-to-string + `(: ,tramp-echo-mark-marker + (= ,tramp-echo-mark-marker-length (group "\b" (? " \b"))))) "Regexp which matches `tramp-echo-mark' as it gets echoed by \ the remote shell.") @@ -598,7 +599,7 @@ if you need to change this." :type 'string) (defcustom tramp-login-prompt-regexp - ".*\\(user\\|login\\)\\( .*\\)?: *" + (rx (* nonl) (group (| "user" "login")) (? (group " " (* nonl))) ":" (* " ")) "Regexp matching login-like prompts. The regexp should match at end of buffer. @@ -610,8 +611,11 @@ Sometimes the prompt is reported to look like \"login as:\"." ;; displayed at the beginning of the line (and Zsh uses it). ;; Allow also [] style prompts. They can appear only during ;; connection initialization; Tramp redefines the prompt afterwards. - (concat "\\(?:^\\|\r\\)" - "[^]#$%>\n]*#?[]#$%>] *\\(\e\\[[[:digit:];]*[[:alpha:]] *\\)*") + (rx (| bol "\r") + (* (not (any "\n#$%>]"))) + (? "#") (any "#$%>]") (* space) + ;; Escape characters. + (* "[" (* (any ";" digit)) alpha (* space))) "Regexp to match prompts from remote shell. Normally, Tramp expects you to configure `shell-prompt-pattern' correctly, but sometimes it happens that you are connecting to a @@ -626,7 +630,9 @@ This regexp must match both `tramp-initial-end-of-output' and :type 'regexp) (defcustom tramp-password-prompt-regexp - (format "^.*\\(%s\\).*:\^@? *" (regexp-opt password-word-equivalents)) + (rx bol (* nonl) + (group (regexp (regexp-opt password-word-equivalents))) + (* nonl) ":" (? "\^@") (* space)) "Regexp matching password-like prompts. The regexp should match at end of buffer. @@ -640,36 +646,26 @@ The `sudo' program appears to insert a `^@' character into the prompt." :type 'regexp) (defcustom tramp-wrong-passwd-regexp - (concat "^.*" - ;; These strings should be on the last line - (regexp-opt '("Permission denied" - "Login incorrect" - "Login Incorrect" - "Connection refused" - "Connection closed" - "Timeout, server not responding." - "Sorry, try again." - "Name or service not known" - "Host key verification failed." - "No supported authentication methods left to try!") - t) - ".*" - "\\|" - "^.*\\(" - ;; Here comes a list of regexes, separated by \\| - "Received signal [[:digit:]]+" - "\\).*") + (rx bol (* nonl) + (| "Permission denied" + "Login [Ii]ncorrect" + "Connection refused" + "Connection closed" + "Timeout, server not responding." + "Sorry, try again." + "Name or service not known" + "Host key verification failed." + "No supported authentication methods left to try!" + (: "Received signal " (+ digit))) + (* nonl)) "Regexp matching a `login failed' message. The regexp should match at end of buffer." :type 'regexp) (defcustom tramp-yesno-prompt-regexp - (concat - (regexp-opt - '("Are you sure you want to continue connecting (yes/no)?" - "Are you sure you want to continue connecting (yes/no/[fingerprint])?") - t) - "\\s-*") + (rx "Are you sure you want to continue connecting (yes/no" + (? "/[fingerprint]") ")?" + (* space)) "Regular expression matching all yes/no queries which need to be confirmed. The confirmation should be done with yes or no. The regexp should match at end of buffer. @@ -677,11 +673,9 @@ See also `tramp-yn-prompt-regexp'." :type 'regexp) (defcustom tramp-yn-prompt-regexp - (concat - (regexp-opt '("Store key in cache? (y/n)" - "Update cached key? (y/n, Return cancels connection)") - t) - "\\s-*") + (rx (| "Store key in cache? (y/n)" + "Update cached key? (y/n, Return cancels connection)") + (* space)) "Regular expression matching all y/n queries which need to be confirmed. The confirmation should be done with y or n. The regexp should match at end of buffer. @@ -698,11 +692,10 @@ files conditionalize this setup based on the TERM environment variable." :type 'string) (defcustom tramp-terminal-prompt-regexp - (concat "\\(" - "TERM = (.*)" - "\\|" - "Terminal type\\? \\[.*\\]" - "\\)\\s-*") + (rx (group + (| (: "TERM = (" (* nonl) ")") + (: "Terminal type? [" (* nonl) "]"))) + (* space)) "Regular expression matching all terminal setting prompts. The regexp should match at end of buffer. The answer will be provided by `tramp-action-terminal', which see." @@ -713,7 +706,7 @@ The answer will be provided by `tramp-action-terminal', which see." ;; "-no-antispoof". However, since we don't know which PuTTY ;; version is installed, we must react interactively. (defcustom tramp-antispoof-regexp - (regexp-quote "Access granted. Press Return to begin session. ") + (rx (literal "Access granted. Press Return to begin session. ")) "Regular expression matching plink's anti-spoofing message. The regexp should match at end of buffer." :version "27.1" @@ -723,42 +716,42 @@ The regexp should match at end of buffer." ;; with their finger. We must tell it to the user. ;; Added in OpenSSH 8.2. I've tested it with yubikey. (defcustom tramp-security-key-confirm-regexp - "^\r*Confirm user presence for key .*[\r\n]*" + (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) "Regular expression matching security key confirmation message. The regexp should match at end of buffer." :version "28.1" :type 'regexp) (defcustom tramp-security-key-confirmed-regexp - "^\r*User presence confirmed[\r\n]*" + (rx bol (* "\r") "User presence confirmed" (* (any "\r\n"))) "Regular expression matching security key confirmation message. The regexp should match at end of buffer." :version "28.1" :type 'regexp) (defcustom tramp-security-key-timeout-regexp - "^\r*sign_and_send_pubkey: signing failed for .*[\r\n]*" + (rx bol (* "\r") "sign_and_send_pubkey: signing failed for " + (* nonl) (* (any "\r\n"))) "Regular expression matching security key timeout message. The regexp should match at end of buffer." :version "28.1" :type 'regexp) (defcustom tramp-operation-not-permitted-regexp - (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*" - (regexp-opt '("Operation not permitted") t)) + (rx (| (: "preserving times" (* nonl)) "set mode") ":" (* space) + "Operation not permitted") "Regular expression matching keep-date problems in (s)cp operations. Copying has been performed successfully already, so this message can be ignored safely." :type 'regexp) (defcustom tramp-copy-failed-regexp - (concat "\\(.+: " - (regexp-opt '("Permission denied" - "not a regular file" - "is a directory" - "No such file or directory") - t) - "\\)\\s-*") + (rx (+ nonl) ": " + (| "No such file or directory" + "Permission denied" + "is a directory" + "not a regular file") + (* space)) "Regular expression matching copy problems in (s)cp operations." :type 'regexp) @@ -809,6 +802,23 @@ Customize. See also `tramp-change-syntax'." :initialize #'custom-initialize-default :set #'tramp-set-syntax) +(defvar tramp-prefix-format) +(defvar tramp-prefix-regexp) +(defvar tramp-method-regexp) +(defvar tramp-postfix-method-format) +(defvar tramp-postfix-method-regexp) +(defvar tramp-prefix-ipv6-format) +(defvar tramp-prefix-ipv6-regexp) +(defvar tramp-postfix-ipv6-format) +(defvar tramp-postfix-ipv6-regexp) +(defvar tramp-postfix-host-format) +(defvar tramp-postfix-host-regexp) +(defvar tramp-remote-file-name-spec-regexp) +(defvar tramp-file-name-structure) +(defvar tramp-file-name-regexp) +(defvar tramp-completion-method-regexp) +(defvar tramp-completion-file-name-regexp) + (defun tramp-set-syntax (symbol value) "Set SYMBOL to value VALUE. Used in user option `tramp-syntax'. There are further variables @@ -822,24 +832,25 @@ to be set, depending on VALUE." ;; Set the value: (set-default symbol value) ;; Reset the depending variables. - (with-no-warnings - (setq tramp-prefix-format (tramp-build-prefix-format) - tramp-prefix-regexp (tramp-build-prefix-regexp) - tramp-method-regexp (tramp-build-method-regexp) - tramp-postfix-method-format (tramp-build-postfix-method-format) - tramp-postfix-method-regexp (tramp-build-postfix-method-regexp) - tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format) - tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp) - tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format) - tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp) - tramp-postfix-host-format (tramp-build-postfix-host-format) - tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) - tramp-remote-file-name-spec-regexp - (tramp-build-remote-file-name-spec-regexp) - tramp-file-name-structure (tramp-build-file-name-structure) - tramp-file-name-regexp (tramp-build-file-name-regexp) - tramp-completion-file-name-regexp - (tramp-build-completion-file-name-regexp))) + (setq tramp-prefix-format (tramp-build-prefix-format) + tramp-prefix-regexp (tramp-build-prefix-regexp) + tramp-method-regexp (tramp-build-method-regexp) + tramp-postfix-method-format (tramp-build-postfix-method-format) + tramp-postfix-method-regexp (tramp-build-postfix-method-regexp) + tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format) + tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp) + tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format) + tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp) + tramp-postfix-host-format (tramp-build-postfix-host-format) + tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) + tramp-remote-file-name-spec-regexp + (tramp-build-remote-file-name-spec-regexp) + tramp-file-name-structure (tramp-build-file-name-structure) + tramp-file-name-regexp (tramp-build-file-name-regexp) + tramp-completion-method-regexp + (tramp-build-completion-method-regexp) + tramp-completion-file-name-regexp + (tramp-build-completion-file-name-regexp)) ;; Rearrange file name handlers. (tramp-register-file-name-handlers)) @@ -872,30 +883,31 @@ Raise an error if it is invalid." "Return `tramp-prefix-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-prefix-format-alist)) -(defvar tramp-prefix-format nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-prefix-format nil ; Initialized when defining `tramp-syntax'! "String matching the very beginning of Tramp file names. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-regexp () "Return `tramp-prefix-regexp'." - (concat "^" (regexp-quote tramp-prefix-format))) + (rx bol (literal (tramp-build-prefix-format)))) -(defvar tramp-prefix-regexp nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-prefix-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching the very beginning of Tramp file names. Should always start with \"^\". Derived from `tramp-prefix-format'.") (defconst tramp-method-regexp-alist - '((default . "[[:alnum:]-]+") + `((default . ,(rx (| (literal tramp-default-method-marker) (>= 2 alnum)))) (simplified . "") - (separate . "[[:alnum:]-]*")) + (separate + . ,(rx (? (| (literal tramp-default-method-marker) (>= 2 alnum)))))) "Alist mapping Tramp syntax to regexps matching methods identifiers.") (defun tramp-build-method-regexp () "Return `tramp-method-regexp' according to `tramp-syntax'." (tramp-lookup-syntax tramp-method-regexp-alist)) -(defvar tramp-method-regexp nil ;Initialized when defining `tramp-syntax'! - "Regexp matching methods identifiers. +(defvar tramp-method-regexp nil ; Initialized when defining `tramp-syntax'! + "Regexp matching method identifiers. The `ftp' syntax does not support methods.") (defconst tramp-postfix-method-format-alist @@ -908,47 +920,47 @@ The `ftp' syntax does not support methods.") "Return `tramp-postfix-method-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-postfix-method-format-alist)) -(defvar tramp-postfix-method-format nil ;Init'd when defining `tramp-syntax'! +(defvar tramp-postfix-method-format nil ; Init'd when defining `tramp-syntax'! "String matching delimiter between method and user or host names. The `ftp' syntax does not support methods. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-method-regexp () "Return `tramp-postfix-method-regexp'." - (regexp-quote tramp-postfix-method-format)) + (rx (literal (tramp-build-postfix-method-format)))) -(defvar tramp-postfix-method-regexp nil ;Init'd when defining `tramp-syntax'! +(defvar tramp-postfix-method-regexp nil ; Init'd when defining `tramp-syntax'! "Regexp matching delimiter between method and user or host names. Derived from `tramp-postfix-method-format'.") -(defconst tramp-user-regexp "[^/|: \t]+" +(defconst tramp-user-regexp (rx (+ (not (any "/:|" space)))) "Regexp matching user names.") (defconst tramp-prefix-domain-format "%" "String matching delimiter between user and domain names.") -(defconst tramp-prefix-domain-regexp (regexp-quote tramp-prefix-domain-format) +(defconst tramp-prefix-domain-regexp (rx (literal tramp-prefix-domain-format)) "Regexp matching delimiter between user and domain names. Derived from `tramp-prefix-domain-format'.") -(defconst tramp-domain-regexp "[[:alnum:]_.-]+" +(defconst tramp-domain-regexp (rx (+ (any "._-" alnum))) "Regexp matching domain names.") (defconst tramp-user-with-domain-regexp - (concat "\\(" tramp-user-regexp "\\)" - tramp-prefix-domain-regexp - "\\(" tramp-domain-regexp "\\)") + (rx (group (regexp tramp-user-regexp)) + (regexp tramp-prefix-domain-regexp) + (group (regexp tramp-domain-regexp))) "Regexp matching user names with domain names.") (defconst tramp-postfix-user-format "@" "String matching delimiter between user and host names. Used in `tramp-make-tramp-file-name'.") -(defconst tramp-postfix-user-regexp (regexp-quote tramp-postfix-user-format) +(defconst tramp-postfix-user-regexp (rx (literal tramp-postfix-user-format)) "Regexp matching delimiter between user and host names. Derived from `tramp-postfix-user-format'.") -(defconst tramp-host-regexp "[[:alnum:]_.%-]+" +(defconst tramp-host-regexp (rx (+ (any "%._-" alnum))) "Regexp matching host names.") (defconst tramp-prefix-ipv6-format-alist @@ -961,22 +973,22 @@ Derived from `tramp-postfix-user-format'.") "Return `tramp-prefix-ipv6-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-prefix-ipv6-format-alist)) -(defvar tramp-prefix-ipv6-format nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-prefix-ipv6-format nil ; Initialized when defining `tramp-syntax'! "String matching left hand side of IPv6 addresses. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-prefix-ipv6-regexp () "Return `tramp-prefix-ipv6-regexp'." - (regexp-quote tramp-prefix-ipv6-format)) + (rx (literal tramp-prefix-ipv6-format))) -(defvar tramp-prefix-ipv6-regexp nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-prefix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching left hand side of IPv6 addresses. Derived from `tramp-prefix-ipv6-format'.") ;; The following regexp is a bit sloppy. But it shall serve our ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in ;; "::ffff:192.168.0.1". -(defconst tramp-ipv6-regexp "\\(?:[[:alnum:]]*:\\)+[[:alnum:].]+" +(defconst tramp-ipv6-regexp (rx (+ (* alnum) ":") (* (any "." alnum))) "Regexp matching IPv6 addresses.") (defconst tramp-postfix-ipv6-format-alist @@ -989,38 +1001,38 @@ Derived from `tramp-prefix-ipv6-format'.") "Return `tramp-postfix-ipv6-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-postfix-ipv6-format-alist)) -(defvar tramp-postfix-ipv6-format nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-postfix-ipv6-format nil ; Initialized when defining `tramp-syntax'! "String matching right hand side of IPv6 addresses. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-ipv6-regexp () "Return `tramp-postfix-ipv6-regexp'." - (regexp-quote tramp-postfix-ipv6-format)) + (rx (literal tramp-postfix-ipv6-format))) -(defvar tramp-postfix-ipv6-regexp nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-postfix-ipv6-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching right hand side of IPv6 addresses. Derived from `tramp-postfix-ipv6-format'.") (defconst tramp-prefix-port-format "#" "String matching delimiter between host names and port numbers.") -(defconst tramp-prefix-port-regexp (regexp-quote tramp-prefix-port-format) +(defconst tramp-prefix-port-regexp (rx (literal tramp-prefix-port-format)) "Regexp matching delimiter between host names and port numbers. Derived from `tramp-prefix-port-format'.") -(defconst tramp-port-regexp "[[:digit:]]+" +(defconst tramp-port-regexp (rx (+ digit)) "Regexp matching port numbers.") (defconst tramp-host-with-port-regexp - (concat "\\(" tramp-host-regexp "\\)" - tramp-prefix-port-regexp - "\\(" tramp-port-regexp "\\)") + (rx (group (regexp tramp-host-regexp)) + (regexp tramp-prefix-port-regexp) + (group (regexp tramp-port-regexp))) "Regexp matching host names with port numbers.") (defconst tramp-postfix-hop-format "|" "String matching delimiter after ad-hoc hop definitions.") -(defconst tramp-postfix-hop-regexp (regexp-quote tramp-postfix-hop-format) +(defconst tramp-postfix-hop-regexp (rx (literal tramp-postfix-hop-format)) "Regexp matching delimiter after ad-hoc hop definitions. Derived from `tramp-postfix-hop-format'.") @@ -1034,19 +1046,19 @@ Derived from `tramp-postfix-hop-format'.") "Return `tramp-postfix-host-format' according to `tramp-syntax'." (tramp-lookup-syntax tramp-postfix-host-format-alist)) -(defvar tramp-postfix-host-format nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-postfix-host-format nil ; Initialized when defining `tramp-syntax'! "String matching delimiter between host names and localnames. Used in `tramp-make-tramp-file-name'.") (defun tramp-build-postfix-host-regexp () "Return `tramp-postfix-host-regexp'." - (regexp-quote tramp-postfix-host-format)) + (rx (literal tramp-postfix-host-format))) -(defvar tramp-postfix-host-regexp nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-postfix-host-regexp nil ; Initialized when defining `tramp-syntax'! "Regexp matching delimiter between host names and localnames. Derived from `tramp-postfix-host-format'.") -(defconst tramp-localname-regexp "[^\n\r]*\\'" +(defconst tramp-localname-regexp (rx (* (not (any "\r\n"))) eos) "Regexp matching localnames.") (defconst tramp-unknown-id-string "UNKNOWN" @@ -1067,16 +1079,20 @@ Derived from `tramp-postfix-host-format'.") (defun tramp-build-remote-file-name-spec-regexp () "Construct a regexp matching a Tramp file name for a Tramp syntax. It is expected, that `tramp-syntax' has the proper value." - (concat - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" - "\\(" "\\(?:" tramp-host-regexp "\\|" - tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?" - tramp-postfix-ipv6-regexp "\\)" - "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")) + (rx ;; Method. + (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp) + ;; Optional user. + (? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp)) + ;; Optional host. + (? (group (| (regexp tramp-host-regexp) + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp)) + (regexp tramp-postfix-ipv6-regexp))) + ;; Optional port. + (? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp)))))) (defvar tramp-remote-file-name-spec-regexp - nil ;Initialized when defining `tramp-syntax'! + nil ; Initialized when defining `tramp-syntax'! "Regular expression matching a Tramp file name between prefix and postfix.") (defun tramp-build-file-name-structure () @@ -1084,15 +1100,15 @@ It is expected, that `tramp-syntax' has the proper value." It is expected, that `tramp-syntax' has the proper value. See `tramp-file-name-structure'." (list - (concat - tramp-prefix-regexp - "\\(" "\\(?:" tramp-remote-file-name-spec-regexp - tramp-postfix-hop-regexp "\\)+" "\\)?" - tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp - "\\(" tramp-localname-regexp "\\)") + (rx (regexp tramp-prefix-regexp) + (? (group (+ (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)))) + (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-host-regexp) + (group (regexp tramp-localname-regexp))) 5 6 7 8 1)) -(defvar tramp-file-name-structure nil ;Initialized when defining `tramp-syntax'! +(defvar tramp-file-name-structure nil ; Initialized when defining `tramp-syntax'! "List detailing the Tramp file name structure. This is a list of six elements (REGEXP METHOD USER HOST FILE HOP). @@ -1117,7 +1133,8 @@ See also `tramp-file-name-regexp'.") (car tramp-file-name-structure)) ;;;###autoload -(defconst tramp-initial-file-name-regexp "\\`/[^/:]+:[^/:]*:" +(defconst tramp-initial-file-name-regexp + (rx bos "/" (+ (not (any "/:"))) ":" (* (not (any "/:"))) ":") "Value for `tramp-file-name-regexp' for autoload. It must match the initial `tramp-syntax' settings.") @@ -1134,78 +1151,56 @@ initial value is overwritten by the car of `tramp-file-name-structure'.") :version "27.1" :type '(choice (const nil) regexp)) -(defconst tramp-completion-file-name-regexp-default - (concat - "\\`" - ;; `file-name-completion' uses absolute paths for matching. This - ;; means that on W32 systems, something like "/ssh:host:~/path" - ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'. - (when (eq system-type 'windows-nt) - "\\(?:[[:alpha:]]:\\)?") - "/\\(" - ;; Optional multi hop. - "\\([^/|:]+:[^/|:]*|\\)*" - ;; Last hop. - (if (memq system-type '(cygwin windows-nt)) - ;; The method is either "-", or at least two characters. - "\\(-\\|[^/|:]\\{2,\\}\\)" - ;; At least one character for method. - "[^/|:]+") - ;; Method separator, user name and host name. - "\\(:[^/|:]*\\)?" - "\\)?\\'") - "Value for `tramp-completion-file-name-regexp' for default remoting. -See `tramp-file-name-structure' for more explanations. - -On W32 systems, the volume letter must be ignored.") - -(defconst tramp-completion-file-name-regexp-simplified - (concat - "\\`" - ;; Allow the volume letter at the beginning of the path. See the - ;; comment in `tramp-completion-file-name-regexp-default' for more - ;; details. - (when (eq system-type 'windows-nt) - "\\(?:[[:alpha:]]:\\)?") - "/\\(" - ;; Optional multi hop. - "\\([^/|:]*|\\)*" - ;; Last hop. - (if (memq system-type '(cygwin windows-nt)) - ;; At least two characters. - "[^/|:]\\{2,\\}" - ;; At least one character. - "[^/|:]+") - "\\)?\\'") - "Value for `tramp-completion-file-name-regexp' for simplified style remoting. -See `tramp-file-name-structure' for more explanations. - -On W32 systems, the volume letter must be ignored.") - -(defconst tramp-completion-file-name-regexp-separate - (concat - "\\`" - ;; Allow the volume letter at the beginning of the path. See the - ;; comment in `tramp-completion-file-name-regexp-default' for more - ;; details. - (when (eq system-type 'windows-nt) - "\\(?:[[:alpha:]]:\\)?") - "/\\(\\[[^]]*\\)?\\'") - "Value for `tramp-completion-file-name-regexp' for separate remoting. -See `tramp-file-name-structure' for more explanations.") - -(defconst tramp-completion-file-name-regexp-alist - `((default . ,tramp-completion-file-name-regexp-default) - (simplified . ,tramp-completion-file-name-regexp-simplified) - (separate . ,tramp-completion-file-name-regexp-separate)) - "Alist mapping incomplete Tramp file names.") +(defconst tramp-volume-letter-regexp + (if (eq system-type 'windows-nt) + (rx bos alpha ":") "") + "Volume letter on MS Windows.") + +;; `tramp-method-regexp' needs at least two characters, in order to +;; distinguish from volume letter. This is in the way when completing. +(defconst tramp-completion-method-regexp-alist + `((default . ,(rx (| (literal tramp-default-method-marker) (+ alnum)))) + (simplified . "") + (separate . ,(rx (| (literal tramp-default-method-marker) (* alnum))))) + "Alist mapping Tramp syntax to regexps matching completion methods.") + +(defun tramp-build-completion-method-regexp () + "Return `tramp-completion-method-regexp' according to `tramp-syntax'." + (tramp-lookup-syntax tramp-completion-method-regexp-alist)) + +(defvar tramp-completion-method-regexp + nil ; Initialized when defining `tramp-syntax'! + "Regexp matching completion method identifiers. +The `ftp' syntax does not support methods.") (defun tramp-build-completion-file-name-regexp () "Return `tramp-completion-file-name-regexp' according to `tramp-syntax'." - (tramp-lookup-syntax tramp-completion-file-name-regexp-alist)) + (if (eq tramp-syntax 'separate) + ;; FIXME: This shouldn't be necessary. + (rx bos "/" (? (group "[" (* (not (any "]"))))) eos) + (rx bos + ;; `file-name-completion' uses absolute paths for matching. + ;; This means that on W32 systems, something like + ;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also + ;; `tramp-drop-volume-letter'. + (? (regexp tramp-volume-letter-regexp)) + (regexp tramp-prefix-regexp) + + ;; Optional multi hops. + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + + ;; Last hop. + (? (regexp tramp-completion-method-regexp) + ;; Method separator, user name and host name. + (? (regexp tramp-postfix-method-regexp) + ;; This is a little bit lax, but it serves. + (? (regexp tramp-host-regexp)))) + + eos))) (defvar tramp-completion-file-name-regexp - nil ;Initialized when defining `tramp-syntax'! + nil ; Initialized when defining `tramp-syntax'! "Regular expression matching file names handled by Tramp completion. This regexp should match partial Tramp file names only. @@ -1218,14 +1213,8 @@ Also see `tramp-file-name-structure'.") ;;;###autoload (defconst tramp-autoload-file-name-regexp - (concat - "\\`/" - (if (memq system-type '(cygwin windows-nt)) - ;; The method is either "-", or at least two characters. - "\\(-\\|[^/|:]\\{2,\\}\\)" - ;; At least one character for method. - "[^/|:]+") - ":") + ;; The method is either "-", or at least two characters. + (rx bos "/" (| "-" (>= 2 (not (any "/:|")))) ":") "Regular expression matching file names handled by Tramp autoload. It must match the initial `tramp-syntax' settings. It should not match file names at root of the underlying local file system, @@ -1528,7 +1517,7 @@ If VEC is a vector, check first in connection properties. Afterwards, check in `tramp-methods'. If the `tramp-methods' entry does not exist, return nil." (let ((hash-entry - (replace-regexp-in-string "^tramp-" "" (symbol-name param)))) + (replace-regexp-in-string (rx bos "tramp-") "" (symbol-name param)))) (if (tramp-connection-property-p vec hash-entry) ;; We use the cached property. (tramp-get-connection-property vec hash-entry) @@ -1548,10 +1537,7 @@ entry does not exist, return nil." "Return t if NAME is a string with Tramp file name syntax." (and tramp-mode (stringp name) ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'. - (not (string-match-p - (if (memq system-type '(cygwin windows-nt)) - "^/[[:alpha:]]?:" "^/:") - name)) + (not (string-match-p (rx bos "/" (? alpha) ":") name)) ;; Excluded file names. (or (null tramp-ignored-file-name-regexp) (not (string-match-p tramp-ignored-file-name-regexp name))) @@ -1744,7 +1730,7 @@ See `tramp-dissect-file-name' for details." (let ((v (tramp-dissect-file-name (concat tramp-prefix-format (replace-regexp-in-string - (concat tramp-postfix-hop-regexp "$") + (rx (regexp tramp-postfix-hop-regexp) eos) tramp-postfix-host-format name)) nodefault))) ;; Only some methods from tramp-sh.el do support multi-hops. @@ -1797,7 +1783,7 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." ;; Assure that the hops are in `tramp-default-proxies-alist'. ;; In tramp-archive.el, the slot `hop' is used for the archive ;; file name. - (unless (string-equal method "archive") + (unless (string-equal method tramp-archive-method) (tramp-add-hops (car args))))) (t (setq method (nth 0 args) @@ -1840,7 +1826,7 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." (replace-regexp-in-string tramp-prefix-regexp "" (replace-regexp-in-string - (concat tramp-postfix-host-regexp "$") tramp-postfix-hop-format + (rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format (tramp-make-tramp-file-name vec 'noloc))))) (defun tramp-completion-make-tramp-file-name (method user host localname) @@ -1955,10 +1941,12 @@ of `current-buffer'." (put #'tramp-debug-buffer-name 'tramp-suppress-trace t) (defconst tramp-debug-outline-regexp - (concat - "[[:digit:]]+:[[:digit:]]+:[[:digit:]]+\\.[[:digit:]]+ " ;; Timestamp. - "\\(?:\\(#\\) \\)?" ;; Thread. - "[[:alnum:]-]+ (\\([[:digit:]]+\\)) #") ;; Function name, verbosity. + (rx ;; Timestamp. + (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) " " + ;; Thread. + (? (group "#") " ") + ;; Function name, verbosity. + (+ (any "-" alnum)) " (" (group (group (+ digit))) ") #") "Used for highlighting Tramp debug buffers in `outline-mode'.") (defconst tramp-debug-font-lock-keywords @@ -1967,7 +1955,7 @@ of `current-buffer'." ;; Also, in `font-lock-defaults' you can specify a function name for ;; the "KEYWORDS" part, so font-lock calls it to get the actual keywords! '(list - (concat "^\\(?:" tramp-debug-outline-regexp "\\).+") + (rx bol (regexp tramp-debug-outline-regexp) (+ nonl)) '(1 font-lock-warning-face t t) '(0 (outline-font-lock-face) keep t)) "Used for highlighting Tramp debug buffers in `outline-mode'.") @@ -2421,13 +2409,16 @@ letter into the file name. This function removes it." (save-match-data (let ((quoted (tramp-compat-file-name-quoted-p name 'top)) (result (tramp-compat-file-name-unquote name 'top))) - (setq result (if (string-match "\\`[[:alpha:]]:/" result) - (replace-match "/" nil t result) result)) + (setq result + (if (string-match + (rx (regexp tramp-volume-letter-regexp) "/") result) + (replace-match "/" nil t result) result)) (if quoted (tramp-compat-file-name-quote result 'top) result)))) ;;; Config Manipulation Functions: -(defconst tramp-dns-sd-service-regexp "^_[-[:alnum:]]+\\._tcp$" +(defconst tramp-dns-sd-service-regexp + (rx bol "_" (+ (any "-" alnum)) "._tcp" eol) "DNS-SD service regexp.") ;;;###tramp-autoload @@ -2530,7 +2521,7 @@ coding system might not be determined. This function repairs it." ;; We found a matching entry in `file-coding-system-alist'. ;; So we add a similar entry, but with the temporary file name ;; as regexp. - (push (cons (regexp-quote tmpname) (cdr elt)) result))))) + (push (cons (rx (literal tmpname)) (cdr elt)) result))))) (defun tramp-run-real-handler (operation args) "Invoke normal file name handler for OPERATION. @@ -2808,14 +2799,12 @@ This avoids problems during autoload, when `load-path' contains remote file names." ;; We expect all other Tramp files in the same directory as tramp.el. (let* ((dir (expand-file-name (file-name-directory (locate-library "tramp")))) - (files-regexp - (format - "^%s$" - (regexp-opt - (mapcar - #'file-name-sans-extension - (directory-files dir nil "\\`tramp.+\\.elc?\\'")) - 'paren)))) + (files (delete-dups + (mapcar + #'file-name-sans-extension + (directory-files + dir nil (rx bos "tramp" (+ nonl) ".el" (? "c") eos))))) + (files-regexp (rx bol (: (regexp (regexp-opt files))) eol))) (mapatoms (lambda (atom) (when (and (functionp atom) @@ -2960,11 +2949,9 @@ not in completion mode." ;; Suppress hop from completion. (when (string-match - (concat - tramp-prefix-regexp - "\\(" "\\(" tramp-remote-file-name-spec-regexp - tramp-postfix-hop-regexp - "\\)+" "\\)") + (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))) @@ -3046,68 +3033,62 @@ not in completion mode." ;; ["x" nil "" nil] ["x" nil "y" nil] ["x" nil "y" ""] ;; ["x" "" nil nil] ["x" "y" nil nil] -;; "/x:y@""/[x/y@" "/x:y@z" "/[x/y@z" "/x:y@z:" "/[x/y@z]" -;;["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""] +;; "/x:y@" "/[x/y@" "/x:y@z" "/[x/y@z" "/x:y@z:" "/[x/y@z]" +;; ["x" "y" nil nil] ["x" "y" "z" nil] ["x" "y" "z" ""] (defun tramp-completion-dissect-file-name (name) "Return a list of `tramp-file-name' structures for NAME. They are collected by `tramp-completion-dissect-file-name1'." - (let* ((x-nil "\\|\\(\\)") - (tramp-completion-ipv6-regexp - (format - "[^%s]*" - (if (zerop (length tramp-postfix-ipv6-format)) - tramp-postfix-host-format - tramp-postfix-ipv6-format))) - ;; "/method" "/[method" + (let* (;; "/method" "/[method" (tramp-completion-file-name-structure1 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (? (regexp tramp-completion-method-regexp))) eol) 1 nil nil nil)) ;; "/method:user" "/[method/user" (tramp-completion-file-name-structure2 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(" tramp-user-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (? (regexp tramp-user-regexp))) eol) 1 2 nil nil)) ;; "/method:host" "/[method/host" (tramp-completion-file-name-structure3 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(" tramp-host-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (? (regexp tramp-host-regexp))) eol) 1 nil 2 nil)) ;; "/method:[ipv6" "/[method/ipv6" (tramp-completion-file-name-structure4 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - tramp-prefix-ipv6-regexp - "\\(" tramp-completion-ipv6-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (? (regexp tramp-ipv6-regexp))) eol) 1 nil 2 nil)) ;; "/method:user@host" "/[method/user@host" (tramp-completion-file-name-structure5 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp - "\\(" tramp-host-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (group (? (regexp tramp-host-regexp))) eol) 1 2 3 nil)) ;; "/method:user@[ipv6" "/[method/user@ipv6" (tramp-completion-file-name-structure6 (list - (concat - tramp-prefix-regexp - "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp - "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp - tramp-prefix-ipv6-regexp - "\\(" tramp-completion-ipv6-regexp x-nil "\\)$") + (rx (regexp tramp-prefix-regexp) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (group (regexp tramp-user-regexp)) + (regexp tramp-postfix-user-regexp) + (regexp tramp-prefix-ipv6-regexp) + (group (? (regexp tramp-ipv6-regexp))) eol) 1 2 3 nil))) (delq nil @@ -3233,11 +3214,10 @@ Either user or host may be nil." Either user or host may be nil." (let (result (regexp - (concat - "^\\(" tramp-host-regexp "\\)" - "\\([ \t]+" "\\(" tramp-user-regexp "\\)" "\\)?"))) + (rx bol (group (regexp tramp-host-regexp)) + (? (+ space) (group (regexp tramp-user-regexp)))))) (when (re-search-forward regexp (line-end-position) t) - (setq result (append (list (match-string 3) (match-string 1))))) + (setq result (append (list (match-string 2) (match-string 1))))) (forward-line 1) result)) @@ -3249,7 +3229,7 @@ User is always nil." (defun tramp-parse-shosts-group () "Return a (user host) tuple allowed to access. User is always nil." - (tramp-parse-group (concat "^\\(" tramp-host-regexp "\\)") 1 ",")) + (tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ",")) (defun tramp-parse-sconfig (filename) "Return a list of (user host) tuples allowed to access. @@ -3260,9 +3240,10 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (concat "\\(?:^[ \t]*Host\\)" "\\|" "\\(?:^.+\\)" - "\\|" "\\(" tramp-host-regexp "\\)") - 1 " \t")) + (rx (| (: bol (* space) "Host") + (: bol (+ nonl)) ;; ??? + (group (regexp tramp-host-regexp)))) + 1 (rx space))) ;; Generic function. (defun tramp-parse-shostkeys-sknownhosts (dirname regexp) @@ -3274,21 +3255,24 @@ User is always nil." (files (and (file-directory-p dirname) (directory-files dirname)))) (cl-loop for f in files - when (and (not (string-match "^\\.\\.?$" f)) (string-match regexp f)) + when (and (not (string-match-p (rx bol (** 1 2 ".") eol) f)) + (string-match regexp f)) collect (list nil (match-string 1 f))))) (defun tramp-parse-shostkeys (dirname) "Return a list of (user host) tuples allowed to access. User is always nil." (tramp-parse-shostkeys-sknownhosts - dirname (concat "^key_[[:digit:]]+_\\(" tramp-host-regexp "\\)\\.pub$"))) + dirname + (rx bol "key_" (+ digit) "_" (group (regexp tramp-host-regexp)) ".pub" eol))) (defun tramp-parse-sknownhosts (dirname) "Return a list of (user host) tuples allowed to access. User is always nil." (tramp-parse-shostkeys-sknownhosts dirname - (concat "^\\(" tramp-host-regexp "\\)\\.ssh-\\(dss\\|rsa\\)\\.pub$"))) + (rx bol (group (regexp tramp-host-regexp)) + ".ssh-" (| "dss" "rsa") ".pub" eol))) (defun tramp-parse-hosts (filename) "Return a list of (user host) tuples allowed to access. @@ -3299,7 +3283,8 @@ User is always nil." "Return a (user host) tuple allowed to access. User is always nil." (tramp-parse-group - (concat "^\\(" tramp-ipv6-regexp "\\|" tramp-host-regexp "\\)") 1 " \t")) + (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp)))) + 1 (rx space))) (defun tramp-parse-passwd (filename) "Return a list of (user host) tuples allowed to access. @@ -3317,7 +3302,7 @@ Host is always \"localhost\"." "Return a (user host) tuple allowed to access. Host is always \"localhost\"." (let (result - (regexp (concat "^\\(" tramp-user-regexp "\\):"))) + (regexp (rx bol (group (regexp tramp-user-regexp)) ":"))) (when (re-search-forward regexp (line-end-position) t) (setq result (list (match-string 1) "localhost"))) (forward-line 1) @@ -3339,7 +3324,8 @@ Host is always \"localhost\"." "Return a (group host) tuple allowed to access. Host is always \"localhost\"." (let (result - (split (split-string (buffer-substring (point) (line-end-position)) ":"))) + (split + (split-string (buffer-substring (point) (line-end-position)) ":"))) (when (member (user-login-name) (split-string (nth 3 split) "," 'omit)) (setq result (list (nth 0 split) "localhost"))) (forward-line 1) @@ -3367,13 +3353,13 @@ User is always nil." (tramp-parse-putty-group registry-or-dirname))))) ;; UNIX case. (tramp-parse-shostkeys-sknownhosts - registry-or-dirname (concat "^\\(" tramp-host-regexp "\\)$")))) + registry-or-dirname (rx bol (group (regexp tramp-host-regexp)) eol)))) (defun tramp-parse-putty-group (registry) "Return a (user host) tuple allowed to access. User is always nil." (let (result - (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)"))) + (regexp (rx (literal registry) "\\" (group (+ nonl))))) (when (re-search-forward regexp (line-end-position) t) (setq result (list nil (match-string 1)))) (forward-line 1) @@ -3773,7 +3759,9 @@ Let-bind it when necessary.") ;; Expand tilde. Usually, the methods applying this handler do ;; not support tilde expansion. But users could declare a ;; respective connection property. (Bug#53847) - (when (string-match "\\`~\\([^/]*\\)\\(.*\\)\\'" localname) + (when (string-match + (rx bos "~" (group (* (not (any "/")))) (group (* nonl)) eos) + localname) (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) @@ -3783,10 +3771,10 @@ Let-bind it when necessary.") (setq localname (concat hname fname))))) ;; Tilde expansion is not possible. (when (and (not tramp-tolerate-tilde) - (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname)) + (string-prefix-p "~" localname)) (tramp-error v 'file-error "Cannot expand tilde in file `%s'" name)) ;; Do not keep "/..". - (when (string-match-p "^/\\.\\.?$" localname) + (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname) (setq localname "/")) ;; Do normal `expand-file-name' (this does "/./" and "/../"). ;; `default-directory' is bound, because on Windows there would @@ -3794,7 +3782,7 @@ Let-bind it when necessary.") (let ((default-directory tramp-compat-temporary-file-directory)) (tramp-make-tramp-file-name v (tramp-drop-volume-letter - (if (string-match-p "\\`\\(~[^/]*\\)\\(.*\\)\\'" localname) + (if (string-prefix-p "~" localname) localname (tramp-run-real-handler #'expand-file-name (list localname))))))))) @@ -3805,7 +3793,10 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." - (eq (file-attribute-type (file-attributes (file-truename filename))) t)) + ;; `file-truename' could raise an error, for example due to a cyclic + ;; symlink. + (ignore-errors + (eq (file-attribute-type (file-attributes (file-truename filename))) t))) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equalp-p' for Tramp files." @@ -3890,7 +3881,7 @@ Let-bind it when necessary.") ;; lower case letters. This avoids us to create a ;; temporary file. (while (and (string-match-p - "[[:lower:]]" (tramp-file-local-name candidate)) + (rx lower) (tramp-file-local-name candidate)) (not (file-exists-p candidate))) (setq candidate (directory-file-name @@ -3898,7 +3889,7 @@ Let-bind it when necessary.") ;; Nothing found, so we must use a temporary file ;; for comparison. (unless (string-match-p - "[[:lower:]]" (tramp-file-local-name candidate)) + (rx lower) (tramp-file-local-name candidate)) (setq tmpfile (let ((default-directory (file-name-directory filename))) @@ -3933,7 +3924,8 @@ Let-bind it when necessary.") (and completion-ignored-extensions (string-match-p - (concat (regexp-opt completion-ignored-extensions 'paren) "$") x) + (rx (regexp (regexp-opt completion-ignored-extensions)) eos) + x) ;; We remember the hit. (push x hits-ignored-extensions)))))) ;; No match. So we try again for ignored files. @@ -3975,7 +3967,8 @@ Let-bind it when necessary.") ;; links. (when-let ((symlink (file-symlink-p filename))) (and (stringp symlink) - (file-readable-p (concat (file-remote-p filename) symlink)))))))) + (file-readable-p + (concat (file-remote-p filename) symlink)))))))) (defun tramp-handle-file-regular-p (filename) "Like `file-regular-p' for Tramp files." @@ -4111,9 +4104,10 @@ Let-bind it when necessary.") (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p - (concat - "Backup file on local temporary directory, " - "do you want to continue?"))))) + (eval-when-compile + (concat + "Backup file on local temporary directory, " + "do you want to continue?")))))) (tramp-error v 'file-error "Unsafe backup file name")))))) (defun tramp-handle-insert-directory @@ -4142,12 +4136,13 @@ Let-bind it when necessary.") (goto-char (point-min)) (while (setq start (text-property-not-all - (point) (line-end-position) 'dired-filename t)) + (point) (line-end-position) 'dired-filename t)) (delete-region start - (or (text-property-any start (line-end-position) 'dired-filename t) - (line-end-position))) - (if (= (line-beginning-position) (line-end-position)) + (or (text-property-any + start (line-end-position) 'dired-filename t) + (line-end-position))) + (if (= (line-beginning-position) (line-end-position)) ;; Empty line. (delete-region (point) (progn (forward-line) (point))) (forward-line))))))))) @@ -4269,15 +4264,13 @@ Let-bind it when necessary.") (defun tramp-ps-time () "Read printed time oif \"ps\" in format \"[[DD-]hh:]mm:ss\". Return it as number of seconds. Used in `tramp-process-attributes-ps-format'." - (search-forward-regexp "\\s-+") - (search-forward-regexp - (concat - "\\(?:" "\\(?:" "\\([0-9]+\\)-" "\\)?" - "\\([0-9]+\\):" "\\)?" - "\\([0-9]+\\):" - ;; Seconds can also be a floating point number. - "\\([0-9.]+\\)") - (line-end-position) 'noerror) + (search-forward-regexp (rx (+ space))) + (search-forward-regexp (rx (? (? (group (+ digit)) "-") + (group (+ digit)) ":") + (group (+ digit)) ":" + ;; Seconds can also be a floating point num. + (group (+ (any "." digit)))) + (line-end-position) 'noerror) (+ (* 24 60 60 (string-to-number (or (match-string 1) "0"))) (* 60 60 (string-to-number (or (match-string 2) "0"))) (* 60 (string-to-number (or (match-string 3) "0"))) @@ -4382,7 +4375,7 @@ It is not guaranteed, that all process attributes as described in ;; "%s" (buffer-substring (point) (line-end-position))) (when (save-excursion (search-forward-regexp - "[[:digit:]]" (line-end-position) 'noerror)) + (rx digit) (line-end-position) 'noerror)) (setq res nil) (dolist (elt tramp-process-attributes-ps-format) (push @@ -4391,16 +4384,17 @@ It is not guaranteed, that all process attributes as described in (cond ((eq (cdr elt) 'number) (read (current-buffer))) ((eq (cdr elt) 'string) - (search-forward-regexp "\\S-+") + (search-forward-regexp (rx (+ (not space)))) (match-string 0)) ((numberp (cdr elt)) - (search-forward-regexp "\\s-+") - (search-forward-regexp ".+" (+ (point) (cdr elt))) + (search-forward-regexp (rx (+ space))) + (search-forward-regexp + (rx (+ nonl)) (+ (point) (cdr elt))) (string-trim (match-string 0))) ((fboundp (cdr elt)) (funcall (cdr elt))) ((null (cdr elt)) - (search-forward-regexp "\\s-+") + (search-forward-regexp (rx (+ whitespace))) (buffer-substring (point) (line-end-position))))) res)) ;; `nice' could be `-'. @@ -4442,7 +4436,10 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defconst tramp-lock-file-info-regexp ;; USER@HOST.PID[:BOOT_TIME] - "\\`\\(.+\\)@\\(.+\\)\\.\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\'" + (rx bos (group (+ nonl)) + "@" (group (+ nonl)) + "." (group (+ digit)) + (? ":" (group (+ digit))) eos) "The format of a lock file.") (defun tramp-handle-file-locked-p (file) @@ -4497,9 +4494,10 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p - (concat - "Lock file on local temporary directory, " - "do you want to continue?"))))) + (eval-when-compile + (concat + "Lock file on local temporary directory, " + "do you want to continue?")))))) (tramp-error v 'file-error "Unsafe lock file name"))) ;; Do the lock. @@ -4538,7 +4536,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") ;; The first condition is always true for absolute file names. ;; Included for safety's sake. (unless (or (file-name-directory file) - (string-match-p "\\.elc?\\'" file)) + (string-match-p (rx ".el" (? "c") eos) file)) (tramp-error v 'file-error "File `%s' does not include a `.el' or `.elc' suffix" file))) @@ -4571,9 +4569,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") tramp-prefix-format proxy tramp-postfix-host-format)) (entry (list (and (stringp host-port) - (concat "^" (regexp-quote host-port) "$")) + (rx bol (literal host-port) eol)) (and (stringp user-domain) - (concat "^" (regexp-quote user-domain) "$")) + (rx bol (literal user-domain) eol)) (propertize proxy 'tramp-ad-hoc t)))) (tramp-message vec 5 "Add %S to `tramp-default-proxies-alist'" entry) ;; Add the hop. @@ -4652,7 +4650,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (setq tramp-default-proxies-alist saved-tdpa) (tramp-user-error vec "Host name `%s' does not match `%s'" host previous-host)) - (setq previous-host (concat "^" (regexp-quote host) "$"))))) + (setq previous-host (rx bol (literal host) eol))))) ;; Result. target-alist)) @@ -4841,7 +4839,7 @@ support symbolic links." (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." - (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) + (let* ((asynchronous (string-match-p (rx (* space) "&" (* space) eos) command)) (command (substring command 0 asynchronous)) current-buffer-p (output-buffer-p output-buffer) @@ -5024,14 +5022,14 @@ BUFFER might be a list, in this case STDERR is separated." (let (process-environment) ;; Ignore in LOCALNAME everything before "//" or "/~". (when (stringp localname) - (if (string-match "//\\(/\\|~\\)" localname) + (if (string-match-p (rx "//" (| "/" "~")) localname) (setq filename (replace-regexp-in-string - "\\`/+" "/" (substitute-in-file-name localname))) + (rx bos (+ "/")) "/" (substitute-in-file-name localname))) (setq filename (concat (file-remote-p filename) (replace-regexp-in-string - "\\`/+" "/" + (rx bos (+ "/")) "/" ;; We must disable cygwin-mount file name ;; handlers and alike. (tramp-run-real-handler @@ -5278,7 +5276,8 @@ Wait, until the connection buffer changes." (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) (tramp-check-for-regexp proc tramp-process-action-regexp) - (with-temp-message (replace-regexp-in-string "[\r\n]" "" (match-string 0)) + (with-temp-message + (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0)) ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. @@ -5614,7 +5613,7 @@ the remote host use line-endings as defined in the variable (tramp-flush-directory-properties vec "/")) (when (buffer-live-p buf) (with-current-buffer buf - (when (and prompt (tramp-search-regexp (regexp-quote prompt))) + (when (and prompt (tramp-search-regexp (rx (literal prompt)))) (delete-region (point) (point-max)))))))) (defun tramp-get-inode (vec) @@ -5818,7 +5817,7 @@ VEC is used for tracing." (while candidates (goto-char (point-min)) (if (string-match-p - (format "^%s\r?$" (regexp-quote (car candidates))) + (rx bol (literal (car candidates)) (? "\r") eol) (buffer-string)) (setq locale (car candidates) candidates nil) @@ -5926,7 +5925,9 @@ to cache the result. Return the modified ATTR." (when (consp (car attr)) (setcar attr (and (stringp (caar attr)) - (string-match ".+ -> .\\(.+\\)." (caar attr)) + (string-match + (rx (+ nonl) " -> " nonl (group (+ nonl)) nonl) + (caar attr)) (decode-coding-string (match-string 1 (caar attr)) 'utf-8)))) ;; Set file's gid change bit. @@ -6111,9 +6112,10 @@ this file, if that variable is non-nil." (not (with-tramp-connection-property (tramp-get-process v) "unsafe-temporary-file" (yes-or-no-p - (concat - "Autosave file on local temporary directory, " - "do you want to continue?"))))) + (eval-when-compile + (concat + "Autosave file on local temporary directory, " + "do you want to continue?")))))) (tramp-error v 'file-error "Unsafe autosave file name")))))) (defun tramp-subst-strs-in-string (alist string) @@ -6124,7 +6126,7 @@ ALIST is of the form ((FROM . TO) ...)." (let* ((pr (car alist)) (from (car pr)) (to (cdr pr))) - (while (string-match (regexp-quote from) string) + (while (string-match (rx (literal from)) string) (setq string (replace-match to t t string))) (setq alist (cdr alist)))) string)) @@ -6226,7 +6228,7 @@ verbosity of 6." (apply #'process-lines program args) (error (tramp-error vec (car err) (cdr err))))) - (tramp-message vec 6 "%s" result) + (tramp-message vec 6 "\n%s" (mapconcat #'identity result "\n")) result)) (defun tramp-process-running-p (process-name) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index f51037aabb4..964404b4bf7 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -40,7 +40,8 @@ "Format for `ert-resource-directory'.") (defvar ert-resource-directory-trim-left-regexp "" "Regexp for `string-trim' (left) used by `ert-resource-directory'.") - (defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el" + (defvar ert-resource-directory-trim-right-regexp + (rx (? "-test" (? "s")) ".el") "Regexp for `string-trim' (right) used by `ert-resource-directory'.") (defmacro ert-resource-directory () @@ -615,13 +616,13 @@ This checks also `file-name-as-directory', `file-name-directory', (insert-directory tramp-archive-test-archive nil) (goto-char (point-min)) (should - (looking-at-p (regexp-quote tramp-archive-test-archive)))) + (looking-at-p (rx (literal tramp-archive-test-archive))))) (with-temp-buffer (insert-directory tramp-archive-test-archive "-al") (goto-char (point-min)) (should (looking-at-p - (format "^.+ %s$" (regexp-quote tramp-archive-test-archive))))) + (rx bol (+ nonl) " " (literal tramp-archive-test-archive) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tramp-archive-test-archive) @@ -629,15 +630,17 @@ This checks also `file-name-as-directory', `file-name-directory', (goto-char (point-min)) (should (looking-at-p - (concat - ;; There might be a summary line. - "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?" - ;; We don't know in which order the files appear. - (format - "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}" - (regexp-opt (directory-files tramp-archive-test-archive)) - (length (directory-files tramp-archive-test-archive))))))) - + (rx-to-string + `(: + ;; There might be a summary line. + (? "total" (+ nonl) (+ digit) (? " ") + (? (any "EGKMPTYZk")) (? "i") (? "B") "\n") + ;; We don't know in which order the files appear. + (= ,(length (directory-files tramp-archive-test-archive)) + (+ nonl) " " + (regexp + ,(regexp-opt (directory-files tramp-archive-test-archive))) + (? " ->" (one-or-more nonl)) "\n")))))) ;; Check error case. (with-temp-buffer (should-error @@ -727,7 +730,7 @@ This tests also `access-file', `file-readable-p' and `file-regular-p'." (setq attr (directory-files-and-attributes tmp-name 'full)) (dolist (elt attr) (should (equal (file-attributes (car elt)) (cdr elt)))) - (setq attr (directory-files-and-attributes tmp-name nil "\\`b")) + (setq attr (directory-files-and-attributes tmp-name nil (rx bos "b"))) (should (equal (mapcar #'car attr) '("bar")))) ;; Cleanup. @@ -914,11 +917,14 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) (should (string-match - (format - "tramp-archive loaded: %s[[:ascii:]]+tramp-archive loaded: %s" - (tramp-archive-file-name-p default-directory) - (or (tramp-archive-file-name-p default-directory) - (and enabled (tramp-archive-file-name-p file)))) + (rx "tramp-archive loaded: " + (literal (symbol-name + (tramp-archive-file-name-p default-directory))) + (+ ascii) + "tramp-archive loaded: " + (literal (symbol-name + (or (tramp-archive-file-name-p default-directory) + (and enabled (tramp-archive-file-name-p file)))))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s --eval %s" @@ -955,9 +961,9 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (dolist (tae '(t nil)) (should (string-match - (format - "tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: nil[[:ascii:]]+tramp-archive loaded: %s" - tae) + (rx "tramp-archive loaded: nil" (+ ascii) + "tramp-archive loaded: nil" (+ ascii) + "tramp-archive loaded: " (literal (symbol-name tae))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -1005,7 +1011,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (apply 'append (mapcar - (lambda (x) (directory-files (concat dir x) 'full "uu\\'" 'sort)) + (lambda (x) + (directory-files (concat dir x) 'full (rx "uu" eos) 'sort)) '("~/src/libarchive-3.2.2/libarchive/test" "~/src/libarchive-3.2.2/cpio/test" "~/src/libarchive-3.2.2/tar/test")))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3e318a729d1..bc67ff2ace7 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -91,7 +91,8 @@ "Format for `ert-resource-directory'.") (defvar ert-resource-directory-trim-left-regexp "" "Regexp for `string-trim' (left) used by `ert-resource-directory'.") - (defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el" + (defvar ert-resource-directory-trim-right-regexp + (rx (? "-test" (? "s")) ".el") "Regexp for `string-trim' (right) used by `ert-resource-directory'.") (defmacro ert-resource-directory () @@ -204,7 +205,7 @@ being the result.") ;; Remove old test files. (dolist (dir `(,temporary-file-directory ,ert-remote-temporary-file-directory)) - (dolist (file (directory-files dir 'full "\\`\\(\\.#\\)?tramp-test")) + (dolist (file (directory-files dir 'full (rx bos (? ".#") "tramp-test"))) (ignore-errors (if (file-directory-p file) (delete-directory file 'recursive) @@ -387,15 +388,17 @@ Also see `ignore'." ;; `tramp-ignored-file-name-regexp' suppresses Tramp. (let ((tramp-ignored-file-name-regexp "^/method:user@host:")) (should-not (tramp-tramp-file-p "/method:user@host:"))) - ;; Methods shall be at least two characters on MS Windows, - ;; except the default method. + ;; Methods shall be at least two characters, except the + ;; default method. (let ((system-type 'windows-nt)) (should-not (tramp-tramp-file-p "/c:/path/to/file")) (should-not (tramp-tramp-file-p "/c::/path/to/file")) - (should (tramp-tramp-file-p "/-::/path/to/file"))) + (should (tramp-tramp-file-p "/-::/path/to/file")) + (should (tramp-tramp-file-p "/mm::/path/to/file"))) (let ((system-type 'gnu/linux)) + (should-not (tramp-tramp-file-p "/m::/path/to/file")) (should (tramp-tramp-file-p "/-:h:/path/to/file")) - (should (tramp-tramp-file-p "/m::/path/to/file")))) + (should (tramp-tramp-file-p "/mm::/path/to/file")))) ;; Exit. (tramp-change-syntax syntax)))) @@ -1064,8 +1067,7 @@ Also see `ignore'." (file-remote-p "/user@email@host:") (format "/%s@%s:" "user@email" "host"))) (should (string-equal - (file-remote-p - "/user@email@host:" 'method) "default-method")) + (file-remote-p "/user@email@host:" 'method) "default-method")) (should (string-equal (file-remote-p "/user@email@host:" 'user) "user@email")) (should (string-equal @@ -1474,11 +1476,10 @@ Also see `ignore'." (file-remote-p "/[method/user@email@host]") (format "/[%s/%s@%s]" "method" "user@email" "host"))) (should (string-equal - (file-remote-p - "/[method/user@email@host]" 'method) "method")) + (file-remote-p "/[method/user@email@host]" 'method) "method")) (should (string-equal - (file-remote-p - "/[method/user@email@host]" 'user) "user@email")) + (file-remote-p "/[method/user@email@host]" 'user) + "user@email")) (should (string-equal (file-remote-p "/[method/user@email@host]" 'host) "host")) (should (string-equal @@ -1505,11 +1506,10 @@ Also see `ignore'." (file-remote-p "/[/user@host#1234]") (format "/[%s/%s@%s]" "default-method" "user" "host#1234"))) (should (string-equal - (file-remote-p - "/[/user@host#1234]" 'method) "default-method")) + (file-remote-p "/[/user@host#1234]" 'method) + "default-method")) (should (string-equal - (file-remote-p - "/[/user@host#1234]" 'user) "user")) + (file-remote-p "/[/user@host#1234]" 'user) "user")) (should (string-equal (file-remote-p "/[/user@host#1234]" 'host) "host#1234")) (should (string-equal @@ -1535,11 +1535,10 @@ Also see `ignore'." (file-remote-p "/[-/user@host#1234]") (format "/[%s/%s@%s]" "default-method" "user" "host#1234"))) (should (string-equal - (file-remote-p - "/[-/user@host#1234]" 'method) "default-method")) + (file-remote-p "/[-/user@host#1234]" 'method) + "default-method")) (should (string-equal - (file-remote-p - "/[-/user@host#1234]" 'user) "user")) + (file-remote-p "/[-/user@host#1234]" 'user) "user")) (should (string-equal (file-remote-p "/[-/user@host#1234]" 'host) "host#1234")) (should (string-equal @@ -1569,8 +1568,7 @@ Also see `ignore'." (should (string-equal (file-remote-p "/[method/user@host#1234]" 'user) "user")) (should (string-equal - (file-remote-p - "/[method/user@host#1234]" 'host) "host#1234")) + (file-remote-p "/[method/user@host#1234]" 'host) "host#1234")) (should (string-equal (file-remote-p "/[method/user@host#1234]" 'localname) "")) (should (string-equal @@ -1595,8 +1593,7 @@ Also see `ignore'." (file-remote-p "/[/user@1.2.3.4]") (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4"))) (should (string-equal - (file-remote-p - "/[/user@1.2.3.4]" 'method) "default-method")) + (file-remote-p "/[/user@1.2.3.4]" 'method) "default-method")) (should (string-equal (file-remote-p "/[/user@1.2.3.4]" 'user) "user")) (should (string-equal @@ -1624,8 +1621,7 @@ Also see `ignore'." (file-remote-p "/[-/user@1.2.3.4]") (format "/[%s/%s@%s]" "default-method" "user" "1.2.3.4"))) (should (string-equal - (file-remote-p - "/[-/user@1.2.3.4]" 'method) "default-method")) + (file-remote-p "/[-/user@1.2.3.4]" 'method) "default-method")) (should (string-equal (file-remote-p "/[-/user@1.2.3.4]" 'user) "user")) (should (string-equal @@ -2299,9 +2295,9 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Check `directory-abbrev-alist' abbreviation. (let ((directory-abbrev-alist - `((,(concat "\\`" (regexp-quote home-dir) "/foo") + `((,(rx bos (literal home-dir) "/foo") . ,(concat home-dir "/f")) - (,(concat "\\`" (regexp-quote remote-host) "/nowhere") + (,(rx bos (literal remote-host) "/nowhere") . ,(concat remote-host "/nw"))))) (should (equal (abbreviate-file-name (concat home-dir "/foo/bar")) (concat remote-host-nohop "~/f/bar"))) @@ -2514,8 +2510,8 @@ This checks also `file-name-as-directory', `file-name-directory', (string-match-p (if (and (null noninteractive) (or (eq visit t) (null visit) (stringp visit))) - (format "^Wrote %s\n\\'" (regexp-quote tmp-name)) - "^\\'") + (rx bol "Wrote " (literal tmp-name) "\n" eos) + (rx bos)) tramp--test-messages)))))) ;; We do not test lockname here. See @@ -3215,38 +3211,40 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (with-temp-buffer (insert-directory tmp-name1 nil) (goto-char (point-min)) - (should (looking-at-p (regexp-quote tmp-name1)))) + (should (looking-at-p (rx (literal tmp-name1))))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) nil) (goto-char (point-min)) (should (looking-at-p - (regexp-quote (file-name-as-directory tmp-name1))))) + (rx (literal (file-name-as-directory tmp-name1)))))) (with-temp-buffer (insert-directory tmp-name1 "-al") (goto-char (point-min)) (should - (looking-at-p (format "^.+ %s$" (regexp-quote tmp-name1))))) + (looking-at-p (rx bol (+ nonl) " " (literal tmp-name1) eol)))) (with-temp-buffer (insert-directory (file-name-as-directory tmp-name1) "-al") (goto-char (point-min)) (should - (looking-at-p (format "^.+ %s/$" (regexp-quote tmp-name1))))) - (let ((directory-files (directory-files tmp-name1))) - (with-temp-buffer - (insert-directory - (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) - (goto-char (point-min)) - (should - (looking-at-p - (concat + (looking-at-p + (rx bol (+ nonl) " " (literal tmp-name1) "/" eol)))) + (with-temp-buffer + (insert-directory + (file-name-as-directory tmp-name1) "-al" nil 'full-directory-p) + (goto-char (point-min)) + (should + (looking-at-p + (rx-to-string + `(: ;; There might be a summary line. - "\\(total.+[[:digit:]]+ ?[kKMGTPEZY]?i?B?\n\\)?" + (? "total" (+ nonl) (+ digit) (? " ") + (? (any "EGKMPTYZk")) (? "i") (? "B") "\n") ;; We don't know in which order ".", ".." and "foo" appear. - (format - "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}" - (regexp-opt directory-files) - (length directory-files))))))) + (= ,(length (directory-files tmp-name1)) + (+ nonl) " " + (regexp ,(regexp-opt (directory-files tmp-name1))) + (? " ->" (+ nonl)) "\n")))))) ;; Check error cases. (when (and (tramp--test-supports-set-file-modes-p) @@ -3274,7 +3272,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (ert-deftest tramp-test17-dired-with-wildcards () "Check `dired' with wildcards." ;; `separate' syntax and IPv6 host name syntax do not work. - (skip-unless (not (string-match-p "\\[" ert-remote-temporary-file-directory))) + (skip-unless + (not (string-match-p (rx "[") ert-remote-temporary-file-directory))) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-rsync-p))) @@ -3313,15 +3312,15 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name1 ert-remote-temporary-file-directory)))) + (rx (literal + (file-relative-name + tmp-name1 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name2 ert-remote-temporary-file-directory))))) + (rx (literal + (file-relative-name + tmp-name2 ert-remote-temporary-file-directory)))))) (kill-buffer buffer) ;; Check for expanded directory and file names. @@ -3333,16 +3332,16 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name3 ert-remote-temporary-file-directory)))) + (rx (literal + (file-relative-name + tmp-name3 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name4 - ert-remote-temporary-file-directory))))) + (rx (literal + (file-relative-name + tmp-name4 + ert-remote-temporary-file-directory)))))) (kill-buffer buffer) ;; Check for special characters. @@ -3361,16 +3360,16 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name3 ert-remote-temporary-file-directory)))) + (rx (literal + (file-relative-name + tmp-name3 ert-remote-temporary-file-directory))))) (goto-char (point-min)) (should (re-search-forward - (regexp-quote - (file-relative-name - tmp-name4 - ert-remote-temporary-file-directory))))) + (rx (literal + (file-relative-name + tmp-name4 + ert-remote-temporary-file-directory)))))) (kill-buffer buffer)) ;; Cleanup. @@ -3420,7 +3419,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (string-equal (dired-get-filename 'no-dir 'no-error) (file-name-nondirectory tmp-name2))) - (should-not (re-search-forward "dired" nil t)) + (should-not (search-forward "dired" nil t)) ;; The copied file has been inserted the line before. (forward-line -1) (should @@ -3766,14 +3765,15 @@ They might differ only in time attributes or directory size." (tramp--test-file-attributes-equal-p (file-attributes (car elt)) (cdr elt)))) - (setq attr (directory-files-and-attributes tmp-name2 nil "\\`b")) + (setq attr (directory-files-and-attributes + tmp-name2 nil (rx bos "b"))) (should (equal (mapcar #'car attr) '("bar" "boz"))) ;; Check the COUNT arg. It exists since Emacs 28. (when (tramp--test-emacs28-p) (with-no-warnings (setq attr (directory-files-and-attributes - tmp-name2 nil "\\`b" nil nil 1)) + tmp-name2 nil (rx bos "b") nil nil 1)) (should (equal (mapcar #'car attr) '("bar")))))) ;; Cleanup. @@ -3879,8 +3879,8 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." `(condition-case err (progn ,@body) (file-error - (unless (string-match-p "^error with add-name-to-file" - (error-message-string err)) + (unless (string-prefix-p "error with add-name-to-file" + (error-message-string err)) (signal (car err) (cdr err)))))) (ert-deftest tramp-test21-file-links () @@ -4653,7 +4653,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let ((process-file-return-signal-string t)) (should (string-match-p - "Interrupt\\|Signal 2" + (rx (| "Interrupt" "Signal 2")) (process-file (tramp--test-shell-file-name) nil nil nil "-c" "kill -2 $$"))))) @@ -4733,7 +4733,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (insert-file-contents tmp-name) (should (string-match-p - "cat:.* No such file or directory" (buffer-string))) + (rx "cat:" (* nonl) " No such file or directory") + (buffer-string))) (should-not (get-buffer-window (current-buffer) t)) (delete-file tmp-name)))) @@ -4883,8 +4884,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; On macOS, there is always newline conversion. ;; "telnet" converts \r to if `crlf' ;; flag is FALSE. See telnet(1) man page. - "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" - "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") + (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") + (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) (buffer-string)))) ;; Cleanup. @@ -5081,7 +5082,9 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (with-timeout (10 (tramp--test-timeout-handler)) (while (accept-process-output proc 0 nil t))) ;; On some MS Windows systems, it returns "unknown signal". - (should (string-match-p "unknown signal\\|killed" (buffer-string)))) + (should + (string-match-p + (rx (| "unknown signal" "killed")) (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) @@ -5114,7 +5117,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (delete-process proc) (should (string-match-p - "cat:.* No such file or directory" (buffer-string))))) + (rx "cat:" (* nonl) " No such file or directory") + (buffer-string))))) ;; Cleanup. (ignore-errors (delete-process proc)) @@ -5141,7 +5145,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (insert-file-contents tmp-name) (should (string-match-p - "cat:.* No such file or directory" (buffer-string))))) + (rx "cat:" (* nonl) " No such file or directory") + (buffer-string))))) ;; Cleanup. (ignore-errors (delete-process proc)) @@ -5192,8 +5197,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; On macOS, there is always newline conversion. ;; "telnet" converts \r to if `crlf' ;; flag is FALSE. See telnet(1) man page. - "66\n6F\n6F\n0D\\(\n00\\)?\n0A\n" - "66\n6F\n6F\n0A\\(\n00\\)?\n0A\n") + (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") + (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) (buffer-string)))) ;; Cleanup. @@ -5672,7 +5677,7 @@ INPUT, if non-nil, is a string sent to the process." ;; Variable is set. (should (string-match-p - (regexp-quote envvar) + (rx (literal envvar)) (funcall this-shell-command-to-string "set")))) (unless (tramp-direct-async-process-p) @@ -5699,7 +5704,7 @@ INPUT, if non-nil, is a string sent to the process." ;; Variable is unset. (should-not (string-match-p - (regexp-quote envvar) + (rx (literal envvar)) ;; We must remove PS1, the output is truncated otherwise. ;; We must suppress "_=VAR...". (funcall @@ -5851,7 +5856,7 @@ INPUT, if non-nil, is a string sent to the process." (with-timeout (10) (while (accept-process-output (get-buffer-process (current-buffer)) nil nil t))) - (should (string-match-p "^foo$" (buffer-string))))) + (should (string-match-p (rx bol "foo" eol) (buffer-string))))) ;; Cleanup. (put 'explicit-shell-file-name 'permanent-local nil) @@ -6369,7 +6374,7 @@ INPUT, if non-nil, is a string sent to the process." ;; When `lock-file-name-transforms' is set, another lock ;; file is used. (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password) - (let ((lock-file-name-transforms `((".*" ,tmp-name2)))) + (let ((lock-file-name-transforms `((,(rx (* nonl)) ,tmp-name2)))) (should (string-equal (with-no-warnings (make-lock-file-name tmp-name1)) @@ -6495,10 +6500,12 @@ INPUT, if non-nil, is a string sent to the process." (insert "bar") (when create-lockfiles (should (string-match-p - (format - "^%s changed on disk; really edit the buffer\\?" - (if (tramp--test-crypt-p) - ".+" (file-name-nondirectory tmp-name))) + (rx-to-string + `(: bol + ,(if (tramp--test-crypt-p) + '(+ nonl) + (file-name-nondirectory tmp-name)) + " changed on disk; really edit the buffer?")) captured-messages)) (should (file-locked-p tmp-name))))) @@ -6589,7 +6596,7 @@ This is used in tests which we don't want to tag :body nil :tags '(:tramp-asynchronous-processes)))) ;; tramp-adb.el cannot apply multi-byte commands. (not (and (tramp--test-adb-p) - (string-match-p "[[:multibyte:]]" default-directory))))) + (string-match-p (rx multibyte) default-directory))))) (defun tramp--test-crypt-p () "Check, whether the remote directory is encrypted." @@ -6614,8 +6621,8 @@ completely." "Check, whether an FTP-like method is used. This does not support globbing characters in file names (yet)." ;; Globbing characters are ??, ?* and ?\[. - (string-match-p - "ftp$" (file-remote-p ert-remote-temporary-file-directory 'method))) + (string-suffix-p + "ftp" (file-remote-p ert-remote-temporary-file-directory 'method))) (defun tramp--test-fuse-p () "Check, whether an FUSE file system isused." @@ -6638,7 +6645,7 @@ If optional METHOD is given, it is checked first." Several special characters do not work properly there." ;; We must refill the cache. `file-truename' does it. (file-truename ert-remote-temporary-file-directory) - (ignore-errors (tramp-check-remote-uname tramp-test-vec "^HP-UX"))) + (ignore-errors (tramp-check-remote-uname tramp-test-vec (rx bol "HP-UX")))) (defun tramp--test-ksh-p () "Check, whether the remote shell is ksh. @@ -6646,8 +6653,9 @@ ksh93 makes some strange conversions of non-latin characters into a $'' syntax." ;; We must refill the cache. `file-truename' does it. (file-truename ert-remote-temporary-file-directory) - (string-match-p - "ksh$" (tramp-get-connection-property tramp-test-vec "remote-shell" ""))) + (string-suffix-p + "ksh" + (tramp-get-connection-property tramp-test-vec "remote-shell" ""))) (defun tramp--test-macos-p () "Check, whether the remote host runs macOS." @@ -6695,7 +6703,7 @@ Additionally, ls does not support \"--dired\"." "Check, whether the method needs a share." (and (tramp--test-gvfs-p) (string-match-p - "^\\(afp\\|davs?\\|smb\\)$" + (rx bol (or "afp" (: "dav" (opt "s")) "smb") eol) (file-remote-p ert-remote-temporary-file-directory 'method)))) (defun tramp--test-sshfs-p () @@ -6747,7 +6755,7 @@ This requires restrictions of file name syntax." ;; Not all tramp-gvfs.el methods support changing the file mode. (and (tramp--test-gvfs-p) - (string-match-p + (string-suffix-p "ftp" (file-remote-p ert-remote-temporary-file-directory 'method))))) (defun tramp--test-check-files (&rest files) @@ -6896,14 +6904,14 @@ This requires restrictions of file name syntax." (should (string-equal (caar (directory-files-and-attributes - file1 nil (regexp-quote elt1))) + file1 nil (rx (literal elt1)))) elt1)) (should (string-equal (funcall (if quoted #'tramp-compat-file-name-quote #'identity) (cadr (car (directory-files-and-attributes - file1 nil (regexp-quote elt1))))) + file1 nil (rx (literal elt1)))))) (file-remote-p (file-truename file2) 'localname))) (delete-file file3) (should-not (file-exists-p file3)))) @@ -6958,10 +6966,8 @@ This requires restrictions of file name syntax." (goto-char (point-min)) (should (re-search-forward - (format - "^%s=%s$" - (regexp-quote envvar) - (regexp-quote (getenv envvar)))))))))) + (rx bol (literal envvar) + "=" (literal (getenv envvar)) eol)))))))) ;; Cleanup. (ignore-errors (kill-buffer buffer)) @@ -7093,7 +7099,7 @@ This requires restrictions of file name syntax." ;; ?\n and ?/ shouldn't be part of any file name. ?\t, ;; ?. and ?? do not work for "smb" method. " " does not ;; work at begin or end of the string for MS Windows. - (replace-regexp-in-string "[ \t\n/.?]" "" x))) + (replace-regexp-in-string (rx (any " \t\n/.?")) "" x))) language-info-alist))))))) (tramp--test-deftest-with-stat tramp-test42-utf8) @@ -7476,7 +7482,7 @@ process sentinels. They shall not disturb each other." ert-remote-temporary-file-directory))) (should (string-match-p - "Tramp loaded: t[\n\r]+" + (rx "Tramp loaded: t" (+ (any "\n\r"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7503,9 +7509,9 @@ process sentinels. They shall not disturb each other." (dolist (tm '(t nil)) (should (string-match-p - (format - "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+" - tm) + (rx "Tramp loaded: nil" (+ (any "\n\r")) + "Tramp loaded: nil" (+ (any "\n\r")) + "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7550,11 +7556,10 @@ process sentinels. They shall not disturb each other." (tramp-cleanup-all-connections))")) (should (string-match-p - (format - "Loading %s" - (regexp-quote - (expand-file-name - "tramp-cmds" (file-name-directory (locate-library "tramp"))))) + (rx "Loading " + (literal + (expand-file-name + "tramp-cmds" (file-name-directory (locate-library "tramp"))))) (shell-command-to-string (format "%s -batch -Q -L %s -l tramp-sh --eval %s" @@ -7595,11 +7600,13 @@ Since it unloads Tramp, it shall be the last test to run." (and (or (and (boundp x) (null (local-variable-if-set-p x))) (and (functionp x) (null (autoloadp (symbol-function x)))) (macrop x)) - (string-match-p "^tramp" (symbol-name x)) + (string-prefix-p "tramp" (symbol-name x)) ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. (not (eq 'tramp-completion-mode x)) - (not (string-match-p "^tramp\\(-archive\\)?--?test" (symbol-name x))) - (not (string-match-p "unload-hook$" (symbol-name x))) + (not (string-match-p + (rx bol "tramp" (? "-archive") (** 1 2 "-") "test") + (symbol-name x))) + (not (string-suffix-p "unload-hook" (symbol-name x))) (not (get x 'tramp-autoload)) (ert-fail (format "`%s' still bound" x))))) @@ -7609,7 +7616,7 @@ Since it unloads Tramp, it shall be the last test to run." (mapatoms (lambda (x) (and (functionp x) (null (autoloadp (symbol-function x))) - (string-match-p "tramp-file-name" (symbol-name x)) + (string-prefix-p "tramp-file-name" (symbol-name x)) (ert-fail (format "Structure function `%s' still exists" x))))) ;; There shouldn't be left a hook function containing a Tramp @@ -7617,8 +7624,9 @@ Since it unloads Tramp, it shall be the last test to run." (mapatoms (lambda (x) (and (boundp x) - (string-match-p "-\\(hook\\|function\\)s?$" (symbol-name x)) - (not (string-match-p "unload-hook$" (symbol-name x))) + (string-match-p + (rx "-" (| "hook" "function") (? "s") eol) (symbol-name x)) + (not (string-suffix-p "unload-hook" (symbol-name x))) (consp (symbol-value x)) (ignore-errors (all-completions "tramp" (symbol-value x))) (ert-fail (format "Hook `%s' still contains Tramp function" x))))) @@ -7629,7 +7637,7 @@ Since it unloads Tramp, it shall be the last test to run." (and (functionp x) (advice-mapc (lambda (fun _symbol) - (and (string-match-p "^tramp" (symbol-name fun)) + (and (string-prefix-p "tramp" (symbol-name fun)) (ert-fail (format "Function `%s' still contains Tramp advice" x)))) x)))) @@ -7646,7 +7654,7 @@ If INTERACTIVE is non-nil, the tests are run interactively." (interactive "p") (funcall (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch) - "^tramp")) + (rx bol "tramp"))) ;; TODO: