diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 912980b688..98b6b194d2 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -789,7 +789,9 @@ Interlocking @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 5238597a46..d73c502924 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -772,6 +772,20 @@ File Locks 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 53a3af4b78..caf5438edb 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -407,9 +407,9 @@ Mailing list archives @cindex Old mailing list posts for GNU lists @cindex Mailing list archives for GNU lists -The FSF has maintained archives of all of the GNU mailing lists for many -years, although there may be some unintentional gaps in coverage. The -archive can be browsed over the web at +The FSF has maintained archives of all of the GNU mailing lists for +many years, although there may be some unintentional gaps in coverage. +The archive can be browsed over the web at @uref{https://lists.gnu.org/r/, the GNU mail archive}. Some web-based Usenet search services also archive the @code{gnu.*} @@ -1519,6 +1519,7 @@ Common requests * 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 @@ Disabling auto-save-mode 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 7bf8c1d8f5..e398e3c789 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2165,6 +2165,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 diff --git a/lisp/files.el b/lisp/files.el index 859c193db9..205b429f9d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -412,6 +412,21 @@ auto-save-file-name-transforms :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 @@ make-auto-save-file-name '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,72 @@ make-auto-save-file-name (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." + (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 446a262a1c..cda7e2f8f6 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -51,7 +51,6 @@ Copyright (C) 1985-1987, 1993-1994, 1996, 1998-2021 Free Software #ifdef WINDOWSNT #include #include /* for fcntl */ -#include "w32.h" /* for dostounix_filename */ #endif #ifndef MSDOS @@ -294,25 +293,6 @@ get_boot_time_1 (const char *filename, bool newest) 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,13 @@ lock_if_free (lock_info_type *clasher, char *lfname) return err; } +static Lisp_Object +make_lock_file_name (Lisp_Object fn) +{ + return ENCODE_FILE (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 +647,9 @@ lock_if_free (lock_info_type *clasher, char *lfname) void lock_file (Lisp_Object fn) { - Lisp_Object orig_fn, encoded_fn; + Lisp_Object lock_filename; 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,30 +657,19 @@ lock_file (Lisp_Object fn) if (will_dump_p ()) 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); - + lock_filename = make_lock_file_name (fn); + lfname = SSDATA (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. */ @@ -715,7 +690,6 @@ lock_file (Lisp_Object fn) if (!NILP (attack)) lock_file_1 (lfname, 1); } - SAFE_FREE (); } } @@ -723,12 +697,9 @@ lock_file (Lisp_Object fn) unlock_file_body (Lisp_Object fn) { char *lfname; - USE_SAFE_ALLOCA; - - Lisp_Object filename = Fexpand_file_name (fn, Qnil); - fn = ENCODE_FILE (filename); - MAKE_LOCK_NAME (lfname, fn); + Lisp_Object filename = make_lock_file_name (fn); + lfname = SSDATA (filename); int err = current_lock_owner (0, lfname); if (err == -2 && unlink (lfname) != 0 && errno != ENOENT) @@ -736,7 +707,6 @@ unlock_file_body (Lisp_Object fn) if (0 < err) report_file_errno ("Unlocking file", filename, err); - SAFE_FREE (); return Qnil; } @@ -842,11 +812,9 @@ DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0, char *lfname; int owner; lock_info_type locker; - USE_SAFE_ALLOCA; - filename = Fexpand_file_name (filename, Qnil); - Lisp_Object encoded_filename = ENCODE_FILE (filename); - MAKE_LOCK_NAME (lfname, encoded_filename); + Lisp_Object lockname = make_lock_file_name (filename); + lfname = SSDATA (lockname); owner = current_lock_owner (&locker, lfname); switch (owner) @@ -857,7 +825,6 @@ DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0, 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 257cbc2d32..a6b0c900be 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -949,6 +949,44 @@ files-tests-file-name-non-special-make-auto-save-file-name (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))