mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-30 09:00:31 -08:00
Code Issues Projects Releases Wiki Activity

Upgrade to length* functions in Tramp

Browse source 
* lisp/net/tramp-compat.el (tramp-compat-replace-regexp-in-region):
Move up.
(tramp-compat-length<, tramp-compat-length>)
(tramp-compat-length=): New defaliases.
(tramp-compat-file-name-unquote, tramp-compat-take)
(tramp-compat-ntake): Use them.

* lisp/net/tramp.el (tramp-string-empty-or-nil-p): New defsubst.
(tramp-find-host, tramp-buffer-name, tramp-make-tramp-file-name)
(tramp-completion-make-tramp-file-name, tramp-debug-buffer-name)
(tramp-completion-handle-file-name-all-completions)
(tramp-handle-directory-file-name)
(tramp-handle-expand-file-name)
(tramp-handle-file-name-as-directory)
(tramp-handle-file-name-completion)
(tramp-direct-async-process-p, tramp-call-process)
(tramp-read-passwd):
* lisp/net/tramp-adb.el (tramp-adb-get-device)
(tramp-adb-execute-adb-command, tramp-adb-maybe-open-connection):
* lisp/net/tramp-archive.el (tramp-archive-handle-directory-file-name):
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name)
(tramp-gvfs-monitor-process-filter)
(tramp-gvfs-handle-get-home-directory)
(tramp-gvfs-handler-askpassword)
(tramp-gvfs-maybe-open-connection, tramp-get-media-devices):
* lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection):
* lisp/net/tramp-sh.el (tramp-sh-handle-file-directory-p)
(tramp-sh-handle-insert-directory)
(tramp-sh-handle-expand-file-name, tramp-sh-handle-make-process)
(tramp-sh-gio-monitor-process-filter, tramp-set-remote-path)
(tramp-open-connection-setup-interactive-shell)
(tramp-maybe-open-connection, tramp-make-copy-program-file-name):
* lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
(tramp-smb-handle-expand-file-name, tramp-smb-handle-file-acl)
(tramp-smb-handle-insert-directory)
(tramp-smb-handle-set-file-acl)
(tramp-smb-handle-get-home-directory)
(tramp-smb-maybe-open-connection):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-expand-file-name)
(tramp-sudoedit-handle-file-name-all-completions): Use the new
functions.

* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test43-file-system-info):
* test/lisp/net/tramp-tests.el (tramp-test26-file-name-completion)
(tramp-test31-memory-info, tramp-test35-remote-path)
(tramp-test43-file-system-info): Use new compat functions.
This commit is contained in:
Michael Albinus 2023-01-15 17:50:17 +01:00
parent 77ca6aa56e
commit ead86da14b
11 changed files with 150 additions and 117 deletions
Download patch file Download diff file Expand all files Collapse all files

9
lisp/net/tramp-adb.el
View file

