master 6d580b0: Some further adaptions wrt Tramp file name locks

[Michael Albinus]

branch: master
commit 6d580b00e48e567ac92645e2d120769475d196ad
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Some further adaptions wrt Tramp file name locks
    
    * lisp/files.el (files--transform-file-name): Rename from
    `auto-save--transform-file-name'.  Wrap with `save-match-data'.
    (make-auto-save-file-name): Use it.
    (make-lock-file-name): Use it.  Call file name handler.
    
    * lisp/net/tramp.el (tramp-handle-write-region):
    * lisp/net/tramp-adb.el (tramp-adb-handle-write-region):
    * lisp/net/tramp-sh.el (tramp-sh-handle-write-region):
    * lisp/net/tramp-smb.el (tramp-smb-handle-write-region):
    Suppress file lock for temporary file.
    
    * lisp/net/tramp-compat.el (tramp-compat-make-lock-file-name):
    New defalias.
    
    * lisp/net/tramp.el (tramp-get-lock-file)
    (tramp-handle-lock-file, tramp-handle-unlock-file): Use it.
    (tramp-make-lock-name): Remove.
    
    * test/lisp/filenotify-tests.el (file-notify-test03-events-remote):
    Tag it :unstable temporarily.
---
 lisp/files.el                 | 122 +++++++++++++++++++++---------------------
 lisp/net/tramp-adb.el         |   3 +-
 lisp/net/tramp-compat.el      |  10 ++++
 lisp/net/tramp-sh.el          |   7 ++-
 lisp/net/tramp-smb.el         |   3 +-
 lisp/net/tramp.el             |  15 +++---
 test/lisp/filenotify-tests.el |   2 +-
 7 files changed, 87 insertions(+), 75 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index c137732..da8598f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6679,12 +6679,12 @@ Does not consider `auto-save-visited-file-name' as that 
variable is checked
 before calling this function.
 See also `auto-save-file-name-p'."
   (if buffer-file-name
-      (let ((handler (find-file-name-handler buffer-file-name
-                                            'make-auto-save-file-name)))
+      (let ((handler (find-file-name-handler
+                      buffer-file-name 'make-auto-save-file-name)))
        (if handler
            (funcall handler 'make-auto-save-file-name)
-          (auto-save--transform-file-name buffer-file-name
-                                          auto-save-file-name-transforms
+          (files--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.)
@@ -6735,73 +6735,73 @@ See also `auto-save-file-name-p'."
        (file-error nil))
       file-name)))
 
-(defun auto-save--transform-file-name (filename transforms
-                                                prefix suffix)
+(defun files--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))))
+  (save-match-data
+    (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 ".#" "")))
+  (let ((handler (find-file-name-handler filename 'make-lock-file-name)))
+    (if handler
+       (funcall handler 'make-lock-file-name filename)
+      (files--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'.
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 9c1c8ac..2bd1367 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -564,7 +564,8 @@ But handle the case, if the \"test\" command is not 
available."
       (when (and append (file-exists-p filename))
        (copy-file filename tmpfile 'ok)
        (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
-      (write-region start end tmpfile append 'no-message)
+      (let (create-lockfiles)
+        (write-region start end tmpfile append 'no-message))
       (with-tramp-progress-reporter
          v 3 (format-message
               "Moving tmp file `%s' to `%s'" tmpfile filename)
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 54cfb6f..9d5e5f7 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -353,6 +353,16 @@ A nil value for either argument stands for the current 
time."
     (lambda (fromstring tostring instring)
       (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
 
+;; Function `make-lock-file-name' is new in Emacs 28.1.
+(defalias 'tramp-compat-make-lock-file-name
+  (if (fboundp 'make-lock-file-name)
+      #'make-lock-file-name
+    (lambda (filename)
+      (expand-file-name
+       (concat
+        ".#" (file-name-nondirectory filename))
+       (file-name-directory filename)))))
+
 (dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
   (put (intern elt) 'tramp-suppress-trace t))
 
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 1103722..c65800b 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3274,7 +3274,9 @@ implementation will be used."
                  (or (file-directory-p localname)
                      (file-writable-p localname)))))
          ;; Short track: if we are on the local host, we can run directly.
-         (write-region start end localname append 'no-message)
+         (write-region
+           start end localname append 'no-message
+           (and lockname (file-local-name lockname)))
 
        (let* ((modes (tramp-default-file-modes
                       filename (and (eq mustbenew 'excl) 'nofollow)))
@@ -3308,7 +3310,8 @@ implementation will be used."
          ;; on.  We must ensure that `file-coding-system-alist'
          ;; matches `tmpfile'.
          (let ((file-coding-system-alist
-                (tramp-find-file-name-coding-system-alist filename tmpfile)))
+                (tramp-find-file-name-coding-system-alist filename tmpfile))
+                create-lockfiles)
            (condition-case err
                (write-region start end tmpfile append 'no-message)
              ((error quit)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 500245b..01192db 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1606,7 +1606,8 @@ errors for shares like \"C$/\", which are common in 
Microsoft Windows."
       ;; We say `no-message' here because we don't want the visited file
       ;; modtime data to be clobbered from the temp file.  We call
       ;; `set-visited-file-modtime' ourselves later on.
-      (write-region start end tmpfile append 'no-message)
+      (let (create-lockfiles)
+        (write-region start end tmpfile append 'no-message))
 
       (with-tramp-progress-reporter
          v 3 (format "Moving tmp file %s to %s" tmpfile filename)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 37d60e8..e9e0826 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3818,15 +3818,10 @@ User is always nil."
       ;; Result.
       (cons (expand-file-name filename) (cdr result)))))
 
-(defun tramp-make-lock-name (file)
-  "Implement MAKE_LOCK_NAME of filelock.c."
-  (expand-file-name
-   (concat ".#" (file-name-nondirectory file)) (file-name-directory file)))
-
 (defun tramp-get-lock-file (file)
   "Read lockfile of FILE.
 Return nil when there is no lockfile"
-  (let ((lockname (tramp-make-lock-name file)))
+  (let ((lockname (tramp-compat-make-lock-file-name file)))
     (or (file-symlink-p lockname)
        (and (file-readable-p lockname)
             (with-temp-buffer
@@ -3873,7 +3868,7 @@ Return nil when there is no lockfile"
                       (match-string 2 contents) (match-string 3 contents)))
          (throw 'dont-lock nil)))
 
-      (let ((lockname (tramp-make-lock-name file))
+      (let ((lockname (tramp-compat-make-lock-file-name file))
            ;; USER@HOST.PID[:BOOT_TIME]
            (contents
             (format
@@ -3886,7 +3881,8 @@ Return nil when there is no lockfile"
 
 (defun tramp-handle-unlock-file (file)
   "Like `unlock-file' for Tramp files."
-  (delete-file (tramp-make-lock-name file)))
+  (ignore-errors
+    (delete-file (tramp-compat-make-lock-file-name file))))
 
 (defun tramp-handle-load (file &optional noerror nomessage nosuffix 
must-suffix)
   "Like `load' for Tramp files."
@@ -4470,7 +4466,8 @@ of."
       ;; We say `no-message' here because we don't want the visited file
       ;; modtime data to be clobbered from the temp file.  We call
       ;; `set-visited-file-modtime' ourselves later on.
-      (write-region start end tmpfile append 'no-message)
+      (let (create-lockfiles)
+        (write-region start end tmpfile append 'no-message))
       (condition-case nil
          (rename-file tmpfile filename 'ok-if-already-exists)
        (error
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index e0fa66a..6125069 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -927,7 +927,7 @@ delivered."
     (file-notify--test-cleanup)))
 
 (file-notify--deftest-remote file-notify-test03-events
-  "Check file creation/change/removal notifications for remote files.")
+  "Check file creation/change/removal notifications for remote files." t)
 
 (require 'autorevert)
 (setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded"