procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add new user option lock-file-name-transforms

Browse source 
* doc/emacs/files.texi (Interlocking): Mention
lock-file-name-transforms.

* doc/lispref/files.texi (File Locks): Document
lock-file-name-transforms.

* doc/misc/efaq.texi (Not writing files to the current directory):
Mention all the three variables needed to not having Emacs writing
files to the current directory in one place.

* lisp/files.el (lock-file-name-transforms): New user option (bug#49261).
(make-auto-save-file-name): Factor out the main logic...
(auto-save--transform-file-name): ... to this new function.
(make-lock-file-name): New function that also calls the
factored-out function.

* src/filelock.c: Remove MAKE_LOCK_NAME and fill_in_lock_file_name.
(make_lock_file_name): New utility function that calls out to Lisp
to heed `lock-file-name-transforms'.
(lock_file): Use it.  Also remove likely buggy call to
dostounix_filename.
(unlock_file_body, Ffile_locked_p): Also use make_lock_file_name.
This commit is contained in:
Lars Ingebrigtsen 2021-07-07 21:39:00 +02:00
parent 6d594848e0
commit 2ad34bcea4
7 changed files with 197 additions and 111 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
doc/emacs/files.texi
View file

@ -789,7 +789,9 @@ Emacs buffer visiting it has unsaved changes.
@vindex create-lockfiles
You can prevent the creation of lock files by setting the variable
@code{create-lockfiles} to @code{nil}. @strong{Caution:} by
doing so you will lose the benefits that this feature provides.
doing so you will lose the benefits that this feature provides. You
can also control where lock files are written by using the
@code{lock-file-name-transforms} variable.
@cindex collision
If you begin to modify the buffer while the visited file is locked by

14
doc/lispref/files.texi
View file

@ -772,6 +772,20 @@ and otherwise ignores the error.
If this variable is @code{nil}, Emacs does not lock files.
@end defopt
@defopt lock-file-name-transforms
By default, Emacs creates the lock files in the same directory as the
files that are being locked. This can be changed by customizing this
variable. Is has the same syntax as
@code{auto-save-file-name-transforms} (@pxref{Auto-Saving}). For
instance, to make Emacs write all the lock files to @file{/var/tmp/},
you could say something like:
@lisp
(setq lock-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
@end lisp
@end defopt
@defun ask-user-about-lock file other-user
This function is called when the user tries to modify @var{file}, but it
is locked by another user named @var{other-user}. The default

34
doc/misc/efaq.texi
View file

@ -1519,6 +1519,7 @@ of files from Macintosh, Microsoft, and Unix platforms.
* Documentation for etags::
* Disabling backups::
* Disabling auto-save-mode::
* Not writing files to the current directory::
* Going to a line by number::
* Modifying pull-down menus::
* Deleting menus and menu options::
@ -2620,6 +2621,39 @@ such as @file{/tmp}.
To disable or change how @code{auto-save-mode} works,
@pxref{Auto Save,,, emacs, The GNU Emacs Manual}.
@node Not writing files to the current directory
@section Making Emacs write all auxiliary files somewhere else
@cindex Writing all auxiliary files to the same directory
By default, Emacs may create many new files in the directory where
you're editing a file. If you're editing the file
@file{/home/user/foo.txt}, Emacs will create the lock file
@file{/home/user/.#foo.txt}, the auto-save file
@file{/home/user/#foo.txt#}, and when you save the file, Emacs will
create the backup file @file{/home/user/foo.txt~}. (The first two
files are deleted when you save the file.)
This may be inconvenient in some setups, so Emacs has mechanisms for
changing the locations of all these files.
@table @code
@item auto-save-file-name-transforms (@pxref{Auto-Saving,,,elisp, GNU Emacs Lisp Reference Manual}).
@item lock-file-name-transforms (@pxref{File Locks,,,elisp, GNU Emacs Lisp Reference Manual}).
@item backup-directory-alist (@pxref{Making Backups,,,elisp, GNU Emacs Lisp Reference Manual}).
@end table
For instance, to write all these things to
@file{~/.emacs.d/aux/}:
@lisp
(setq lock-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t)))
(setq auto-save-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "~/.emacs.d/aux/\\1" t)))
(setq backup-directory-alist
'((".*" . "~/.emacs.d/aux/")))
@end lisp
@node Going to a line by number
@section How can I go to a certain line given its number?
@cindex Going to a line by number

5
etc/NEWS
View file

@ -2169,6 +2169,11 @@ summaries will include the failing condition.
** Miscellaneous
+++
*** New user option 'lock-file-name-transforms'.
This option allows controlling where lock files are written. It uses
the same syntax as 'auto-save-file-name-transforms'.
+++
*** New user option 'kill-transform-function'.
This can be used to transform (and suppress) strings from entering the

141
lisp/files.el
View file

@ -412,6 +412,21 @@ ignored."
:initialize 'custom-initialize-delay
:version "21.1")
(defcustom lock-file-name-transforms nil
"Transforms to apply to buffer file name before making a lock file name.
This has the same syntax as
`auto-save-file-name-transforms' (which see), but instead of
applying to auto-save file names, it's applied to lock file names.
By default, a lock file is put into the same directory as the
file it's locking, and it has the same name, but with \".#\" prepended."
:group 'files
:type '(repeat (list (regexp :tag "Regexp")
(string :tag "Replacement")
(boolean :tag "Uniquify")))
:initialize 'custom-initialize-delay
:version "28.1")
(defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.")
(defcustom auto-save-visited-interval 5
@ -6668,63 +6683,11 @@ See also `auto-save-file-name-p'."
'make-auto-save-file-name)))
(if handler
(funcall handler 'make-auto-save-file-name)
(let ((list auto-save-file-name-transforms)
(filename buffer-file-name)
result uniq)
;; Apply user-specified translations
;; to the file name.
(while (and list (not result))
(if (string-match (car (car list)) filename)
(setq result (replace-match (cadr (car list)) t nil
filename)
uniq (car (cddr (car list)))))
(setq list (cdr list)))
(if result
(setq filename
(cond
((memq uniq (secure-hash-algorithms))
(concat
(file-name-directory result)
(secure-hash uniq filename)))
(uniq
(concat
(file-name-directory result)
(subst-char-in-string
?/ ?!
(replace-regexp-in-string
"!" "!!" filename))))
(t result))))
(setq result
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
;; We truncate the file name to DOS 8+3 limits
;; before doing anything else, because the regexp
;; passed to string-match below cannot handle
;; extensions longer than 3 characters, multiple
;; dots, and other atrocities.
(let ((fn (dos-8+3-filename
(file-name-nondirectory buffer-file-name))))
(string-match
"\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
fn)
(concat (file-name-directory buffer-file-name)
"#" (match-string 1 fn)
"." (match-string 3 fn) "#"))
(concat (file-name-directory filename)
"#"
(file-name-nondirectory filename)
"#")))
;; Make sure auto-save file names don't contain characters
;; invalid for the underlying filesystem.
(if (and (memq system-type '(ms-dos windows-nt cygwin))
;; Don't modify remote filenames
(not (file-remote-p result)))
(convert-standard-filename result)
result))))
(auto-save--transform-file-name buffer-file-name
auto-save-file-name-transforms
"#" "#")))
;; Deal with buffers that don't have any associated files. (Mail
;; mode tends to create a good number of these.)
(let ((buffer-name (buffer-name))
(limit 0)
file-name)
@ -6772,6 +6735,74 @@ See also `auto-save-file-name-p'."
(file-error nil))
file-name)))
(defun auto-save--transform-file-name (filename transforms
prefix suffix)
"Transform FILENAME according to TRANSFORMS.
See `auto-save-file-name-transforms' for the format of
TRANSFORMS. PREFIX is prepended to the non-directory portion of
the resulting file name, and SUFFIX is appended."
(let (result uniq)
;; Apply user-specified translations
;; to the file name.
(while (and transforms (not result))
(if (string-match (car (car transforms)) filename)
(setq result (replace-match (cadr (car transforms)) t nil
filename)
uniq (car (cddr (car transforms)))))
(setq transforms (cdr transforms)))
(when result
(setq filename
(cond
((memq uniq (secure-hash-algorithms))
(concat
(file-name-directory result)
(secure-hash uniq filename)))
(uniq
(concat
(file-name-directory result)
(subst-char-in-string
?/ ?!
(replace-regexp-in-string
"!" "!!" filename))))
(t result))))
(setq result
(if (and (eq system-type 'ms-dos)
(not (msdos-long-file-names)))
;; We truncate the file name to DOS 8+3 limits
;; before doing anything else, because the regexp
;; passed to string-match below cannot handle
;; extensions longer than 3 characters, multiple
;; dots, and other atrocities.
(let ((fn (dos-8+3-filename
(file-name-nondirectory buffer-file-name))))
(string-match
"\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'"
fn)
(concat (file-name-directory buffer-file-name)
prefix (match-string 1 fn)
"." (match-string 3 fn) suffix))
(concat (file-name-directory filename)
prefix
(file-name-nondirectory filename)
suffix)))
;; Make sure auto-save file names don't contain characters
;; invalid for the underlying filesystem.
(expand-file-name
(if (and (memq system-type '(ms-dos windows-nt cygwin))
;; Don't modify remote filenames
(not (file-remote-p result)))
(convert-standard-filename result)
result))))
(defun make-lock-file-name (filename)
"Make a lock file name for FILENAME.
By default, this just prepends \".*\" to the non-directory part
of FILENAME, but the transforms in `lock-file-name-transforms'
are done first."
(save-match-data
(auto-save--transform-file-name
filename lock-file-name-transforms ".#" "")))
(defun auto-save-file-name-p (filename)
"Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
FILENAME should lack slashes.

72
src/filelock.c
View file

@ -51,7 +51,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifdef WINDOWSNT
#include <share.h>
#include <sys/socket.h> /* for fcntl */
#include "w32.h" /* for dostounix_filename */
#endif
#ifndef MSDOS
@ -294,25 +293,6 @@ typedef struct
char user[MAX_LFINFO + 1 + sizeof " (pid )" - sizeof "."];
} lock_info_type;
/* Write the name of the lock file for FNAME into LOCKNAME. Length
will be that of FNAME plus two more for the leading ".#", plus one
for the null. */
#define MAKE_LOCK_NAME(lockname, fname) \
(lockname = SAFE_ALLOCA (SBYTES (fname) + 2 + 1), \
fill_in_lock_file_name (lockname, fname))
static void
fill_in_lock_file_name (char *lockfile, Lisp_Object fn)
{
char *last_slash = memrchr (SSDATA (fn), '/', SBYTES (fn));
char *base = last_slash + 1;
ptrdiff_t dirlen = base - SSDATA (fn);
memcpy (lockfile, SSDATA (fn), dirlen);
lockfile[dirlen] = '.';
lockfile[dirlen + 1] = '#';
strcpy (lockfile + dirlen + 2, base);
}
/* For some reason Linux kernels return EPERM on file systems that do
not support hard or symbolic links. This symbol documents the quirk.
There is no way to tell whether a symlink call fails due to
@ -639,6 +619,12 @@ lock_if_free (lock_info_type *clasher, char *lfname)
return err;
}
static Lisp_Object
make_lock_file_name (Lisp_Object fn)
{
return call1 (intern ("make-lock-file-name"), Fexpand_file_name (fn, Qnil));
}
/* lock_file locks file FN,
meaning it serves notice on the world that you intend to edit that file.
This should be done only when about to modify a file-visiting
@ -660,10 +646,7 @@ lock_if_free (lock_info_type *clasher, char *lfname)
void
lock_file (Lisp_Object fn)
{
Lisp_Object orig_fn, encoded_fn;
char *lfname = NULL;
lock_info_type lock_info;
USE_SAFE_ALLOCA;
/* Don't do locking while dumping Emacs.
Uncompressing wtmp files uses call-process, which does not work
@ -671,8 +654,6 @@ lock_file (Lisp_Object fn)
if (will_dump_p ())
return;
/* If the file name has special constructs in it,
call the corresponding file name handler. */
Lisp_Object handler;
handler = Ffind_file_name_handler (fn, Qlock_file);
if (!NILP (handler))
@ -681,30 +662,20 @@ lock_file (Lisp_Object fn)
return;
}
orig_fn = fn;
fn = Fexpand_file_name (fn, Qnil);
#ifdef WINDOWSNT
/* Ensure we have only '/' separators, to avoid problems with
looking (inside fill_in_lock_file_name) for backslashes in file
names encoded by some DBCS codepage. */
dostounix_filename (SSDATA (fn));
#endif
encoded_fn = ENCODE_FILE (fn);
if (create_lockfiles)
/* Create the name of the lock-file for file fn */
MAKE_LOCK_NAME (lfname, encoded_fn);
Lisp_Object lock_filename = make_lock_file_name (fn);
char *lfname = SSDATA (ENCODE_FILE (lock_filename));
/* See if this file is visited and has changed on disk since it was
visited. */
Lisp_Object subject_buf = get_truename_buffer (orig_fn);
Lisp_Object subject_buf = get_truename_buffer (fn);
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (fn))
&& !(lfname && current_lock_owner (NULL, lfname) == -2))
&& !NILP (Ffile_exists_p (lock_filename))
&& !(create_lockfiles && current_lock_owner (NULL, lfname) == -2))
call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
/* Don't do locking if the user has opted out. */
if (lfname)
if (create_lockfiles)
{
/* Try to lock the lock. FIXME: This ignores errors when
lock_if_free returns a positive errno value. */
@ -725,7 +696,6 @@ lock_file (Lisp_Object fn)
if (!NILP (attack))
lock_file_1 (lfname, 1);
}
SAFE_FREE ();
}
}
@ -733,7 +703,6 @@ static Lisp_Object
unlock_file_body (Lisp_Object fn)
{
char *lfname;
USE_SAFE_ALLOCA;
/* If the file name has special constructs in it,
call the corresponding file name handler. */
@ -745,18 +714,15 @@ unlock_file_body (Lisp_Object fn)
return Qnil;
}
Lisp_Object filename = Fexpand_file_name (fn, Qnil);
fn = ENCODE_FILE (filename);
MAKE_LOCK_NAME (lfname, fn);
Lisp_Object lock_filename = make_lock_file_name (fn);
lfname = SSDATA (ENCODE_FILE (lock_filename));
int err = current_lock_owner (0, lfname);
if (err == -2 && unlink (lfname) != 0 && errno != ENOENT)
err = errno;
if (0 < err)
report_file_errno ("Unlocking file", filename, err);
report_file_errno ("Unlocking file", fn, err);
SAFE_FREE ();
return Qnil;
}
@ -880,10 +846,8 @@ t if it is locked by you, else a string saying which user has locked it. */)
return Qnil;
#else
Lisp_Object ret;
char *lfname;
int owner;
lock_info_type locker;
USE_SAFE_ALLOCA;
/* If the file name has special constructs in it,
call the corresponding file name handler. */
@ -894,9 +858,8 @@ t if it is locked by you, else a string saying which user has locked it. */)
return call2 (handler, Qfile_locked_p, filename);
}
filename = Fexpand_file_name (filename, Qnil);
Lisp_Object encoded_filename = ENCODE_FILE (filename);
MAKE_LOCK_NAME (lfname, encoded_filename);
Lisp_Object lock_filename = make_lock_file_name (filename);
char *lfname = SSDATA (ENCODE_FILE (lock_filename));
owner = current_lock_owner (&locker, lfname);
switch (owner)
@ -907,7 +870,6 @@ t if it is locked by you, else a string saying which user has locked it. */)
default: report_file_errno ("Testing file lock", filename, owner);
}
SAFE_FREE ();
return ret;
#endif
}

