From: Lars Ingebrigtsen Date: Tue, 21 Sep 2021 17:05:15 +0000 (+0200) Subject: Revert "Make dired-compress-file query for a directory to uncompress to" X-Git-Tag: emacs-28.0.90~772 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=bd6fe44a57f4486767855332eee8fc1a5c5b95ba;p=emacs.git 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. --- diff --git a/etc/NEWS b/etc/NEWS index e8196d277d0..558656bf01b 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 f2cb745ad47..53fbcfb6d0b 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. @@ -1254,42 +1253,6 @@ 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. @@ -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 5888f4cd993..7f1743f88d7 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