[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 2ad34bc: Add new user option lock-file-name-transforms
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 2ad34bc: Add new user option lock-file-name-transforms |
|
Date: |
Wed, 7 Jul 2021 15:39:26 -0400 (EDT) |
branch: master
commit 2ad34bcea4ed686e56078e91d63417480e5642b4
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Add new user option lock-file-name-transforms
* 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.
---
doc/emacs/files.texi | 4 +-
doc/lispref/files.texi | 14 +++++
doc/misc/efaq.texi | 34 ++++++++++++
etc/NEWS | 5 ++
lisp/files.el | 141 +++++++++++++++++++++++++++++------------------
src/filelock.c | 72 ++++++------------------
test/lisp/files-tests.el | 38 +++++++++++++
7 files changed, 197 insertions(+), 111 deletions(-)
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 912980b..98b6b19 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -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
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index ae763a2..fe3affe 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -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
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 53a3af4..d66c12f 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -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
diff --git a/etc/NEWS b/etc/NEWS
index 0e8a846..b9522c0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2170,6 +2170,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
kill ring.
diff --git a/lisp/files.el b/lisp/files.el
index 859c193..c137732 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -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.
diff --git a/src/filelock.c b/src/filelock.c
index dcdc635..99803cc 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -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
}
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 257cbc2..a6b0c90 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -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))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 2ad34bc: Add new user option lock-file-name-transforms,
Lars Ingebrigtsen <=