mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-06 03:40:56 -08:00
Revert "Make dired-compress-file query for a directory to uncompress to"
This reverts commit 7e395a59b0.
The behaviour change isn't good for the majority of tar files.
This commit is contained in:
Lars Ingebrigtsen
parent
ff714466e7
commit
bd6fe44a57
3 changed files with 27 additions and 100 deletions
3
etc/NEWS
3
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',
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue