[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master be2e6228f8: Use `rx' in Tramp where possible
|
From: |
Michael Albinus |
|
Subject: |
master be2e6228f8: Use `rx' in Tramp where possible |
|
Date: |
Fri, 26 Aug 2022 10:20:01 -0400 (EDT) |
branch: master
commit be2e6228f8c9c57d2809bdd953d065ebfc63d4c4
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
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.
---
lisp/net/tramp-adb.el | 107 +++---
lisp/net/tramp-archive.el | 22 +-
lisp/net/tramp-cache.el | 5 +-
lisp/net/tramp-cmds.el | 54 +--
lisp/net/tramp-compat.el | 4 +-
lisp/net/tramp-crypt.el | 8 +-
lisp/net/tramp-ftp.el | 4 +-
lisp/net/tramp-fuse.el | 13 +-
lisp/net/tramp-gvfs.el | 128 ++++---
lisp/net/tramp-integration.el | 13 +-
lisp/net/tramp-rclone.el | 10 +-
lisp/net/tramp-sh.el | 250 +++++++------
lisp/net/tramp-smb.el | 255 +++++++------
lisp/net/tramp-sshfs.el | 2 +-
lisp/net/tramp-sudoedit.el | 31 +-
lisp/net/tramp.el | 688 ++++++++++++++++++-----------------
test/lisp/net/tramp-archive-tests.el | 51 +--
test/lisp/net/tramp-tests.el | 252 ++++++-------
18 files changed, 996 insertions(+), 901 deletions(-)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index be231fcba6..b38b908edb 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 548999ca1d..0d931b42da 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -168,7 +168,8 @@
It must be supported by libarchive(3).")
;; <https://unix-memo.readthedocs.io/en/latest/vfs.html>
-;; 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 289df2f9aa..6a3e60f703 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 b2a68fc5eb..a7ac135266 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 203d3ede98..b7c0a3113e 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 657437b283..e7bb1ebe33 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 dd7e0f9f34..ad736256ca 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 486a3cc57b..4b51af070a 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 ca5e959bea..9060f37ed5 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.")
;; </interface>
(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 226113d880..946f972502 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 5bee5641bb..435faf8329 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 ca08c6f0b3..2489ac9aec 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 ba0a1d3598..9e63d53262 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 4e3b94277b..31720a605e 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 643b5f35c0..893afcdbbe 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 238ec50c40..bb6eeaa741 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."
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
(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 .+>\\) \\)?" ;; Thread.
- "[[:alnum:]-]+ (\\([[:digit:]]+\\)) #") ;; Function name, verbosity.
+ (rx ;; Timestamp.
+ (+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) " "
+ ;; Thread.
+ (? (group "#<thread " (+ nonl) ">") " ")
+ ;; 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 f51037aabb..964404b4bf 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 3e318a729d..bc67ff2ace 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 <CR><NUL> 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 <CR><NUL> 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:
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master be2e6228f8: Use `rx' in Tramp where possible,
Michael Albinus <=