diff options
| author | Eli Zaretskii | 2020-01-08 18:21:53 +0200 |
|---|---|---|
| committer | Eli Zaretskii | 2020-01-08 18:21:53 +0200 |
| commit | 6cd9ccb0a28ec03ffe180b7429e0378511b7d459 (patch) | |
| tree | 0f705f8ecff0bc6dd57eb25108c5654c46bfa157 | |
| parent | 42329e6d3b51dd7a9202cd1a98160d5e2db34509 (diff) | |
| download | emacs-6cd9ccb0a28ec03ffe180b7429e0378511b7d459.tar.gz emacs-6cd9ccb0a28ec03ffe180b7429e0378511b7d459.zip | |
Fix compression of directories in Dired
This fixes comporession and uncompression of directories on
MS-Windows, but also on other systems. The original code used
":" as the REGEXP of the directory entry in
dired-compress-file-suffixes, which on Windows always matched any
absolute file name, and can also match unusual file names on Posix
hosts. This false match would cause dired-compress-file to act as
if we are decompressing a directory, but use a command suitable
for compression, which would fail in interesting ways.
We now use a REGEXP that can never match any valid file name.
* lisp/dired-aux.el (dired-compress-file-suffixes): Make the
"compress directory" entry's REGEXP really fail to match any valid
file name.
(dired-compress-file): Adapt to the change in
dired-compress-file-suffixes. (Bug#39024)
(dired-compress): If the current file is a directory, or if the
uncompressed file is a directory, don't remove the original from
the listing, since it is left in the filesystem.
| -rw-r--r-- | lisp/dired-aux.el | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 59d389dc630..0069c1744dc 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el | |||
| @@ -992,7 +992,14 @@ command with a prefix argument (the value does not matter)." | |||
| 992 | (ignore-errors (dired-remove-entry new-file)) | 992 | (ignore-errors (dired-remove-entry new-file)) |
| 993 | (goto-char start) | 993 | (goto-char start) |
| 994 | ;; Now replace the current line with an entry for NEW-FILE. | 994 | ;; Now replace the current line with an entry for NEW-FILE. |
| 995 | (dired-update-file-line new-file) nil) | 995 | ;; But don't remove the current line if either FROM-FILE or |
| 996 | ;; NEW-FILE is a directory, because compressing/uncompressing | ||
| 997 | ;; directories doesn't remove the original. | ||
| 998 | (if (or (file-directory-p from-file) | ||
| 999 | (file-directory-p new-file)) | ||
| 1000 | (dired-add-entry new-file nil t) | ||
| 1001 | (dired-update-file-line new-file)) | ||
| 1002 | nil) | ||
| 996 | (dired-log (concat "Failed to (un)compress " from-file)) | 1003 | (dired-log (concat "Failed to (un)compress " from-file)) |
| 997 | from-file))) | 1004 | from-file))) |
| 998 | 1005 | ||
| @@ -1020,8 +1027,9 @@ command with a prefix argument (the value does not matter)." | |||
| 1020 | ("\\.7z\\'" "" "7z x -aoa -o%o %i") | 1027 | ("\\.7z\\'" "" "7z x -aoa -o%o %i") |
| 1021 | ;; This item controls naming for compression. | 1028 | ;; This item controls naming for compression. |
| 1022 | ("\\.tar\\'" ".tgz" nil) | 1029 | ("\\.tar\\'" ".tgz" nil) |
| 1023 | ;; This item controls the compression of directories | 1030 | ;; This item controls the compression of directories. Its REGEXP |
| 1024 | (":" ".tar.gz" "tar -cf - %i | gzip -c9 > %o")) | 1031 | ;; element should never match any valid file name. |
| 1032 | ("\000" ".tar.gz" "tar -cf - %i | gzip -c9 > %o")) | ||
| 1025 | "Control changes in file name suffixes for compression and uncompression. | 1033 | "Control changes in file name suffixes for compression and uncompression. |
| 1026 | Each element specifies one transformation rule, and has the form: | 1034 | Each element specifies one transformation rule, and has the form: |
| 1027 | (REGEXP NEW-SUFFIX PROGRAM) | 1035 | (REGEXP NEW-SUFFIX PROGRAM) |
| @@ -1145,7 +1153,7 @@ Return nil if no change in files." | |||
| 1145 | (condition-case nil | 1153 | (condition-case nil |
| 1146 | (if (file-directory-p file) | 1154 | (if (file-directory-p file) |
| 1147 | (progn | 1155 | (progn |
| 1148 | (setq suffix (cdr (assoc ":" dired-compress-file-suffixes))) | 1156 | (setq suffix (cdr (assoc "\000" dired-compress-file-suffixes))) |
| 1149 | (when suffix | 1157 | (when suffix |
| 1150 | (let ((out-name (concat file (car suffix))) | 1158 | (let ((out-name (concat file (car suffix))) |
| 1151 | (default-directory (file-name-directory file))) | 1159 | (default-directory (file-name-directory file))) |