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

@@ -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

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

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

etc/NEWS

@@ -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

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)
+          (auto-save--transform-file-name buffer-file-name
-		(filename buffer-file-name)
+                                          auto-save-file-name-transforms
-		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))))
-
     ;; 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.

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;
+  Lisp_Object lock_filename = make_lock_file_name (fn);
-  fn = Fexpand_file_name (fn, Qnil);
+  char *lfname = SSDATA (ENCODE_FILE (lock_filename));
-#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);
 
   /* 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))
+      && !NILP (Ffile_exists_p (lock_filename))
-      && !(lfname && current_lock_owner (NULL, lfname) == -2))
+      && !(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);
+  Lisp_Object lock_filename = make_lock_file_name (fn);
-  fn = ENCODE_FILE (filename);
+  lfname = SSDATA (ENCODE_FILE (lock_filename));
-
-  MAKE_LOCK_NAME (lfname, fn);
 
   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 lock_filename = make_lock_file_name (filename);
-  Lisp_Object encoded_filename = ENCODE_FILE (filename);
+  char *lfname = SSDATA (ENCODE_FILE (lock_filename));
-  MAKE_LOCK_NAME (lfname, encoded_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
 }

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))