38
test/lisp/files-tests.el
View file

@ -949,6 +949,44 @@ unquoted file names."
(make-auto-save-file-name)
(kill-buffer)))))))
(ert-deftest files-test-auto-save-name-default ()
(with-temp-buffer
(let ((auto-save-file-name-transforms nil))
(setq buffer-file-name "/tmp/foo.txt")
(should (equal (make-auto-save-file-name) "/tmp/#foo.txt#")))))
(ert-deftest files-test-auto-save-name-transform ()
(with-temp-buffer
(setq buffer-file-name "/tmp/foo.txt")
(let ((auto-save-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil))))
(should (equal (make-auto-save-file-name) "/var/tmp/#foo.txt#")))))
(ert-deftest files-test-auto-save-name-unique ()
(with-temp-buffer
(setq buffer-file-name "/tmp/foo.txt")
(let ((auto-save-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
(should (equal (make-auto-save-file-name) "/var/tmp/#!tmp!foo.txt#")))
(let ((auto-save-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
(should (equal (make-auto-save-file-name)
"/var/tmp/#b57c5a04f429a83305859d3350ecdab8315a9037#")))))
(ert-deftest files-test-lock-name-default ()
(let ((lock-file-name-transforms nil))
(should (equal (make-lock-file-name "/tmp/foo.txt") "/tmp/.#foo.txt"))))
(ert-deftest files-test-lock-name-unique ()
(let ((lock-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
(should (equal (make-lock-file-name "/tmp/foo.txt")
"/var/tmp/.#!tmp!foo.txt")))
(let ((lock-file-name-transforms
'(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
(should (equal (make-lock-file-name "/tmp/foo.txt")
"/var/tmp/.#b57c5a04f429a83305859d3350ecdab8315a9037"))))
(ert-deftest files-tests-file-name-non-special-make-directory ()
(files-tests--with-temp-non-special (tmpdir nospecial-dir t)
(let ((default-directory nospecial-dir))