From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Fri, 7 Aug 2020 09:59:25 +0000 (+0200)
Subject: Add a new command to copy a file from zip files
X-Git-Tag: emacs-28.0.90~6772
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9c34b50fa17565311d1868de6a6557d128ed9206;p=emacs.git

Add a new command to copy a file from zip files

* lisp/arc-mode.el (archive-copy-file): New command, keystroke and
menu bar entry (bug#26192).
(archive-extract): Refactored out code from here...
(archive--extract-file): ... to here for use in archive-copy-file.
---

diff --git a/etc/NEWS b/etc/NEWS
index 64b77feb119..002a078f840 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -175,6 +175,11 @@ and variables.
 'archive-hideshow-column'.  These let you control which columns are
 displayed and which are kept hidden.
 
+---
+*** New command bound to 'C': 'archive-copy-file'
+This command extracts the file under point and writes the data to a
+file.
+
 ** Emacs Lisp mode
 
 *** The mode-line now indicates whether we're using lexical or dynamic scoping.
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 901f09302ef..97213ab9e12 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -391,6 +391,7 @@ file.  Archive and member name will be added."
     (define-key map "e" 'archive-extract)
     (define-key map "f" 'archive-extract)
     (define-key map "\C-m" 'archive-extract)
+    (define-key map "C" 'archive-copy-file)
     (define-key map "m" 'archive-mark)
     (define-key map "n" 'archive-next-line)
     (define-key map "\C-n" 'archive-next-line)
@@ -430,6 +431,9 @@ file.  Archive and member name will be added."
     (define-key map [menu-bar immediate view]
       '(menu-item "View This File" archive-view
                   :help "Display file at cursor in View Mode"))
+    (define-key map [menu-bar immediate view]
+      '(menu-item "Copy This File" archive-copy-file
+                  :help "Copy file at cursor to another location"))
     (define-key map [menu-bar immediate display]
       '(menu-item "Display in Other Window" archive-display-other-window
                   :help "Display file at cursor in another window"))
@@ -1036,6 +1040,26 @@ return nil.  Otherwise point is returned."
       (archive-goto-file short))
     next))
 
+(defun archive-copy-file (file new-name)
+  "Copy file under point to a different location."
+  (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))))
+
 (defun archive-extract (&optional other-window-p event)
   "In archive mode, extract this entry of the archive into its own buffer."
   (interactive (list nil last-input-event))
@@ -1077,26 +1101,7 @@ return nil.  Otherwise point is returned."
           (setq archive-subfile-mode descr)
 	  (setq archive-file-name-coding-system file-name-coding)
 	  (if (and
-	       (null
-		(let (;; We may have to encode the file name argument for
-		      ;; external programs.
-		      (coding-system-for-write
-		       (and enable-multibyte-characters
-			    archive-file-name-coding-system))
-		      ;; We read an archive member by no-conversion at
-		      ;; first, then decode appropriately by calling
-		      ;; archive-set-buffer-as-visiting-file later.
-		      (coding-system-for-read 'no-conversion)
-		      ;; Avoid changing dir mtime by lock_file
-		      (create-lockfiles nil))
-		  (condition-case err
-		      (if (fboundp extractor)
-			  (funcall extractor archive ename)
-			(archive-*-extract archive ename
-					   (symbol-value extractor)))
-		    (error
-		     (ding (message "%s" (error-message-string err)))
-		     nil))))
+	       (null (archive--extract-file extractor archive ename))
 	       just-created)
 	      (progn
 		(set-buffer-modified-p nil)
@@ -1129,6 +1134,27 @@ return nil.  Otherwise point is returned."
            (other-window-p (switch-to-buffer-other-window buffer))
            (t (switch-to-buffer buffer))))))
 
+(defun archive--extract-file (extractor archive ename)
+  (let (;; We may have to encode the file name argument for
+	;; external programs.
+	(coding-system-for-write
+	 (and enable-multibyte-characters
+	      archive-file-name-coding-system))
+	;; We read an archive member by no-conversion at
+	;; first, then decode appropriately by calling
+	;; archive-set-buffer-as-visiting-file later.
+	(coding-system-for-read 'no-conversion)
+	;; Avoid changing dir mtime by lock_file
+	(create-lockfiles nil))
+    (condition-case err
+	(if (fboundp extractor)
+	    (funcall extractor archive ename)
+	  (archive-*-extract archive ename
+			     (symbol-value extractor)))
+      (error
+       (ding (message "%s" (error-message-string err)))
+       nil))))
+
 (defun archive-*-extract (archive name command)
   (let* ((default-directory (file-name-as-directory archive-tmpdir))
 	 (tmpfile (expand-file-name (file-name-nondirectory name)