@ -1078,11 +1078,12 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
(format "%s:%s" host port))
;; An empty host name shall be mapped as well, when there
;; is exactly one entry in `devices'.
((and (zerop (length host)) (= (length devices) 1))
((and (tramp-string-empty-or-nil-p host)
(tramp-compat-length= devices 1))
(car devices))
;; Try to connect device.
((and tramp-adb-connect-if-not-connected
(not (zerop (length host)))
(tramp-compat-length> host 0)
(tramp-adb-execute-adb-command
vec "connect"
(tramp-compat-string-replace
@ -1099,7 +1100,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\"
"Execute an adb command.
Insert the result into the connection buffer. Return nil on
error and non-nil on success."
(when (and (> (length (tramp-file-name-host vec)) 0)
(when (and (tramp-compat-length> (tramp-file-name-host vec) 0)
;; The -s switch is only available for ADB device commands.
(not (member (car args) '("connect" "disconnect"))))
(setq args (append (list "-s" (tramp-adb-get-device vec)) args)))
@ -1226,7 +1227,7 @@ connection if a previous connection has died for some reason."
(unless (process-live-p p)
(save-match-data
(when (and p (processp p)) (delete-process p))
(if (zerop (length device))
(if (tramp-string-empty-or-nil-p device)
(tramp-error vec 'file-error "Device %s not connected" host))
(with-tramp-progress-reporter vec 3 "Opening adb shell connection"
(let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?

2
lisp/net/tramp-archive.el
View file

@ -598,7 +598,7 @@ offered."
(defun tramp-archive-handle-directory-file-name (directory)
"Like `directory-file-name' for file archives."
(with-parsed-tramp-archive-file-name directory nil
(if (and (not (zerop (length localname)))
(if (and (tramp-compat-length> localname 0)
(eq (aref localname (1- (length localname))) ?/)
(not (string= localname "/")))
(substring directory 0 -1)

69
lisp/net/tramp-compat.el
View file

@ -178,6 +178,48 @@ Add the extension of F, if existing."
(car components))
(cdr components)))))))
;; Function `replace-regexp-in-region' is new in Emacs 28.1.
(defalias 'tramp-compat-replace-regexp-in-region
(if (fboundp 'replace-regexp-in-region)
#'replace-regexp-in-region
(lambda (regexp replacement &optional start end)
(if start
(when (< start (point-min))
(error "Start before start of buffer"))
(setq start (point)))
(if end
(when (> end (point-max))
(error "End after end of buffer"))
(setq end (point-max)))
(save-excursion
(let ((matches 0)
(case-fold-search nil))
(goto-char start)
(while (re-search-forward regexp end t)
(replace-match replacement t)
(setq matches (1+ matches)))
(and (not (zerop matches))
matches))))))
;; `length<', `length>' and `length=' are added to Emacs 28.1.
(defalias 'tramp-compat-length<
(if (fboundp 'length<)
#'length<
(lambda (sequence length)
(< (length sequence) length))))
(defalias 'tramp-compat-length>
(if (fboundp 'length>)
#'length>
(lambda (sequence length)
(> (length sequence) length))))
(defalias 'tramp-compat-length=
(if (fboundp 'length=)
#'length=
(lambda (sequence length)
(= (length sequence) length))))
;; `permission-denied' is introduced in Emacs 29.1.
(defconst tramp-permission-denied
(if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error)
@ -205,7 +247,7 @@ Add the extension of F, if existing."
#'take
(lambda (n list)
(when (and (natnump n) (> n 0))
(if (>= n (length list))
(if (tramp-compat-length< list n)
list (butlast list (- (length list) n)))))))
;; Function `ntake' is new in Emacs 29.1.
@ -214,7 +256,7 @@ Add the extension of F, if existing."
#'ntake
(lambda (n list)
(when (and (natnump n) (> n 0))
(if (>= n (length list))
(if (tramp-compat-length< list n)
list (nbutlast list (- (length list) n)))))))
;; Function `string-equal-ignore-case' is new in Emacs 29.1.
@ -234,29 +276,6 @@ Add the extension of F, if existing."
(autoload 'netrc-parse "netrc")
(netrc-parse file))))
;; Function `replace-regexp-in-region' is new in Emacs 28.1.
(defalias 'tramp-compat-replace-regexp-in-region
(if (fboundp 'replace-regexp-in-region)
#'replace-regexp-in-region
(lambda (regexp replacement &optional start end)
(if start
(when (< start (point-min))
(error "Start before start of buffer"))
(setq start (point)))
(if end
(when (> end (point-max))
(error "End after end of buffer"))
(setq end (point-max)))
(save-excursion
(let ((matches 0)
(case-fold-search nil))
(goto-char start)
(while (re-search-forward regexp end t)
(replace-match replacement t)
(setq matches (1+ matches)))
(and (not (zerop matches))
matches))))))
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t))

19
lisp/net/tramp-gvfs.el
View file

@ -1154,7 +1154,8 @@ file names."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
(when (zerop (length name)) (setq name "."))
(when (string-empty-p name)
(setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
@ -1169,7 +1170,7 @@ file names."
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
hname)
(when (zerop (length uname))
(when (tramp-string-empty-or-nil-p uname)
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@ -1530,7 +1531,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
'file-notify-callback (list proc action file file1)))))
;; Save rest of the string.
(when (zerop (length string)) (setq string nil))
(when (string-empty-p string) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(process-put proc 'rest-string string)))
@ -1611,7 +1612,7 @@ VEC or USER, or if there is no home directory, return nil."
(let ((localname (tramp-get-connection-property vec "default-location"))
result)
(cond
((zerop (length localname))
((tramp-string-empty-or-nil-p localname)
(tramp-get-connection-property (tramp-get-process vec) "share"))
;; Google-drive.
((not (string-prefix-p "/" localname))
@ -1743,11 +1744,11 @@ a downcased host name only."
(condition-case nil
(with-parsed-tramp-file-name filename l
(when (and (zerop (length user))
(when (and (tramp-string-empty-or-nil-p user)
(not
(zerop (logand flags tramp-gvfs-password-need-username))))
(setq user (read-string "User name: ")))
(when (and (zerop (length domain))
(when (and (tramp-string-empty-or-nil-p domain)
(not
(zerop (logand flags tramp-gvfs-password-need-domain))))
(setq domain (read-string "Domain name: ")))
@ -2184,7 +2185,7 @@ connection if a previous connection has died for some reason."
(with-tramp-progress-reporter
vec 3
(if (zerop (length user))
(if (tramp-string-empty-or-nil-p user)
(format "Opening connection for %s using %s" host method)
(format "Opening connection for %s@%s using %s" user host method))
@ -2234,7 +2235,7 @@ connection if a previous connection has died for some reason."
(with-timeout
((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
tramp-connection-timeout)
(if (zerop (length (tramp-file-name-user vec)))
(if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
(tramp-error
vec 'file-error
"Timeout reached mounting %s using %s" host method)
@ -2413,7 +2414,7 @@ VEC is used only for traces."
;; Adapt default host name, supporting /mtp:: when possible.
(setq tramp-default-host-alist
(append
`(("mtp" nil ,(if (= (length devices) 1) (car devices) "")))
`(("mtp" nil ,(if (tramp-compat-length= devices 1) (car devices) "")))
(delete
(assoc "mtp" tramp-default-host-alist)
tramp-default-host-alist)))))

2
lisp/net/tramp-rclone.el
View file

@ -361,7 +361,7 @@ connection if a previous connection has died for some reason."
(let ((host (tramp-file-name-host vec)))
(when (rassoc `(,host) (tramp-rclone-parse-device-names nil))
(if (zerop (length host))
(if (tramp-string-empty-or-nil-p host)
(tramp-error vec 'file-error "Storage %s not connected" host))
;; We need a process bound to the connection buffer. Therefore,
;; we create a dummy process. Maybe there is a better solution?

27
lisp/net/tramp-sh.el
View file

@ -1736,7 +1736,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; Sometimes, when a connection is not established yet, it is
;; desirable to return t immediately for "/method:foo:". It can
;; be expected that this is always a directory.
(or (zerop (length localname))
(or (tramp-string-empty-or-nil-p localname)
(with-tramp-file-property v localname "file-directory-p"
(if-let
((truename (tramp-get-file-property v localname "file-truename"))
@ -2349,7 +2349,7 @@ The method used must be an out-of-band method."
copy-program copy-args copy-env copy-keep-date listener spec
options source target remote-copy-program remote-copy-args p)
(if (and v1 v2 (zerop (length (tramp-scp-direct-remote-copying v1 v2))))
(if (and v1 v2 (string-empty-p (tramp-scp-direct-remote-copying v1 v2)))
;; Both are Tramp files. We cannot use direct remote copying.
(let* ((dir-flag (file-directory-p filename))
@ -2684,9 +2684,9 @@ The method used must be an out-of-band method."
(tramp-get-ls-command v)
switches
(if (or wildcard
(zerop (length
(tramp-string-empty-or-nil-p
(tramp-run-real-handler
#'file-name-nondirectory (list localname)))))
#'file-name-nondirectory (list localname))))
""
(tramp-shell-quote-argument
(tramp-run-real-handler
@ -2803,7 +2803,8 @@ the result will be a local, non-Tramp, file name."
;; If DIR is not given, use `default-directory' or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
(when (zerop (length name)) (setq name "."))
(when (string-empty-p name)
(setq name "."))
;; On MS Windows, some special file names are not returned properly
;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified',
;; there could be the false positive "/:".
@ -2838,7 +2839,7 @@ the result will be a local, non-Tramp, file name."
;; the default user name for tilde expansion is not
;; appropriate either, because ssh and companions might
;; use a user name from the config file.
(when (and (zerop (length uname))
(when (and (tramp-string-empty-or-nil-p uname)
(string-match-p (rx bos "su" (? "do") eos) method))
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
@ -2939,7 +2940,7 @@ implementation will be used."
(heredoc (and (not (bufferp stderr))
(stringp program)
(string-match-p (rx "sh" eol) program)
(= (length args) 2)
(tramp-compat-length= args 2)
(string-equal "-c" (car args))
;; Don't if there is a quoted string.
(not
@ -2949,7 +2950,7 @@ implementation will be used."
;; When PROGRAM is nil, we just provide a tty.
(args (if (not heredoc) args
(let ((i 250))
(while (and (< i (length (cadr args)))
(while (and (not (tramp-compat-length< (cadr args) i))
(string-match " " (cadr args) i))
(setcdr
args
@ -3931,7 +3932,7 @@ Fall back to normal file name handler if no Tramp handler exists."
;; Save rest of the string.
(while (string-match (rx bol "\n") string)
(setq string (replace-match "" nil nil string)))
(when (zerop (length string)) (setq string nil))
(when (string-empty-p string) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(process-put proc 'rest-string string)))
@ -4176,7 +4177,7 @@ variable PATH."
'noerror)))
tmpfile chunk chunksize)
(tramp-message vec 5 "Setting $PATH environment variable")
(if (< (length command) pipe-buf)
(if (tramp-compat-length< command pipe-buf)
(tramp-send-command vec command)
;; Use a temporary file. We cannot use `write-region' because
;; setting the remote path happens in the early connection
@ -4565,7 +4566,7 @@ process to set up. VEC specifies the connection."
;; Set `remote-tty' process property.
(let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror)))
(unless (zerop (length tty))
(unless (string-empty-p tty)
(process-put proc 'remote-tty tty)
(tramp-set-connection-property proc "remote-tty" tty)))
@ -5138,7 +5139,7 @@ connection if a previous connection has died for some reason."
(unless (process-live-p p)
(with-tramp-progress-reporter
vec 3
(if (zerop (length (tramp-file-name-user vec)))
(if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
(format "Opening connection %s for %s using %s"
process-name
(tramp-file-name-host vec)
@ -5511,7 +5512,7 @@ raises an error."
(cond
((tramp-get-method-parameter vec 'tramp-remote-copy-program)
localname)
((zerop (length user)) (format "%s:%s" host localname))
((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname))
(t (format "%s@%s:%s" user host localname)))))
(defun tramp-method-out-of-band-p (vec size)

40
lisp/net/tramp-smb.el
View file

@ -487,9 +487,9 @@ arguments to pass to the OPERATION."
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
(setq args (append args (list "-N"))))
(if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-N")))
(setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port))))
@ -712,7 +712,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
(when (zerop (length name)) (setq name "."))
(when (string-empty-p name)
(setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
@ -727,7 +728,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
hname)
(when (zerop (length uname))
(when (tramp-string-empty-or-nil-p uname)
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@ -781,9 +782,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
(setq args (append args (list "-N"))))
(if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-N")))
(setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port))))
@ -1071,7 +1072,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq entries
(delq
nil
(if (or wildcard (zerop (length base)))
(if (or wildcard (string-empty-p base))
;; Check for matching entries.
(mapcar
(lambda (x)
@ -1096,7 +1097,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (tramp-compat-string-search "F" switches)
(mapc
(lambda (x)
(unless (zerop (length (car x)))
(unless (string-empty-p (car x))
(cond
((char-equal ?d (string-to-char (nth 1 x)))
(setcar x (concat (car x) "/")))
@ -1116,7 +1117,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Print entries.
(mapc
(lambda (x)
(unless (zerop (length (nth 0 x)))
(unless (string-empty-p (nth 0 x))
(let ((attr
(when (tramp-smb-get-stat-capability v)
(ignore-errors
@ -1409,9 +1410,9 @@ component is used as the target of the symlink."
"\n" "," acl-string)))
(options tramp-smb-options))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
(setq args (append args (list "-N"))))
(if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-N")))
(setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port))))
@ -1561,7 +1562,7 @@ If USER is a string, return its home directory instead of the
user identified by VEC. If there is no user specified in either
VEC or USER, or if there is no home directory, return nil."
(let ((user (or user (tramp-file-name-user vec))))
(unless (zerop (length user))
(unless (tramp-string-empty-or-nil-p user)
(concat "/" user))))
(defun tramp-smb-handle-write-region
@ -1959,9 +1960,9 @@ If ARGUMENT is non-nil, use it as argument for
(t
(setq args (list "-g" "-L" host ))))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
(setq args (append args (list "-N"))))
(if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-N")))
(setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port))))
@ -1976,7 +1977,8 @@ If ARGUMENT is non-nil, use it as argument for
(with-tramp-progress-reporter
vec 3
(format "Opening connection for //%s%s/%s"
(if (not (zerop (length user))) (concat user "@") "")
(if (tramp-string-empty-or-nil-p user)
"" (concat user "@"))
host (or share ""))
(let* (coding-system-for-read

9
lisp/net/tramp-sudoedit.el
View file

@ -363,7 +363,8 @@ the result will be a local, non-Tramp, file name."
;; If DIR is not given, use `default-directory' or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
(when (zerop (length name)) (setq name "."))
(when (string-empty-p name)
(setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
@ -374,7 +375,7 @@ the result will be a local, non-Tramp, file name."
;; Tilde expansion if necessary. We cannot accept "~/", because
;; under sudo "~/" is expanded to the local user home directory
;; but to the root home directory.
(when (zerop (length localname))
(when (tramp-string-empty-or-nil-p localname)
(setq localname "~"))
(unless (file-name-absolute-p localname)
(setq localname (format "~%s/%s" user localname)))
@ -383,7 +384,7 @@ the result will be a local, non-Tramp, file name."
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
hname)
(when (zerop (length uname))
(when (tramp-string-empty-or-nil-p uname)
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@ -471,7 +472,7 @@ the result will be a local, non-Tramp, file name."
(with-tramp-file-property v localname "file-name-all-completions"
(tramp-sudoedit-send-command
v "ls" "-a1" "--quoting-style=literal" "--show-control-chars"
(if (zerop (length localname))
(if (tramp-string-empty-or-nil-p localname)
"" (file-name-unquote localname)))
(mapcar
(lambda (f)

62
lisp/net/tramp.el
View file

@ -1630,7 +1630,7 @@ This is USER, if non-nil. Otherwise, do a lookup in
This is HOST, if non-nil. Otherwise, do a lookup in
`tramp-default-host-alist' and `tramp-default-host'."
(let ((result
(or (and (> (length host) 0) host)
(or (and (tramp-compat-length> host 0) host)
(let ((choices tramp-default-host-alist)
lhost item)
(while choices
@ -1642,7 +1642,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in
lhost)
tramp-default-host)))
;; We must mark, whether a default value has been used.
(if (or (> (length host) 0) (null result))
(if (or (tramp-compat-length> host 0) (null result))
result
(propertize result 'tramp-default t))))
@ -1748,14 +1748,18 @@ See `tramp-dissect-file-name' for details."
(put #'tramp-dissect-hop-name 'tramp-suppress-trace t)
(defsubst tramp-string-empty-or-nil-p (string)
"Check whether STRING is empty or nil."
(or (null string) (string= string "")))
(defun tramp-buffer-name (vec)
"A name for the connection buffer VEC."
(let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec)))
(if (not (zerop (length user-domain)))
(format "*tramp/%s %s@%s*" method user-domain host-port)
(format "*tramp/%s %s*" method host-port))))
(if (tramp-string-empty-or-nil-p user-domain)
(format "*tramp/%s %s*" method host-port)
(format "*tramp/%s %s@%s*" method user-domain host-port))))
(put #'tramp-buffer-name 'tramp-suppress-trace t)
@ -1800,23 +1804,23 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
hop (nth 6 args))))
;; Unless `tramp-syntax' is `simplified', we need a method.
(when (and (not (zerop (length tramp-postfix-method-format)))
(zerop (length method)))
(when (and (not (string-empty-p tramp-postfix-method-format))
(tramp-string-empty-or-nil-p method))
(signal 'wrong-type-argument (list #'stringp method)))
(concat tramp-prefix-format hop
(unless (zerop (length tramp-postfix-method-format))
(unless (string-empty-p tramp-postfix-method-format)
(concat method tramp-postfix-method-format))
user
(unless (zerop (length domain))
(unless (tramp-string-empty-or-nil-p domain)
(concat tramp-prefix-domain-format domain))
(unless (zerop (length user))
(unless (tramp-string-empty-or-nil-p user)
tramp-postfix-user-format)
(when host
(if (string-match-p tramp-ipv6-regexp host)
(concat
tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
host))
(unless (zerop (length port))
(unless (tramp-string-empty-or-nil-p port)
(concat tramp-prefix-port-format port))
tramp-postfix-host-format
localname)))
@ -1840,12 +1844,12 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
It must not be a complete Tramp file name, but as long as there are
necessary only. This function will be used in file name completion."
(concat tramp-prefix-format
(unless (or (zerop (length method))
(zerop (length tramp-postfix-method-format)))
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-postfix-method-format))
(concat method tramp-postfix-method-format))
(unless (zerop (length user))
(unless (tramp-string-empty-or-nil-p user)
(concat user tramp-postfix-user-format))
(unless (zerop (length host))
(unless (tramp-string-empty-or-nil-p host)
(concat
(if (string-match-p tramp-ipv6-regexp host)
(concat
@ -1940,9 +1944,9 @@ of `current-buffer'."
(let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec)))
(if (not (zerop (length user-domain)))
(format "*debug tramp/%s %s@%s*" method user-domain host-port)
(format "*debug tramp/%s %s*" method host-port))))
(if (tramp-string-empty-or-nil-p user-domain)
(format "*debug tramp/%s %s*" method host-port)
(format "*debug tramp/%s %s@%s*" method user-domain host-port))))
(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
@ -2942,10 +2946,10 @@ not in completion mode."
(tramp-drop-volume-letter (expand-file-name filename directory)))
;; When `tramp-syntax' is `simplified', we need a default method.
(tramp-default-method
(and (zerop (length tramp-postfix-method-format))
(and (string-empty-p tramp-postfix-method-format)
tramp-default-method))
(tramp-default-method-alist
(and (zerop (length tramp-postfix-method-format))
(and (string-empty-p tramp-postfix-method-format)
tramp-default-method-alist))
tramp-default-user tramp-default-user-alist
tramp-default-host tramp-default-host-alist
@ -3768,7 +3772,7 @@ Let-bind it when necessary.")
;; Otherwise, remove any trailing slash from localname component.
;; Method, host, etc, are unchanged.
(while (with-parsed-tramp-file-name directory nil
(and (not (zerop (length localname)))
(and (tramp-compat-length> localname 0)
(eq (aref localname (1- (length localname))) ?/)
(not (string= localname "/"))))
(setq directory (substring directory 0 -1)))
@ -3799,7 +3803,8 @@ Let-bind it when necessary.")
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
(when (zerop (length name)) (setq name "."))
(when (string-empty-p name)
(setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
@ -3818,7 +3823,7 @@ Let-bind it when necessary.")
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
hname)
(when (zerop (length uname))
(when (tramp-string-empty-or-nil-p uname)
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@ -3901,7 +3906,7 @@ Let-bind it when necessary.")
;; Run the command on the localname portion only unless we are in
;; completion mode.
(tramp-make-tramp-file-name
v (or (and (zerop (length (tramp-file-name-localname v)))
v (or (and (tramp-string-empty-or-nil-p (tramp-file-name-localname v))
(not (tramp-connectable-p file)))
(tramp-run-real-handler
#'file-name-as-directory
@ -3964,7 +3969,8 @@ Let-bind it when necessary.")
;; "." and ".." are never interesting as completions, and are
;; actually in the way in a directory with only one file. See
;; file_name_completion() in dired.c.
(when (and (consp fnac) (= (length (delete "./" (delete "../" fnac))) 1))
(when (and (consp fnac)
(tramp-compat-length= (delete "./" (delete "../" fnac)) 1))
(setq fnac (delete "./" (delete "../" fnac))))
(or
(try-completion
@ -4725,7 +4731,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for
(tramp-get-connection-property v "direct-async-process")
;; There's no multi-hop.
(or (not (tramp-multi-hop-p v))
(= (length (tramp-compute-multi-hops v)) 1))
(null (cdr (tramp-compute-multi-hops v))))
;; There's no remote stdout or stderr file.
(or (not (stringp buffer)) (not (tramp-tramp-file-p buffer)))
(or (not (stringp stderr)) (not (tramp-tramp-file-p stderr))))))
@ -6343,7 +6349,7 @@ are written with verbosity of 6."
(error
(setq error (error-message-string err)
result 1)))
(if (zerop (length error))
(if (tramp-string-empty-or-nil-p error)
(tramp-message vec 6 "%s\n%s" result output)
(tramp-message vec 6 "%s\n%s\n%s" result output error))
result))
@ -6479,7 +6485,7 @@ Consults the auth-source package."
;; Workaround. Prior Emacs 28.1, auth-source has saved empty
;; passwords. See discussion in Bug#50399.
(when (zerop (length auth-passwd))
(when (tramp-string-empty-or-nil-p auth-passwd)
(setq tramp-password-save-function nil))
(tramp-set-connection-property vec "first-password-request" nil)

2
test/lisp/net/tramp-archive-tests.el
View file

@ -872,7 +872,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(let ((fsi (file-system-info tramp-archive-test-archive)))
(skip-unless fsi)
(should (and (consp fsi)
(= (length fsi) 3)
(tramp-compat-length= fsi 3)
(numberp (nth 0 fsi))
;; FREE and AVAIL are always 0.
(zerop (nth 1 fsi))

20
test/lisp/net/tramp-tests.el
View file

@ -4516,17 +4516,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(and (string-match-p tramp-ipv6-regexp host)
tramp-postfix-ipv6-format)))
;; Complete method name.
(unless (or (zerop (length method))
(zerop (length tramp-method-regexp)))
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp))
(should
(member
(concat prefix-format method tramp-postfix-method-format)
(file-name-all-completions
(concat prefix-format (substring method 0 1)) "/"))))
;; Complete host name.
(unless (or (zerop (length method))
(zerop (length tramp-method-regexp))
(zerop (length host))
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp)
(tramp-string-empty-or-nil-p host)
(tramp--test-gvfs-p method))
(should
(member
@ -5370,7 +5370,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(when-let ((default-directory ert-remote-temporary-file-directory)
(mi (memory-info)))
(should (consp mi))
(should (= (length mi) 4))
(should (tramp-compat-length= mi 4))
(dotimes (i (length mi))
(should (natnump (nth i mi))))))
@ -5915,7 +5915,8 @@ INPUT, if non-nil, is a string sent to the process."
;; We make a super long `tramp-remote-path'.
(make-directory tmp-name)
(should (file-directory-p tmp-name))
(while (< (length (mapconcat #'identity orig-exec-path ":")) 5000)
(while (tramp-compat-length<
(mapconcat #'identity orig-exec-path ":") 5000)
(let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir)))
(should (file-directory-p dir))
(setq tramp-remote-path
@ -5931,7 +5932,8 @@ INPUT, if non-nil, is a string sent to the process."
;; Ignore trailing newline.
(setq path (substring (shell-command-to-string "echo $PATH") nil -1))
;; The shell doesn't handle such long strings.
(when (<= (length path)
(unless (tramp-compat-length>
path
(tramp-get-connection-property
tramp-test-vec "pipe-buf" 4096))
;; The last element of `exec-path' is `exec-directory'.
@ -7070,7 +7072,7 @@ This requires restrictions of file name syntax."
(when-let ((fsi (file-system-info ert-remote-temporary-file-directory)))
(should (consp fsi))
(should (= (length fsi) 3))
(should (tramp-compat-length= fsi 3))
(dotimes (i (length fsi))
(should (natnump (or (nth i fsi) 0))))))