commit 0a6a25320eb671816087164b17e6ecb68632303c (HEAD, refs/remotes/origin/master) Merge: 1bf92d91950 1e8322bb26e Author: Jim Porter Date: Sat Aug 5 21:26:14 2023 -0700 Merge from origin/emacs-29 1e8322bb26e Fix handling of 'byte-compile-ignore-files' when nil commit 1e8322bb26e4945de460780168732250bbd083d0 Author: Jim Porter Date: Fri Aug 4 13:01:35 2023 -0700 Fix handling of 'byte-compile-ignore-files' when nil Before this fix, when 'byte-compile-ignore-files' was nil, 'byte-recompile-directory' would ignore every file (bug#64985). * lisp/emacs-lisp/bytecomp.el (byte-recompile-directory): Handle case when 'byte-compile-ignore-files' is nil. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 65ccb60726f..d093d95a775 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1923,7 +1923,9 @@ byte-recompile-directory (let ((directories (list default-directory)) (default-directory default-directory) (ignore-files-regexp - (mapconcat #'identity byte-compile-ignore-files "\\|")) + (if byte-compile-ignore-files + (mapconcat #'identity byte-compile-ignore-files "\\|") + regexp-unmatchable)) (skip-count 0) (fail-count 0) (file-count 0) commit 1bf92d91950271c497675d3a7dc418fc6bf75175 Author: Mattias Engdegård Date: Sat Aug 5 18:22:07 2023 +0200 * test/lisp/align-resources/c-mode.erts: Make test agree with Emacs This eliminates a failure in align-tests. There doesn't seem to be anything obviously wrong with Emacs's behaviour in this case. diff --git a/test/lisp/align-resources/c-mode.erts b/test/lisp/align-resources/c-mode.erts index ecdff507103..a28c2bdbed0 100644 --- a/test/lisp/align-resources/c-mode.erts +++ b/test/lisp/align-resources/c-mode.erts @@ -17,7 +17,7 @@ Name: example from Commentary short foo = 2; double blah = 4; =-= - int a = 1; - short foo = 2; - double blah = 4; + int a = 1; + short foo = 2; + double blah = 4; =-=-= commit 1fc95b23a6929f1eff749795ae83ffd77a481f54 Merge: 479c0543b68 2695af297e8 Author: Michael Albinus Date: Sat Aug 5 18:18:31 2023 +0200 ; Merge from origin/emacs-29 The following commit was skipped: 2695af297e8 Sync with Tramp 2.6.2-pre commit 479c0543b68746977cf74414d5348a918f8c6695 Merge: 8e20da1517a f2b2c752a59 Author: Michael Albinus Date: Sat Aug 5 18:18:30 2023 +0200 Merge from origin/emacs-29 f2b2c752a59 Fix documentation of saveplace facilities for Dired 4ed9d61c89a ; * lisp/tab-bar.el: Autoload cl--set-substring, as that ... 30976ecd8d8 ; * lisp/bindings.el (mode-line-modes): Fix typo (bug#650... 8574ef314c4 Fix loaddef generation with ";;;foo-autoload" cookies in ... 8cbd4a02a2b Delete comment saying that project.el is experimental commit 2695af297e8811d98f3082013f5bf4a5d0281efe Author: Michael Albinus Date: Sat Aug 5 18:07:58 2023 +0200 Sync with Tramp 2.6.2-pre * doc/misc/tramp.texi (Overview): Use "scp" in example. (Obtaining @value{tramp}): Prefer https: to git: URIs on Savannah. (Ssh setup): Extend for MS Windows and ssh. Explain tramp-use-ssh-controlmaster-options value `suppress'. (File name completion): Remove completion styles restrictions. (Ad-hoc multi-hops): Describe tramp-show-ad-hoc-proxies. (Remote processes): Add reference to "Using ssh connection sharing". * doc/misc/trampver.texi: * lisp/net/trampver.el (tramp-version): Set to "2.6.2-pre". * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): * lisp/net/tramp-archive.el (tramp-archive-handle-file-name-all-completions): * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions): * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-name-all-completions): Return nil when DIRECTORY is missing. (Bug#61890) * lisp/net/tramp.el (tramp-accept-process-output): Don't use TIMEOUT anymore, default it to 0. When the connection uses a shared socket possibly, accept also the output from other processes over the same connection. (Bug#61350) (tramp-handle-file-notify-rm-watch, tramp-action-process-alive) (tramp-action-out-of-band, tramp-process-one-action) (tramp-interrupt-process): * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch): * lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch): * lisp/net/tramp-smb.el (tramp-smb-action-get-acl) (tramp-smb-action-set-acl, tramp-smb-wait-for-output): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-action-sudo): Adapt callees. * lisp/net/tramp.el (tramp-get-process, tramp-message) (tramp-handle-make-process, tramp-handle-file-notify-valid-p) (tramp-process-actions, tramp-accept-process-output) (tramp-process-sentinel, tramp-read-passwd) (tramp-interrupt-process, tramp-signal-process): * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): * lisp/net/tramp-cmds.el (tramp-cleanup-connection): * lisp/net/tramp-crypt.el (tramp-crypt-maybe-open-connection): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch) (tramp-gvfs-monitor-process-filter) (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) (tramp-sh-handle-file-notify-add-watch) (tramp-sh-gio-monitor-process-filter) (tramp-sh-inotifywait-process-filter) (tramp-barf-if-no-shell-prompt, tramp-maybe-open-connection): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl) (tramp-smb-maybe-open-connection): * lisp/net/tramp-sshfs.el (tramp-sshfs-maybe-open-connection): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection) (tramp-sudoedit-send-command): Prefix internal process properties with "tramp-". * lisp/net/tramp.el (tramp-skeleton-file-exists-p): New defmacro, which also handles host name completion. (tramp-handle-file-exists-p): * lisp/net/tramp-adb.el (tramp-adb-handle-file-exists-p): * lisp/net/tramp-sh.el (tramp-sh-handle-file-exists-p): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-exists-p): Use it. * lisp/net/tramp.el (tramp-wrong-passwd-regexp): * lisp/net/tramp-adb.el (tramp-adb-prompt): * lisp/net/tramp-sh.el (tramp-sh-inotifywait-process-filter): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Unify regexps. * lisp/net/tramp.el: * lisp/net/tramp-cmds.el: * lisp/net/tramp-crypt.el: * lisp/net/tramp-gvfs.el: * lisp/net/tramp-sh.el: * lisp/net/tramp-smb.el: Fix error messages. * lisp/net/tramp-cmds.el (tramp-cleanup-connection): Protect `delete-process'. * 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): * lisp/net/tramp-compat.el (tramp-syntax): * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-event-vector): Rearrange declarations. * lisp/net/tramp-compat.el (ansi-color): Require. (ls-lisp): Don't require. (Bug#64124) (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-container.el (tramp-container--completion-function): Rename from `tramp-docker--completion-function'. Add argument PROGRAM. Use it for "docker" and "podman" host name completion. * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-exists-p): New defun. (tramp-crypt-file-name-handler-alist): Add it. * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-exists-p): New defun. (tramp-fuse-mount-timeout): Move up. (tramp-fuse-mount-point): Use `tramp-fuse-mount-timeout'. (tramp-fuse-unmount): Flush "mount-point" file property. (tramp-fuse-mount-point, tramp-fuse-mounted-p): Support existing mount points. (tramp-fuse-mounted-p): The mount-spec could contain an optional trailing slash. (Bug#64278) * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file) * lisp/net/tramp-rclone.el (tramp-rclone-do-copy-or-rename-file): Improve stability for WebDAV. (tramp-rclone-handle-file-system-info): Check return code of command. * lisp/net/tramp-gvfs.el (while-no-input-ignore-events): Add `dbus-event' for older Emacs versions. (tramp-gvfs-parse-device-names): Ignore errors. * lisp/net/tramp-sh.el (tramp-display-escape-sequence-regexp) (tramp-device-escape-sequence-regexp): Delete. (tramp-sh-handle-insert-directory, tramp-barf-if-no-shell-prompt) (tramp-wait-for-output): Use `ansi-color-control-seq-regexp'. (tramp-use-ssh-controlmaster-options): Allow new value `suppress'. (tramp-ssh-option-exists-p): New defun. (tramp-ssh-controlmaster-options): Implement `suppress' actions. Should never return nil, but empty string. (tramp-perl-file-name-all-completions): Don't print status message. (tramp-sh-handle-file-name-all-completions): Return nil when check fails. (Bug#61890) (tramp-run-test): Add VEC argument. (tramp-sh-handle-file-executable-p) (tramp-sh-handle-file-readable-p) (tramp-sh-handle-file-directory-p) (tramp-sh-handle-file-writable-p): Adapt callees. (tramp-sh-handle-insert-directory): (tramp-sh-handle-insert-directory): Test whether -N is understood by ls since that option is used along with --dired. Remove -N when we remove --dired. (Bug#63142) (tramp-sh-handle-insert-directory, tramp-barf-if-no-shell-prompt) (tramp-wait-for-output): Use `ansi-color-control-seq-regexp'. (tramp-sh-handle-expand-file-name): `null-device' could be nil. Reported by Richard Copley . (tramp-sh-handle-make-process): Improve handling of connection-type `pipe'. (Bug#61341) * lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-symbolic-link): Flush TARGET file properties. * lisp/net/tramp-smb.el (tramp-smb-handle-copy-file): Flush proper file properties. (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl): Remove superfluous `unwind-protect'. * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): Use `tramp-fuse-handle-file-exists-p'. (tramp-sshfs-handle-insert-file-contents): Move result out of unwindform. * lisp/net/tramp.el (tramp-string-empty-or-nil-p): New defsubst. Use it everywhere when appropriate. * lisp/net/tramp.el (tramp-methods) <->: Add. (tramp-completion-file-name-handler-alist): Add `expand-file-name', `file-exists-p', `file-name-directory' and `file-name-nondirectory'. (tramp-dissect-file-name): Do not extra check for `tramp-default-method-marker'. (tramp-completion-handle-expand-file-name) (tramp-completion-handle-file-exists-p) (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-nondirectory): New defuns. (tramp-completion-handle-file-name-all-completions): Remove duplicates. (tramp-show-ad-hoc-proxies): New defcustom. (tramp-make-tramp-file-name): Use it. (tramp-make-tramp-hop-name): Don't add hop twice. (tramp-shell-prompt-pattern): Remove escape characters. (tramp-process-one-action, tramp-convert-file-attributes): Use `ansi-color-control-seq-regexp'. (Bug#63539) (tramp-wrong-passwd-regexp): Add "Authentication failed" string (from doas). (tramp-terminal-type): Fix docstring. (tramp-process-one-action): Delete ANSI control escape sequences in buffer. (Bug#63539) (tramp-build-completion-file-name-regexp): Support user name completion. (tramp-make-tramp-file-name): Keep hop while in file (tramp-set-completion-function): Check, that cdr of FUNCTION-LIST entries is a string. (tramp-completion-file-name-handler): Run only when `minibuffer-completing-file-name' is non-nil. (tramp-skeleton-write-region): Fix scoping. (Bug#65022) (tramp-handle-memory-info): Work on newly created objects, or use non-destructive operations. (tramp-accept-process-output): Use `with-local-quit'. (tramp-call-process, tramp-call-process-region): Let-bind `temporary-file-directory'. * test/lisp/net/tramp-archive-tests.el (tramp-archive--test-emacs28-p): New defun. (tramp-archive-test16-directory-files): Don't mutate. (tramp-archive-test47-auto-load): Adapt test. * test/lisp/net/tramp-tests.el (tramp-display-escape-sequence-regexp): Dont't declare. (tramp-action-yesno): Suppress run in tests. (tramp-test02-file-name-dissect): (tramp-test02-file-name-dissect-simplified) (tramp-test02-file-name-dissect-separate): Adapt tests. (tramp-test21-file-links): (tramp-test21-file-links, tramp-test26-file-name-completion) (tramp-test28-process-file, tramp-test29-start-file-process) (tramp-test30-make-process, tramp-test33-environment-variables) (tramp-test38-find-backup-file-name, tramp-test47-auto-load) (tramp-test39-detect-external-change, tramp-test42-utf8) (tramp-test47-auto-load, tramp-test47-delay-load) (tramp-test48-unload): Adapt tests. (tramp-test26-file-name-completion-with-perl): (tramp-test26-file-name-completion-with-ls) (tramp-test26-interactive-file-name-completion): New tests. (tramp-test44-asynchronous-requests): Mark as :unstable. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6ed7e0ac032..7387dfcd1e4 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -289,9 +289,11 @@ Overview file's contents. For external transfers, @value{tramp} sends a command as follows: + @example -$ rcp user@@host:/path/to/remote/file /tmp/tramp.4711 +$ scp user@@host:/path/to/remote/file /tmp/tramp.4711 @end example + @value{tramp} reads the local temporary file @file{/tmp/tramp.4711} into a buffer, and then deletes the temporary file. @@ -361,7 +363,7 @@ Obtaining @value{tramp} @example @group $ cd ~/emacs -$ git clone git://git.savannah.gnu.org/tramp.git +$ git clone https://git.savannah.gnu.org/git/tramp.git @end group @end example @@ -2721,6 +2723,7 @@ Ssh setup There is no counter which could be set. +@anchor{Using ssh connection sharing} @subsection Using ssh connection sharing @vindex ControlPath@r{, ssh option} @@ -2751,19 +2754,32 @@ Ssh setup @samp{%%r}, @samp{%%h} and @samp{%%p}. @vindex tramp-use-ssh-controlmaster-options -If the @file{~/.ssh/config} file is configured appropriately for the -above behavior, then any changes to @command{ssh} can be suppressed -with this @code{nil} setting: +Using a predefined string in @code{tramp-ssh-controlmaster-options}, +or puzzling an own string, happens only when user option +@code{tramp-use-ssh-controlmaster-options} is set to @code{t}. If the +@file{~/.ssh/config} file is configured appropriately for the above +behavior, then any changes to @command{ssh} can be suppressed with +this @code{nil} setting: @lisp (customize-set-variable 'tramp-use-ssh-controlmaster-options nil) @end lisp +Sometimes, it is not possible to use OpenSSH's @option{ControlMaster} +option for remote processes. This could result in concurrent access +to the OpenSSH socket when reading data by different processes, which +could block Emacs. In this case, setting +@code{tramp-use-ssh-controlmaster-options} to @code{suppress} disables +shared access. It is not needed to set this user option permanently +to @code{suppress}, binding the user option prior calling +@code{make-process} is sufficient. @value{tramp} does this for +esxample for compilation processes on its own. + @vindex ProxyCommand@r{, ssh option} @vindex ProxyJump@r{, ssh option} -This should also be set to @code{nil} if you use the -@option{ProxyCommand} or @option{ProxyJump} options in your -@command{ssh} configuration. +@code{tramp-use-ssh-controlmaster-options} should also be set to +@code{nil} or @code{suppress} if you use the @option{ProxyCommand} or +@option{ProxyJump} options in your @command{ssh} configuration. In order to use the @option{ControlMaster} option, @value{tramp} must check whether the @command{ssh} client supports this option. This is @@ -3472,12 +3488,7 @@ File name completion @value{tramp} can complete the following @value{tramp} file name components: method names, user names, host names, and file names -located on remote hosts. User name and host name completion is -activated only, if file name completion has one of the styles -@code{basic}, @code{emacs21}, or @code{emacs22}. -@ifinfo -@xref{Completion Styles, , , emacs}. -@end ifinfo +located on remote hosts. For example, type @kbd{C-x C-f @value{prefixwithspace} s @key{TAB}}, @value{tramp} completion choices show up as @@ -3511,10 +3522,7 @@ File name completion Type @kbd{s h @value{postfixhop}} for the minibuffer completion to @samp{@value{prefix}ssh@value{postfixhop}}. Typing @kbd{@key{TAB}} shows host names @value{tramp} extracts from @file{~/.ssh/config} -@c bug#50387 -file, for example@footnote{Some completion styles, like -@code{substring} or @code{flex}, require to type at least one -character after the trailing @samp{@value{postfixhop}}.}. +file, for example: @example @group @@ -3608,10 +3616,20 @@ Ad-hoc multi-hops @code{tramp-default-proxies-alist} and is available for re-use during that Emacs session. Subsequent @value{tramp} connections to the same remote host can then use the shortcut form: -@samp{@trampfn{ssh,you@@remotehost,/path}}. Ad-hoc definitions are -removed from @code{tramp-default-proxies-alist} via the command -@kbd{M-x tramp-cleanup-all-connections @key{RET}} (@pxref{Cleanup -remote connections}). +@samp{@trampfn{ssh,you@@remotehost,/path}}. + +@defopt tramp-show-ad-hoc-proxies +If this user option is non-@code{nil}, ad-hoc definitions are kept in +remote file names instead of showing the shortcuts. + +@lisp +(customize-set-variable 'tramp-show-ad-hoc-proxies t) +@end lisp +@end defopt + +Ad-hoc definitions are removed from @code{tramp-default-proxies-alist} +via the command @kbd{M-x tramp-cleanup-all-connections @key{RET}} +(@pxref{Cleanup remote connections}). @defopt tramp-save-ad-hoc-proxies For ad-hoc definitions to be saved automatically in @@ -4299,7 +4317,8 @@ Remote processes @code{start-file-process}. Furthermore, you might set @code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to bypass @value{tramp}'s handling of the @option{ControlMaster} options, -and use your own settings in @file{~/.ssh/config}. +and use your own settings in @file{~/.ssh/config}, @ref{Using ssh +connection sharing}. @node Cleanup remote connections diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 299fb3fcb31..c2560169e31 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.6.0.29.1 +@set trampver 2.6.2-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 26.1 diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 4578f1fe073..58c93245335 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,7 +55,7 @@ tramp-adb-connect-if-not-connected (defconst tramp-adb-method "adb" "When this method name is used, forward all calls to Android Debug Bridge.") -(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") blank) +(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\r\n"))) (any "#$") blank) "Regexp used as prompt in almquist shell." :type 'regexp :version "28.1" @@ -449,31 +449,32 @@ tramp-adb-handle-delete-file (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (tramp-adb-send-command - v (format "%s -a %s | cat" - (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (with-current-buffer (tramp-get-buffer v) - (delete-dups - (append - ;; On some file systems like "sdcard", "." and ".." are - ;; not included. We fix this by `delete-dups'. - '("." "..") - (delq - nil - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n"))))))))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (tramp-adb-send-command + v (format "%s -a %s | cat" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname))) + (mapcar + (lambda (f) + (if (file-directory-p (expand-file-name f directory)) + (file-name-as-directory f) + f)) + (with-current-buffer (tramp-get-buffer v) + (delete-dups + (append + ;; On some file systems like "sdcard", "." and ".." are + ;; not included. We fix this by `delete-dups'. + '("." "..") + (delq + nil + (mapcar + (lambda (l) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string (buffer-string) "\n")))))))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." @@ -504,16 +505,9 @@ tramp-adb-handle-file-executable-p (defun tramp-adb-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - ;; `file-exists-p' is used as predicate in file name completion. - ;; We don't want to run it when `non-essential' is t, or there is - ;; no connection process yet. - (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-tramp-file-property v localname "file-exists-p" - (if (tramp-file-property-p v localname "file-attributes") - (not (null (tramp-get-file-property v localname "file-attributes"))) - (tramp-adb-send-command-and-check - v (format "test -e %s" (tramp-shell-quote-argument localname)))))))) + (tramp-skeleton-file-exists-p filename + (tramp-adb-send-command-and-check + v (format "test -e %s" (tramp-shell-quote-argument localname))))) (defun tramp-adb-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -1023,7 +1017,7 @@ tramp-adb-handle-make-process (progn (goto-char (point-min)) (not (search-forward "\n" nil t))) - (tramp-accept-process-output p 0)) + (tramp-accept-process-output p)) (delete-region (point-min) (point))) ;; Provide error buffer. This shows only ;; initial error messages; messages @@ -1032,17 +1026,19 @@ tramp-adb-handle-make-process ;; file will exist until the process is ;; deleted. (when (bufferp stderr) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit)) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit))) ;; Delete tmpstderr file. (add-function :after (process-sentinel p) (lambda (_proc _msg) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit nil nil 'replace)) - (delete-file remote-tmpstderr)))) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr))))) ;; Return process. p)))) @@ -1106,11 +1102,12 @@ tramp-adb-get-device (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 @@ -1127,7 +1124,7 @@ tramp-adb-execute-adb-command "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))) @@ -1254,7 +1251,7 @@ tramp-adb-maybe-open-connection (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? @@ -1279,7 +1276,7 @@ tramp-adb-maybe-open-connection ;; Set sentinel and query flag. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 36992014e13..72415efdf9f 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -631,7 +631,7 @@ tramp-archive-handle-copy-file (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) @@ -643,23 +643,22 @@ tramp-archive-handle-directory-file-name (defun tramp-archive-handle-directory-files (directory &optional full match nosort count) "Like `directory-files' for Tramp files." - (unless (file-exists-p directory) - (tramp-error (tramp-dissect-file-name directory) 'file-missing directory)) - (when (file-directory-p directory) - (setq directory (file-name-as-directory (expand-file-name directory))) - (let ((temp (nreverse (file-name-all-completions "" directory))) - result item) - - (while temp - (setq item (directory-file-name (pop temp))) - (when (or (null match) (string-match-p match item)) - (push (if full (concat directory item) item) - result))) - (unless nosort - (setq result (sort result #'string<))) - (when (and (natnump count) (> count 0)) - (setq result (tramp-compat-ntake count result))) - result))) + (tramp-barf-if-file-missing (tramp-dissect-file-name directory) directory + (when (file-directory-p directory) + (setq directory (file-name-as-directory (expand-file-name directory))) + (let ((temp (nreverse (file-name-all-completions "" directory))) + result item) + + (while temp + (setq item (directory-file-name (pop temp))) + (when (or (null match) (string-match-p match item)) + (push (if full (concat directory item) item) + result))) + (unless nosort + (setq result (sort result #'string<))) + (when (and (natnump count) (> count 0)) + (setq result (tramp-compat-ntake count result))) + result)))) (defun tramp-archive-handle-dired-uncache (dir) "Like `dired-uncache' for file archives." @@ -683,7 +682,9 @@ tramp-archive-handle-file-local-copy (defun tramp-archive-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for file archives." - (file-name-all-completions filename (tramp-archive-gvfs-file-name directory))) + (tramp-compat-ignore-error file-missing + (file-name-all-completions + filename (tramp-archive-gvfs-file-name directory)))) (defun tramp-archive-handle-file-readable-p (filename) "Like `file-readable-p' for file archives." diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index bf7d45d2a5a..9b20bc710fb 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -123,11 +123,11 @@ tramp-cleanup-connection ;; Delete processes. (dolist (key (hash-table-keys tramp-cache-data)) (when (and (processp key) - (tramp-file-name-equal-p (process-get key 'vector) vec) + (tramp-file-name-equal-p (process-get key 'tramp-vector) vec) (or (not keep-processes) (eq key (tramp-get-process vec)))) (tramp-flush-connection-properties key) - (delete-process key))) + (ignore-errors (delete-process key)))) ;; Remove buffers. (dolist @@ -319,7 +319,7 @@ tramp-rename-files (read-file-name-function #'read-file-name-default) source target) (if (null connections) - (tramp-user-error nil "There are no remote connections.") + (tramp-user-error nil "There are no remote connections") (setq source ;; Likely, the source remote connection is broken. So we ;; shall avoid any action on it. @@ -367,15 +367,15 @@ tramp-rename-files (list source target))) (unless (tramp-tramp-file-p source) - (tramp-user-error nil "Source %s must be remote." source)) + (tramp-user-error nil "Source %s must be remote" source)) (when (null target) (or (setq target (tramp-default-rename-file source)) (tramp-user-error nil (concat "There is no target specified. " - "Check `tramp-default-rename-alist' for a proper entry.")))) + "Check `tramp-default-rename-alist' for a proper entry")))) (when (tramp-equal-remote source target) - (tramp-user-error nil "Source and target must have different remote.")) + (tramp-user-error nil "Source and target must have different remote")) ;; Append local file name if none is specified. (when (string-equal (file-remote-p target) target) @@ -461,7 +461,7 @@ tramp-rename-these-files nil (substitute-command-keys (concat "Current buffer is not remote. " - "Consider `\\[tramp-rename-files]' instead."))) + "Consider `\\[tramp-rename-files]' instead"))) (setq target (when (null current-prefix-arg) ;; The source remote connection shall not trigger any action. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 673c6679dbe..4aa0dccccb7 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -29,19 +29,18 @@ ;;; Code: +(require 'ansi-color) (require 'auth-source) (require 'format-spec) (require 'parse-time) (require 'shell) (require 'subr-x) -(when (memq system-type '(ms-dos windows-nt)) - (require 'ls-lisp)) - (declare-function tramp-compat-rx "tramp") (declare-function tramp-error "tramp") (declare-function tramp-file-name-handler "tramp") (declare-function tramp-tramp-file-p "tramp") +(defvar tramp-syntax) (defvar tramp-temp-name-prefix) (defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version) @@ -121,14 +120,14 @@ 'tramp-compat-file-name-unquote (localname (file-local-name name))) (when (tramp-compat-file-name-quoted-p localname top) (setq - localname (if (= (length localname) 2) "/" (substring localname 2)))) + localname + (if (tramp-compat-length= localname 2) "/" (substring localname 2)))) (concat (file-remote-p name) localname))))) ;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still ;; support old settings. (defsubst tramp-compat-tramp-syntax () "Return proper value of `tramp-syntax'." - (defvar tramp-syntax) (cond ((eq tramp-syntax 'ftp) 'default) ((eq tramp-syntax 'sep) 'separate) (t tramp-syntax))) @@ -328,6 +327,48 @@ 'tramp-compat-file-name-concat (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) @@ -355,7 +396,7 @@ 'tramp-compat-take #'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. @@ -364,7 +405,7 @@ 'tramp-compat-ntake #'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. @@ -384,29 +425,6 @@ 'tramp-compat-auth-source-netrc-parse-all (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)) diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 6cdd6c654ea..e45b73a2134 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -96,15 +96,16 @@ tramp-kubernetes-method "Tramp method name to use to connect to Kubernetes containers.") ;;;###tramp-autoload -(defun tramp-docker--completion-function (&rest _args) - "List Docker-like containers available for connection. +(defun tramp-container--completion-function (program) + "List running containers available for connection. +PROGRAM is the program to be run for \"ps\", either +`tramp-docker-program' or `tramp-podman-program'. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." (when-let ((default-directory tramp-compat-temporary-file-directory) (raw-list (shell-command-to-string - (concat tramp-docker-program - " ps --format '{{.ID}}\t{{.Names}}'"))) + (concat program " ps --format '{{.ID}}\t{{.Names}}'"))) (lines (split-string raw-list "\n" 'omit)) (names (mapcar (lambda (line) @@ -114,7 +115,7 @@ tramp-docker--completion-function line) (or (match-string 2 line) (match-string 1 line)))) lines))) - (mapcar (lambda (m) (list nil m)) (delq nil names)))) + (mapcar (lambda (name) (list nil name)) (delq nil names)))) ;;;###tramp-autoload (defun tramp-kubernetes--completion-function (&rest _args) @@ -128,9 +129,7 @@ tramp-kubernetes--completion-function " get pods --no-headers " "-o custom-columns=NAME:.metadata.name"))) (names (split-string raw-list "\n" 'omit))) - (mapcar (lambda (name) - (list nil name)) - names))) + (mapcar (lambda (name) (list nil name)) names))) (defun tramp-kubernetes--current-context-data (vec) "Return Kubernetes current context data as JSON string." @@ -167,6 +166,7 @@ tramp-default-remote-shell (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods `(,tramp-podman-method (tramp-login-program ,tramp-podman-program) @@ -179,6 +179,7 @@ tramp-default-remote-shell (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods `(,tramp-kubernetes-method (tramp-login-program ,tramp-kubernetes-program) @@ -195,11 +196,13 @@ tramp-default-remote-shell (tramp-set-completion-function tramp-docker-method - '((tramp-docker--completion-function ""))) + `((tramp-container--completion-function + ,(executable-find tramp-docker-program)))) (tramp-set-completion-function tramp-podman-method - '((tramp-docker--completion-function ""))) + `((tramp-container--completion-function + ,(executable-find tramp-podman-program)))) (tramp-set-completion-function tramp-kubernetes-method diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index c7696a51dae..62cd3f0a3b2 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -180,7 +180,7 @@ tramp-crypt-file-name-handler-alist (file-directory-p . tramp-handle-file-directory-p) (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-crypt-handle-file-executable-p) - (file-exists-p . tramp-handle-file-exists-p) + (file-exists-p . tramp-crypt-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-locked-p . tramp-crypt-handle-file-locked-p) @@ -315,7 +315,7 @@ tramp-crypt-maybe-open-connection :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil))) ;; The following operations must be performed without @@ -435,7 +435,7 @@ tramp-crypt-do-encrypt-or-decrypt-file-name crypt-vec (if (eq op 'encrypt) "encode" "decode") tramp-compat-temporary-file-directory localname) (tramp-error - crypt-vec 'file-error "%s of file name %s failed." + crypt-vec 'file-error "%s of file name %s failed" (if (eq op 'encrypt) "Encoding" "Decoding") name)) (with-current-buffer (tramp-get-connection-buffer crypt-vec) (goto-char (point-min)) @@ -470,7 +470,7 @@ tramp-crypt-do-encrypt-or-decrypt-file (file-name-directory infile) (concat "/" (file-name-nondirectory infile))) (tramp-error - crypt-vec 'file-error "%s of file %s failed." + crypt-vec 'file-error "%s of file %s failed" (if (eq op 'encrypt) "Encrypting" "Decrypting") infile)) (with-current-buffer (tramp-get-connection-buffer crypt-vec) (write-region nil nil outfile))))) @@ -494,11 +494,11 @@ tramp-crypt-add-directory ;; (declare (completion tramp-crypt-command-completion-p)) (interactive "DRemote directory name: ") (unless tramp-crypt-enabled - (tramp-user-error nil "Feature is not enabled.")) + (tramp-user-error nil "Feature is not enabled")) (unless (and (tramp-tramp-file-p name) (file-directory-p name)) - (tramp-user-error nil "%s must be an existing remote directory." name)) + (tramp-user-error nil "%s must be an existing remote directory" name)) (when (tramp-compat-file-name-quoted-p name) - (tramp-user-error nil "%s must not be quoted." name)) + (tramp-user-error nil "%s must not be quoted" name)) (setq name (file-name-as-directory (expand-file-name name))) (unless (member name tramp-crypt-directories) (setq tramp-crypt-directories (cons name tramp-crypt-directories))) @@ -517,7 +517,7 @@ tramp-crypt-remove-directory ;; (declare (completion tramp-crypt-command-completion-p)) (interactive "DRemote directory name: ") (unless tramp-crypt-enabled - (tramp-user-error nil "Feature is not enabled.")) + (tramp-user-error nil "Feature is not enabled")) (setq name (file-name-as-directory (expand-file-name name))) (when (and (member name tramp-crypt-directories) (delete @@ -723,6 +723,11 @@ tramp-crypt-handle-file-executable-p (let (tramp-crypt-enabled) (file-executable-p (tramp-crypt-encrypt-file-name filename)))) +(defun tramp-crypt-handle-file-exists-p (filename) + "Like `file-exists-p' for Tramp files." + (let (tramp-crypt-enabled) + (file-exists-p (tramp-crypt-encrypt-file-name filename)))) + (defun tramp-crypt-handle-file-locked-p (filename) "Like `file-locked-p' for Tramp files." (let (tramp-crypt-enabled) @@ -730,18 +735,19 @@ tramp-crypt-handle-file-locked-p (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (let* (completion-regexp-list - tramp-crypt-enabled - (directory (file-name-as-directory directory)) - (enc-dir (tramp-crypt-encrypt-file-name directory))) - (mapcar - (lambda (x) - (substring - (tramp-crypt-decrypt-file-name (concat enc-dir x)) - (length directory))) - (file-name-all-completions "" enc-dir))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (let* (completion-regexp-list + tramp-crypt-enabled + (directory (file-name-as-directory directory)) + (enc-dir (tramp-crypt-encrypt-file-name directory))) + (mapcar + (lambda (x) + (substring + (tramp-crypt-decrypt-file-name (concat enc-dir x)) + (length directory))) + (file-name-all-completions "" enc-dir)))))) (defun tramp-crypt-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index c10c715d70e..e4610b069ad 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -97,23 +97,29 @@ tramp-fuse-handle-file-executable-p (with-tramp-file-property v localname "file-executable-p" (file-executable-p (tramp-fuse-local-file-name filename))))) +(defun tramp-fuse-handle-file-exists-p (filename) + "Like `file-exists-p' for Tramp files." + (tramp-skeleton-file-exists-p filename + (file-exists-p (tramp-fuse-local-file-name filename)))) + (defun tramp-fuse-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-fuse-remove-hidden-files - (all-completions - filename - (delete-dups - (append - (file-name-all-completions - filename (tramp-fuse-local-file-name directory)) - ;; Some storage systems do not return "." and "..". - (let (result) - (dolist (item '(".." ".") result) - (when (string-prefix-p filename item) - (catch 'match - (dolist (elt completion-regexp-list) - (unless (string-match-p elt item) (throw 'match nil))) - (setq result (cons (concat item "/") result))))))))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (delete-dups + (append + (file-name-all-completions + filename (tramp-fuse-local-file-name directory)) + ;; Some storage systems do not return "." and "..". + (let (result) + (dolist (item '(".." ".") result) + (when (string-prefix-p filename item) + (catch 'match + (dolist (elt completion-regexp-list) + (unless (string-match-p elt item) (throw 'match nil))) + (setq result (cons (concat item "/") result)))))))))))) ;; This function isn't used. (defun tramp-fuse-handle-insert-directory @@ -146,23 +152,24 @@ tramp-fuse-mount-spec (format "%s@%s:/" user host) (format "%s:/" host))) -(defun tramp-fuse-mount-point (vec) - "Return local mount point of VEC." - (or (tramp-get-connection-property vec "mount-point") - (expand-file-name - (concat - tramp-temp-name-prefix - (tramp-file-name-method vec) "." - (when (tramp-file-name-user vec) - (concat (tramp-file-name-user-domain vec) "@")) - (tramp-file-name-host-port vec)) - tramp-compat-temporary-file-directory))) - (defconst tramp-fuse-mount-timeout (eval (car (get 'remote-file-name-inhibit-cache 'standard-value)) t) "Time period to check whether the mount point still exists. It has the same meaning as `remote-file-name-inhibit-cache'.") +(defun tramp-fuse-mount-point (vec) + "Return local mount point of VEC." + (let ((remote-file-name-inhibit-cache tramp-fuse-mount-timeout)) + (or (tramp-get-file-property vec "/" "mount-point") + (expand-file-name + (concat + tramp-temp-name-prefix + (tramp-file-name-method vec) "." + (when (tramp-file-name-user vec) + (concat (tramp-file-name-user-domain vec) "@")) + (tramp-file-name-host-port vec)) + tramp-compat-temporary-file-directory)))) + (defun tramp-fuse-mounted-p (vec) "Check, whether fuse volume determined by VEC is mounted." ;; Remember the mount status by using a file property on "/", @@ -194,6 +201,8 @@ tramp-fuse-mounted-p bol (group (regexp mount-spec)) " on " (group (+ (not blank))) blank) mount) + (tramp-set-file-property + vec "/" "mount-point" (match-string 2 mount)) (match-string 1 mount))))))) (defun tramp-fuse-get-fusermount () @@ -213,6 +222,7 @@ tramp-fuse-unmount (command (format "%s -u %s" (tramp-fuse-get-fusermount) mount-point))) (tramp-message vec 6 "%s\n%s" command (shell-command-to-string command)) (tramp-flush-file-property vec "/" "mounted") + (tramp-flush-file-property vec "/" "mount-point") (setq tramp-fuse-mount-points (delete (tramp-file-name-unify vec) tramp-fuse-mount-points)) ;; Give the caches a chance to expire. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0273c28beca..46342042880 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -114,6 +114,7 @@ (declare-function zeroconf-service-host "zeroconf") (declare-function zeroconf-service-port "zeroconf") (declare-function zeroconf-service-txt "zeroconf") +(defvar tramp-gvfs-dbus-event-vector) ;; We don't call `dbus-ping', because this would load dbus.el. (defconst tramp-gvfs-enabled @@ -848,8 +849,6 @@ tramp-gvfs-file-name-p (let ((method (tramp-file-name-method vec))) (and (stringp method) (member method tramp-gvfs-methods))))) -(defvar tramp-gvfs-dbus-event-vector) - ;;;###tramp-autoload (defun tramp-gvfs-file-name-handler (operation &rest args) "Invoke the GVFS related OPERATION and ARGS. @@ -871,6 +870,14 @@ tramp-gvfs-file-name-handler (tramp-register-foreign-file-name-handler #'tramp-gvfs-file-name-p #'tramp-gvfs-file-name-handler))) +;; Event type `dbus-event' is added to `while-no-input-ignore-events' +;; in Emacs 29.1. If it is missing, some packages like Helm report +;; problems. So we add it here. +(when (and (featurep 'dbusbind) + (not (memq 'dbus-event while-no-input-ignore-events))) + (setq while-no-input-ignore-events + (cons 'dbus-event while-no-input-ignore-events))) + ;; D-Bus helper function. @@ -1027,6 +1034,8 @@ tramp-gvfs-do-copy-or-rename-file (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) + (when (file-regular-p newname) + (delete-file newname)) (cond ;; We cannot rename volatile files, as used by Google-drive. @@ -1079,7 +1088,7 @@ tramp-gvfs-do-copy-or-rename-file (goto-char (point-min)) (tramp-error-with-buffer nil v 'file-error - "%s failed, see buffer `%s' for details." + "%s failed, see buffer `%s' for details" msg-operation (buffer-name))) ;; Some WebDAV server, like the one from QNAP, do @@ -1157,7 +1166,8 @@ tramp-gvfs-handle-expand-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))) @@ -1173,7 +1183,7 @@ tramp-gvfs-handle-expand-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))))) @@ -1422,16 +1432,19 @@ tramp-gvfs-handle-file-executable-p (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (tramp-compat-string-search "/" filename) - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (let ((result '("./" "../"))) - ;; Get a list of directories and files. - (dolist (item (tramp-gvfs-get-directory-attributes directory) result) - (if (string-equal (cdr (assoc "type" item)) "directory") - (push (file-name-as-directory (car item)) result) - (push (car item) result))))))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (let ((result '("./" "../"))) + ;; Get a list of directories and files. + (dolist (item + (tramp-gvfs-get-directory-attributes directory) + result) + (if (string-equal (cdr (assoc "type" item)) "directory") + (push (file-name-as-directory (car item)) result) + (push (car item) result)))))))))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1461,16 +1474,16 @@ tramp-gvfs-handle-file-notify-add-watch v 'file-notify-error "Monitoring not supported for `%s'" file-name) (tramp-message v 6 "Run `%s', %S" (string-join (process-command p) " ") p) - (process-put p 'vector v) - (process-put p 'events events) - (process-put p 'watch-name localname) + (process-put p 'tramp-vector v) + (process-put p 'tramp-events events) + (process-put p 'tramp-watch-name localname) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (set-process-filter p #'tramp-gvfs-monitor-process-filter) (set-process-sentinel p #'tramp-file-notify-process-sentinel) ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (unless (process-live-p p) (tramp-error p 'file-notify-error "Monitoring not supported for `%s'" file-name)) @@ -1482,8 +1495,8 @@ tramp-gvfs-handle-file-notify-add-watch (defun tramp-gvfs-monitor-process-filter (proc string) "Read output from \"gvfs-monitor-file\" and add corresponding \ `file-notify' events." - (let* ((events (process-get proc 'events)) - (rest-string (process-get proc 'rest-string)) + (let* ((events (process-get proc 'tramp-events)) + (rest-string (process-get proc 'tramp-rest-string)) (dd (tramp-get-default-directory (process-buffer proc))) (ddu (tramp-compat-rx (literal (tramp-gvfs-url-file-name dd))))) (when rest-string @@ -1526,7 +1539,7 @@ tramp-gvfs-monitor-process-filter (setq file1 (url-unhex-string file1))) ;; Remove watch when file or directory to be watched is deleted. (when (and (member action '(moved deleted)) - (string-equal file (process-get proc 'watch-name))) + (string-equal file (process-get proc 'tramp-watch-name))) (delete-process proc)) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at @@ -1536,9 +1549,9 @@ tramp-gvfs-monitor-process-filter '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))) + (process-put proc 'tramp-rest-string string))) (defun tramp-gvfs-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -1636,7 +1649,7 @@ tramp-gvfs-handle-get-home-directory (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)) @@ -1769,11 +1782,11 @@ tramp-gvfs-handler-askpassword (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: "))) @@ -2175,7 +2188,7 @@ tramp-gvfs-maybe-open-connection :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. @@ -2212,7 +2225,7 @@ tramp-gvfs-maybe-open-connection (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)) @@ -2262,7 +2275,7 @@ tramp-gvfs-maybe-open-connection (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) @@ -2441,7 +2454,7 @@ tramp-get-media-devices ;; 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))))) @@ -2493,16 +2506,17 @@ tramp-gvfs-parse-device-names (delete-dups (mapcar (lambda (x) - (let* ((list (split-string x ";")) - (host (nth 6 list)) - (text (split-string (nth 9 list) "\" \"" 'omit "\"")) - user) - ;; A user is marked in a TXT field like "u=guest". - (while 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))) + (ignore-errors + (let* ((list (split-string x ";")) + (host (nth 6 list)) + (text (split-string (nth 9 list) "\" \"" 'omit "\"")) + user) + ;; A user is marked in a TXT field like "u=guest". + (while 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)))) result)))) (when tramp-gvfs-enabled diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 2360abfb1dd..70bbf7e0192 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -224,6 +224,7 @@ tramp-rclone-do-copy-or-rename-file (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) + (equal-remote (tramp-equal-remote filename newname)) (rclone-operation (if (eq op 'copy) "copyto" "moveto")) (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) @@ -234,8 +235,12 @@ tramp-rclone-do-copy-or-rename-file (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) + (when (file-regular-p newname) + (delete-file newname)) - (if (or (and t1 (not (tramp-rclone-file-name-p filename))) + (if (or (and equal-remote + (tramp-get-connection-property v "direct-copy-failed")) + (and t1 (not (tramp-rclone-file-name-p filename))) (and t2 (not (tramp-rclone-file-name-p newname)))) ;; We cannot copy or rename directly. @@ -255,9 +260,20 @@ tramp-rclone-do-copy-or-rename-file v rclone-operation (tramp-rclone-remote-file-name filename) (tramp-rclone-remote-file-name newname))) - (tramp-error - v 'file-error - "Error %s `%s' `%s'" msg-operation filename newname))) + (if (or (not equal-remote) + (and equal-remote + (tramp-get-connection-property + v "direct-copy-failed"))) + (tramp-error + v 'file-error + "Error %s `%s' `%s'" msg-operation filename newname) + + ;; Some WebDAV server, like the one from QNAP, do + ;; not support direct copy/move. Try a fallback. + (tramp-set-connection-property v "direct-copy-failed" t) + (tramp-rclone-do-copy-or-rename-file + op filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes)))) (when (and t1 (eq op 'rename)) (while (file-exists-p filename) @@ -298,25 +314,25 @@ tramp-rclone-handle-file-system-info (setq filename (file-name-directory filename))) (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-message v 5 "file system info: %s" localname) - (tramp-rclone-send-command v "about" (concat host ":")) - (with-current-buffer (tramp-get-connection-buffer v) - (let (total used free) - (goto-char (point-min)) - (while (not (eobp)) - (when (looking-at (rx "Total: " (+ blank) (group (+ digit)))) - (setq total (string-to-number (match-string 1)))) - (when (looking-at (rx "Used: " (+ blank) (group (+ digit)))) - (setq used (string-to-number (match-string 1)))) - (when (looking-at (rx "Free: " (+ blank) (group (+ digit)))) - (setq free (string-to-number (match-string 1)))) - (forward-line)) - (when used - ;; The used number of bytes is not part of the result. As - ;; side effect, we store it as file property. - (tramp-set-file-property v localname "used-bytes" used)) - ;; Result. - (when (and total free) - (list total free (- total free)))))))) + (when (zerop (tramp-rclone-send-command v "about" (concat host ":"))) + (with-current-buffer (tramp-get-connection-buffer v) + (let (total used free) + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at (rx "Total: " (+ blank) (group (+ digit)))) + (setq total (string-to-number (match-string 1)))) + (when (looking-at (rx "Used: " (+ blank) (group (+ digit)))) + (setq used (string-to-number (match-string 1)))) + (when (looking-at (rx "Free: " (+ blank) (group (+ digit)))) + (setq free (string-to-number (match-string 1)))) + (forward-line)) + (when used + ;; The used number of bytes is not part of the result. + ;; As side effect, we store it as file property. + (tramp-set-file-property v localname "used-bytes" used)) + ;; Result. + (when (and total free) + (list total free (- total free))))))))) (defun tramp-rclone-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -361,7 +377,7 @@ tramp-rclone-maybe-open-connection (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? @@ -370,7 +386,7 @@ tramp-rclone-maybe-open-connection :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 502040902e1..9895af92502 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -81,13 +81,6 @@ tramp-histfile-override (const :tag "Unset HISTFILE" t) (string :tag "Redirect to a file"))) -;;;###tramp-autoload -(defconst tramp-display-escape-sequence-regexp (rx "\e" (+ (any ";[" digit)) "m") - "Terminal control escape sequences for display attributes.") - -(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 ;; root users. It uses the `$' character for other users. In order ;; to guarantee a proper prompt, we use "#$ " for the prompt. @@ -109,11 +102,18 @@ tramp-end-of-heredoc (defcustom tramp-use-ssh-controlmaster-options (not (eq system-type 'windows-nt)) "Whether to use `tramp-ssh-controlmaster-options'. +Set it to t, if you want Tramp to apply these options. Set it to nil, if you use Control* or Proxy* options in your ssh -configuration." +configuration. +Set it to `suppress' if you want to disable settings in your +\"~/.ssh/config¸\"." :group 'tramp - :version "28.1" - :type 'boolean) + :version "29.2" + :type '(choice (const :tag "Set ControlMaster" t) + (const :tag "Don't set ControlMaster" nil) + (const :tag "Suppress ControlMaster" suppress)) + ;; Check with (safe-local-variable-p 'tramp-use-ssh-controlmaster-options 'suppress) + :safe (lambda (val) (and (memq val '(t nil suppress)) t))) (defvar tramp-ssh-controlmaster-options nil "Which ssh Control* arguments to use. @@ -124,8 +124,8 @@ tramp-ssh-controlmaster-options spec must be doubled, because the string is used as format string. Otherwise, it will be auto-detected by Tramp, if -`tramp-use-ssh-controlmaster-options' is non-nil. The value -depends on the installed local ssh version. +`tramp-use-ssh-controlmaster-options' is t. The value depends on +the installed local ssh version. The string is used in `tramp-methods'.") @@ -632,7 +632,6 @@ tramp-perl-file-name-all-completions print \"$f\\n\"; } } -print \"ok\\n\" ' \"$1\" %n" "Perl script to produce output suitable for use with `file-name-all-completions' on the remote file system. @@ -1159,8 +1158,8 @@ tramp-sh-handle-make-symbolic-link (unless ln (tramp-error v 'file-error - (concat "Making a symbolic link. " - "ln(1) does not exist on the remote host."))) + (concat "Making a symbolic link: " + "ln(1) does not exist on the remote host"))) ;; Do the 'confirm if exists' thing. (when (file-exists-p linkname) @@ -1252,20 +1251,13 @@ tramp-sh-handle-file-truename (defun tramp-sh-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - ;; `file-exists-p' is used as predicate in file name completion. - ;; We don't want to run it when `non-essential' is t, or there is - ;; no connection process yet. - (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-tramp-file-property v localname "file-exists-p" - (if (tramp-file-property-p v localname "file-attributes") - (not (null (tramp-get-file-property v localname "file-attributes"))) - (tramp-send-command-and-check - v - (format - "%s %s" - (tramp-get-file-exists-command v) - (tramp-shell-quote-argument localname)))))))) + (tramp-skeleton-file-exists-p filename + (tramp-send-command-and-check + v + (format + "%s %s" + (tramp-get-file-exists-command v) + (tramp-shell-quote-argument localname))))) (defun tramp-sh-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." @@ -1724,7 +1716,7 @@ tramp-sh-handle-file-executable-p (if (tramp-file-property-p v localname "file-attributes") (or (tramp-check-cached-permissions v ?x) (tramp-check-cached-permissions v ?s)) - (tramp-run-test "-x" filename))))) + (tramp-run-test v "-x" localname))))) (defun tramp-sh-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -1734,7 +1726,7 @@ tramp-sh-handle-file-readable-p ;; satisfied without remote operation. (if (tramp-file-property-p v localname "file-attributes") (tramp-handle-file-readable-p filename) - (tramp-run-test "-r" filename))))) + (tramp-run-test v "-r" localname))))) ;; Functions implemented using the basic functions above. @@ -1745,7 +1737,7 @@ tramp-sh-handle-file-directory-p ;; 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")) @@ -1755,7 +1747,7 @@ tramp-sh-handle-file-directory-p (tramp-get-file-property v (tramp-file-local-name truename) "file-attributes")) t) - (tramp-run-test "-d" filename)))))) + (tramp-run-test v "-d" localname)))))) (defun tramp-sh-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -1766,7 +1758,7 @@ tramp-sh-handle-file-writable-p ;; Examine `file-attributes' cache to see if request can ;; be satisfied without remote operation. (tramp-check-cached-permissions v ?w) - (tramp-run-test "-w" filename)) + (tramp-run-test v "-w" localname)) ;; If file doesn't exist, check if directory is writable. (and (file-directory-p (file-name-directory filename)) @@ -1840,64 +1832,43 @@ tramp-sh-handle-file-name-all-completions (with-parsed-tramp-file-name (expand-file-name directory) nil (when (and (not (tramp-compat-string-search "/" filename)) (tramp-connectable-p v)) - (all-completions - filename - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files, including reliably - ;; tagging the directories with a trailing "/". Because I - ;; rock. --daniel@danann.net - (tramp-send-command - v - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (format "tramp_perl_file_name_all_completions %s" - (tramp-shell-quote-argument localname))) - - (format (concat - "(cd %s 2>&1 && %s -a 2>%s" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>%s;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" - " && \\echo ok) || \\echo fail") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - (tramp-get-remote-null-device v) - (tramp-get-test-command v) - (tramp-get-remote-null-device v)))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - - ;; Check result code, found in last line of output. - (forward-line -1) - (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'). - (forward-line -1) - (tramp-error - v 'file-error - "tramp-sh-handle-file-name-all-completions: %s" - (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 (rx bol "ok" eol)) - (tramp-error - v 'file-error - (concat "tramp-sh-handle-file-name-all-completions: " - "internal error accessing `%s': `%s'") - (tramp-shell-quote-argument localname) (buffer-string)))) - - (while (zerop (forward-line -1)) - (push (buffer-substring (point) (line-end-position)) result))) - result)))))) + (unless (tramp-compat-string-search "/" filename) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including + ;; reliably tagging the directories with a trailing "/". + ;; Because I rock. --daniel@danann.net + (when (tramp-send-command-and-check + v + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (format "tramp_perl_file_name_all_completions %s" + (tramp-shell-quote-argument localname))) + + (format (concat + "cd %s 2>&1 && %s -a 2>%s" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>%s;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi;" + " done") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + (tramp-get-remote-null-device v) + (tramp-get-test-command v) + (tramp-get-remote-null-device v)))) + + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + (while (zerop (forward-line -1)) + (push (buffer-substring (point) (line-end-position)) result))) + result))))))))) ;; cp, mv and ln @@ -2240,7 +2211,7 @@ tramp-do-copy-or-rename-file-directly cmd-result) (tramp-error-with-buffer nil v 'file-error - "Copying directly failed, see buffer `%s' for details." + "Copying directly failed, see buffer `%s' for details" (buffer-name))))) ;; We are on the local host. @@ -2295,7 +2266,7 @@ tramp-do-copy-or-rename-file-directly "%s %s %s" cmd (tramp-shell-quote-argument localname1) (tramp-shell-quote-argument tmpfile)) - "Copying directly failed, see buffer `%s' for details." + "Copying directly failed, see buffer `%s' for details" (tramp-get-buffer v)) ;; We must change the ownership as remote user. ;; Since this does not work reliable, we also @@ -2328,7 +2299,7 @@ tramp-do-copy-or-rename-file-directly "cp -f -p %s %s" (tramp-shell-quote-argument tmpfile) (tramp-shell-quote-argument localname2)) - "Copying directly failed, see buffer `%s' for details." + "Copying directly failed, see buffer `%s' for details" (tramp-get-buffer v))) (t1 (tramp-run-real-handler @@ -2363,7 +2334,7 @@ tramp-do-copy-or-rename-file-out-of-band 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)) @@ -2523,7 +2494,11 @@ tramp-do-copy-or-rename-file-out-of-band (tramp-get-connection-buffer v) copy-program copy-args))) (tramp-message v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, + ;; the setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -2673,7 +2648,7 @@ tramp-sh-handle-insert-directory (setq switches (append switches (split-string (tramp-sh--quoting-style-options v)))) (unless (tramp-get-ls-command-with v "--dired") - (setq switches (delete "--dired" switches))) + (setq switches (delete "-N" (delete "--dired" switches)))) (when wildcard (setq wildcard (tramp-run-real-handler #'file-name-nondirectory (list localname))) @@ -2711,9 +2686,9 @@ tramp-sh-handle-insert-directory (tramp-get-ls-command v) switches (if (or wildcard - (zerop (length - (tramp-run-real-handler - #'file-name-nondirectory (list localname))))) + (tramp-string-empty-or-nil-p + (tramp-run-real-handler + #'file-name-nondirectory (list localname)))) "" (tramp-shell-quote-argument (tramp-run-real-handler @@ -2761,7 +2736,7 @@ tramp-sh-handle-insert-directory (unless (tramp-compat-string-search "color" (tramp-get-connection-property v "ls" "")) (goto-char (point-min)) - (while (re-search-forward tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match ""))) ;; Now decode what read if necessary. Stolen from `insert-directory'. @@ -2830,13 +2805,15 @@ tramp-sh-handle-expand-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 "/:". (if (or (and (eq system-type 'windows-nt) (string-match-p - (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol))) + (tramp-compat-rx + bol (| (: alpha ":") (: (literal (or null-device "")) eol))) name)) (and (not (tramp-tramp-file-p name)) (not (tramp-tramp-file-p dir)))) @@ -2868,7 +2845,7 @@ tramp-sh-handle-expand-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)) @@ -2969,7 +2946,7 @@ tramp-sh-handle-make-process (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 @@ -2979,7 +2956,7 @@ tramp-sh-handle-make-process ;; 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 @@ -3095,13 +3072,20 @@ tramp-sh-handle-make-process (process-put p 'remote-pid pid) (tramp-set-connection-property p "remote-pid" pid)) - ;; Disable carriage return to newline - ;; translation. This does not work on - ;; macOS, see Bug#50748. - (when (and (memq connection-type '(nil pipe)) - (not - (tramp-check-remote-uname v "Darwin"))) - (tramp-send-command v "stty -icrnl")) + (when (memq connection-type '(nil pipe)) + ;; Disable carriage return to newline + ;; translation. This does not work on + ;; macOS, see Bug#50748. + ;; We must also disable buffering, + ;; otherwise strings larger than 4096 + ;; bytes, sent by the process, could + ;; block, see termios(3) and Bug#61341. + ;; FIXME: Shall we rather use "stty raw"? + (if (tramp-check-remote-uname v "Darwin") + (tramp-send-command + v "stty -icanon min 1 time 0") + (tramp-send-command + v "stty -icrnl -icanon min 1 time 0"))) ;; `tramp-maybe-open-connection' and ;; `tramp-send-command-and-read' could ;; have trashed the connection buffer. @@ -3236,7 +3220,7 @@ tramp-sh-handle-process-file (if (tramp-compat-string-search "=" elt) (setq env (append env `(,elt))) (setq uenv (cons elt uenv))))) - (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep) + (setq env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) (when env (setq command (format @@ -3861,16 +3845,20 @@ tramp-sh-handle-file-notify-add-watch "`%s' failed to start on remote host" (string-join sequence " ")) (tramp-message v 6 "Run `%s', %S" (string-join sequence " ") p) - (process-put p 'vector v) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and only if + ;; the respective options are set. Perhaps, the setting could + ;; be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) ;; Needed for process filter. - (process-put p 'events events) - (process-put p 'watch-name localname) + (process-put p 'tramp-events events) + (process-put p 'tramp-watch-name localname) (set-process-query-on-exit-flag p nil) (set-process-filter p filter) (set-process-sentinel p #'tramp-file-notify-process-sentinel) ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (unless (process-live-p p) (tramp-error p 'file-notify-error "Monitoring not supported for `%s'" file-name)) @@ -3878,10 +3866,10 @@ tramp-sh-handle-file-notify-add-watch (defun tramp-sh-gio-monitor-process-filter (proc string) "Read output from \"gio monitor\" and add corresponding `file-notify' events." - (let ((events (process-get proc 'events)) + (let ((events (process-get proc 'tramp-events)) (remote-prefix (file-remote-p (tramp-get-default-directory (process-buffer proc)))) - (rest-string (process-get proc 'rest-string)) + (rest-string (process-get proc 'tramp-rest-string)) pos) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) @@ -3961,15 +3949,15 @@ tramp-sh-gio-monitor-process-filter ;; 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))) + (process-put proc 'tramp-rest-string string))) (defun tramp-sh-inotifywait-process-filter (proc string) "Read output from \"inotifywait\" and add corresponding `file-notify' events." - (let ((events (process-get proc 'events))) + (let ((events (process-get proc 'tramp-events))) (tramp-message proc 6 "%S\n%s" proc string) - (dolist (line (split-string string "[\n\r]+" 'omit)) + (dolist (line (split-string string (rx (+ (any "\r\n"))) 'omit)) ;; Check, whether there is a problem. (unless (string-match (rx bol (+ (not blank)) (+ blank) (group (+ (not blank))) @@ -3986,7 +3974,8 @@ tramp-sh-inotifywait-process-filter (tramp-compat-string-replace "_" "-" (downcase x)))) (split-string (match-string 1 line) "," 'omit)) (or (match-string 2 line) - (file-name-nondirectory (process-get proc 'watch-name)))))) + (file-name-nondirectory + (process-get proc 'tramp-watch-name)))))) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at ;; once. Therefore, we apply the handler directly. @@ -4132,17 +4121,14 @@ tramp-maybe-send-script (tramp-set-connection-property (tramp-get-connection-process vec) "scripts" (cons name scripts)))))) -(defun tramp-run-test (switch filename) - "Run `test' on the remote system, given a SWITCH and a FILENAME. +(defun tramp-run-test (vec switch localname) + "Run `test' on the remote system VEC, given a SWITCH and a LOCALNAME. Returns the exit code of the `test' program." - (with-parsed-tramp-file-name filename nil - (tramp-send-command-and-check - v - (format - "%s %s %s" - (tramp-get-test-command v) - switch - (tramp-shell-quote-argument localname))))) + (tramp-send-command-and-check + vec + (format + "%s %s %s" + (tramp-get-test-command vec) switch (tramp-shell-quote-argument localname)))) (defun tramp-find-executable (vec progname dirlist &optional ignore-tilde ignore-path) @@ -4217,7 +4203,7 @@ tramp-set-remote-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 @@ -4432,12 +4418,13 @@ tramp-barf-if-no-shell-prompt "Wait for shell prompt and barf if none appears. Looks at process PROC to see if a shell prompt appears in TIMEOUT seconds. If not, it produces an error message with the given ERROR-ARGS." - (let ((vec (process-get proc 'vector))) + (let ((vec (process-get proc 'tramp-vector))) (condition-case nil (tramp-wait-for-regexp proc timeout (tramp-compat-rx (| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern)) + (? (regexp ansi-color-control-seq-regexp)) eos)) (error (delete-process proc) @@ -4608,7 +4595,7 @@ tramp-open-connection-setup-interactive-shell ;; Set `remote-tty' process property. (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) - (unless (zerop (length tty)) + (unless (tramp-string-empty-or-nil-p tty) (process-put proc 'remote-tty tty) (tramp-set-connection-property proc "remote-tty" tty))) @@ -4942,6 +4929,16 @@ tramp-find-inline-compress (tramp-message vec 2 "Couldn't find an inline transfer compress command"))))) +(defun tramp-ssh-option-exists-p (vec option) + "Check, whether local ssh OPTION is applicable." + ;; We don't want to cache it persistently. + (with-tramp-connection-property nil option + ;; "ssh -G" is introduced in OpenSSH 6.7. + ;; We use a non-existing IP address for check, in order to avoid + ;; useless connections, and DNS timeouts. + (zerop + (tramp-call-process vec "ssh" nil nil nil "-G" "-o" option "0.0.0.1")))) + (defun tramp-ssh-controlmaster-options (vec) "Return the Control* arguments of the local ssh." (cond @@ -4951,40 +4948,34 @@ tramp-ssh-controlmaster-options "") ;; There is already a value to be used. - ((stringp tramp-ssh-controlmaster-options) tramp-ssh-controlmaster-options) + ((and (eq tramp-use-ssh-controlmaster-options t) + (stringp tramp-ssh-controlmaster-options)) + tramp-ssh-controlmaster-options) + + ;; We can't auto-compute the options. + ((ignore-errors + (not (tramp-ssh-option-exists-p vec "ControlMaster=auto"))) + "") ;; Determine the options. - (t (setq tramp-ssh-controlmaster-options "") - (let ((case-fold-search t)) - (ignore-errors - (with-tramp-progress-reporter - vec 4 "Computing ControlMaster options" - ;; We use a non-existing IP address, in order to avoid - ;; useless connections, and DNS timeouts. - (when (zerop - (tramp-call-process - vec "ssh" nil nil nil - "-G" "-o" "ControlMaster=auto" "0.0.0.1")) - (setq tramp-ssh-controlmaster-options - "-o ControlMaster=auto") - (if (zerop - (tramp-call-process - vec "ssh" nil nil nil - "-G" "-o" "ControlPath=tramp.%C" "0.0.0.1")) - (setq tramp-ssh-controlmaster-options - (concat tramp-ssh-controlmaster-options - " -o ControlPath=tramp.%%C")) - (setq tramp-ssh-controlmaster-options - (concat tramp-ssh-controlmaster-options - " -o ControlPath=tramp.%%r@%%h:%%p"))) - (when (zerop - (tramp-call-process - vec "ssh" nil nil nil - "-G" "-o" "ControlPersist=no" "0.0.0.1")) - (setq tramp-ssh-controlmaster-options - (concat tramp-ssh-controlmaster-options - " -o ControlPersist=no"))))))) - tramp-ssh-controlmaster-options))) + (t (ignore-errors + ;; ControlMaster and ControlPath options are introduced in OpenSSH 3.9. + (concat + "-o ControlMaster=" + (if (eq tramp-use-ssh-controlmaster-options 'suppress) + "no" "auto") + + " -o ControlPath=" + (if (eq tramp-use-ssh-controlmaster-options 'suppress) + "none" + ;; Hashed tokens are introduced in OpenSSH 6.7. + (if (tramp-ssh-option-exists-p vec "ControlPath=tramp.%C") + "tramp.%%C" "tramp.%%r@%%h:%%p")) + + ;; ControlPersist option is introduced in OpenSSH 5.6. + (when (and (not (eq tramp-use-ssh-controlmaster-options 'suppress)) + (tramp-ssh-option-exists-p vec "ControlPersist=no")) + " -o ControlPersist=no")))))) (defun tramp-scp-strict-file-name-checking (vec) "Return the strict file name checking argument of the local scp." @@ -5181,7 +5172,7 @@ tramp-maybe-open-connection (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) @@ -5238,7 +5229,11 @@ tramp-maybe-open-connection ;; Set sentinel and query flag. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, + ;; the setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (setq tramp-current-connection (cons vec (current-time))) @@ -5405,14 +5400,14 @@ tramp-wait-for-output (tramp-error proc 'file-error "Process `%s' not available, try again" proc)) (with-current-buffer (process-buffer proc) (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might - ;; be leading escape sequences, which must be ignored. - ;; Busyboxes built with the EDITING_ASK_TERMINAL config - ;; option send also escape sequences, which must be - ;; ignored. + ;; be leading ANSI control escape sequences, which must be + ;; ignored. Busyboxes built with the EDITING_ASK_TERMINAL + ;; config option send also ANSI control escape sequences, + ;; which must be ignored. (regexp (tramp-compat-rx (* (not (any "#$\n"))) (literal tramp-end-of-output) - (? (regexp tramp-device-escape-sequence-regexp)) + (? (regexp ansi-color-control-seq-regexp)) (? "\r") eol)) ;; Sometimes, the commands do not return a newline but a ;; null byte before the shell prompt, for example "git @@ -5555,7 +5550,7 @@ tramp-make-copy-program-file-name (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) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index cad6cb335cc..c50bd5b387f 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -487,9 +487,9 @@ tramp-smb-handle-copy-directory (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)))) @@ -558,7 +558,7 @@ tramp-smb-handle-copy-directory (tramp-message v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) + (process-put p 'tramp-vector v) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -641,9 +641,6 @@ tramp-smb-handle-copy-file (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) (unless (tramp-smb-get-share v) (tramp-error v 'file-error "Target `%s' must contain a share name" newname)) @@ -652,7 +649,12 @@ tramp-smb-handle-copy-file (tramp-smb-shell-quote-argument filename) (tramp-smb-shell-quote-localname v))) (tramp-error - v 'file-error "Cannot copy `%s' to `%s'" filename newname))))) + v 'file-error "Cannot copy `%s' to `%s'" filename newname)) + + ;; When newname did exist, we have wrong cached values. + (when (tramp-tramp-file-p newname) + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname)))))) ;; KEEP-DATE handling. (when keep-date @@ -691,7 +693,7 @@ tramp-smb-handle-delete-directory ;; "rmdir" does not report an error. So we check ourselves. (when (file-exists-p directory) - (tramp-error v 'file-error "`%s' not removed." directory))))) + (tramp-error v 'file-error "`%s' not removed" directory))))) (defun tramp-smb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." @@ -719,7 +721,8 @@ tramp-smb-handle-expand-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))) @@ -735,7 +738,7 @@ tramp-smb-handle-expand-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))))) @@ -789,9 +792,9 @@ tramp-smb-handle-file-acl (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)))) @@ -806,32 +809,31 @@ tramp-smb-handle-file-acl (append args (list (tramp-unquote-shell-quote-argument localname) (concat "2>" (tramp-get-remote-null-device v))))) - (unwind-protect - (with-tramp-saved-connection-properties - v '("process-name" "process-buffer") - (with-temp-buffer - ;; Set the transfer process properties. - (tramp-set-connection-property - v "process-name" (buffer-name (current-buffer))) - (tramp-set-connection-property - v "process-buffer" (current-buffer)) - - ;; Use an asynchronous process. By this, password - ;; can be handled. - (let ((p (apply - #'start-process - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - tramp-smb-acl-program args))) - - (tramp-message - v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) - (process-put p 'adjust-window-size-function #'ignore) - (set-process-query-on-exit-flag p nil) - (tramp-process-actions p v nil tramp-smb-actions-get-acl) - (when (> (point-max) (point-min)) - (substring-no-properties (buffer-string))))))))))))) + (with-tramp-saved-connection-properties + v '("process-name" "process-buffer") + (with-temp-buffer + ;; Set the transfer process properties. + (tramp-set-connection-property + v "process-name" (buffer-name (current-buffer))) + (tramp-set-connection-property + v "process-buffer" (current-buffer)) + + ;; Use an asynchronous process. By this, password + ;; can be handled. + (let ((p (apply + #'start-process + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) + tramp-smb-acl-program args))) + + (tramp-message + v 6 "%s" (string-join (process-command p) " ")) + (process-put p 'tramp-vector v) + (process-put p 'adjust-window-size-function #'ignore) + (set-process-query-on-exit-flag p nil) + (tramp-process-actions p v nil tramp-smb-actions-get-acl) + (when (> (point-max) (point-min)) + (substring-no-properties (buffer-string)))))))))))) (defun tramp-smb-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." @@ -982,18 +984,20 @@ tramp-smb-handle-file-local-copy ;; files. (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (delete-dups - (mapcar - (lambda (x) - (list - (if (tramp-compat-string-search "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory))))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (when (file-directory-p directory) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (delete-dups + (mapcar + (lambda (x) + (list + (if (tramp-compat-string-search "d" (nth 1 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + (tramp-smb-get-file-entries directory))))))))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -1079,7 +1083,7 @@ tramp-smb-handle-insert-directory (setq entries (delq nil - (if (or wildcard (zerop (length base))) + (if (or wildcard (string-empty-p base)) ;; Check for matching entries. (mapcar (lambda (x) @@ -1105,7 +1109,7 @@ tramp-smb-handle-insert-directory (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) "/"))) @@ -1125,7 +1129,7 @@ tramp-smb-handle-insert-directory ;; 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 @@ -1229,7 +1233,10 @@ tramp-smb-handle-make-symbolic-link (let ((non-essential t)) (when (and (tramp-tramp-file-p target) (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) + (setq target (tramp-file-local-name (expand-file-name target)))) + ;; There could be a cyclic link. + (tramp-flush-file-properties + v (expand-file-name target (tramp-file-local-name default-directory)))) ;; If TARGET is still remote, quote it. (if (tramp-tramp-file-p target) @@ -1455,9 +1462,9 @@ tramp-smb-handle-set-file-acl "\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)))) @@ -1473,44 +1480,43 @@ tramp-smb-handle-set-file-acl "&&" "echo" "tramp_exit_status" "0" "||" "echo" "tramp_exit_status" "1"))) - (unwind-protect - (with-tramp-saved-connection-properties - v '("process-name" "process-buffer") - (with-temp-buffer - ;; Set the transfer process properties. - (tramp-set-connection-property - v "process-name" (buffer-name (current-buffer))) - (tramp-set-connection-property - v "process-buffer" (current-buffer)) - - ;; Use an asynchronous process. By this, password - ;; can be handled. - (let ((p (apply - #'start-process - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - tramp-smb-acl-program args))) - - (tramp-message - v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) - (process-put p 'adjust-window-size-function #'ignore) - (set-process-query-on-exit-flag p nil) - (tramp-process-actions p v nil tramp-smb-actions-set-acl) - ;; This is meant for traces, and returning from - ;; the function. No error is propagated outside, - ;; due to the `ignore-errors' closure. - (unless - (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) - (tramp-error - v 'file-error - "Couldn't find exit status of `%s'" - tramp-smb-acl-program)) - (skip-chars-forward "^ ") - (when (zerop (read (current-buffer))) - ;; Success. - (tramp-set-file-property v localname "file-acl" acl-string) - t)))))))))) + (with-tramp-saved-connection-properties + v '("process-name" "process-buffer") + (with-temp-buffer + ;; Set the transfer process properties. + (tramp-set-connection-property + v "process-name" (buffer-name (current-buffer))) + (tramp-set-connection-property + v "process-buffer" (current-buffer)) + + ;; Use an asynchronous process. By this, password + ;; can be handled. + (let ((p (apply + #'start-process + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) + tramp-smb-acl-program args))) + + (tramp-message + v 6 "%s" (string-join (process-command p) " ")) + (process-put p 'tramp-vector v) + (process-put p 'adjust-window-size-function #'ignore) + (set-process-query-on-exit-flag p nil) + (tramp-process-actions p v nil tramp-smb-actions-set-acl) + ;; This is meant for traces, and returning from + ;; the function. No error is propagated outside, + ;; due to the `ignore-errors' closure. + (unless + (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) + (tramp-error + v 'file-error + "Couldn't find exit status of `%s'" + tramp-smb-acl-program)) + (skip-chars-forward "^ ") + (when (zerop (read (current-buffer))) + ;; Success. + (tramp-set-file-property v localname "file-acl" acl-string) + t))))))))) (defun tramp-smb-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." @@ -1607,7 +1613,7 @@ tramp-smb-handle-get-home-directory 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 @@ -1956,7 +1962,7 @@ tramp-smb-maybe-open-connection (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 (rx (+ (any " \t\n\r")) eos) tramp-smb-version) + (if (string-match (rx (+ (any " \t\r\n")) eos) tramp-smb-version) (setq tramp-smb-version (replace-match "" nil nil tramp-smb-version)))) @@ -2009,9 +2015,9 @@ tramp-smb-maybe-open-connection (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)))) @@ -2026,7 +2032,8 @@ tramp-smb-maybe-open-connection (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 @@ -2044,7 +2051,7 @@ tramp-smb-maybe-open-connection args)))) (tramp-message vec 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -2098,7 +2105,7 @@ tramp-smb-wait-for-output ;; Read pending output. (while (not (re-search-forward tramp-smb-prompt nil t)) - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (goto-char (point-min))) (tramp-message vec 6 "\n%s" (buffer-string)) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 2d3c436632f..0ec2a1e74b8 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -100,7 +100,7 @@ tramp-sshfs-file-name-handler-alist (file-directory-p . tramp-handle-file-directory-p) (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-fuse-handle-file-executable-p) - (file-exists-p . tramp-handle-file-exists-p) + (file-exists-p . tramp-fuse-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) @@ -244,8 +244,8 @@ tramp-sshfs-handle-insert-file-contents (setq result (insert-file-contents (tramp-fuse-local-file-name filename) visit beg end replace)) - (when visit (setq buffer-file-name filename)) - (cons filename (cdr result))))) + (when visit (setq buffer-file-name filename))) + (cons filename (cdr result)))) (defun tramp-sshfs-handle-process-file (program &optional infile destination display &rest args) @@ -399,7 +399,7 @@ tramp-sshfs-maybe-open-connection :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 88dacdc7893..d167bf13b14 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -366,7 +366,8 @@ tramp-sudoedit-handle-expand-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))) @@ -377,7 +378,7 @@ tramp-sudoedit-handle-expand-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))) @@ -387,7 +388,7 @@ tramp-sudoedit-handle-expand-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))))) @@ -457,39 +458,33 @@ tramp-sudoedit-handle-file-executable-p (defun tramp-sudoedit-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - ;; `file-exists-p' is used as predicate in file name completion. - ;; We don't want to run it when `non-essential' is t, or there is - ;; no connection process yet. - (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-tramp-file-property v localname "file-exists-p" - (if (tramp-file-property-p v localname "file-attributes") - (not (null (tramp-get-file-property v localname "file-attributes"))) - (tramp-sudoedit-send-command - v "test" "-e" (tramp-compat-file-name-unquote localname))))))) + (tramp-skeleton-file-exists-p filename + (tramp-sudoedit-send-command + v "test" "-e" (tramp-compat-file-name-unquote localname)))) (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (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)) - "" (tramp-compat-file-name-unquote localname))) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (delq - nil + (tramp-compat-ignore-error file-missing + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (tramp-sudoedit-send-command + v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" + (if (tramp-string-empty-or-nil-p localname) + "" (tramp-compat-file-name-unquote localname))) (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string - (tramp-get-buffer-string (tramp-get-connection-buffer v)) - "\n" 'omit)))))))) + (lambda (f) + (if (ignore-errors (file-directory-p (expand-file-name f directory))) + (file-name-as-directory f) + f)) + (delq + nil + (mapcar + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string + (tramp-get-buffer-string (tramp-get-connection-buffer v)) + "\n" 'omit))))))))) (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -653,7 +648,10 @@ tramp-sudoedit-handle-make-symbolic-link (let ((non-essential t)) (when (and (tramp-tramp-file-p target) (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) + (setq target (tramp-file-local-name (expand-file-name target)))) + ;; There could be a cyclic link. + (tramp-flush-file-properties + v (expand-file-name target (tramp-file-local-name default-directory)))) ;; If TARGET is still remote, quote it. (if (tramp-tramp-file-p target) @@ -774,7 +772,7 @@ tramp-sudoedit-action-sudo "Check, whether a sudo process has finished. Remove unneeded output." ;; There might be pending output for the exit status. (unless (process-live-p proc) - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) ;; Delete narrowed region, it would be in the way reading a Lisp form. (goto-char (point-min)) (widen) @@ -802,7 +800,7 @@ tramp-sudoedit-maybe-open-connection :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. @@ -840,7 +838,7 @@ tramp-sudoedit-send-command (tramp-message vec 6 "%s" (string-join (process-command p) " ")) ;; Avoid process status message in output buffer. (set-process-sentinel p #'ignore) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 29361f8a113..9fa698293ce 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -64,6 +64,22 @@ (declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) (defvar ls-lisp-use-insert-directory-program) +(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) ;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ;; ELPA package. @@ -83,6 +99,7 @@ tramp (progn (defvar tramp--startup-hook nil "Forms to be executed at the end of tramp.el.") + (put 'tramp--startup-hook 'tramp-suppress-trace t) (defmacro tramp--with-startup (&rest body) @@ -441,6 +458,8 @@ tramp-default-method-alist (defconst tramp-default-method-marker "-" "Marker for default method in remote file names.") +(add-to-list 'tramp-methods `(,tramp-default-method-marker)) + (defcustom tramp-default-user nil "Default user to use for transferring files. It is nil by default; otherwise settings in configuration files like @@ -520,6 +539,11 @@ tramp-save-ad-hoc-proxies :version "24.3" :type 'boolean) +(defcustom tramp-show-ad-hoc-proxies nil + "Whether to show ad-hoc proxies in file names." + :version "29.2" + :type 'boolean) + ;; For some obscure technical reasons, `system-name' on w32 returns ;; either lower case or upper case letters. See ;; . @@ -624,9 +648,7 @@ tramp-shell-prompt-pattern ;; connection initialization; Tramp redefines the prompt afterwards. (rx (| bol "\r") (* (not (any "\n#$%>]"))) - (? "#") (any "#$%>]") (* blank) - ;; Escape characters. - (* "[" (* (any ";" digit)) alpha (* blank))) + (? "#") (any "#$%>]") (* blank)) "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 @@ -660,14 +682,14 @@ tramp-password-prompt-regexp (defcustom tramp-wrong-passwd-regexp (rx bol (* nonl) (| "Permission denied" - (: "Login " (| "Incorrect" "incorrect")) - "Connection refused" - "Connection closed" "Timeout, server not responding." "Sorry, try again." "Name or service not known" "Host key verification failed." + "Authentication failed" "No supported authentication methods left to try!" + (: "Login " (| "Incorrect" "incorrect")) + (: "Connection " (| "refused" "closed")) (: "Received signal " (+ digit))) (* nonl)) "Regexp matching a `login failed' message. @@ -698,7 +720,7 @@ tramp-yn-prompt-regexp (defcustom tramp-terminal-type "dumb" "Value of TERM environment variable for logging in to remote host. Because Tramp wants to parse the output of the remote shell, it is easily -confused by ANSI color escape sequences and suchlike. Often, shell init +confused by ANSI control escape sequences and suchlike. Often, shell init files conditionalize this setup based on the TERM environment variable." :group 'tramp :type 'string) @@ -725,7 +747,8 @@ tramp-antispoof-regexp ;; A security key requires the user physically to touch the device ;; with their finger. We must tell it to the user. -;; Added in OpenSSH 8.2. I've tested it with yubikey. +;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey, +;; which has also passed the tests, does not show such a message. (defcustom tramp-security-key-confirm-regexp (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) "Regular expression matching security key confirmation message. @@ -790,6 +813,7 @@ tramp-temp-buffer-name (defvar tramp-temp-buffer-file-name nil "File name of a persistent local temporary file. Useful for \"rsync\" like methods.") + (make-variable-buffer-local 'tramp-temp-buffer-file-name) (put 'tramp-temp-buffer-file-name 'permanent-local t) @@ -813,23 +837,6 @@ tramp-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 @@ -1218,9 +1225,12 @@ tramp-build-completion-file-name-regexp (? (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)))) - + (? (regexp tramp-user-regexp) + (regexp tramp-postfix-user-regexp)) + (? (| (regexp tramp-host-regexp) ;; This includes a user. + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp) + (? (regexp tramp-postfix-ipv6-regexp)))))))) eos))) (defvar tramp-completion-file-name-regexp @@ -1430,6 +1440,7 @@ tramp-password-save-function "Password save function. Will be called once the password has been verified by successful authentication.") + (put 'tramp-password-save-function 'tramp-suppress-trace t) (defvar tramp-password-prompt-not-unique nil @@ -1438,9 +1449,13 @@ tramp-password-prompt-not-unique during direct remote copying with scp.") (defconst tramp-completion-file-name-handler-alist - '((file-name-all-completions + '((expand-file-name . tramp-completion-handle-expand-file-name) + (file-exists-p . tramp-completion-handle-file-exists-p) + (file-name-all-completions . tramp-completion-handle-file-name-all-completions) - (file-name-completion . tramp-completion-handle-file-name-completion)) + (file-name-completion . tramp-completion-handle-file-name-completion) + (file-name-directory . tramp-completion-handle-file-name-directory) + (file-name-nondirectory . tramp-completion-handle-file-name-nondirectory)) "Alist of completion handler functions. Used for file names matching `tramp-completion-file-name-regexp'. Operations not mentioned here will be handled by Tramp's file @@ -1657,7 +1672,7 @@ tramp-find-host 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 @@ -1669,7 +1684,7 @@ tramp-find-host 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)))) @@ -1732,14 +1747,13 @@ tramp-dissect-file-name :port port :localname localname :hop hop)) ;; The method must be known. (unless (or nodefault non-essential - (string-equal method tramp-default-method-marker) (assoc method tramp-methods)) (tramp-user-error - v "Method `%s' is not known." method)) + v "Method `%s' is not known" method)) ;; Only some methods from tramp-sh.el do support multi-hops. (unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v)) (tramp-user-error - v "Method `%s' is not supported for multi-hops." method))))))) + v "Method `%s' is not supported for multi-hops" method))))))) (put #'tramp-dissect-file-name 'tramp-suppress-trace t) @@ -1768,21 +1782,25 @@ tramp-dissect-hop-name ;; Only some methods from tramp-sh.el do support multi-hops. (unless (or nodefault non-essential (tramp-multi-hop-p v)) (tramp-user-error - v "Method `%s' is not supported for multi-hops." + v "Method `%s' is not supported for multi-hops" (tramp-file-name-method v))) ;; Return result. v)) (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) @@ -1811,7 +1829,9 @@ tramp-make-tramp-file-name (when (cadr args) (setq localname (and (stringp (cadr args)) (cadr args)))) (when hop - (setq hop nil) + ;; Keep hop in file name for completion or when indicated. + (unless (or minibuffer-completing-file-name tramp-show-ad-hoc-proxies) + (setq hop nil)) ;; Assure that the hops are in `tramp-default-proxies-alist'. ;; In tramp-archive.el, the slot `hop' is used for the archive ;; file name. @@ -1827,23 +1847,23 @@ tramp-make-tramp-file-name 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))) @@ -1861,19 +1881,19 @@ tramp-make-tramp-hop-name (tramp-compat-rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format - (tramp-make-tramp-file-name vec 'noloc))))) + (tramp-make-tramp-file-name (tramp-file-name-unify vec)))))) (defun tramp-completion-make-tramp-file-name (method user host localname) "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME. 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 @@ -1920,7 +1940,7 @@ tramp-get-process (or (and (tramp-file-name-p vec-or-proc) (get-buffer-process (tramp-buffer-name vec-or-proc))) (and (processp vec-or-proc) - (tramp-get-process (process-get vec-or-proc 'vector))) + (tramp-get-process (process-get vec-or-proc 'tramp-vector))) tramp-cache-undefined)) (defun tramp-get-connection-process (vec) @@ -1970,9 +1990,9 @@ tramp-debug-buffer-name (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) @@ -2202,7 +2222,7 @@ tramp-message vec-or-proc 'dont-create)))))))) ;; Translate proc to vec. (when (processp vec-or-proc) - (setq vec-or-proc (process-get vec-or-proc 'vector)))) + (setq vec-or-proc (process-get vec-or-proc 'tramp-vector)))) ;; Do it. (when (tramp-file-name-p vec-or-proc) (apply #'tramp-debug-message @@ -2325,12 +2345,12 @@ tramp-with-demoted-errors (progn ,@body) (error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) -;; This macro shall optimize the cases where an `file-exists-p' call -;; is invoked first. Often, the file exists, so the remote command is +;; This macro shall optimize the cases where a `file-exists-p' call is +;; invoked first. Often, the file exists, so the remote command is ;; superfluous. (defmacro tramp-barf-if-file-missing (vec filename &rest body) "Execute BODY and return the result. -In case if an error, raise a `file-missing' error if FILENAME +In case of an error, raise a `file-missing' error if FILENAME does not exist, otherwise propagate the error." (declare (indent 2) (debug (symbolp form body))) (let ((err (make-symbol "err"))) @@ -2483,13 +2503,14 @@ tramp-set-completion-function (setcdr v (delete (car v) (cdr v)))) ;; Check for function and file or registry key. (unless (and (functionp (nth 0 (car v))) + (stringp (nth 1 (car v))) (cond ;; Windows registry. ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v))) (and (memq system-type '(cygwin windows-nt)) (zerop (tramp-call-process - v "reg" nil nil nil "query" (nth 1 (car v)))))) + nil "reg" nil nil nil "query" (nth 1 (car v)))))) ;; DNS-SD service type. ((string-match-p tramp-dns-sd-service-regexp (nth 1 (car v)))) @@ -2794,7 +2815,7 @@ tramp-completion-file-name-handler "Invoke Tramp file name completion handler for OPERATION and ARGS. Falls back to normal file name handler if no Tramp file name handler exists." (if-let - ((fn (and tramp-mode + ((fn (and tramp-mode minibuffer-completing-file-name (assoc operation tramp-completion-file-name-handler-alist)))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) @@ -2967,6 +2988,75 @@ tramp-connectable-p (and vec (process-live-p (get-process (tramp-buffer-name vec)))) (not non-essential)))) +(defun tramp-completion-handle-expand-file-name (filename &optional directory) + "Like `expand-file-name' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; check, whether DIRECTORY is "/method:" or "/[method/". + (let ((dir (or directory default-directory "/"))) + (cond + ((file-name-absolute-p filename) filename) + ((and (eq tramp-syntax 'simplified) + (string-match-p + (tramp-compat-rx (regexp tramp-postfix-host-regexp) eos) dir)) + (concat dir filename)) + ((string-match-p + (tramp-compat-rx + bos (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp) + (? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp))) + eos) + dir) + (concat dir filename)) + (t (tramp-run-real-handler #'expand-file-name (list filename directory)))))) + +(defun tramp-completion-handle-file-exists-p (filename) + "Like `file-exists-p' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; regard all files "/method:" or "/[method/" as existent, if + ;; "method" is a valid Tramp method. And we regard all files + ;; "/method:user@", "/user@" or "/[method/user@" as existent, if + ;; "user@" is a valid file name completion. Host completion is + ;; performed in the respective backen operation. + (or (and (cond + ;; Completion styles like `flex' and `substring' check for + ;; the file name "/". This does exist. + ((string-equal filename "/")) + ;; Is it a valid method? + ((and (not (string-empty-p tramp-postfix-method-format)) + (string-match + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (group-n 9 (regexp tramp-method-regexp)) + (? (regexp tramp-postfix-method-regexp)) + eos) + filename)) + (assoc (match-string 9 filename) tramp-methods)) + ;; Is it a valid user? + ((string-match + (tramp-compat-rx + (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (group-n 10 + (regexp tramp-method-regexp) + (regexp tramp-postfix-method-regexp)) + (group-n 11 + (regexp tramp-user-regexp) + (regexp tramp-postfix-user-regexp)) + eos) + filename) + (member + (match-string 11 filename) + (file-name-all-completions + "" (concat tramp-prefix-format (match-string 10 filename)))))) + t) + + (tramp-run-real-handler #'file-exists-p (list filename)))) + ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of ;; `tramp-file-name' structures. For all of them we return possible @@ -2977,10 +3067,10 @@ tramp-completion-handle-file-name-all-completions (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 @@ -3040,11 +3130,12 @@ tramp-completion-handle-file-name-all-completions result1))) ;; Complete local parts. - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))) + (delete-dups + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion @@ -3202,6 +3293,47 @@ tramp-get-completion-user-host (unless (zerop (+ (length user) (length host))) (tramp-completion-make-tramp-file-name method user host nil))) +(defun tramp-completion-handle-file-name-directory (filename) + "Like `file-name-directory' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; return "/method:" or "/[method/", if "method" is a valid Tramp + ;; method. In the `separate' file name syntax, we return "/[" when + ;; `filename' is "/[string" w/o a trailing method separator "/". + (cond + ((string-match + (tramp-compat-rx + (group (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp))) + (? (regexp tramp-completion-method-regexp)) eos) + filename) + (match-string 1 filename)) + ((and (string-match + (tramp-compat-rx + (group + (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (? (regexp tramp-user-regexp) + (regexp tramp-postfix-user-regexp))) + (? (| (regexp tramp-host-regexp) + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp) + (? (regexp tramp-postfix-ipv6-regexp)))))) + eos) + filename) + ;; Is it a valid method? + (or (tramp-string-empty-or-nil-p (match-string 2 filename)) + (assoc (match-string 2 filename) tramp-methods))) + (match-string 1 filename)) + (t (tramp-run-real-handler #'file-name-directory (list filename))))) + +(defun tramp-completion-handle-file-name-nondirectory (filename) + "Like `file-name-nondirectory' for partial Tramp files." + (tramp-compat-string-replace (file-name-directory filename) "" filename)) + (defun tramp-parse-default-user-host (method) "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' @@ -3527,6 +3659,25 @@ tramp-skeleton-directory-files-and-attributes (tramp-dissect-file-name ,directory) 'file-missing ,directory) nil))) +(defmacro tramp-skeleton-file-exists-p (filename &rest body) + "Skeleton for `tramp-*-handle-file-exists-p'. +BODY is the backend specific code." + (declare (indent 1) (debug t)) + ;; `file-exists-p' is used as predicate in file name completion. + `(or (and minibuffer-completing-file-name + (file-name-absolute-p ,filename) + (tramp-string-empty-or-nil-p + (tramp-file-name-localname (tramp-dissect-file-name ,filename)))) + ;; We don't want to run it when `non-essential' is t, or there + ;; is no connection process yet. + (when (tramp-connectable-p ,filename) + (with-parsed-tramp-file-name (expand-file-name ,filename) nil + (with-tramp-file-property v localname "file-exists-p" + (if (tramp-file-property-p v localname "file-attributes") + (not + (null (tramp-get-file-property v localname "file-attributes"))) + ,@body)))))) + (defmacro tramp-skeleton-file-local-copy (filename &rest body) "Skeleton for `tramp-*-handle-file-local-copy'. BODY is the backend specific code." @@ -3640,29 +3791,29 @@ tramp-skeleton-write-region ;; Set the ownership. (when need-chown - (tramp-set-file-uid-gid filename uid gid))) - - ;; Set extended attributes. We ignore possible errors, - ;; because ACL strings could be incompatible. - (when attributes - (ignore-errors - (set-file-extended-attributes filename attributes))) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; Sanity check. - (unless (equal curbuf (current-buffer)) - (tramp-error - v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - - (when (and (null noninteractive) - (or (eq ,visit t) (string-or-null-p ,visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))))) + (tramp-set-file-uid-gid filename uid gid)) + + ;; Set extended attributes. We ignore possible errors, + ;; because ACL strings could be incompatible. + (when attributes + (ignore-errors + (set-file-extended-attributes filename attributes))) + + ;; Unlock file. + (when file-locked + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file lockname)) + + ;; Sanity check. + (unless (equal curbuf (current-buffer)) + (tramp-error + v 'file-error + "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) + + (when (and (null noninteractive) + (or (eq ,visit t) (string-or-null-p ,visit))) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook))))))) ;;; Common file name handler functions for different backends: @@ -3711,7 +3862,7 @@ tramp-handle-abbreviate-file-name (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." (setq filename (file-truename filename)) - (with-parsed-tramp-file-name filename v + (with-parsed-tramp-file-name filename nil (if (file-exists-p filename) (unless (funcall @@ -3766,7 +3917,7 @@ tramp-handle-directory-file-name ;; 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))) @@ -3797,7 +3948,8 @@ tramp-handle-expand-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))) @@ -3817,7 +3969,7 @@ tramp-handle-expand-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))))) @@ -3846,9 +3998,10 @@ tramp-handle-file-accessible-directory-p (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." ;; `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))) + ;; symlink. We don't protect this despite it, because other errors + ;; might be worth to be visible, for example impossibility to mount + ;; in tramp-gvfs.el. + (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." @@ -3861,13 +4014,8 @@ tramp-handle-file-equal-p (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - ;; `file-exists-p' is used as predicate in file name completion. - ;; We don't want to run it when `non-essential' is t, or there is - ;; no connection process yet. - (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-tramp-file-property v localname "file-exists-p" - (not (null (file-attributes filename))))))) + (tramp-skeleton-file-exists-p filename + (not (null (file-attributes filename))))) (defun tramp-handle-file-in-directory-p (filename directory) "Like `file-in-directory-p' for Tramp files." @@ -3902,7 +4050,7 @@ tramp-handle-file-name-as-directory ;; 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 @@ -3965,7 +4113,8 @@ tramp-handle-file-name-completion ;; "." 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 @@ -4698,7 +4847,7 @@ tramp-compute-multi-hops (unless (tramp-multi-hop-p item) (setq tramp-default-proxies-alist saved-tdpa) (tramp-user-error - vec "Method `%s' is not supported for multi-hops." + vec "Method `%s' is not supported for multi-hops" (tramp-file-name-method item))))) ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the @@ -4752,7 +4901,7 @@ tramp-direct-async-process-p (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)))))) @@ -4891,6 +5040,11 @@ tramp-handle-make-process ;; t. See Bug#51177. (when filter (set-process-filter p filter)) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, the + ;; setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'remote-command orig-command) (tramp-set-connection-property p "remote-command" orig-command) @@ -4908,7 +5062,7 @@ tramp-handle-make-symbolic-link (defun tramp-handle-memory-info () "Like `memory-info' for Tramp files." - (let ((result '(0 0 0 0)) + (let ((result (list 0 0 0 0)) process-file-side-effects) (with-temp-buffer (cond @@ -5108,17 +5262,19 @@ tramp-handle-shell-command (add-function :after (process-sentinel p) (lambda (_proc _string) - (with-current-buffer error-buffer - (insert-file-contents-literally - error-file nil nil nil 'replace)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally + error-file nil nil nil 'replace)) + (delete-file error-file))))) (display-buffer output-buffer '(nil (allow-no-window . t))))) ;; Insert error messages if they were separated. (when (and error-file (not (process-live-p p))) - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))))) ;; Synchronous case. (prog1 @@ -5126,9 +5282,10 @@ tramp-handle-shell-command (process-file-shell-command command nil buffer) ;; Insert error messages if they were separated. (when error-file - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))) (if current-buffer-p ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, @@ -5300,7 +5457,7 @@ tramp-handle-file-notify-rm-watch ;; There might be pending output. Avoid problems with reentrant ;; call of Tramp. (ignore-errors - (while (tramp-accept-process-output proc 0))) + (while (tramp-accept-process-output proc))) (tramp-message proc 6 "Kill %S" proc) (delete-process proc)) @@ -5312,7 +5469,7 @@ tramp-handle-file-notify-valid-p (with-current-buffer (process-buffer proc) (file-exists-p (concat (file-remote-p default-directory) - (process-get proc 'watch-name)))))) + (process-get proc 'tramp-watch-name)))))) (defun tramp-file-notify-process-sentinel (proc event) "Call `file-notify-rm-watch'." @@ -5438,7 +5595,7 @@ tramp-action-show-and-confirm-message ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. - (while (not (tramp-compat-ignore-error 'file-error + (while (not (tramp-compat-ignore-error file-error (tramp-wait-for-regexp proc 0.1 tramp-security-key-confirmed-regexp))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) @@ -5452,13 +5609,13 @@ tramp-action-process-alive "Check, whether a process has finished." (unless (process-live-p proc) ;; There might be pending output. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (throw 'tramp-action 'process-died))) (defun tramp-action-out-of-band (proc vec) "Check, whether an out-of-band copy has finished." ;; There might be pending output for the exit status. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (cond ((and (not (process-live-p proc)) (zerop (process-exit-status proc))) (tramp-message vec 3 "Process has finished.") @@ -5489,12 +5646,18 @@ tramp-process-one-action (while (not found) ;; Reread output once all actions have been performed. ;; Obviously, the output was not complete. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) + ;; Remove ANSI control escape sequences. + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-min)) + (while (re-search-forward ansi-color-control-seq-regexp nil t) + (replace-match ""))) (setq todo actions) (while todo (setq item (pop todo) tramp-process-action-regexp (symbol-value (nth 0 item)) - pattern (format "\\(%s\\)\\'" tramp-process-action-regexp) + pattern + (tramp-compat-rx (group (regexp tramp-process-action-regexp)) eos) action (nth 1 item)) (tramp-message vec 5 "Looking for regexp \"%s\" from remote shell" pattern) @@ -5532,7 +5695,7 @@ tramp-process-actions ;; use the "password-vector" property in case we have several hops. (tramp-set-connection-property (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector)) + proc "password-vector" (process-get proc 'tramp-vector)) "first-password-request" tramp-cache-read-persistent-data) (save-restriction (with-tramp-progress-reporter @@ -5606,11 +5769,22 @@ with-tramp-locked-connection ,@body) (tramp-flush-connection-property ,proc "locked")))) -(defun tramp-accept-process-output (proc &optional timeout) +(defun tramp-accept-process-output (proc &optional _timeout) "Like `accept-process-output' for Tramp processes. This is needed in order to hide `last-coding-system-used', which is set for process communication also. If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." + (declare (advertised-calling-convention (proc) "29.2")) + ;; There could be other processes which use the same socket for + ;; communication. This could block the output for the current + ;; process. Read such output first. (Bug#61350) + ;; The process property isn't set anymore due to Bug#62194. + (when-let (((process-get proc 'tramp-shared-socket)) + (v (process-get proc 'tramp-vector))) + (dolist (p (delq proc (process-list))) + (when (tramp-file-name-equal-p v (process-get p 'tramp-vector)) + (with-local-quit (accept-process-output p 0 nil t))))) + (with-current-buffer (process-buffer proc) (let ((inhibit-read-only t) last-coding-system-used @@ -5620,10 +5794,10 @@ tramp-accept-process-output ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit' ;; returns t in order to report success. (if (with-local-quit - (setq result (accept-process-output proc timeout nil t)) t) + (setq result (accept-process-output proc 0 nil t)) t) (tramp-message - proc 10 "%s %s %s %s\n%s" - proc timeout (process-status proc) result (buffer-string)) + proc 10 "%s %s %s\n%s" + proc (process-status proc) result (buffer-string)) ;; Propagate quit. (keyboard-quit))) result))) @@ -5761,7 +5935,7 @@ tramp-send-string (defun tramp-process-sentinel (proc event) "Flush file caches and remove shell prompt." (unless (process-live-p proc) - (let ((vec (process-get proc 'vector)) + (let ((vec (process-get proc 'tramp-vector)) (buf (process-buffer proc)) (prompt (tramp-get-connection-property proc "prompt"))) (when vec @@ -6039,10 +6213,9 @@ tramp-convert-file-attributes (with-tramp-file-property ,vec ,localname "file-attributes" (when-let ((attr ,attr)) (save-match-data - ;; Remove color escape sequences from symlink. + ;; Remove ANSI control escape sequences from symlink. (when (stringp (car attr)) - (while (string-match - tramp-display-escape-sequence-regexp (car attr)) + (while (string-match ansi-color-control-seq-regexp (car attr)) (setcar attr (replace-match "" nil nil (car attr))))) ;; Convert uid and gid. Use `tramp-unknown-id-integer' ;; as indication of unusable value. @@ -6364,6 +6537,7 @@ tramp-call-process PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (destination (if (eq destination t) (current-buffer) destination)) (vec (or vec (car tramp-current-connection))) @@ -6384,7 +6558,7 @@ tramp-call-process (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)) @@ -6396,6 +6570,7 @@ tramp-call-process-region PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (buffer (if (eq buffer t) (current-buffer) buffer)) result) @@ -6469,7 +6644,7 @@ tramp-read-passwd ;; In tramp-sh.el, we must use "password-vector" due to ;; multi-hop. (vec (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector))) + proc "password-vector" (process-get proc 'tramp-vector))) (key (tramp-make-tramp-file-name vec 'noloc)) (method (tramp-file-name-method vec)) (user (or (tramp-file-name-user-domain vec) @@ -6520,7 +6695,7 @@ tramp-read-passwd ;; 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) @@ -6632,13 +6807,14 @@ tramp-interrupt-process ;; negative pid, so we try both variants. (tramp-compat-funcall 'tramp-send-command - (process-get proc 'vector) + (process-get proc 'tramp-vector) (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s" pid pid - (tramp-get-remote-null-device (process-get proc 'vector)))) + (tramp-get-remote-null-device + (process-get proc 'tramp-vector)))) ;; Wait, until the process has disappeared. If it doesn't, ;; fall back to the default implementation. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (not (process-live-p proc)))))) (add-hook 'interrupt-process-functions #'tramp-interrupt-process) @@ -6661,7 +6837,7 @@ tramp-signal-process (cond ((processp process) (setq pid (process-get process 'remote-pid) - vec (process-get process 'vector))) + vec (process-get process 'tramp-vector))) ((numberp process) (setq pid process vec (and (stringp remote) (tramp-dissect-file-name remote)))) @@ -6739,5 +6915,7 @@ tramp-get-remote-null-device ;; "/ssh:user1@host:~user2". ;; ;; * Implement file name abbreviation for user and host names. +;; +;; * Implement user and host name completion for multi-hops. ;;; tramp.el ends here diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 0d27829b915..f96ffac2e13 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.6.0.29.1 +;; Version: 2.6.2-pre ;; Package-Requires: ((emacs "26.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.6.0.29.1" +(defconst tramp-version "2.6.2-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ tramp-repository-version ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "26.1")) "ok" - (format "Tramp 2.6.0.29.1 is not fit for %s" + (format "Tramp 2.6.2-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index b28b32bc7d3..a23f72635fe 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -127,6 +127,12 @@ tramp-archive--test-emacs27-p variables, so we check the Emacs version directly." (>= emacs-major-version 27)) +(defun tramp-archive--test-emacs28-p () + "Check for Emacs version >= 28.1. +Some semantics has been changed for there, without new functions or +variables, so we check the Emacs version directly." + (>= emacs-major-version 28)) + (ert-deftest tramp-archive-test00-availability () "Test availability of archive file name functions." :expected-result (if tramp-archive-enabled :passed :failed) @@ -593,11 +599,11 @@ tramp-archive-test16-directory-files (mapcar (lambda (x) (concat tmp-name x)) files))) (should (equal (directory-files tmp-name nil directory-files-no-dot-files-regexp) - (delete "." (delete ".." files)))) + (remove "." (remove ".." files)))) (should (equal (directory-files tmp-name 'full directory-files-no-dot-files-regexp) (mapcar (lambda (x) (concat tmp-name x)) - (delete "." (delete ".." files)))))) + (remove "." (remove ".." files)))))) ;; Cleanup. (tramp-archive-cleanup-hash)))) @@ -888,7 +894,7 @@ tramp-archive-test43-file-system-info (let ((fsi (with-no-warnings (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)) @@ -913,12 +919,15 @@ tramp-archive-test47-auto-load (featurep 'tramp-archive))))")) (dolist (enabled '(t nil)) (dolist (default-directory - `(,temporary-file-directory + (append + `(,temporary-file-directory) ;; Starting Emacs in a directory which has ;; `tramp-archive-file-name-regexp' syntax is ;; supported only with Emacs > 27.2 (sigh!). ;; (Bug#48476) - ,(file-name-as-directory tramp-archive-test-directory))) + (and (tramp-archive--test-emacs28-p) + `(,(file-name-as-directory + tramp-archive-test-directory))))) (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) (should (string-match diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0a777617c1d..00e368abe4d 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -66,7 +66,6 @@ (defvar ange-ftp-make-backup-files) (defvar tramp-connection-properties) (defvar tramp-copy-size-limit) -(defvar tramp-display-escape-sequence-regexp) (defvar tramp-fuse-remove-hidden-files) (defvar tramp-fuse-unmount-on-cleanup) (defvar tramp-inline-compress-start-size) @@ -166,6 +165,9 @@ dired-copy-dereference ;; Suppress nasty messages. (fset #'shell-command-sentinel #'ignore) ;; We do not want to be interrupted. + (fset #'tramp-action-yesno + (lambda (_proc vec) + (tramp-send-string vec (concat "yes" tramp-local-end-of-line)) t)) (eval-after-load 'tramp-gvfs '(fset 'tramp-gvfs-handler-askquestion (lambda (_message _choices) '(t nil 0))))) @@ -529,6 +531,7 @@ tramp-test02-file-name-dissect tramp-default-method-alist tramp-default-user-alist tramp-default-host-alist + tramp-default-proxies-alist ;; Suppress method name check. (non-essential t) ;; Suppress check for multihops. @@ -855,154 +858,203 @@ tramp-test02-file-name-dissect "/path/to/file")) ;; Multihop. - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file") - "/method2:user2@host2:")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method) - "method2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user) - "user2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host) - "host2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop) - (format "%s:%s@%s|" - "method1" "user1" "host1"))) + (dolist (tramp-show-ad-hoc-proxies '(nil t)) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file")) - "/method3:user3@host3:")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'method) - "method3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'user) - "user3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'host) - "host3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'hop) - (format "%s:%s@%s|%s:%s@%s|" - "method1" "user1" "host1" "method2" "user2" "host2"))) - - ;; Expand `tramp-default-method-alist'. - (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1")) - (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2")) - (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3")) - (should - (string-equal - (file-remote-p - (concat - "/-:user1@host1" - "|-:user2@host2" - "|-:user3@host3:/path/to/file")) - "/method3:user3@host3:")) - - ;; Expand `tramp-default-user-alist'. - (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) - (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) - (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:host1" - "|method2:host2" - "|method3:host3:/path/to/file")) - "/method3:user3@host3:")) - - ;; Expand `tramp-default-host-alist'. - (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) - (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) - (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@" - "|method2:user2@" - "|method3:user3@:/path/to/file")) - "/method3:user3@host3:")) - - ;; Ad-hoc user name and host name expansion. - (setq tramp-default-method-alist nil - tramp-default-user-alist nil - tramp-default-host-alist nil) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@" - "|method3:user3@:/path/to/file")) - "/method3:user3@host1:")) - (should - (string-equal - (file-remote-p - (concat - "/method1:%u@%h" - "|method2:user2@host2" - "|method3:%u@%h" - "|method4:user4%domain4@host4#1234:/path/to/file")) - "/method4:user4%domain4@host4#1234:"))) + ;; Explicit settings in `tramp-default-proxies-alist' + ;; shouldn't show hops. + (setq tramp-default-proxies-alist + '(("^host2$" "^user2$" "/method1:user1@host1:"))) + (should + (string-equal + (file-remote-p "/method2:user2@host2:/path/to/file") + "/method2:user2@host2:")) + (setq tramp-default-proxies-alist nil) + + ;; Ad-hoc settings. + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file") + (if tramp-show-ad-hoc-proxies + "/method1:user1@host1|method2:user2@host2:" + "/method2:user2@host2:"))) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method) + "method2")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user) + "user2")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host) + "host2")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop) + (format "%s:%s@%s|" + "method1" "user1" "host1"))) + + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:") + "/method3:user3@host3:"))) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'method) + "method3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'user) + "user3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'host) + "host3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'hop) + (format "%s:%s@%s|%s:%s@%s|" + "method1" "user1" "host1" "method2" "user2" "host2"))) + + ;; Expand `tramp-default-method-alist'. + (add-to-list + 'tramp-default-method-alist '("host1" "user1" "method1")) + (add-to-list + 'tramp-default-method-alist '("host2" "user2" "method2")) + (add-to-list + 'tramp-default-method-alist '("host3" "user3" "method3")) + (should + (string-equal + (file-remote-p + (concat + "/-:user1@host1" + "|-:user2@host2" + "|-:user3@host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:") + "/method3:user3@host3:"))) + + ;; Expand `tramp-default-user-alist'. + (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) + (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) + (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:host1" + "|method2:host2" + "|method3:host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:") + "/method3:user3@host3:"))) + + ;; Expand `tramp-default-host-alist'. + (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) + (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) + (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@" + "|method2:user2@" + "|method3:user3@:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:") + "/method3:user3@host3:"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-method-alist nil + tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@" + "|method3:user3@:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host1" + "|method3:user3@host1:") + "/method3:user3@host1:"))) + (should + (string-equal + (file-remote-p + (concat + "/method1:%u@%h" + "|method2:user2@host2" + "|method3:%u@%h" + "|method4:user4%domain4@host4#1234:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user2@host2" + "|method2:user2@host2" + "|method3:user4@host4" + "|method4:user4%domain4@host4#1234:") + "/method4:user4%domain4@host4#1234:"))))) ;; Exit. (tramp-change-syntax syntax)))) @@ -1015,6 +1067,7 @@ tramp-test02-file-name-dissect-simplified (tramp-default-host "default-host") tramp-default-user-alist tramp-default-host-alist + tramp-default-proxies-alist ;; Suppress method name check. (non-essential t) ;; Suppress check for multihops. @@ -1186,137 +1239,178 @@ tramp-test02-file-name-dissect-simplified "/path/to/file")) ;; Multihop. - (should - (string-equal - (file-remote-p "/user1@host1|user2@host2:/path/to/file") - "/user2@host2:")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'method) - "default-method")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'user) - "user2")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'host) - "host2")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'hop) - (format "%s@%s|" "user1" "host1"))) + (dolist (tramp-show-ad-hoc-proxies '(nil t)) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file")) - "/user3@host3:")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'method) - "default-method")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'user) - "user3")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'host) - "host3")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'hop) - (format "%s@%s|%s@%s|" - "user1" "host1" "user2" "host2"))) - - ;; Expand `tramp-default-user-alist'. - (add-to-list 'tramp-default-user-alist '(nil "host1" "user1")) - (add-to-list 'tramp-default-user-alist '(nil "host2" "user2")) - (add-to-list 'tramp-default-user-alist '(nil "host3" "user3")) - (should - (string-equal - (file-remote-p - (concat - "/host1" - "|host2" - "|host3:/path/to/file")) - "/user3@host3:")) - - ;; Expand `tramp-default-host-alist'. - (add-to-list 'tramp-default-host-alist '(nil "user1" "host1")) - (add-to-list 'tramp-default-host-alist '(nil "user2" "host2")) - (add-to-list 'tramp-default-host-alist '(nil "user3" "host3")) - (should - (string-equal - (file-remote-p - (concat - "/user1@" - "|user2@" - "|user3@:/path/to/file")) - "/user3@host3:")) - - ;; Ad-hoc user name and host name expansion. - (setq tramp-default-user-alist nil - tramp-default-host-alist nil) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@" - "|user3@:/path/to/file")) - "/user3@host1:")) - (should - (string-equal - (file-remote-p - (concat - "/%u@%h" - "|user2@host2" - "|%u@%h" - "|user4%domain4@host4#1234:/path/to/file")) - "/user4%domain4@host4#1234:"))) + ;; Explicit settings in `tramp-default-proxies-alist' + ;; shouldn't show hops. + (setq tramp-default-proxies-alist + '(("^host2$" "^user2$" "/user1@host1:"))) + (should + (string-equal + (file-remote-p "/user2@host2:/path/to/file") + "/user2@host2:")) + (setq tramp-default-proxies-alist nil) + + ;; Ad-hoc settings. + (should + (string-equal + (file-remote-p "/user1@host1|user2@host2:/path/to/file") + (if tramp-show-ad-hoc-proxies + "/user1@host1|user2@host2:" + "/user2@host2:"))) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'method) + "default-method")) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'user) + "user2")) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'host) + "host2")) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'hop) + (format "%s@%s|" "user1" "host1"))) + + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:") + "/user3@host3:"))) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'method) + "default-method")) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'user) + "user3")) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'host) + "host3")) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'hop) + (format "%s@%s|%s@%s|" + "user1" "host1" "user2" "host2"))) + + ;; Expand `tramp-default-user-alist'. + (add-to-list 'tramp-default-user-alist '(nil "host1" "user1")) + (add-to-list 'tramp-default-user-alist '(nil "host2" "user2")) + (add-to-list 'tramp-default-user-alist '(nil "host3" "user3")) + (should + (string-equal + (file-remote-p + (concat + "/host1" + "|host2" + "|host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:") + "/user3@host3:"))) + + ;; Expand `tramp-default-host-alist'. + (add-to-list 'tramp-default-host-alist '(nil "user1" "host1")) + (add-to-list 'tramp-default-host-alist '(nil "user2" "host2")) + (add-to-list 'tramp-default-host-alist '(nil "user3" "host3")) + (should + (string-equal + (file-remote-p + (concat + "/user1@" + "|user2@" + "|user3@:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:") + "/user3@host3:"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@" + "|user3@:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user1@host1" + "|user2@host1" + "|user3@host1:") + "/user3@host1:"))) + (should + (string-equal + (file-remote-p + (concat + "/%u@%h" + "|user2@host2" + "|%u@%h" + "|user4%domain4@host4#1234:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user2@host2" + "|user2@host2" + "|user4@host4" + "|user4%domain4@host4#1234:") + "/user4%domain4@host4#1234:"))))) ;; Exit. (tramp-change-syntax syntax)))) @@ -1330,6 +1424,7 @@ tramp-test02-file-name-dissect-separate tramp-default-method-alist tramp-default-user-alist tramp-default-host-alist + tramp-default-proxies-alist ;; Suppress method name check. (non-essential t) ;; Suppress check for multihops. @@ -1802,154 +1897,203 @@ tramp-test02-file-name-dissect-separate "/path/to/file")) ;; Multihop. - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file") - "/[method2/user2@host2]")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method) - "method2")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user) - "user2")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host) - "host2")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop) - (format "%s/%s@%s|" - "method1" "user1" "host1"))) + (dolist (tramp-show-ad-hoc-proxies '(nil t)) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file")) - "/[method3/user3@host3]")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'method) - "method3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'user) - "user3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'host) - "host3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'hop) - (format "%s/%s@%s|%s/%s@%s|" - "method1" "user1" "host1" "method2" "user2" "host2"))) - - ;; Expand `tramp-default-method-alist'. - (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1")) - (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2")) - (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3")) - (should - (string-equal - (file-remote-p - (concat - "/[/user1@host1" - "|/user2@host2" - "|/user3@host3]/path/to/file")) - "/[method3/user3@host3]")) - - ;; Expand `tramp-default-user-alist'. - (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) - (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) - (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/host1" - "|method2/host2" - "|method3/host3]/path/to/file")) - "/[method3/user3@host3]")) - - ;; Expand `tramp-default-host-alist'. - (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) - (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) - (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@" - "|method2/user2@" - "|method3/user3@]/path/to/file")) - "/[method3/user3@host3]")) - - ;; Ad-hoc user name and host name expansion. - (setq tramp-default-method-alist nil - tramp-default-user-alist nil - tramp-default-host-alist nil) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@" - "|method3/user3@]/path/to/file")) - "/[method3/user3@host1]")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/%u@%h" - "|method2/user2@host2" - "|method3/%u@%h" - "|method4/user4%domain4@host4#1234]/path/to/file")) - "/[method4/user4%domain4@host4#1234]"))) + ;; Explicit settings in `tramp-default-proxies-alist' + ;; shouldn't show hops. + (setq tramp-default-proxies-alist + '(("^host2$" "^user2$" "/[method1/user1@host1]"))) + (should + (string-equal + (file-remote-p "/[method2/user2@host2]/path/to/file") + "/[method2/user2@host2]")) + (setq tramp-default-proxies-alist nil) + + ;; Ad-hoc settings. + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file") + (if tramp-show-ad-hoc-proxies + "/[method1/user1@host1|method2/user2@host2]" + "/[method2/user2@host2]"))) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method) + "method2")) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user) + "user2")) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host) + "host2")) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop) + (format "%s/%s@%s|" + "method1" "user1" "host1"))) + + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]") + "/[method3/user3@host3]"))) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'method) + "method3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'user) + "user3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'host) + "host3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'hop) + (format "%s/%s@%s|%s/%s@%s|" + "method1" "user1" "host1" "method2" "user2" "host2"))) + + ;; Expand `tramp-default-method-alist'. + (add-to-list + 'tramp-default-method-alist '("host1" "user1" "method1")) + (add-to-list + 'tramp-default-method-alist '("host2" "user2" "method2")) + (add-to-list + 'tramp-default-method-alist '("host3" "user3" "method3")) + (should + (string-equal + (file-remote-p + (concat + "/[/user1@host1" + "|/user2@host2" + "|/user3@host3]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]") + "/[method3/user3@host3]"))) + + ;; Expand `tramp-default-user-alist'. + (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) + (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) + (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/host1" + "|method2/host2" + "|method3/host3]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]") + "/[method3/user3@host3]"))) + + ;; Expand `tramp-default-host-alist'. + (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) + (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) + (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@" + "|method2/user2@" + "|method3/user3@]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]") + "/[method3/user3@host3]"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-method-alist nil + tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@" + "|method3/user3@]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host1" + "|method3/user3@host1]") + "/[method3/user3@host1]"))) + (should + (string-equal + (file-remote-p + (concat + "/[method1/%u@%h" + "|method2/user2@host2" + "|method3/%u@%h" + "|method4/user4%domain4@host4#1234]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user2@host2" + "|method2/user2@host2" + "|method3/user4@host4" + "|method4/user4%domain4@host4#1234]") + "/[method4/user4%domain4@host4#1234]"))))) ;; Exit. (tramp-change-syntax syntax)))) @@ -2522,7 +2666,7 @@ tramp-test10-write-region ;; Do not overwrite if excluded. (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always) ;; Ange-FTP. - ((symbol-function 'yes-or-no-p) #'tramp--test-always)) + ((symbol-function #'yes-or-no-p) #'tramp--test-always)) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) (should-error (cl-letf (((symbol-function #'y-or-n-p) #'ignore) @@ -4166,6 +4310,10 @@ tramp-test21-file-links (should (file-symlink-p tmp-name1)) (should-not (file-regular-p tmp-name1)) (should-not (file-regular-p tmp-name2)) + (should + (string-equal + (file-truename tmp-name1) + (file-truename tmp-name2))) (if (tramp--test-smb-p) ;; The symlink command of "smbclient" detects the ;; cycle already. @@ -4173,10 +4321,15 @@ tramp-test21-file-links (make-symbolic-link tmp-name1 tmp-name2) :type 'file-error) (make-symbolic-link tmp-name1 tmp-name2) + (should (file-symlink-p tmp-name1)) (should (file-symlink-p tmp-name2)) + (should-not (file-regular-p tmp-name1)) (should-not (file-regular-p tmp-name2)) (should-error (file-truename tmp-name1) + :type 'file-error) + (should-error + (file-truename tmp-name2) :type 'file-error)))) ;; Cleanup. @@ -4511,42 +4664,40 @@ tramp-test26-file-name-completion (let ((tramp-fuse-remove-hidden-files t) (method (file-remote-p ert-remote-temporary-file-directory 'method)) (host (file-remote-p ert-remote-temporary-file-directory 'host)) - (orig-syntax tramp-syntax)) + (orig-syntax tramp-syntax) + (minibuffer-completing-file-name t)) (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) (setq host (match-string 1 host))) (unwind-protect - (dolist - (syntax - (if (tramp--test-expensive-test-p) - (tramp-syntax-values) `(,orig-syntax))) + (dolist (syntax (if (tramp--test-expensive-test-p) + (tramp-syntax-values) `(,orig-syntax))) (tramp-change-syntax syntax) ;; This has cleaned up all connection data, which are used ;; for completion. We must refill the cache. (tramp-set-connection-property tramp-test-vec "property" nil) - (let ;; This is needed for the `separate' syntax. - ((prefix-format (substring tramp-prefix-format 1)) - ;; This is needed for the IPv6 host name syntax. - (ipv6-prefix - (and (string-match-p tramp-ipv6-regexp host) - tramp-prefix-ipv6-format)) - (ipv6-postfix - (and (string-match-p tramp-ipv6-regexp host) - tramp-postfix-ipv6-format))) + (let (;; This is needed for the `separate' syntax. + (prefix-format (substring tramp-prefix-format 1)) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (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)) - (tramp--test-gvfs-p method)) + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp) + (tramp-string-empty-or-nil-p host)) (should (member (concat @@ -4579,6 +4730,13 @@ tramp-test26-file-name-completion (should (equal (file-name-completion "foo" tmp-name) t)) (should (equal (file-name-completion "b" tmp-name) "bo")) (should-not (file-name-completion "a" tmp-name)) + ;; `file-name-completion' should not err out if + ;; directory does not exist. (Bug#61890) + ;; Ange-FTP does not support this. + (unless (tramp--test-ange-ftp-p) + (should-not + (file-name-completion + "a" (tramp-compat-file-name-concat tmp-name "fuzz")))) ;; Ange-FTP does not support predicates. (unless (tramp--test-ange-ftp-p) (should @@ -4624,6 +4782,190 @@ tramp-test26-file-name-completion ;; Cleanup. (ignore-errors (delete-directory tmp-name 'recursive))))))) +(tramp--test-deftest-with-perl tramp-test26-file-name-completion) + +(tramp--test-deftest-with-ls tramp-test26-file-name-completion) + +;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042 +;; and Bug#60505. +(ert-deftest tramp-test26-interactive-file-name-completion () + "Check interactive completion with different `completion-styles'." + ;; Method, user and host name in completion mode. This kind of + ;; completion does not work on MS Windows. + (skip-unless (not (memq system-type '(cygwin windows-nt)))) + (tramp-cleanup-connection tramp-test-vec nil 'keep-password) + + (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) + (user (file-remote-p ert-remote-temporary-file-directory 'user)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (hop (file-remote-p ert-remote-temporary-file-directory 'hop)) + (orig-syntax tramp-syntax) + (non-essential t) + (inhibit-message t)) + (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) + (setq host (match-string 1 host))) + + ;; (trace-function #'tramp-completion-file-name-handler) + ;; (trace-function #'completion-file-name-table) + (unwind-protect + (dolist (syntax (if (tramp--test-expensive-test-p) + (tramp-syntax-values) `(,orig-syntax))) + (tramp-change-syntax syntax) + ;; This has cleaned up all connection data, which are used + ;; for completion. We must refill the cache. + (tramp-set-connection-property tramp-test-vec "property" nil) + + (dolist + (style + (if (tramp--test-expensive-test-p) + ;; It doesn't work for `initials' and `shorthand' + ;; completion styles. Should it? + '(emacs21 emacs22 basic partial-completion substring flex) + '(basic))) + + (when (assoc style completion-styles-alist) + (let* (;; Force the real minibuffer in batch mode. + (executing-kbd-macro noninteractive) + (completion-styles `(,style)) + completion-category-defaults + completion-category-overrides + ;; This is needed for the `simplified' syntax, + (tramp-default-method method) + (method-string + (unless (string-empty-p tramp-method-regexp) + (concat method tramp-postfix-method-format))) + (user-string + (unless (tramp-string-empty-or-nil-p user) + (concat user tramp-postfix-user-format))) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format)) + (host-string + (unless (tramp-string-empty-or-nil-p host) + (concat + ipv6-prefix host + ipv6-postfix tramp-postfix-host-format))) + ;; The hop string fits only the initial syntax. + (hop (and (eq tramp-syntax orig-syntax) hop)) + test result completions) + + (dolist + (test-and-result + ;; These are triples of strings (TEST-STRING + ;; RESULT-CHECK COMPLETION-CHECK). RESULT-CHECK + ;; could be not unique, in this case it is a list + ;; (RESULT1 RESULT2 ...). + (append + ;; Complete method name. + (unless (string-empty-p tramp-method-regexp) + `((,(concat + tramp-prefix-format hop + (substring-no-properties + method 0 (min 2 (length method)))) + ,(concat tramp-prefix-format hop method-string) + ,method-string))) + ;; Complete user name. + (unless (tramp-string-empty-or-nil-p user) + `((,(concat + tramp-prefix-format hop method-string + (substring-no-properties + user 0 (min 2 (length user)))) + ,(concat + tramp-prefix-format hop method-string user-string) + ,user-string))) + ;; Complete host name. + (unless (tramp-string-empty-or-nil-p host) + `((,(concat + tramp-prefix-format hop method-string + ipv6-prefix + (substring-no-properties + host 0 (min 2 (length host)))) + (,(concat + tramp-prefix-format hop method-string host-string) + ,(concat + tramp-prefix-format hop method-string + user-string host-string)) + ,host-string))) + ;; Complete user and host name. + (unless (or (tramp-string-empty-or-nil-p user) + (tramp-string-empty-or-nil-p host)) + `((,(concat + tramp-prefix-format hop method-string user-string + ipv6-prefix + (substring-no-properties + host 0 (min 2 (length host)))) + ,(concat + tramp-prefix-format hop method-string + user-string host-string) + ,host-string))))) + + (ignore-errors (kill-buffer "*Completions*")) + ;; (and (bufferp trace-buffer) (kill-buffer trace-buffer)) + (discard-input) + (setq test (car test-and-result) + unread-command-events + (mapcar #'identity (concat test "\t\t\n")) + completions nil + result (read-file-name "Prompt: ")) + + (if (or (not (get-buffer "*Completions*")) + (string-match-p + (if (string-empty-p tramp-method-regexp) + (tramp-compat-rx + (| (regexp tramp-postfix-user-regexp) + (regexp tramp-postfix-host-regexp)) + eos) + (tramp-compat-rx + (| (regexp tramp-postfix-method-regexp) + (regexp tramp-postfix-user-regexp) + (regexp tramp-postfix-host-regexp)) + eos)) + result)) + (progn + ;; (tramp--test-message + ;; "syntax: %s style: %s test: %s result: %s" + ;; syntax style test result) + (if (stringp (cadr test-and-result)) + (should + (string-prefix-p (cadr test-and-result) result)) + (should + (let (res) + (dolist (elem (cadr test-and-result) res) + (setq + res (or res (string-prefix-p elem result)))))))) + + (with-current-buffer "*Completions*" + ;; We must remove leading `default-directory'. + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (while (re-search-forward "//" nil 'noerror) + (delete-region (line-beginning-position) (point)))) + (goto-char (point-min)) + (re-search-forward + (rx bol (0+ nonl) + (any "Pp") "ossible completions" + (0+ nonl) eol)) + (forward-line 1) + (setq completions + (split-string + (buffer-substring-no-properties (point) (point-max)) + (rx (any "\r\n\t ")) 'omit))) + + ;; (tramp--test-message + ;; "syntax: %s style: %s test: %s result: %s completions: %S" + ;; syntax style test result completions) + (should (member (caddr test-and-result) completions)))))))) + + ;; Cleanup. + ;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer)) + ;; (untrace-function #'tramp-completion-file-name-handler) + ;; (untrace-function #'completion-file-name-table) + (tramp-change-syntax orig-syntax)))) + (ert-deftest tramp-test27-load () "Check `load'." (skip-unless (tramp--test-enabled)) @@ -4715,8 +5057,7 @@ tramp-test28-process-file (if (bufferp destination) destination (current-buffer)) ;; "ls" could produce colorized output. (goto-char (point-min)) - (while (re-search-forward - tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match "" nil nil)) (should (string-equal (if destination (format "%s\n" fnnd) "") @@ -4730,8 +5071,7 @@ tramp-test28-process-file (if (bufferp destination) destination (current-buffer)) ;; "ls" could produce colorized output. (goto-char (point-min)) - (while (re-search-forward - tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match "" nil nil)) (should (string-equal @@ -4871,8 +5211,8 @@ tramp-test29-start-file-process ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Disabled process filter. "sshfs" does not cooperate. - (unless (tramp--test-sshfs-p) + ;; Disabled process filter. It doesn't work reliable. + (unless t (unwind-protect (with-temp-buffer (setq command '("cat") @@ -4914,23 +5254,21 @@ tramp-test29-start-file-process (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) + ;; Give the pipe process a chance to start. + (when (memq process-connection-type '(nil pipe)) + (sit-for 0.1 'nodisp)) (process-send-string proc "foo\r\n") (process-send-eof proc) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (< (- (point-max) (point-min)) - (length "66\n6F\n6F\n0D\n0A\n")) - (while (accept-process-output proc 0 nil t)))) - (should - (string-match-p - (if (and (memq process-connection-type '(nil pipe)) - (not (tramp--test-macos-p))) - ;; On macOS, there is always newline conversion. - ;; "telnet" converts \r to if `crlf' - ;; flag is FALSE. See telnet(1) man page. - (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") - (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) - (buffer-string)))) + ;; Read output. On macOS, there is always newline + ;; conversion. "telnet" converts \r to if + ;; `crlf' flag is FALSE. See telnet(1) man page. + (let ((expected + (rx "66\n" "6F\n" "6F\n" + (| "0D\n" "0A\n") (? "00\n") "0A\n"))) + (with-timeout (10 (tramp--test-timeout-handler)) + (while (not (string-match-p expected (buffer-string))) + (while (accept-process-output proc 0 nil t)))) + (should (string-match-p expected (buffer-string))))) ;; Cleanup. (ignore-errors (delete-process proc))))) @@ -5078,8 +5416,8 @@ tramp-test30-make-process ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Disabled process filter. "sshfs" does not cooperate. - (unless (tramp--test-sshfs-p) + ;; Disabled process filter. It doesn't work reliable. + (unless t (unwind-protect (with-temp-buffer (setq command '("cat") @@ -5209,7 +5547,7 @@ tramp-test30-make-process ;; `process-connection-type' is taken when ;; `:connection-type' is nil. (dolist (process-connection-type - (unless connection-type '(nil pipe t pty))) + (if connection-type '(nil pipe t pty) '(nil))) (unwind-protect (with-temp-buffer (setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"") @@ -5226,24 +5564,22 @@ tramp-test30-make-process (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) + ;; Give the pipe process a chance to start. + (when (or (eq connection-type 'pipe) + (memq process-connection-type '(nil pipe))) + (sit-for 0.1 'nodisp)) (process-send-string proc "foo\r\n") (process-send-eof proc) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (< (- (point-max) (point-min)) - (length "66\n6F\n6F\n0D\n0A\n")) - (while (accept-process-output proc 0 nil t)))) - (should - (string-match-p - (if (and (memq (or connection-type process-connection-type) - '(nil pipe)) - (not (tramp--test-macos-p))) - ;; On macOS, there is always newline conversion. - ;; "telnet" converts \r to if `crlf' - ;; flag is FALSE. See telnet(1) man page. - (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") - (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) - (buffer-string)))) + ;; Read output. On macOS, there is always newline + ;; conversion. "telnet" converts \r to if + ;; `crlf' flag is FALSE. See telnet(1) man page. + (let ((expected + (rx "66\n" "6F\n" "6F\n" + (| "0D\n" "0A\n") (? "00\n") "0A\n"))) + (with-timeout (10 (tramp--test-timeout-handler)) + (while (not (string-match-p expected (buffer-string))) + (while (accept-process-output proc 0 nil t)))) + (should (string-match-p expected (buffer-string))))) ;; Cleanup. (ignore-errors (delete-process proc))))))))) @@ -5419,7 +5755,7 @@ tramp-test31-memory-info (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)))))) @@ -5485,8 +5821,7 @@ tramp-test32-shell-command (current-buffer)) ;; "ls" could produce colorized output. (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match "" nil nil)) (should (string-equal @@ -5741,7 +6076,9 @@ tramp-test33-environment-variables ;; Unset the variable. (let ((tramp-remote-process-environment (cons (concat envvar "=foo") tramp-remote-process-environment))) - ;; Set the initial value, we want to unset below. + ;; Refill the cache; we don't want to run into timeouts. + (file-truename default-directory) + ;; Check the initial value, we want to unset below. (should (string-match-p "foo" @@ -6008,7 +6345,8 @@ tramp-test35-remote-path ;; 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 @@ -6024,9 +6362,10 @@ tramp-test35-remote-path ;; 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) - (tramp-get-connection-property - tramp-test-vec "pipe-buf" 4096)) + (unless (tramp-compat-length> + path + (tramp-get-connection-property + tramp-test-vec "pipe-buf" 4096)) ;; The last element of `exec-path' is `exec-directory'. (should (string-equal @@ -6260,7 +6599,10 @@ tramp-test38-find-backup-file-name (if quoted #'tramp-compat-file-name-quote #'identity) (expand-file-name (format "%s~" (file-name-nondirectory tmp-name1)) - ert-remote-temporary-file-directory))))))) + ert-remote-temporary-file-directory)))))) + + ;; Cleanup. Nothing to do yet. + nil) (unwind-protect ;; Map `backup-directory-alist'. @@ -6540,8 +6882,9 @@ tramp-test39-detect-external-change (insert "foo") ;; Bug#53207: with `create-lockfiles' nil, saving the ;; buffer results in a prompt. - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (_) (ert-fail "Test failed unexpectedly")))) + (cl-letf (((symbol-function #'read-from-minibuffer) + (lambda (&rest _) + (ert-fail "Test failed unexpectedly")))) (should (buffer-modified-p)) (save-buffer) (should-not (buffer-modified-p))) @@ -6559,7 +6902,7 @@ tramp-test39-detect-external-change ;; modification time properly, for them it doesn't ;; make sense to test. (when (not (verify-visited-file-modtime)) - (cl-letf (((symbol-function 'read-char-choice) + (cl-letf (((symbol-function #'read-char-choice) (lambda (prompt &rest _) (message "%s" prompt) ?y))) (ert-with-message-capture captured-messages (insert "bar") @@ -6575,8 +6918,8 @@ tramp-test39-detect-external-change (should (file-locked-p tmp-name))))) ;; `save-buffer' removes the file lock. - (cl-letf (((symbol-function 'yes-or-no-p) #'tramp--test-always) - ((symbol-function 'read-char-choice) + (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always) + ((symbol-function #'read-char-choice) (lambda (&rest _) ?y))) (should (buffer-modified-p)) (save-buffer) @@ -7152,6 +7495,9 @@ tramp-test42-utf8 ;; Use all available language specific snippets. (lambda (x) (and + ;; The "Oriya" and "Odia" languages use some problematic + ;; composition characters. + (not (member (car x) '("Oriya" "Odia"))) (stringp (setq x (eval (get-language-info (car x) 'sample-text) t))) ;; Filter out strings which use unencodable characters. (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p)) @@ -7186,7 +7532,7 @@ tramp-test43-file-system-info (when-let ((fsi (with-no-warnings (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)))))) @@ -7234,10 +7580,7 @@ tramp-test44-asynchronous-requests "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." - :tags (append '(:expensive-test :tramp-asynchronous-processes) - (and (or (getenv "EMACS_HYDRA_CI") - (getenv "EMACS_EMBA_CI")) - '(:unstable))) + :tags '(:expensive-test :tramp-asynchronous-processes :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for @@ -7372,34 +7715,37 @@ tramp-test44-asynchronous-requests ;; Send a string to the processes. Use a random order of ;; the buffers. Mix with regular operation. - (let ((buffers (copy-sequence buffers))) + (let ((buffers (copy-sequence buffers)) + buf) (while buffers - (let* ((buf (seq-random-elt buffers)) - (proc (get-buffer-process buf)) - (file (process-get proc 'foo)) - (count (process-get proc 'bar))) - (tramp--test-message - "Start action %d %s %s" count buf (current-time-string)) - ;; Regular operation prior process action. - (dired-uncache file) - (if (= count 0) - (should-not (file-attributes file)) - (should (file-attributes file))) - ;; Send string to process. - (process-send-string proc (format "%s\n" (buffer-name buf))) - (while (accept-process-output nil 0)) - (tramp--test-message - "Continue action %d %s %s" count buf (current-time-string)) - ;; Regular operation post process action. - (dired-uncache file) - (if (= count 2) - (should-not (file-attributes file)) - (should (file-attributes file))) - (tramp--test-message - "Stop action %d %s %s" count buf (current-time-string)) - (process-put proc 'bar (1+ count)) - (unless (process-live-p proc) - (setq buffers (delq buf buffers)))))) + (setq buf (seq-random-elt buffers)) + (if-let ((proc (get-buffer-process buf)) + (file (process-get proc 'foo)) + (count (process-get proc 'bar))) + (progn + (tramp--test-message + "Start action %d %s %s" count buf (current-time-string)) + ;; Regular operation prior process action. + (dired-uncache file) + (if (= count 0) + (should-not (file-attributes file)) + (should (file-attributes file))) + ;; Send string to process. + (process-send-string proc (format "%s\n" (buffer-name buf))) + (while (accept-process-output nil 0)) + (tramp--test-message + "Continue action %d %s %s" count buf (current-time-string)) + ;; Regular operation post process action. + (dired-uncache file) + (if (= count 2) + (should-not (file-attributes file)) + (should (file-attributes file))) + (tramp--test-message + "Stop action %d %s %s" count buf (current-time-string)) + (process-put proc 'bar (1+ count)) + (unless (process-live-p proc) + (setq buffers (delq buf buffers)))) + (setq buffers (delq buf buffers))))) ;; Checks. All process output shall exists in the ;; respective buffers. All created files shall be @@ -7549,7 +7895,7 @@ tramp-test47-auto-load ert-remote-temporary-file-directory))) (should (string-match-p - (rx "Tramp loaded: t" (+ (any "\n\r"))) + (rx "Tramp loaded: t" (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7577,9 +7923,9 @@ tramp-test47-delay-load (should (string-match-p (tramp-compat-rx - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r"))) + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7670,6 +8016,7 @@ tramp-test48-unload (and (functionp x) (null (autoloadp (symbol-function x)))) (macrop x)) (string-prefix-p "tramp" (symbol-name x)) + (string-match-p (rx bol "with" (| "tramp" "parsed")) (symbol-name x)) ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. (not (eq 'tramp-completion-mode x)) ;; `tramp-register-archive-file-name-handler' is autoloaded @@ -7744,6 +8091,9 @@ tramp-test-all ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". +;; * Check, why a process filter t doesn't work in +;; `tramp-test29-start-file-process' and +;; `tramp-test30-make-process'. ;; * Implement `tramp-test31-interrupt-process' and ;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct ;; async processes. Check, why they don't run stable. commit 8e20da1517aa585e6286fa8e439db10fb62aaa57 Author: Stefan Kangas Date: Sat Aug 5 17:58:19 2023 +0200 Simplify rng-substq with cl-substitute * lisp/nxml/rng-util.el (rng-substq): Simplify. (cl-lib): Require. diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el index 27c924d960f..4f49885fc45 100644 --- a/lisp/nxml/rng-util.el +++ b/lisp/nxml/rng-util.el @@ -24,6 +24,8 @@ ;;; Code: +(require 'cl-lib) + (defun rng-make-datatypes-uri (uri) (if (string-equal uri "") ;; The spec doesn't say to do this, but it's perfectly conformant @@ -39,26 +41,7 @@ rng-builtin-datatypes-uri (defun rng-substq (new old list) "Replace first member of LIST (if any) that is `eq' to OLD by NEW. LIST is not modified." - (cond ((null list) nil) - ((eq (car list) old) - (cons new (cdr list))) - (t - (let ((tail (cons (car list) - nil)) - (rest (cdr list))) - (setq list tail) - (while rest - (let ((item (car rest))) - (setq rest (cdr rest)) - (cond ((eq item old) - (setcdr tail - (cons new rest)) - (setq rest nil)) - (t - (setq tail - (setcdr tail - (cons item nil)))))))) - list))) + (cl-substitute new old list :count 1 :test #'eq)) (defun rng-escape-string (s) (replace-regexp-in-string "[&\"<>]" commit ed3954445045aca3cdc60dbd6b75a3a55470e28b Author: Stefan Kangas Date: Sat Aug 5 14:56:27 2023 +0200 Make eshell-redisplay into alias for redisplay * lisp/eshell/esh-util.el (eshell-redisplay): Make into obsolete function alias for 'redisplay'. This removes a workaround for some obscure bug apparently found in Emacs 21. Update all callers. diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 2c199ec160f..79232d8e9b5 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -534,7 +534,7 @@ eshell-list-history (forward-line 3) (while (search-backward "completion" nil 'move) (replace-match "history reference"))) - (eshell-redisplay) + (redisplay) (message "Hit space to flush") (let ((ch (read-event))) (if (eq ch ?\ ) diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index d8b7fadc2c2..d5002a59d14 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -214,7 +214,7 @@ eshell-refresh-windows 0 frame) (if affected (let (window-scroll-functions) ;;FIXME: Why? - (eshell-redisplay))))) + (redisplay))))) (defun eshell-smart-display-setup () "Set the point to somewhere in the beginning of the last command." @@ -261,7 +261,7 @@ eshell-smart-redisplay (recenter -1) ;; trigger the redisplay now, so that we catch any attempted ;; point motion; this is to cover for a redisplay bug - (eshell-redisplay)) + (redisplay)) (let ((top-point (point))) (and (memq 'eshell-smart-display-move pre-command-hook) (>= (point) eshell-last-input-start) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 6353e3d4aae..87cd1f5dcb2 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -476,16 +476,6 @@ eshell-winnow-list (cadr flist) (cdr flist)))) -(defsubst eshell-redisplay () - "Allow Emacs to redisplay buffers." - ;; for some strange reason, Emacs 21 is prone to trigger an - ;; "args out of range" error in `sit-for', if this function - ;; runs while point is in the minibuffer and the users attempt - ;; to use completion. Don't ask me. - (condition-case nil - (sit-for 0) - (error nil))) - (defun eshell-user-login-name () "Return the connection-aware value of the user's login name. See also `user-login-name'." @@ -795,6 +785,8 @@ eshell-sublist (declare (obsolete seq-subseq "28.1")) (seq-subseq l n (1+ m))) +(define-obsolete-function-alias 'eshell-redisplay #'redisplay "30.1") + (provide 'esh-util) ;;; esh-util.el ends here commit 7df1adab1e1a9a37920f3fa107794c2d081ebaf4 Author: Stefan Kangas Date: Sat Aug 5 14:49:26 2023 +0200 Use file-size-human-readable in eshell * lisp/eshell/esh-util.el (eshell-printable-size): Simplify using file-size-human-readable. diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 82b0d9fc623..6353e3d4aae 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -439,37 +439,15 @@ eshell-printable-size (error "human-readable must be 1000 or 1024")) (let ((size (float (or filesize 0)))) (if human-readable - (if (< size human-readable) - (if (= (round size) 0) - "0" - (if block-size - "1.0k" - (format "%.0f" size))) - (setq size (/ size human-readable)) - (if (< size human-readable) - (if (<= size 9.94) - (format "%.1fk" size) - (format "%.0fk" size)) - (setq size (/ size human-readable)) - (if (< size human-readable) - (let ((str (if (<= size 9.94) - (format "%.1fM" size) - (format "%.0fM" size)))) - (if use-colors - (put-text-property 0 (length str) - 'face 'bold str)) - str) - (setq size (/ size human-readable)) - (if (< size human-readable) - (let ((str (if (<= size 9.94) - (format "%.1fG" size) - (format "%.0fG" size)))) - (if use-colors - (put-text-property 0 (length str) - 'face 'bold-italic str)) - str) - (let ((flavor (and (= human-readable 1000) 'si))) - (file-size-human-readable filesize flavor)))))) + (let* ((flavor (and (= human-readable 1000) 'si)) + (str (file-size-human-readable size flavor))) + (if (not use-colors) + str + (cond ((> size (expt human-readable 3)) + (propertize str 'face 'bold-italic)) + ((> size (expt human-readable 2)) + (propertize str 'face 'bold)) + (t str)))) (if block-size (setq size (/ size block-size))) (format "%.0f" size)))) commit 3b2b0b5f921fd49ef0ac21e1522b0e037b80dffa Author: Stefan Kangas Date: Sat Aug 5 12:54:26 2023 +0200 Fix eshell "ls" command for files larger than 1TiB * lisp/eshell/esh-util.el (eshell-printable-size): Fix displaying file sizes larger than 1 TiB or 1 TB. * test/lisp/eshell/esh-util-tests.el (esh-util-test/eshell-printable-size) (esh-util-test/eshell-printable-size/zero) (esh-util-test/eshell-printable-size/terabyte) (esh-util-test/eshell-printable-size/use-colors) (esh-util-test/eshell-printable-size/block-size) (esh-util-test/eshell-printable-size/human-readable-arg): New tests. diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 1d0f41d7b82..82b0d9fc623 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -433,6 +433,10 @@ eshell-regexp-arg (defun eshell-printable-size (filesize &optional human-readable block-size use-colors) "Return a printable FILESIZE." + (when (and human-readable + (not (= human-readable 1000)) + (not (= human-readable 1024))) + (error "human-readable must be 1000 or 1024")) (let ((size (float (or filesize 0)))) (if human-readable (if (< size human-readable) @@ -463,7 +467,9 @@ eshell-printable-size (if use-colors (put-text-property 0 (length str) 'face 'bold-italic str)) - str))))) + str) + (let ((flavor (and (= human-readable 1000) 'si))) + (file-size-human-readable filesize flavor)))))) (if block-size (setq size (/ size block-size))) (format "%.0f" size)))) diff --git a/test/lisp/eshell/esh-util-tests.el b/test/lisp/eshell/esh-util-tests.el index 8585677e14e..fe4eb9f31dd 100644 --- a/test/lisp/eshell/esh-util-tests.el +++ b/test/lisp/eshell/esh-util-tests.el @@ -125,4 +125,35 @@ esh-util-test/eshell-convert-to-number/no-convert (should (equal (eshell-convert-to-number "123") "123")) (should (equal (eshell-convert-to-number "1.23") "1.23")))) +(ert-deftest esh-util-test/eshell-printable-size () + (should (equal (eshell-printable-size (expt 2 16)) "65536")) + (should (equal (eshell-printable-size (expt 2 32)) "4294967296"))) + +(ert-deftest esh-util-test/eshell-printable-size/zero () + (should (equal (eshell-printable-size 0 1000 nil t) "0"))) + +(ert-deftest esh-util-test/eshell-printable-size/terabyte () + (should (equal (eshell-printable-size (1- (expt 2 40)) 1024 nil t) "1024G")) + (should (equal (eshell-printable-size (expt 2 40) 1024 nil t) "1T")) + (should (equal (eshell-printable-size (1- (expt 10 12)) 1000 nil t) "1000G")) + (should (equal (eshell-printable-size (expt 10 12) 1000 nil t) "1T"))) + +(ert-deftest esh-util-test/eshell-printable-size/use-colors () + (should (equal-including-properties + (eshell-printable-size (1- (expt 2 20)) 1024 nil t) + "1024k")) + (should (equal-including-properties + (eshell-printable-size (1- (expt 2 30)) 1024 nil t) + (propertize "1024M" 'face 'bold))) + (should (equal-including-properties + (eshell-printable-size (1- (expt 2 40)) 1024 nil t) + (propertize "1024G" 'face 'bold-italic)))) + +(ert-deftest esh-util-test/eshell-printable-size/block-size () + (should (equal (eshell-printable-size (1- (expt 2 20)) nil 4096) "256")) + (should (equal (eshell-printable-size (1- (expt 2 30)) nil 4096) "262144"))) + +(ert-deftest esh-util-test/eshell-printable-size/human-readable-arg () + (should-error (eshell-printable-size 0 999 nil t))) + ;;; esh-util-tests.el ends here commit ee788ab2f81f3a8ad338648c870a8feeb17e192d Author: Stefan Kangas Date: Sat Aug 5 10:59:11 2023 +0200 ; * lisp/eshell/esh-util.el: Delete redundant autoload. diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 3608c78ba2b..1d0f41d7b82 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -628,8 +628,6 @@ eshell-current-ange-uids (setq host-users (cdr host-users)) (cdr (assoc user host-users)))))) -(autoload 'parse-time-string "parse-time") - (eval-when-compile (require 'ange-ftp)) ; ange-ftp-parse-filename commit 88ce2a5624be78dfa7a420a4d255886bd3a22e24 Author: Stefan Kangas Date: Sat Aug 5 10:55:27 2023 +0200 Simplify pcomplete-uniquify-list * lisp/pcomplete.el (pcomplete-uniquify-list): Improve docstring. Simplify. diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 36f68f1af57..c7ec228c1db 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -1318,10 +1318,10 @@ pcomplete--help ;; general utilities -(defun pcomplete-uniquify-list (l) - "Sort and remove multiples in L." - (setq l (sort l #'string-lessp)) - (seq-uniq l)) +(defun pcomplete-uniquify-list (sequence) + "Sort and remove multiples in SEQUENCE. +Sequence should be a vector or list of strings." + (sort (seq-uniq sequence) #'string-lessp)) (define-obsolete-function-alias 'pcomplete-uniqify-list #'pcomplete-uniquify-list "27.1") (defun pcomplete-process-result (cmd &rest args) commit 25641c3e88209eb57793ae1df71ee6de9ce3b675 Author: Stefan Kangas Date: Fri Aug 4 15:27:18 2023 +0200 Add crossref to set-default-file-modes docstring * src/fileio.c (Fset_default_file_modes): Doc fix; add to the docstring a cross-reference to with-file-modes. diff --git a/src/fileio.c b/src/fileio.c index 663d89b9dfc..63f4e698528 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3551,7 +3551,9 @@ DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_mode Note that when `write-region' creates a file, it resets the execute bit, even if the mask set by this function allows that bit -by having the corresponding bit in the mask reset. */) +by having the corresponding bit in the mask reset. + +See also `with-file-modes'. */) (Lisp_Object mode) { mode_t oldrealmask, oldumask, newumask; commit 3f8db3bbe5ec8083a69e0eee54a06addd72131d6 Author: Stefan Kangas Date: Fri Aug 4 15:24:46 2023 +0200 image-dired: Fix gallery directory permissions * lisp/image/image-dired.el (image-dired-gallery-generate): Set umask to 077 before creating gallery directory. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index 33beb5b3e49..9a92cae8ad5 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -1905,8 +1905,8 @@ image-dired-gallery-generate (if (file-exists-p image-dired-gallery-dir) (if (not (file-directory-p image-dired-gallery-dir)) (error "Variable image-dired-gallery-dir is not a directory")) - ;; FIXME: Should we set umask to 077 here, as we do for thumbnails? - (make-directory image-dired-gallery-dir)) + (with-file-modes #o700 + (make-directory image-dired-gallery-dir))) ;; Open index file (with-temp-file index-file (if (file-exists-p index-file) commit 5683c4bad3cbca07b186942023df27f7a5afc86b Author: Eli Zaretskii Date: Sat Aug 5 18:15:47 2023 +0300 ; * etc/NEWS: Announce 'cjk-ambiguous-chars-are-wide' (bug#64420). diff --git a/etc/NEWS b/etc/NEWS index 567f19012eb..0dd663edcc6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -156,6 +156,25 @@ whereas if the mouse pointer is in the left half of a glyph, point will be put in front the buffer position corresponding to that glyph. By default this is disabled. +** Internationalization + +--- +*** Users in CJK locales can control width of some non-CJK characters. +Some characters are considered by Unicode as "ambiguous" with respect +to their display width: either "full-width" (i.e. taking 2 columns on +display) or "narrow" (taking 1 column). The actual width depends on +the fonts used for these characters by Emacs or (for text-mode frames) +by the terminal emulator. Traditionally, font sets in CJK locales +were set up so as to display these characters as full-width, and thus +Emacs modified the char-width table in those locales to follow suit. +Lately, the tendency is to display these characters as narrow. The +new user option 'cjk-ambiguous-chars-are-wide' allows users to control +whether Emacs considers these characters as full-width (the default) +or narrow (if the variable is customized to the nil value). + +This setting affects the results of 'string-width' and similar +functions in CJK locales. + * Changes in Specialized Modes and Packages in Emacs 30.1 commit a06a2950e168dddcbf1c3cd14697875d93a4f9ff Author: Eli Zaretskii Date: Sat Aug 5 17:55:56 2023 +0300 Allow user control on char-width of "ambiguous" characters * src/character.c (syms_of_character) : New char-table. * lisp/international/characters.el (ambiguous-width-chars): Fill the table. (update-cjk-ambiguous-char-widths): New function. (cjk-ambiguous-chars-are-wide): New defcustom, uses 'update-cjk-ambiguous-char-widths' as its :set function. (use-cjk-char-width-table): Obey 'cjk-ambiguous-chars-are-wide' by adding another child char-table for ambiguous-width characters, where the width is set according to the option. * lisp/language/chinese.el ("Chinese-GB", "Chinese-BIG5") ("Chinese-CNS", "Chinese-EUC-TW", "Chinese-GBK"): * lisp/language/japanese.el ("Japanese"): * lisp/language/korean.el ("Korean"): Add new language-info slot 'cjk-locale-symbol'. Bug#64420 diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 9aea5e27063..1aa570ca59a 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -1394,6 +1394,174 @@ ?L (dolist (elt l) (set-char-table-range char-width-table elt 2))) +;; A: East Asian "Ambiguous" characters. +(let ((l '((#x00A1 . #x00A1) + (#x00A4 . #x00A4) + (#x00A7 . #x00A8) + (#x00AA . #x00AA) + (#x00AD . #x00AE) + (#x00B0 . #x00B4) + (#x00B6 . #x00BA) + (#x00BC . #x00BF) + (#x00C6 . #x00C6) + (#x00D0 . #x00D0) + (#x00D7 . #x00D8) + (#x00E0 . #x00E1) + (#x00E6 . #x00E6) + (#x00E8 . #x00EA) + (#x00EC . #x00ED) + (#x00F0 . #x00F0) + (#x00F2 . #x00F3) + (#x00F7 . #x00FA) + (#x00FC . #x00FC) + (#x00FE . #x00FE) + (#x0101 . #x0101) + (#x0111 . #x0111) + (#x0113 . #x0113) + (#x011B . #x011B) + (#x0126 . #x0127) + (#x012B . #x012B) + (#x0131 . #x0133) + (#x0138 . #x0138) + (#x013F . #x0142) + (#x0144 . #x0144) + (#x0148 . #x014B) + (#x014D . #x014D) + (#x0152 . #x0153) + (#x0166 . #x0167) + (#x016B . #x016B) + (#x01CE . #x01CE) + (#x01D0 . #x01D0) + (#x01D2 . #x01D2) + (#x01D4 . #x01D4) + (#x01D6 . #x01D6) + (#x01D8 . #x01D8) + (#x01DA . #x01DA) + (#x01DC . #x01DC) + (#x0251 . #x0251) + (#x0261 . #x0261) + (#x02C4 . #x02C4) + (#x02C7 . #x02C7) + (#x02C9 . #x02CB) + (#x02CD . #x02CD) + (#x02D0 . #x02D0) + (#x02D8 . #x02DB) + (#x02DD . #x02DD) + (#x02DF . #x02DF) + (#x0300 . #x036F) + (#x0391 . #x03A1) + (#x03A3 . #x03A9) + (#x03B1 . #x03C1) + (#x03C3 . #x03C9) + (#x0401 . #x0401) + (#x0410 . #x044F) + (#x0451 . #x0451) + (#x2010 . #x2010) + (#x2013 . #x2016) + (#x2018 . #x2019) + (#x201C . #x201D) + (#x2020 . #x2022) + (#x2024 . #x2027) + (#x2030 . #x2030) + (#x2032 . #x2033) + (#x2035 . #x2035) + (#x203E . #x203E) + (#x2074 . #x2074) + (#x207F . #x207F) + (#x2081 . #x2084) + (#x20AC . #x20AC) + (#x2103 . #x2103) + (#x2105 . #x2105) + (#x2109 . #x2109) + (#x2113 . #x2113) + (#x2116 . #x2116) + (#x2121 . #x2122) + (#x2126 . #x2126) + (#x212B . #x212B) + (#x2153 . #x2154) + (#x215B . #x215E) + (#x2160 . #x216B) + (#x2170 . #x2179) + (#x2189 . #x2189) + (#x2190 . #x2199) + (#x21B8 . #x21B9) + (#x21D2 . #x21D2) + (#x21D4 . #x21D4) + (#x21E7 . #x21E7) + (#x2200 . #x2200) + (#x2202 . #x2203) + (#x2207 . #x2208) + (#x220B . #x220B) + (#x220F . #x220F) + (#x2211 . #x2211) + (#x2215 . #x2215) + (#x221A . #x221A) + (#x221D . #x2220) + (#x2223 . #x2223) + (#x2225 . #x2225) + (#x2227 . #x222C) + (#x222E . #x222E) + (#x2234 . #x2237) + (#x223C . #x223D) + (#x2248 . #x2248) + (#x224C . #x224C) + (#x2252 . #x2252) + (#x2260 . #x2261) + (#x2264 . #x2267) + (#x226A . #x226B) + (#x226E . #x226F) + (#x2282 . #x2283) + (#x2286 . #x2287) + (#x2295 . #x2295) + (#x2299 . #x2299) + (#x22A5 . #x22A5) + (#x22BF . #x22BF) + (#x2312 . #x2312) + (#x2460 . #x24E9) + (#x24EB . #x254B) + (#x2550 . #x2573) + (#x2580 . #x258F) + (#x2592 . #x2595) + (#x25A0 . #x25A1) + (#x25A3 . #x25A9) + (#x25B2 . #x25B3) + (#x25B6 . #x25B7) + (#x25BC . #x25BD) + (#x25C0 . #x25C1) + (#x25C6 . #x25C8) + (#x25CE . #x25D1) + (#x25E2 . #x25E5) + (#x25EF . #x25EF) + (#x2605 . #x2606) + (#x260E . #x260F) + (#x261C . #x261C) + (#x261E . #x261E) + (#x2640 . #x2640) + (#x2642 . #x2642) + (#x2660 . #x2661) + (#x2663 . #x2665) + (#x2667 . #x266A) + (#x266C . #x266D) + (#x266F . #x266F) + (#x269E . #x269F) + (#x26BF . #x26BF) + (#x26C6 . #x26CD) + (#x26CF . #x26D3) + (#x26D5 . #x26E1) + (#x26E3 . #x26E3) + (#x26E8 . #x26E9) + (#x26EB . #x26F1) + (#x26F4 . #x26F4) + (#x26F6 . #x26F9) + (#x26FB . #x26FC) + (#x26FE . #x26FF) + (#x273D . #x273D) + (#x2776 . #x277F) + (#x2B56 . #x2B59) + (#x3248 . #x324F)))) + (dolist (elt l) + (set-char-table-range ambiguous-width-chars elt t))) + ;; Other double width ;;(map-charset-chars ;; (lambda (range ignore) (set-char-table-range char-width-table range 2)) @@ -1427,6 +1595,45 @@ cjk-char-width-table-list (chinese-cns11643-1 (#x2121 . #x427E))) (ko_KR nil (korean-ksc5601 (#x2121 . #x2C7E))))) +(defun update-cjk-ambiguous-char-widths (locale-name) + "Update character widths for LOCALE-NAME using `ambiguous-width-chars'. +LOCALE-NAME is the symbol of a CJK locale, such as \\='zh_CN." + (let ((slot (assq locale-name cjk-char-width-table-list))) + (or slot (error "Unknown locale for CJK language environment: %s" + locale-name)) + ;; Force recomputation of child table in 'use-cjk-char-width-table'. + (setcar (cdr slot) nil) + (use-cjk-char-width-table locale-name))) + + +(defcustom cjk-ambiguous-chars-are-wide t + "Whether the \"ambiguous-width\" characters take 2 columns on display. + +Some of the characters are defined by Unicode as being of \"ambiguous\" +width: the actual width, either 1 column or 2 columns, should be +determined at display time, depending on the language context. +If this variable is non-nil, Emacs will consider these characters as +full-width, i.e. taking 2 columns; otherwise they are narrow characters +taking 1 column on display. Which value is correct depends on the +fonts being used. In some CJK locales the fonts are set so that +these characters are displayed as full-width. This setting is most +important for text-mode frames, because there Emacs cannot access the +metrics of the fonts used by the console or the terminal emulator. + +Do not set this directly via `setq'; instead, use `setopt' or the +Customize commands. Alternatively, call `update-cjk-ambiguous-char-widths' +passing it the symbol of the current locale environment, after changing +the value of the variable with `setq'." + :type 'boolean + :set (lambda (symbol value) + (set-default symbol value) + (let ((locsym (get-language-info current-language-environment + 'cjk-locale-symbol))) + (when locsym + (update-cjk-ambiguous-char-widths locsym)))) + :version "30.1" + :group 'display) + ;; Internal use only. ;; Setup char-width-table appropriate for a language environment ;; corresponding to LOCALE-NAME (symbol). @@ -1448,7 +1655,15 @@ use-cjk-char-width-table (car code-range) (cdr code-range))))) (optimize-char-table table) (set-char-table-parent table char-width-table) - (setcar (cdr slot) table))) + (let ((tbl (make-char-table nil))) + (map-char-table + (lambda (range _val) + (set-char-table-range tbl range + (if cjk-ambiguous-chars-are-wide 2 1))) + ambiguous-width-chars) + (optimize-char-table tbl) + (set-char-table-parent tbl table) + (setcar (cdr slot) tbl)))) (setq char-width-table (nth 1 slot)))) (defun use-default-char-width-table () diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el index 26f1194aa4c..e35f3f179ad 100644 --- a/lisp/language/chinese.el +++ b/lisp/language/chinese.el @@ -111,6 +111,7 @@ 'hz (set-language-info-alist "Chinese-GB" '((charset chinese-gb2312 chinese-sisheng) (iso639-language . zh) + (cjk-locale-symbol . zh_CN) (setup-function . (lambda () (use-cjk-char-width-table 'zh_CN))) (exit-function . use-default-char-width-table) @@ -142,6 +143,7 @@ 'cp950 (set-language-info-alist "Chinese-BIG5" '((charset chinese-big5-1 chinese-big5-2) (iso639-language . zh) + (cjk-locale-symbol . zh_HK) (setup-function . (lambda () (use-cjk-char-width-table 'zh_HK))) (exit-function . use-default-char-width-table) @@ -198,6 +200,7 @@ 'euc-taiwan chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7) (iso639-language . zh) + (cjk-locale-symbol . zh_TW) (setup-function . (lambda () (use-cjk-char-width-table 'zh_TW))) (exit-function . use-default-char-width-table) @@ -218,6 +221,7 @@ 'euc-taiwan chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7 chinese-big5-1 chinese-big5-2) (iso639-language . zh) + (cjk-locale-symbol . zh_TW) (setup-function . (lambda () (use-cjk-char-width-table 'zh_TW))) (exit-function . use-default-char-width-table) @@ -248,6 +252,7 @@ 'windows-936 (set-language-info-alist "Chinese-GBK" '((charset chinese-gbk) (iso639-language . zh) + (cjk-locale-symbol . zh_CN) (setup-function . (lambda () (use-cjk-char-width-table 'zh_CN))) (exit-function . use-default-char-width-table) diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el index 681dc9d7b92..6042ebf4511 100644 --- a/lisp/language/japanese.el +++ b/lisp/language/japanese.el @@ -208,6 +208,7 @@ 'cp290 "Japanese" '((setup-function . setup-japanese-environment-internal) (exit-function . use-default-char-width-table) (iso639-language . ja) + (cjk-locale-symbol . ja_JP) (tutorial . "TUTORIAL.ja") (charset japanese-jisx0208 japanese-jisx0212 latin-jisx0201 katakana-jisx0201 diff --git a/lisp/language/korean.el b/lisp/language/korean.el index fef5796bc4b..ede37d5d07c 100644 --- a/lisp/language/korean.el +++ b/lisp/language/korean.el @@ -68,6 +68,7 @@ 'cp949 (set-language-info-alist "Korean" '((setup-function . setup-korean-environment-internal) (exit-function . exit-korean-environment) + (cjk-locale-symbol . ko_KR) (iso639-language . ko) (tutorial . "TUTORIAL.ko") (charset korean-ksc5601 cp949) diff --git a/src/character.c b/src/character.c index f4164360f21..2118b20a7c7 100644 --- a/src/character.c +++ b/src/character.c @@ -1117,6 +1117,14 @@ syms_of_character (void) char_table_set_range (Vchar_width_table, MAX_5_BYTE_CHAR + 1, MAX_CHAR, make_fixnum (4)); + DEFVAR_LISP ("ambiguous-width-chars", Vambiguous_width_chars, + doc: /* +A char-table for characters whose width (columns) can be 1 or 2. + +The actual width depends on the language-environment and on the +value of `cjk-ambiguous-chars-are-wide'. */); + Vambiguous_width_chars = Fmake_char_table (Qnil, Qnil); + DEFVAR_LISP ("printable-chars", Vprintable_chars, doc: /* A char-table for each printable character. */); Vprintable_chars = Fmake_char_table (Qnil, Qnil); commit f2b2c752a5920c1152fd70d917e0fc5a3c9728c4 Author: Eli Zaretskii Date: Sat Aug 5 12:13:47 2023 +0300 Fix documentation of saveplace facilities for Dired * lisp/saveplace.el (save-place-dired-hook, save-place-alist): * lisp/dired.el (dired-initial-position-hook) (dired-initial-position): Doc fixes. (Bug#65055) diff --git a/lisp/dired.el b/lisp/dired.el index d14cf47ffd5..d0af05d68f0 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -346,7 +346,7 @@ dired-make-directory-clickable :type 'boolean) (defcustom dired-initial-position-hook nil - "This hook is used to position the point. + "Hook used to position point in a new Dired listing display. It is run by the function `dired-initial-position'." :group 'dired :type 'hook @@ -3541,9 +3541,9 @@ dired-find-subdir ;; FIXME document whatever dired-x is doing. (defun dired-initial-position (dirname) - "Where point should go in a new listing of DIRNAME. -Point is assumed to be at the beginning of new subdir line. -It runs the hook `dired-initial-position-hook'." + "Return position of point in a new listing of DIRNAME. +Point is assumed to be at the beginning of a new subdir line. +Runs the hook `dired-initial-position-hook'." (end-of-line) (and (featurep 'dired-x) dired-find-subdir (dired-goto-subdir dirname)) diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 7512fc87c5d..71cd8b9bc0e 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -47,6 +47,17 @@ save-place-alist Each element looks like (FILENAME . POSITION); visiting file FILENAME goes automatically to position POSITION rather than the beginning of the buffer. +A list element can also have the form + + (DIRECTORY (dired-filename . FILENAME)) + +where DIRECTORY is the name of a directory ending in a slash, +and FILENAME is the name of a file in that directory. This +format is used for saving places in Dired buffers, see the +function `save-place-dired-hook'; the FILENAME is the file +where point was located in the Dired listing of DIRECTORY +when the place in that buffer was recorded. + This alist is saved between Emacs sessions.") (defcustom save-place-file (locate-user-emacs-file "places" ".emacs-places") @@ -366,7 +377,8 @@ save-place-find-file-hook (declare-function dired-goto-file "dired" (file)) (defun save-place-dired-hook () - "Position the point in a Dired buffer." + "Position point in a Dired buffer according to its saved place. +This is run via `dired-initial-position-hook', which see." (or save-place-loaded (save-place-load-alist-from-file)) (let* ((directory (and (derived-mode-p 'dired-mode) (boundp 'dired-subdir-alist) commit 4ed9d61c89aa54581892c8634c7f93ba21f9603f Author: Eli Zaretskii Date: Sat Aug 5 10:31:20 2023 +0300 ; * lisp/tab-bar.el: Autoload cl--set-substring, as that is needed for loadup. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index dc9ea63c490..17fc4b346cb 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -36,6 +36,8 @@ (require 'seq) (require 'icons)) +(autoload 'cl--set-substring "cl-lib") + (defgroup tab-bar nil "Frame-local tabs." commit 30976ecd8d8f1f982a7a481c5b069feea52dbf6c Author: Eshel Yaron Date: Sat Aug 5 09:45:56 2023 +0300 ; * lisp/bindings.el (mode-line-modes): Fix typo (bug#65065). diff --git a/lisp/bindings.el b/lisp/bindings.el index 6db043e495c..e118fa1a35c 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -382,7 +382,7 @@ mode-line-minor-mode-keymap (defvar mode-line-modes (let ((recursive-edit-help-echo - "Recursive edit, type M-C-c to get out")) + "Recursive edit, type C-M-c to get out")) (list (propertize "%[" 'help-echo recursive-edit-help-echo) "(" `(:propertize ("" mode-name) commit 8574ef314c4250f7c10245cb8abe11dcc07bfe6d Author: Jim Porter Date: Fri Aug 4 09:31:59 2023 -0700 Fix loaddef generation with ";;;foo-autoload" cookies in external packages This caused an issue where package-specific autoload cookies weren't being correctly recognized, so they got dumped into the package's main "-autoloads.el" file, instead of "-loaddefs.el" as they should (bug#65023). * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): Save match data when checking syntax. diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 5db9af21508..d7b9b131bc8 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -431,7 +431,8 @@ loaddefs-generate--parse-file ;; have an autoload cookie on the first column of a ;; doc string or the like. (The Emacs tree ;; shouldn't contain any such instances.) - (not (ppss-string-terminator (syntax-ppss)))) + (not (ppss-string-terminator + (save-match-data (syntax-ppss))))) ;; ... and if we have one of these names, then alter outfile. (let* ((aname (match-string 2)) (to-file (if aname commit 8cbd4a02a2b9823a6aa7e722af6e3d204f881aed Author: Stefan Kangas Date: Fri Aug 4 12:25:15 2023 +0200 Delete comment saying that project.el is experimental * lisp/progmodes/project.el (Commentary): Delete comment saying that the API is "still experimental". It is to be considered stable starting with the version released with Emacs 29. Ref: https://lists.gnu.org/r/emacs-devel/2023-07/msg00415.html diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index d482cc24d70..8d8bf594628 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -24,11 +24,6 @@ ;;; Commentary: -;; NOTE: The project API is still experimental and can change in major, -;; backward-incompatible ways. Everyone is encouraged to try it, and -;; report to us any problems or use cases we hadn't anticipated, by -;; sending an email to emacs-devel, or `M-x report-emacs-bug'. -;; ;; This file contains generic infrastructure for dealing with ;; projects, some utility functions, and commands using that ;; infrastructure.