;; We depend on being the last handler on the list,
;; so that anything else which does need handling
;; has been handled already.
-;; So it is safe for us to inhibit *all* magic file name handlers for
-;; operations, which return a file name. See Bug#29579.
+;; So it is safe for us to inhibit *all* magic file name handlers.
(defun file-name-non-special (operation &rest arguments)
- (let* ((op-returns-file-name-list
- '(expand-file-name file-name-directory file-name-as-directory
- directory-file-name file-name-sans-versions
- find-backup-file-name file-remote-p))
- (file-name-handler-alist
- (and
- (not (memq operation op-returns-file-name-list))
- file-name-handler-alist))
- (default-directory
- ;; Some operations respect file name handlers in
- ;; `default-directory'. Because core function like
- ;; `call-process' don't care about file name handlers in
- ;; `default-directory', we here have to resolve the
- ;; directory into a local one. For `process-file',
- ;; `start-file-process', and `shell-command', this fixes
- ;; Bug#25949.
- (if (memq operation
- '(insert-directory process-file start-file-process
- shell-command))
- (directory-file-name
- (expand-file-name
- (unhandled-file-name-directory default-directory)))
- default-directory))
- ;; Get a list of the indices of the args which are file names.
- (file-arg-indices
- (cdr (or (assq operation
- ;; The first seven are special because they
- ;; return a file name. We want to include the /:
- ;; in the return value.
- ;; So just avoid stripping it in the first place.
- (append
- (mapcar 'list op-returns-file-name-list)
- '(;; `identity' means just return the first arg
- ;; not stripped of its quoting.
- (substitute-in-file-name identity)
- ;; `add' means add "/:" to the result.
- (file-truename add 0)
- (insert-file-contents insert-file-contents 0)
- ;; `unquote-then-quote' means set buffer-file-name
- ;; temporarily to unquoted filename.
- (verify-visited-file-modtime unquote-then-quote)
- ;; List the arguments which are filenames.
- (file-name-completion 1)
- (file-name-all-completions 1)
- (write-region 2 5)
- (rename-file 0 1)
- (copy-file 0 1)
- (copy-directory 0 1)
- (file-in-directory-p 0 1)
- (make-symbolic-link 0 1)
- (add-name-to-file 0 1))))
- ;; For all other operations, treat the first argument only
- ;; as the file name.
- '(nil 0))))
- method
- ;; Copy ARGUMENTS so we can replace elements in it.
- (arguments (copy-sequence arguments)))
+ (let ((file-name-handler-alist nil)
+ (default-directory
+ ;; Some operations respect file name handlers in
+ ;; `default-directory'. Because core function like
+ ;; `call-process' don't care about file name handlers in
+ ;; `default-directory', we here have to resolve the
+ ;; directory into a local one. For `process-file',
+ ;; `start-file-process', and `shell-command', this fixes
+ ;; Bug#25949.
+ (if (memq operation '(insert-directory process-file start-file-process
+ shell-command))
+ (directory-file-name
+ (expand-file-name
+ (unhandled-file-name-directory default-directory)))
+ default-directory))
+ ;; Get a list of the indices of the args which are file names.
+ (file-arg-indices
+ (cdr (or (assq operation
+ ;; The first six are special because they
+ ;; return a file name. We want to include the /:
+ ;; in the return value.
+ ;; So just avoid stripping it in the first place.
+ '((expand-file-name . nil)
+ (file-name-directory . nil)
+ (file-name-as-directory . nil)
+ (directory-file-name . nil)
+ (file-name-sans-versions . nil)
+ (find-backup-file-name . nil)
+ ;; `identity' means just return the first arg
+ ;; not stripped of its quoting.
+ (substitute-in-file-name identity)
+ ;; `add' means add "/:" to the result.
+ (file-truename add 0)
+ (insert-file-contents insert-file-contents 0)
+ ;; `unquote-then-quote' means set buffer-file-name
+ ;; temporarily to unquoted filename.
+ (verify-visited-file-modtime unquote-then-quote)
+ ;; List the arguments which are filenames.
+ (file-name-completion 1)
+ (file-name-all-completions 1)
+ (write-region 2 5)
+ (rename-file 0 1)
+ (copy-file 0 1)
+ (make-symbolic-link 0 1)
+ (add-name-to-file 0 1)))
+ ;; For all other operations, treat the first argument only
+ ;; as the file name.
+ '(nil 0))))
+ method
+ ;; Copy ARGUMENTS so we can replace elements in it.
+ (arguments (copy-sequence arguments)))
(if (symbolp (car file-arg-indices))
(setq method (pop file-arg-indices)))
;; Strip off the /: from the file names that have it.
"Check `copy-file'."
(skip-unless (tramp--test-enabled))
- ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
- (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
- '(nil t) '(nil)))
+ ;; TODO: The quoted case does not work. Copy local file to remote.
+ ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
"Check `rename-file'."
(skip-unless (tramp--test-enabled))
- ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
- (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
- '(nil t) '(nil)))
+ ;; TODO: The quoted case does not work.
+ ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
;; Symbolic links could look like a remote file name.
;; They must be quoted then.
(delete-file tmp-name2)
- (make-symbolic-link
- (funcall
- (if quoted 'tramp-compat-file-name-unquote 'identity)
- "/penguin:motd:")
- tmp-name2)
+ (make-symbolic-link "/penguin:motd:" tmp-name2)
(should (file-symlink-p tmp-name2))
(should
(string-equal
;; We must unquote it.
(should
(string-equal
- (tramp-compat-file-name-unquote (file-truename tmp-name1))
+ (file-truename tmp-name1)
(tramp-compat-file-name-unquote (file-truename tmp-name3)))))
;; Cleanup.
(skip-unless (tramp--test-enabled))
(skip-unless (file-acl tramp-test-temporary-file-directory))
- ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
- (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
- '(nil t) '(nil)))
+ ;; TODO: The quoted case does not work. Copy local file to remote.
+ ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(not (equal (file-selinux-context tramp-test-temporary-file-directory)
'(nil nil nil nil))))
- ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
- (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
- '(nil t) '(nil)))
+ ;; TODO: The quoted case does not work. Copy local file to remote.
+ ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES."
- ;; `filename-non-special' has been fixed in Emacs 26.1, see Bug#29579.
- (dolist (quoted (if (and tramp--test-expensive-test (tramp--test-emacs26-p))
- '(nil t) '(nil)))
+ ;; TODO: The quoted case does not work.
+ ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let (quoted)
;; We must use `file-truename' for the temporary directory,
;; because it could be located on a symlinked directory. This
;; would let the test fail.
projects / emacs.git / commitdiff