[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 71916f0: Make the `C' command work on marked files
From: |
Lars Ingebrigtsen |
Subject: |
master 71916f0: Make the `C' command work on marked files |
Date: |
Tue, 24 Nov 2020 02:44:38 -0500 (EST) |
branch: master
commit 71916f0758297d616fcb9c12db1c4f19c0e85458
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Make the `C' command work on marked files
* lisp/arc-mode.el (archive-copy-file): Make the `C' command work
on marked files (bug#44753).
---
lisp/arc-mode.el | 56 ++++++++++++++++++++++++++++++++++++--------------------
1 file changed, 36 insertions(+), 20 deletions(-)
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index ce0c061..69a159a 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1058,27 +1058,43 @@ return nil. Otherwise point is returned."
(archive-goto-file short))
next))
-(defun archive-copy-file (file new-name)
- "Copy FILE to a location specified by NEW-NAME.
-Interactively, FILE is the file at point, and the function prompts
-for NEW-NAME."
+(defun archive-copy-file (files new-name)
+ "Copy FILES to a location specified by NEW-NAME.
+FILES can be a single file or a list of files.
+
+Interactively, FILES is the list of marked files, or the file at
+point if nothing is marked, and the function prompts for
+NEW-NAME."
(interactive
- (let ((name (archive--file-desc-ext-file-name (archive-get-descr))))
- (list name
- (read-file-name (format "Copy %s to: " name)))))
- (when (file-directory-p new-name)
- (setq new-name (expand-file-name file new-name)))
- (when (and (file-exists-p new-name)
- (not (yes-or-no-p (format "%s already exists; overwrite? "
- new-name))))
- (user-error "Not overwriting %s" new-name))
- (let* ((descr (archive-get-descr))
- (archive (buffer-file-name))
- (extractor (archive-name "extract"))
- (ename (archive--file-desc-ext-file-name descr)))
- (with-temp-buffer
- (archive--extract-file extractor archive ename)
- (write-region (point-min) (point-max) new-name))))
+ (let ((names
+ (mapcar
+ #'archive--file-desc-ext-file-name
+ (or (archive-get-marked ?*) (list (archive-get-descr))))))
+ (list names
+ (read-file-name (format "Copy %s to: " (string-join names ", "))))))
+ (unless (consp files)
+ (setq files (list files)))
+ (when (and (> (length files) 1)
+ (not (file-directory-p new-name)))
+ (user-error "Can't copy a list of files to a single file"))
+ (save-excursion
+ (dolist (file files)
+ (let ((write-to (if (file-directory-p new-name)
+ (expand-file-name file new-name)
+ new-name)))
+ (when (and (file-exists-p write-to)
+ (not (yes-or-no-p (format "%s already exists; overwrite? "
+ write-to))))
+ (user-error "Not overwriting %s" write-to))
+ (archive-goto-file file)
+ (let* ((descr (archive-get-descr))
+ (archive (buffer-file-name))
+ (extractor (archive-name "extract"))
+ (ename (archive--file-desc-ext-file-name descr)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (archive--extract-file extractor archive ename)
+ (write-region (point-min) (point-max) write-to)))))))
(defun archive-extract (&optional other-window-p event)
"In archive mode, extract this entry of the archive into its own buffer."
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 71916f0: Make the `C' command work on marked files,
Lars Ingebrigtsen <=