Implement EXCL of write-region for Tramp

* lisp/net/ange-ftp.el (ange-ftp-write-region):
* lisp/net/tramp-adb.el (tramp-adb-handle-write-region)
* lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region):
* lisp/net/tramp-sh.el (tramp-sh-handle-write-region)
* lisp/net/tramp-smb.el (tramp-smb-handle-write-region):
Implement MUSTBENEW.

* lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file)
* lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link)
(tramp-sh-handle-add-name-to-file)
(tramp-do-copy-or-rename-file)
* lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link):
Adapt error message for `file-already-exists'.

* src/lisp.h:
* src/eval.c (call8): New function.

* src/fileio.c (write_region): Pass also lockname and
mustbenew to the file name handler.

* test/lisp/net/tramp-tests.el (tramp-test10-write-region):
Add tests for MUSTBENEW.

5 files changed, 47 insertions, 54 deletions

diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index ecb60e5a4f4..ebc14693f65 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -3223,8 +3223,12 @@ system TYPE.")
 (defun ange-ftp-binary-file (file)
   (string-match-p ange-ftp-binary-file-name-regexp file))
 
-(defun ange-ftp-write-region (start end filename &optional append visit)
+(defun ange-ftp-write-region
+    (start end filename &optional append visit _lockname mustbenew)
   (setq filename (expand-file-name filename))
+  (when mustbenew
+    (ange-ftp-barf-or-query-if-file-exists
+     filename "overwrite" (not (eq mustbenew 'excl))))
   (let ((parsed (ange-ftp-ftp-name filename)))
     (if parsed
         (let* ((host (nth 0 parsed))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 346979000f5..6e662df6e29 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -630,14 +630,17 @@ But handle the case, if the \"test\" command is not available."
                        rw-path)))))))
 
 (defun tramp-adb-handle-write-region
-  (start end filename &optional append visit lockname confirm)
+  (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
   (setq filename (expand-file-name filename))
   (with-parsed-tramp-file-name filename nil
-    (when (and confirm (file-exists-p filename))
-      (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
-                                filename))
-        (tramp-error v 'file-error "File not overwritten")))
+    (when (and mustbenew (file-exists-p filename)
+               (or (eq mustbenew 'excl)
+                   (not
+                    (y-or-n-p
+                     (format "File %s exists; overwrite anyway? " filename)))))
+      (tramp-error v 'file-already-exists filename))
+
     ;; We must also flush the cache of the directory, because
     ;; `file-attributes' reads the values from there.
     (tramp-flush-file-property v (file-name-directory localname))
