Fix compatibility problem in Tramp
* lisp/net/tramp.el (tramp-interrupt-process): Better error handling. * lisp/net/tramp-compat.el (default-toplevel-value): Move up. (top): Do not call `tramp-change-syntax' anymore. (tramp-compat-directory-name-p): New defalias. * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file): * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-copy-file): Use it. * test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process): Modify test.
This commit is contained in:
parent
411bec82c4
commit
57249fb297
6 changed files with 37 additions and 32 deletions
|
@ -740,7 +740,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
|
|||
|
||||
;; Remote newname.
|
||||
(when (and (file-directory-p newname)
|
||||
(directory-name-p newname))
|
||||
(tramp-compat-directory-name-p newname))
|
||||
(setq newname
|
||||
(expand-file-name
|
||||
(file-name-nondirectory filename) newname)))
|
||||
|
|
|
@ -23,8 +23,9 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; Tramp's main Emacs version for development is Emacs 26. This
|
||||
;; package provides compatibility functions for Emacs 24 and Emacs 25.
|
||||
;; Tramp's main Emacs version for development is Emacs 27. This
|
||||
;; package provides compatibility functions for Emacs 24, Emacs 25 and
|
||||
;; Emacs 26.
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
@ -104,6 +105,10 @@ Add the extension of F, if existing."
|
|||
'tramp-error vec-or-proc
|
||||
(if (fboundp 'user-error) 'user-error 'error) format args))
|
||||
|
||||
;; `default-toplevel-value' has been declared in Emacs 24.4.
|
||||
(unless (fboundp 'default-toplevel-value)
|
||||
(defalias 'default-toplevel-value 'symbol-value))
|
||||
|
||||
;; `file-attribute-*' are introduced in Emacs 25.1.
|
||||
|
||||
(if (fboundp 'file-attribute-type)
|
||||
|
@ -163,14 +168,23 @@ This is a floating point number if the size is too large for an integer."
|
|||
This is a string of ten letters or dashes as in ls -l."
|
||||
(nth 8 attributes)))
|
||||
|
||||
;; `default-toplevel-value' has been declared in Emacs 24.4.
|
||||
(unless (fboundp 'default-toplevel-value)
|
||||
(defalias 'default-toplevel-value 'symbol-value))
|
||||
|
||||
;; `format-message' is new in Emacs 25.1.
|
||||
(unless (fboundp 'format-message)
|
||||
(defalias 'format-message 'format))
|
||||
|
||||
;; `directory-name-p' is new in Emacs 25.1.
|
||||
(if (fboundp 'directory-name-p)
|
||||
(defalias 'tramp-compat-directory-name-p 'directory-name-p)
|
||||
(defsubst tramp-compat-directory-name-p (name)
|
||||
"Return non-nil if NAME ends with a directory separator character."
|
||||
(let ((len (length name))
|
||||
(lastc ?.))
|
||||
(if (> len 0)
|
||||
(setq lastc (aref name (1- len))))
|
||||
(or (= lastc ?/)
|
||||
(and (memq system-type '(windows-nt ms-dos))
|
||||
(= lastc ?\\))))))
|
||||
|
||||
;; `file-missing' is introduced in Emacs 26.1.
|
||||
(defconst tramp-file-missing
|
||||
(if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
|
||||
|
@ -221,13 +235,6 @@ If NAME is a remote file name, the local part of NAME is unquoted."
|
|||
((eq tramp-syntax 'sep) 'separate)
|
||||
(t tramp-syntax)))
|
||||
|
||||
;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'.
|
||||
(eval-after-load 'tramp
|
||||
'(unless
|
||||
(memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
|
||||
(tramp-compat-funcall
|
||||
(quote tramp-change-syntax) (tramp-compat-tramp-syntax))))
|
||||
|
||||
(provide 'tramp-compat)
|
||||
|
||||
;;; TODO:
|
||||
|
|
|
@ -1985,7 +1985,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
|
|||
;; scp or rsync DTRT.
|
||||
(progn
|
||||
(when (and (file-directory-p newname)
|
||||
(not (directory-name-p newname)))
|
||||
(not (tramp-compat-directory-name-p newname)))
|
||||
(tramp-error v 'file-already-exists newname))
|
||||
(setq dirname (directory-file-name (expand-file-name dirname))
|
||||
newname (directory-file-name (expand-file-name newname)))
|
||||
|
|
|
@ -415,7 +415,7 @@ pass to the OPERATION."
|
|||
(with-tramp-progress-reporter
|
||||
v 0 (format "Copying %s to %s" dirname newname)
|
||||
(when (and (file-directory-p newname)
|
||||
(not (directory-name-p newname)))
|
||||
(not (tramp-compat-directory-name-p newname)))
|
||||
(tramp-error v 'file-already-exists newname))
|
||||
(cond
|
||||
;; We must use a local temporary directory.
|
||||
|
@ -586,7 +586,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
|
|||
|
||||
;; Remote newname.
|
||||
(when (and (file-directory-p newname)
|
||||
(directory-name-p newname))
|
||||
(tramp-compat-directory-name-p newname))
|
||||
(setq newname
|
||||
(expand-file-name (file-name-nondirectory filename) newname)))
|
||||
|
||||
|
|
|
@ -4547,16 +4547,17 @@ Only works for Bourne-like shells."
|
|||
(t process)))
|
||||
pid)
|
||||
;; If it's a Tramp process, send the INT signal remotely.
|
||||
(when (and (processp proc) (process-live-p proc)
|
||||
(setq pid (process-get proc 'remote-pid)))
|
||||
(tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
|
||||
;; This is for tramp-sh.el. Other backends do not support this (yet).
|
||||
(tramp-compat-funcall
|
||||
'tramp-send-command
|
||||
(tramp-get-connection-property proc "vector" nil)
|
||||
(format "kill -2 %d" pid))
|
||||
;; Report success.
|
||||
proc)))
|
||||
(when (and (processp proc) (setq pid (process-get proc 'remote-pid)))
|
||||
(if (not (process-live-p proc))
|
||||
(tramp-error proc 'error "Process %s is not active" proc)
|
||||
(tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
|
||||
;; This is for tramp-sh.el. Other backends do not support this (yet).
|
||||
(tramp-compat-funcall
|
||||
'tramp-send-command
|
||||
(tramp-get-connection-property proc "vector" nil)
|
||||
(format "kill -2 %d" pid))
|
||||
;; Report success.
|
||||
proc))))
|
||||
|
||||
;; `interrupt-process-functions' exists since Emacs 26.1.
|
||||
(when (boundp 'interrupt-process-functions)
|
||||
|
|
|
@ -3193,15 +3193,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
|
|||
(should (processp proc))
|
||||
(should (process-live-p proc))
|
||||
(should (equal (process-status proc) 'run))
|
||||
(should (numberp (process-get proc 'remote-pid)))
|
||||
(should (interrupt-process proc))
|
||||
;; Let the process accept the interrupt.
|
||||
(accept-process-output proc 1 nil 0)
|
||||
(should-not (process-live-p proc))
|
||||
(should (equal (process-status proc) 'signal))
|
||||
;; An interrupted process cannot be interrupted, again.
|
||||
;; Does not work reliable.
|
||||
;; (should-error (interrupt-process proc) :type 'error))
|
||||
)
|
||||
(should-error (interrupt-process proc) :type 'error))
|
||||
|
||||
;; Cleanup.
|
||||
(ignore-errors (delete-process proc)))))
|
||||
|
@ -3477,7 +3475,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
|
|||
(skip-unless (tramp--test-enabled))
|
||||
(skip-unless (tramp--test-sh-p))
|
||||
|
||||
;; TODO: This test fails.
|
||||
(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
|
||||
(let* ((default-directory tramp-test-temporary-file-directory)
|
||||
(tmp-name1 (tramp--test-make-temp-name nil quoted))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue