master bd6fe44 2/2: Revert "Make dired-compress-file query for a directory to uncompress to"

[Lars Ingebrigtsen]

branch: master
commit bd6fe44a57f4486767855332eee8fc1a5c5b95ba
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Revert "Make dired-compress-file query for a directory to uncompress to"
    
    This reverts commit 7e395a59b025c7f4be49294ad806addf5b1a25c9.
    
    The behaviour change isn't good for the majority of tar files.
---
 etc/NEWS                     |  3 --
 lisp/dired-aux.el            | 70 +++++++++++++++++---------------------------
 test/lisp/dired-aux-tests.el | 54 ----------------------------------
 3 files changed, 27 insertions(+), 100 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index e8196d2..558656b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1191,9 +1191,6 @@ 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 f2cb745..53fbcfb 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1134,10 +1134,9 @@ 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 - -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")
+    ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -")
+    ("\\.tar\\.xz\\'" "" "xz -dc %i | tar -xf -")
+    ("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
     ("\\.gz\\'" "" "gzip -d")
     ("\\.lz\\'" "" "lzip -d")
     ("\\.Z\\'" "" "uncompress")
@@ -1149,8 +1148,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 - -C %c")
-    ("\\.tzst\\'" "" "unzstd -c %i | tar -xf - -C %c")
+    ("\\.tar\\.zst\\'" "" "unzstd -c %i | tar -xf -")
+    ("\\.tzst\\'" "" "unzstd -c %i | tar -xf -")
     ("\\.zst\\'" "" "unzstd --rm")
     ("\\.7z\\'" "" "7z x -aoa -o%o %i")
     ;; This item controls naming for compression.
@@ -1255,42 +1254,6 @@ and `dired-compress-files-alist'."
                       (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.
 Return the name of the compressed or uncompressed file.
@@ -1314,7 +1277,28 @@ Return nil if no change in files."
           ((file-symlink-p file)
            nil)
           ((and suffix (setq command (nth 2 suffix)))
-           (dired-uncompress-file file newname command))
+           (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))))
           (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 5888f4c..7f1743f 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -158,59 +158,5 @@
     (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