emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/crux 7365fdc 075/112: Add crux-copy-file-preserve-attribut


From: ELPA Syncer
Subject: [nongnu] elpa/crux 7365fdc 075/112: Add crux-copy-file-preserve-attribute
Date: Wed, 11 Aug 2021 09:57:57 -0400 (EDT)

branch: elpa/crux
commit 7365fdcfcd903e61faf3799fc4f851e736ae421c
Author: Jimmy Yuen Ho Wong <wyuenho@gmail.com>
Commit: Bozhidar Batsov <bozhidar.batsov@gmail.com>

    Add crux-copy-file-preserve-attribute
---
 README.md |  1 +
 crux.el   | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 49 insertions(+)

diff --git a/README.md b/README.md
index 8be24f2..bdb4bd7 100644
--- a/README.md
+++ b/README.md
@@ -52,6 +52,7 @@ Command                                             | 
Suggested Keybinding(s)
 `crux-eval-and-replace`                             | <kbd>C-c e</kbd> | Eval 
a bit of Emacs Lisp code and replace it with its result.
 `crux-transpose-windows`                            | <kbd>C-x 4 t</kbd> | 
Transpose the buffers between two windows.
 `crux-delete-file-and-buffer`                       | <kbd>C-c D</kbd> | 
Delete current file and buffer.
+`crux-copy-file-preserve-attributes`                | <kbd>C-c c</kbd> | Copy 
current file with file attributes preserved
 `crux-duplicate-current-line-or-region`             | <kbd>C-c d</kbd> | 
Duplicate the current line (or region).
 `crux-duplicate-and-comment-current-line-or-region` | <kbd>C-c M-d</kbd> | 
Duplicate and comment the current line (or region).
 `crux-rename-file-and-buffer`                       | <kbd>C-c r</kbd> | 
Rename the current buffer and its visiting file if any.
diff --git a/crux.el b/crux.el
index 53e644a..deeabea 100644
--- a/crux.el
+++ b/crux.el
@@ -360,6 +360,54 @@ there's a region, all lines that region covers will be 
duplicated."
 (defalias 'crux-delete-buffer-and-file #'crux-delete-file-and-buffer)
 
 ;;;###autoload
+(defun crux-copy-file-preserve-attributes (visit)
+    "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
+directory does not exist, this function confirms with the user
+whether it should be created. A directory must end in a slash
+like `copy-file' expects. If the destination is a directory and
+already has a file named as the origin file, offers to
+overwrite.
+
+If the current buffer is not a file-visiting file or the
+destination is a non-existent directory but the user has elected
+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))))))))))
+
+;;;###autoload
 (defun crux-view-url ()
   "Open a new buffer containing the contents of URL."
   (interactive)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]