From 7e395a59b025c7f4be49294ad806addf5b1a25c9 Mon Sep 17 00:00:00 2001 From: Michalis V Date: Tue, 21 Sep 2021 06:30:58 +0200 Subject: [PATCH] Make dired-compress-file query for a directory to uncompress to * lisp/dired-aux.el (dired-compress-file-suffixes): Specify the directory in the tar targets. (dired-uncompress-file): New function (bug#47058). This asks what directory to uncompress to. (dired-compress-file): Use it. --- etc/NEWS | 3 ++ lisp/dired-aux.el | 70 ++++++++++++++++++++++-------------- test/lisp/dired-aux-tests.el | 54 ++++++++++++++++++++++++++++ 3 files changed, 100 insertions(+), 27 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index cbbb6b0276b..2bdcb6434b7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1191,6 +1191,9 @@ keys, add the following to your init file: Using it instead of 'read-char-choice' allows using 'C-x o' to switch to the help window displayed after typing 'C-h'. +--- +*** 'dired-compress-file' now queries for a directory to uncompress to. + +++ ** New user option 'isearch-allow-motion'. When 'isearch-allow-motion' is set, the commands 'beginning-of-buffer', diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 53fbcfb6d0b..f2cb745ad47 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1134,9 +1134,10 @@ present. A FMT of \"\" will suppress the messaging." ;; "tar -zxf" isn't used because it's not available on the ;; Solaris 10 version of tar (obsolete in 2024?). ;; Same thing on AIX 7.1 (obsolete 2023?) and 7.2 (obsolete 2022?). - ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -") - ("\\.tar\\.xz\\'" "" "xz -dc %i | tar -xf -") - ("\\.tgz\\'" "" "gzip -dc %i | tar -xf -") + ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf - -C %c") + ("\\.tar\\.xz\\'" "" "xz -dc %i | tar -xf - -C %c") + ("\\.tgz\\'" "" "gzip -dc %i | tar -xf - -C %c") + ("\\.tar\\.bz2\\'" "" "bunzip2 -c %i | tar -xf - -C %c") ("\\.gz\\'" "" "gzip -d") ("\\.lz\\'" "" "lzip -d") ("\\.Z\\'" "" "uncompress") @@ -1148,8 +1149,8 @@ present. A FMT of \"\" will suppress the messaging." ("\\.bz2\\'" "" "bunzip2") ("\\.xz\\'" "" "unxz") ("\\.zip\\'" "" "unzip -o -d %o %i") - ("\\.tar\\.zst\\'" "" "unzstd -c %i | tar -xf -") - ("\\.tzst\\'" "" "unzstd -c %i | tar -xf -") + ("\\.tar\\.zst\\'" "" "unzstd -c %i | tar -xf - -C %c") + ("\\.tzst\\'" "" "unzstd -c %i | tar -xf - -C %c") ("\\.zst\\'" "" "unzstd --rm") ("\\.7z\\'" "" "7z x -aoa -o%o %i") ;; This item controls naming for compression. @@ -1253,6 +1254,42 @@ and `dired-compress-files-alist'." (length in-files) (file-name-nondirectory out-file))))))) +;;;###autoload +(defun dired-uncompress-file (file dirname command) + "Uncompress FILE using COMMAND. +If file is a tar archive or some other format that supports +output directory in its parameters, ask user the target directory +to extract it (defaults to DIRNAME). Returns the directory or +filename produced after the uncompress operation." + (if (string-match "%[ioc]" command) + (let ((extractdir (expand-file-name + (read-file-name + (format "Extract file to (default %s): " dirname) + dirname)))) + (prog1 + (file-name-as-directory extractdir) + (unless (file-directory-p extractdir) + (dired-create-directory extractdir)) + (dired-shell-command + (replace-regexp-in-string + "%[oc]" (shell-quote-argument extractdir) + (replace-regexp-in-string + "%i" (shell-quote-argument file) + command + nil t) + nil t)))) + ;; We found an uncompression rule without output dir argument + (let ((match (string-search " " command)) + (msg (concat "Uncompressing " file))) + (unless (if match + (dired-check-process + msg + (substring command 0 match) + (substring command (1+ match)) + file) + (dired-check-process msg command file)) + dirname)))) + ;;;###autoload (defun dired-compress-file (file) "Compress or uncompress FILE. @@ -1277,28 +1314,7 @@ Return nil if no change in files." ((file-symlink-p file) nil) ((and suffix (setq command (nth 2 suffix))) - (if (string-match "%[io]" command) - (prog1 (setq newname (file-name-as-directory newname)) - (dired-shell-command - (replace-regexp-in-string - "%o" (shell-quote-argument newname) - (replace-regexp-in-string - "%i" (shell-quote-argument file) - command - nil t) - nil t))) - ;; We found an uncompression rule. - (let ((match (string-search " " command)) - (msg (concat "Uncompressing " file))) - (unless (if match - (dired-check-process msg - (substring command 0 match) - (substring command (1+ match)) - file) - (dired-check-process msg - command - file)) - newname)))) + (dired-uncompress-file file newname command)) (t ;; We don't recognize the file as compressed, so compress it. ;; Try gzip; if we don't have that, use compress. diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 7f1743f88d7..5888f4cd993 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -158,5 +158,59 @@ (should (string-match (regexp-quote command) (nth 0 lines))) (dired-test--check-highlighting (nth 0 lines) '(8)))) +(ert-deftest dired-test-bug47058-tar () + "test for https://debbugs.gnu.org/47058 ." + (dired-test-bug47058-fn "tar -cf - %i | gzip -c9 > %o" + "gzip -dc %i | tar -xf - -C %c" + ".tar.gz")) + +(ert-deftest dired-test-bug47058-zip () + "test for https://debbugs.gnu.org/47058 ." + (dired-test-bug47058-fn "zip %o -r --filesync %i" + "unzip -o -d %o %i" + ".zip")) + +(defun dired-test-bug47058-fn (compress-cmd uncompress-cmd extension) + "helper fn for testing https://debbugs.gnu.org/47058 ." + (let* ((base-file (make-temp-file "dired-test-47058-")) + (archive-file (concat base-file extension)) + (file1 (make-temp-file "a")) + (file2 (make-temp-file "b")) + (file3 (make-temp-file "c")) + (filelist (list file1 file2 file3)) + (comprcmd (replace-regexp-in-string + "%c" (shell-quote-argument temporary-file-directory) + (replace-regexp-in-string + "%i" (mapconcat 'identity filelist " ") + (replace-regexp-in-string + "%o" (shell-quote-argument archive-file) + compress-cmd))))) + (cl-letf (((symbol-function 'read-file-name) + (lambda (&rest _) base-file))) + (dired-delete-file base-file) + (should-not (file-exists-p base-file)) + (should-not (file-exists-p archive-file)) + (dired-shell-command comprcmd) + (should (file-exists-p archive-file)) + (mapcar (lambda (f) (should (file-exists-p f))) + filelist) + (mapcar (lambda (f) (delete-file f)) + filelist) + (mapcar (lambda (f) (should-not (file-exists-p f))) + filelist) + (should (string-equal + (dired-uncompress-file archive-file + base-file + uncompress-cmd) + (file-name-as-directory base-file))) + (mapcar (lambda (f) + (should (file-exists-p + (concat (file-name-as-directory base-file) f)))) + filelist) + (dired-delete-file base-file 'always' nil) + (dired-delete-file archive-file 'always' nil) + (should-not (file-exists-p base-file)) + (should-not (file-exists-p archive-file))))) + (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.39.5