@@ -650,8 +653,7 @@ But handle the case, if the \"test\" command is not available."
          tmpfile
          (logior (or (file-modes tmpfile) 0) (string-to-number "0600" 8))))
       (tramp-run-real-handler
-       'write-region
-       (list start end tmpfile append 'no-message lockname confirm))
+       'write-region (list start end tmpfile append 'no-message lockname))
       (with-tramp-progress-reporter
         v 3 (format-message
              "Moving tmp file `%s' to `%s'" tmpfile filename)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 4c750df3c40..48f50a3d05a 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -658,8 +658,7 @@ file names."
 
       (with-parsed-tramp-file-name (if t1 filename newname) nil
         (when (and (not ok-if-already-exists) (file-exists-p newname))
-          (tramp-error
-           v 'file-already-exists "File %s already exists" newname))
+          (tramp-error v 'file-already-exists newname))
 
         (if (or (and equal-remote
                      (tramp-get-connection-property v "direct-copy-failed" nil))
@@ -1172,12 +1171,16 @@ file-notify events."
      'rename-file (list filename newname ok-if-already-exists))))
 
 (defun tramp-gvfs-handle-write-region
-  (start end filename &optional append visit lockname confirm)
+  (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
+  (setq filename (expand-file-name filename))
   (with-parsed-tramp-file-name filename nil
-    (when (and confirm (file-exists-p filename))
-      (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
-        (tramp-error v 'file-error "File not overwritten")))
+    (when (and mustbenew (file-exists-p filename)
+               (or (eq mustbenew 'excl)
+                   (not
+                    (y-or-n-p
+                     (format "File %s exists; overwrite anyway? " filename)))))
+      (tramp-error v 'file-already-exists filename))
 
     (let ((tmpfile (tramp-compat-make-temp-file filename)))
       (when (and append (file-exists-p filename))
@@ -1186,10 +1189,7 @@ file-notify events."
       ;; modtime data to be clobbered from the temp file.  We call
       ;; `set-visited-file-modtime' ourselves later on.
       (tramp-run-real-handler
-       'write-region
-       (if confirm ; don't pass this arg unless defined for backward compat.
-           (list start end tmpfile append 'no-message lockname confirm)
-         (list start end tmpfile append 'no-message lockname)))
+       'write-region (list start end tmpfile append 'no-message lockname))
       (condition-case nil
           (rename-file tmpfile filename 'ok-if-already-exists)
         (error
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 4beb6fe5216..6b365c10e25 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1085,8 +1085,7 @@ target of the symlink differ."
                            (format
                             "File %s already exists; make it a link anyway? "
                             l-localname)))))
-            (tramp-error
-             l 'file-already-exists "File %s already exists" l-localname)
+            (tramp-error l 'file-already-exists l-localname)
           (delete-file linkname)))
 
       ;; If FILENAME is a Tramp name, use just the localname component.
@@ -1925,9 +1924,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
                     (format
                      "File %s already exists; make it a new name anyway? "
                      newname)))
-          (tramp-error
-           v2 'file-already-exists
-           "add-name-to-file: file %s already exists" newname))
+          (tramp-error v2 'file-already-exists newname))
         (when ok-if-already-exists (setq ln (concat ln " -f")))
         (tramp-flush-file-property v2 (file-name-directory v2-localname))
         (tramp-flush-file-property v2 v2-localname)
@@ -2041,8 +2038,7 @@ file names."
 
     (with-parsed-tramp-file-name (if t1 filename newname) nil
       (when (and (not ok-if-already-exists) (file-exists-p newname))
-        (tramp-error
-         v 'file-already-exists "File %s already exists" newname))
+        (tramp-error v 'file-already-exists newname))
 
       (with-tramp-progress-reporter
           v 0 (format "%s %s to %s"
@@ -3150,23 +3146,16 @@ the result will be a local, non-Tramp, file name."
 
 ;; CCC grok LOCKNAME
 (defun tramp-sh-handle-write-region
-  (start end filename &optional append visit lockname confirm)
+  (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
   (setq filename (expand-file-name filename))
   (with-parsed-tramp-file-name filename nil
-    ;; Following part commented out because we don't know what to do about
-    ;; file locking, and it does not appear to be a problem to ignore it.
-    ;; Ange-ftp ignores it, too.
-    ;;  (when (and lockname (stringp lockname))
-    ;;    (setq lockname (expand-file-name lockname)))
-    ;;  (unless (or (eq lockname nil)
-    ;;              (string= lockname filename))
-    ;;    (error
-    ;;     "tramp-sh-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
-
-    (when (and confirm (file-exists-p filename))
-      (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
-        (tramp-error v 'file-error "File not overwritten")))
+    (when (and mustbenew (file-exists-p filename)
+               (or (eq mustbenew 'excl)
+                   (not
+                    (y-or-n-p
+                     (format "File %s exists; overwrite anyway? " filename)))))
+      (tramp-error v 'file-already-exists filename))
 
     (let ((uid (or (tramp-compat-file-attribute-user-id
                     (file-attributes filename 'integer))
@@ -3185,8 +3174,7 @@ the result will be a local, non-Tramp, file name."
                       (file-writable-p localname)))))
           ;; Short track: if we are on the local host, we can run directly.
           (tramp-run-real-handler
-           'write-region
-           (list start end localname append 'no-message lockname confirm))
+           'write-region (list start end localname append 'no-message lockname))
 
         (let* ((modes (save-excursion (tramp-default-file-modes filename)))
                ;; We use this to save the value of
@@ -3223,7 +3211,7 @@ the result will be a local, non-Tramp, file name."
             (condition-case err
                 (tramp-run-real-handler
                  'write-region
-                 (list start end tmpfile append 'no-message lockname confirm))
+                 (list start end tmpfile append 'no-message lockname))
               ((error quit)
                (setq tramp-temp-buffer-file-name nil)
                (delete-file tmpfile)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 1aadd14fb41..367beb823aa 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -137,6 +137,7 @@ call, letting the SMB client use the default one."
          "NT_STATUS_HOST_UNREACHABLE"
          "NT_STATUS_IMAGE_ALREADY_LOADED"
          "NT_STATUS_INVALID_LEVEL"
+         "NT_STATUS_INVALID_PARAMETER_MIX"
          "NT_STATUS_IO_TIMEOUT"
          "NT_STATUS_LOGON_FAILURE"
          "NT_STATUS_NETWORK_ACCESS_DENIED"
@@ -1124,9 +1125,7 @@ target of the symlink differ."
                   (format
                    "File %s already exists; make it a new name anyway? "
                    linkname)))
-        (tramp-error
-         v2 'file-already-exists
-         "make-symbolic-link: file %s already exists" linkname))
+        (tramp-error v2 'file-already-exists linkname))
       (unless (tramp-smb-get-cifs-capabilities v1)
         (tramp-error v2 'file-error "make-symbolic-link not supported"))
       ;; We must also flush the cache of the directory, because
@@ -1469,14 +1468,17 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
       (error filename))))
 
 (defun tramp-smb-handle-write-region
-  (start end filename &optional append visit lockname confirm)
+  (start end filename &optional append visit lockname mustbenew)
   "Like `write-region' for Tramp files."
   (setq filename (expand-file-name filename))
   (with-parsed-tramp-file-name filename nil
-    (when (and confirm (file-exists-p filename))
-      (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
-                                filename))
-        (tramp-error v 'file-error "File not overwritten")))
+    (when (and mustbenew (file-exists-p filename)
+               (or (eq mustbenew 'excl)
+                   (not
+                    (y-or-n-p
+                     (format "File %s exists; overwrite anyway? " filename)))))
+      (tramp-error v 'file-already-exists filename))
+
     ;; We must also flush the cache of the directory, because
     ;; `file-attributes' reads the values from there.
     (tramp-flush-file-property v (file-name-directory localname))
@@ -1489,10 +1491,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
       ;; modtime data to be clobbered from the temp file.  We call
       ;; `set-visited-file-modtime' ourselves later on.
       (tramp-run-real-handler
-       'write-region
-       (if confirm ; don't pass this arg unless defined for backward compat.
-           (list start end tmpfile append 'no-message lockname confirm)
-         (list start end tmpfile append 'no-message lockname)))
+       'write-region (list start end tmpfile append 'no-message lockname))
 
       (with-tramp-progress-reporter
           v 3 (format "Moving tmp file %s to %s" tmpfile filename)