[nongnu] elpa/crux df476a778e 1/6: More robust crux-copy-file-preserve-attributes

[ELPA Syncer]

branch: elpa/crux
commit df476a778e53f76cc7c4ae05618c8b7c2c0a3e01
Author: Frédéric Giquel <frederic.giquel@laposte.net>
Commit: Bozhidar Batsov <bozhidar@batsov.dev>

    More robust crux-copy-file-preserve-attributes
---
 CHANGELOG.md |  1 +
 crux.el      | 56 ++++++++++++++++++++++++++------------------------------
 2 files changed, 27 insertions(+), 30 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 4cd9771f18..db6fbaa8f9 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -9,6 +9,7 @@
 
 * More robust `crux-rename-file-and-buffer`.
 * Fix `sudo` not found error in OpenBSD and Alpine Linux (they use `doas`).
+* More robust `crux-copy-file-preserve-attributes`.
 
 ## 0.4.0 (2021-08-10)
 
diff --git a/crux.el b/crux.el
index d501e4d5a1..4fdb400471 100644
--- a/crux.el
+++ b/crux.el
@@ -452,7 +452,7 @@ there's a region, all lines that region covers will be 
duplicated."
 
 ;;;###autoload
 (defun crux-copy-file-preserve-attributes (visit)
-    "Copy the current file-visiting buffer's file to a destination.
+  "Copy the current file-visiting buffer's file to a destination.
 
 This function prompts for the new file's location and copies it
 similar to cp -p. If the new location is a directory, and the
@@ -468,35 +468,31 @@ to not created it, nothing will be done.
 
 When invoke with C-u, the newly created file will be visited.
 "
-    (interactive "p")
-    (let ((current-file (buffer-file-name)))
-      (when current-file
-        (let* ((new-file (read-file-name "Copy file to: "))
-               (abs-path (expand-file-name new-file))
-               (create-dir-prompt "%s is a non-existent directory, create it? 
")
-               (is-dir? (string-match "/" abs-path (1- (length abs-path))))
-               (dir-missing? (and is-dir? (not (file-exists-p abs-path))))
-               (create-dir? (and is-dir?
-                                 dir-missing?
-                                 (y-or-n-p
-                                  (format create-dir-prompt new-file))))
-               (destination (concat (file-name-directory abs-path)
-                                    (file-name-nondirectory current-file))))
-          (unless (and is-dir? dir-missing? (not create-dir?))
-            (when (and is-dir? dir-missing? create-dir?)
-              (make-directory abs-path))
-            (condition-case nil
-                (progn
-                  (copy-file current-file abs-path nil t t t)
-                  (message "Wrote %s" destination)
-                  (when visit
-                    (find-file-other-window destination)))
-              (file-already-exists
-               (when (y-or-n-p (format "%s already exists, overwrite? " 
destination))
-                 (copy-file current-file abs-path t t t t)
-                 (message "Wrote %s" destination)
-                 (when visit
-                   (find-file-other-window destination))))))))))
+  (interactive "P")
+  (when-let ((current-file (buffer-file-name)))
+    (let* ((input-dest (expand-file-name (read-file-name "Copy file to: ")))
+           (input-dest-is-dir? (or (file-directory-p input-dest)
+                                   (string-match "/" input-dest (1- (length 
input-dest)))))
+           (dest-file (if input-dest-is-dir?
+                          (expand-file-name (file-name-nondirectory 
current-file) input-dest)
+                        input-dest))
+           (dest-dir (file-name-directory dest-file))
+           (dest-dir-missing? (not (file-directory-p dest-dir)))
+           (create-dir? (and dest-dir-missing?
+                             (y-or-n-p
+                              (format "%s is a non-existent directory, create 
it? " dest-dir))))
+           (dest-file-exists? (file-regular-p dest-file))
+           (overwrite-dest-file? (and dest-file-exists?
+                                      (y-or-n-p
+                                       (format "%s already exists, overwrite? 
" dest-file)))))
+      (unless (or (and dest-dir-missing? (not create-dir?))
+                  (and dest-file-exists? (not overwrite-dest-file?)))
+        (when (and dest-dir-missing? create-dir?)
+          (make-directory dest-dir))
+        (copy-file current-file dest-file overwrite-dest-file? t t t)
+        (message "Wrote %s" dest-file)
+        (when visit
+          (find-file-other-window dest-file))))))
 
 ;;;###autoload
 (defun crux-view-url ()