Commit 2c050617 authored by Michael Albinus's avatar Michael Albinus

Add `make-nearby-temp-file' and `temporary-file-directory'

* doc/lispref/files.texi (Unique File Names):
Introduce `make-nearby-temp-file' and `temporary-file-directory'.
(Magic File Names): Mention `make-nearby-temp-file' and
`temporary-file-directory'.

* etc/NEWS (provided): Mention `make-nearby-temp-file' and
`temporary-file-directory'.

* lisp/files.el (mounted-file-systems): New defcustom.
(temporary-file-directory, make-nearby-temp-file): New defuns.
(normal-backup-enable-predicate): Fix docstring.

* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist):
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
<make-nearby-temp-file, temporary-file-directory>: Add handler.

* lisp/net/tramp.el (tramp-file-name-for-operation):
Add `make-nearby-temp-file' and `temporary-file-directory'.
(tramp-get-remote-tmpdir): Remove compatibility code.
(tramp-handle-temporary-file-directory)
(tramp-handle-make-nearby-temp-file): New defuns.

* lisp/org/ob-core.el (org-babel-local-file-name):
* lisp/progmodes/gud.el (gud-common-init):
* lisp/vc/vc-hooks.el (vc-user-login-name): Use `file-remote-p'.

* lisp/vc/vc-git.el (vc-git-checkin): Handle remote log message.

* test/lisp/net/tramp-tests.el (tramp-test06-directory-file-name):
Check `tramp--test-enabled'.
(tramp-test18-file-attributes): Add tests for
`file-ownership-preserved-p'.
(tramp-test27-start-file-process, tramp-test28-shell-command):
Reduce timeouts in `accept-process-output'.
(tramp-test--shell-command-to-string-asynchronously): Add timeout.
(tramp-test29-environment-variables): Remove additional sleep calls.
(tramp-test32-make-nearby-temp-file): New test.
(tramp--test-special-characters, tramp--test-utf8): Adapt docstring.
(tramp-test33-special-characters)
(tramp-test33-special-characters-with-stat)
(tramp-test33-special-characters-with-perl)
(tramp-test33-special-characters-with-ls, tramp-test34-utf8)
(tramp-test34-utf8-with-stat, tramp-test34-utf8-with-perl)
(tramp-test34-utf8-with-ls)
(tramp-test35-asynchronous-requests)
(tramp-test36-recursive-load, tramp-test37-unload): Rename.
(tramp--test-ftp-p): Simplify check.
(tramp--test-sh-p): New defun.
(tramp-test20-file-modes, tramp-test22-file-times)
(tramp-test26-process-file, tramp-test27-start-file-process)
(tramp-test28-shell-command)
(tramp-test29-environment-variables)
(tramp-test30-vc-registered)
(tramp-test33-special-characters-with-stat)
(tramp-test33-special-characters-with-perl)
(tramp-test33-special-characters-with-ls)
(tramp-test34-utf8-with-stat, tramp-test34-utf8-with-perl)
(tramp-test34-utf8-with-ls)
(tramp-test35-asynchronous-requests): Use it.
parent a7985477
......@@ -2440,6 +2440,50 @@ condition, between the @code{make-temp-name} call and the creation of
the file, which in some cases may cause a security hole.
@end defun
Sometimes, it is necessary to create a temporary file on a remote host
or a mounted directory. The following two functions support this.
@defun make-nearby-temp-file prefix &optional dir-flag suffix
This function is similar to @code{make-temp-file}, but it creates a
temporary file as close as possible to @code{default-directory}. If
@var{prefix} is a relative file name, and @code{default-directory} is
a remote file name or located on a mounted file systems, the temporary
file is created in the directory returned by the function
@code{temporary-file-directory}. Otherwise, the function
@code{make-temp-file} is used. @var{prefix}, @var{dir-flag} and
@var{suffix} have the same meaning as in @code{make-temp-file}.
@example
@group
(let ((default-directory "/ssh:remotehost:"))
(make-nearby-temp-file "foo"))
@result{} "/ssh:remotehost:/tmp/foo232J6v"
@end group
@end example
@end defun
@defun temporary-file-directory
The directory for writing temporary files via
@code{make-nearby-temp-file}. In case of a remote
@code{default-directory}, this is a directory for temporary files on
that remote host. If such a directory does not exist, or
@code{default-directory} ought to be located on a mounted file system
(see @code{mounted-file-systems}), the function returns
@code{default-directory}. For a non-remote and non-mounted
@code{default-directory}, the value of the variable
@code{temporary-file-directory} is returned.
@end defun
In order to extract the local part of the path name from a temporary
file, the following code could be used:
@example
@group
(let ((tmpfile (make-nearby-temp-file "foo")))
(or (file-remote-p tmpfile 'localname) tmpfile))
@end group
@end example
@node File Name Completion
@subsection File Name Completion
@cindex file name completion subroutines
......@@ -2903,6 +2947,7 @@ first, before handlers for jobs such as remote file access.
@code{make-auto-save-file-name},
@code{make-directory},
@code{make-directory-internal},
@code{make-nearby-temp-file},
@code{make-symbolic-link},@*
@code{process-file},
@code{rename-file}, @code{set-file-acl}, @code{set-file-modes},
......@@ -2910,6 +2955,7 @@ first, before handlers for jobs such as remote file access.
@code{set-visited-file-modtime}, @code{shell-command},
@code{start-file-process},
@code{substitute-in-file-name},@*
@code{temporary-file-directory},
@code{unhandled-file-name-directory},
@code{vc-registered},
@code{verify-visited-file-modtime},@*
......
......@@ -563,7 +563,11 @@ ABBR is a time zone abbreviation. The affected functions are
The Info-quoted and tex-verbatim faces now default to inheriting from it.
** New built-in function `mapcan' which avoids unnecessary consing (and garbage
collection).
collection).
+++
** The new functions `make-nearby-temp-file' and `temporary-file-directory'
can be used for creation of temporary files of remote or mounted directories.
* Changes in Emacs 25.2 on Non-Free Operating Systems
......
......@@ -1314,6 +1314,36 @@ Optional second argument FLAVOR controls the units and the display format:
(car post-fixes))
(if (eq flavor 'iec) "iB" ""))))
(defcustom mounted-file-systems
(if (memq system-type '(windows-nt cygwin))
"^//[^/]+/"
;; regexp-opt.el is not dumped into emacs binary.
;;(concat
;; "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))))
"^\\(?:/\\(?:afs/\\|m\\(?:edia/\\|nt\\)\\|\\(?:ne\\|tmp_mn\\)t/\\)\\)")
"File systems which ought to be mounted."
:group 'files
:version "25.2"
:require 'regexp-opt
:type 'regexp)
(defun temporary-file-directory ()
"The directory for writing temporary files.
In case of a remote `default-directory', this is a directory for
temporary files on that remote host. If such a directory does
not exist, or `default-directory' ought to be located on a
mounted file system (see `mounted-file-systems'), the function
returns `default-directory'.
For a non-remote and non-mounted `default-directory', the value of
the variable `temporary-file-directory' is returned."
(let ((handler (find-file-name-handler
default-directory 'temporary-file-directory)))
(if handler
(funcall handler 'temporary-file-directory)
(if (string-match mounted-file-systems default-directory)
default-directory
temporary-file-directory))))
(defun make-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file.
The returned file name (created by appending some random characters at the end
......@@ -1350,6 +1380,21 @@ If SUFFIX is non-nil, add that at the end of the file name."
nil)
file)))
(defun make-nearby-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file as close as possible to `default-directory'.
If PREFIX is a relative file name, and `default-directory' is a
remote file name or located on a mounted file systems, the
temporary file is created in the directory returned by the
function `temporary-file-directory'. Otherwise, the function
`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
same meaning as in `make-temp-file'."
(let ((handler (find-file-name-handler
default-directory 'make-nearby-temp-file)))
(if (and handler (not (file-name-absolute-p default-directory)))
(funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
(let ((temporary-file-directory (temporary-file-directory)))
(make-temp-file prefix dir-flag suffix)))))
(defun recode-file-name (file coding new-coding &optional ok-if-already-exists)
"Change the encoding of FILE's name from CODING to NEW-CODING.
The value is a new name of FILE.
......@@ -4404,7 +4449,7 @@ ignored."
(defun normal-backup-enable-predicate (name)
"Default `backup-enable-predicate' function.
Checks for files in `temporary-file-directory',
`small-temporary-file-directory', and /tmp."
`small-temporary-file-directory', and \"/tmp\"."
(let ((temporary-file-directory temporary-file-directory)
caseless)
;; On MS-Windows, file-truename will convert short 8+3 aliases to
......
......@@ -148,6 +148,7 @@ It is used for TCP/IP devices."
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-adb-handle-make-directory)
(make-directory-internal . ignore)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . tramp-adb-handle-process-file)
(rename-file . tramp-adb-handle-rename-file)
......@@ -159,6 +160,7 @@ It is used for TCP/IP devices."
(shell-command . tramp-adb-handle-shell-command)
(start-file-process . tramp-adb-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
......
......@@ -502,6 +502,7 @@ Every entry is a list (NAME ADDRESS).")
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-gvfs-handle-make-directory)
(make-directory-internal . ignore)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-handle-make-symbolic-link)
(process-file . ignore)
(rename-file . tramp-gvfs-handle-rename-file)
......@@ -513,6 +514,7 @@ Every entry is a list (NAME ADDRESS).")
(shell-command . ignore)
(start-file-process . ignore)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
......
......@@ -1043,6 +1043,7 @@ of command line.")
(load . tramp-handle-load)
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-sh-handle-make-directory)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-sh-handle-make-symbolic-link)
(process-file . tramp-sh-handle-process-file)
(rename-file . tramp-sh-handle-rename-file)
......@@ -1054,6 +1055,7 @@ of command line.")
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-sh-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . tramp-sh-handle-vc-registered)
(verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime)
......
......@@ -265,6 +265,7 @@ See `tramp-actions-before-shell' for more info.")
(make-auto-save-file-name . tramp-handle-make-auto-save-file-name)
(make-directory . tramp-smb-handle-make-directory)
(make-directory-internal . tramp-smb-handle-make-directory-internal)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
(make-symbolic-link . tramp-smb-handle-make-symbolic-link)
(process-file . tramp-smb-handle-process-file)
(rename-file . tramp-smb-handle-rename-file)
......@@ -276,6 +277,7 @@ See `tramp-actions-before-shell' for more info.")
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-smb-handle-start-file-process)
(substitute-in-file-name . tramp-smb-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
......
......@@ -1917,7 +1917,9 @@ ARGS are the arguments OPERATION has been called with."
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
;; COMMAND.
((member operation
'(process-file shell-command start-file-process))
'(process-file shell-command start-file-process
;; Emacs 25.2+ only.
make-nearby-temp-file temporary-file-directory))
default-directory)
;; PROC.
((member operation
......@@ -3893,9 +3895,6 @@ be granted."
(defun tramp-get-remote-tmpdir (vec)
"Return directory for temporary files on the remote host identified by VEC."
(when (file-remote-p (tramp-get-connection-property vec "tmpdir" ""))
;; Compatibility code: Cached value shall be the local path only.
(tramp-set-connection-property vec "tmpdir" 'undef))
(let ((dir (tramp-make-tramp-file-name
(tramp-file-name-method vec)
(tramp-file-name-user vec)
......@@ -3985,6 +3984,21 @@ ALIST is of the form ((FROM . TO) ...)."
(setq alist (cdr alist))))
string))
(defun tramp-handle-temporary-file-directory ()
"Like `temporary-file-directory' for Tramp files."
(catch 'result
(dolist (dir `(,(ignore-errors
(tramp-get-remote-tmpdir
(tramp-dissect-file-name default-directory)))
,default-directory))
(when (and (stringp dir) (file-directory-p dir) (file-writable-p dir))
(throw 'result (expand-file-name dir))))))
(defun tramp-handle-make-nearby-temp-file (prefix &optional dir-flag suffix)
"Like `make-nearby-temp-file' for Tramp files."
(let ((temporary-file-directory (temporary-file-directory)))
(make-temp-file prefix dir-flag suffix)))
;;; Compatibility functions section:
(defun tramp-call-process
......
......@@ -43,11 +43,6 @@
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function tramp-compat-make-temp-file "tramp-compat"
(filename &optional dir-flag))
(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
(declare-function tramp-file-name-user "tramp" (vec))
(declare-function tramp-file-name-host "tramp" (vec))
(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)
t)
(declare-function org-icompleting-read "org" (&rest args))
(declare-function org-edit-src-code "org-src"
(&optional context code edit-buffer-name))
......@@ -2670,7 +2665,7 @@ of the string."
(start end program &optional delete buffer display &rest args)
"Use Tramp to handle `call-process-region'.
Fixes a bug in `tramp-handle-call-process-region'."
(if (and (featurep 'tramp) (file-remote-p default-directory))
(if (file-remote-p default-directory)
(let ((tmpfile (tramp-compat-make-temp-file "")))
(write-region start end tmpfile)
(when delete (delete-region start end))
......@@ -2687,11 +2682,7 @@ Fixes a bug in `tramp-handle-call-process-region'."
(defun org-babel-local-file-name (file)
"Return the local name component of FILE."
(if (file-remote-p file)
(let (localname)
(with-parsed-tramp-file-name file nil
localname))
file))
(or (file-remote-p file 'localname) file))
(defun org-babel-process-file-name (name &optional no-quote-p)
"Prepare NAME to be used in an external process.
......
......@@ -2567,9 +2567,6 @@ comint mode, which see."
:group 'gud
:type 'boolean)
(declare-function tramp-file-name-localname "tramp" (vec))
(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
;; Perform initializations common to all debuggers.
;; The first arg is the specified command line,
;; which starts with the program to debug.
......@@ -2628,8 +2625,7 @@ comint mode, which see."
(setcar w
(if (file-remote-p file)
;; Tramp has already been loaded if we are here.
(setq file (tramp-file-name-localname
(tramp-dissect-file-name file)))
(setq file (file-remote-p file 'localname))
file))))
(apply 'make-comint (concat "gud" filepart) program nil
(if massage-args (funcall massage-args file args) args))
......
......@@ -705,7 +705,12 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
;; arguments must be in the system codepage, and therefore
;; might not support the non-ASCII characters in the log
;; message.
(if (eq system-type 'windows-nt) (make-temp-file "git-msg"))))
(if (eq system-type 'windows-nt)
(if (file-remote-p file1)
(let ((default-directory (file-name-directory file1)))
(file-remote-p
(make-nearby-temp-file "git-msg") 'localname))
(make-temp-file "git-msg")))))
(cl-flet ((boolean-arg-fn
(argument)
(lambda (value) (when (equal value "yes") (list argument)))))
......
......@@ -394,7 +394,7 @@ For registered files, the possible values are:
(defun vc-user-login-name (file)
"Return the name under which the user accesses the given FILE."
(or (and (eq (string-match tramp-file-name-regexp file) 0)
(or (and (file-remote-p file)
;; tramp case: execute "whoami" via tramp
(let ((default-directory (file-name-directory file))
process-file-side-effects)
......
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment