bug#47119: Re: bug#47119: 28.0.50; [patch][Dired] new user option for compressing dir suffix

[Lin Sun via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/html, Size: 1875 bytes --]

[-- Attachment #2: 0001-dired-new-user-option-dired-compress-files-default-s.patch --]
[-- Type: application/octet-stream, Size: 6347 bytes --]

From e7d8f160784d16d641d7e719b941a427b11126d9 Mon Sep 17 00:00:00 2001
From: Lin Sun <lin.sun@zoom.us>
Date: Sat, 13 Mar 2021 11:47:23 +0800
Subject: [PATCH] [*dired] new user option
 'dired-compress-files-default-suffix'

*dired-aux.el: user option 'dired-compress-files-default-suffix' for
default suffix for compressing directory.
---
 doc/emacs/dired.texi | 12 ++++++++----
 etc/NEWS             |  6 ++++++
 lisp/dired-aux.el    | 50 ++++++++++++++++++++++++++++++++------------------
 3 files changed, 46 insertions(+), 22 deletions(-)

diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index f57606d..8f360ac 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -865,10 +865,14 @@ Operating on Files
 @command{compress}.  On a directory name, this command produces a
 compressed @file{.tar.gz} archive containing all of the directory's
 files, by running the @command{tar} command with output piped to
-@command{gzip}.  To allow decompression of compressed directories,
-typing @kbd{Z} on a @file{.tar.gz} or @file{.tgz} archive file unpacks
-all the files in the archive into a directory whose name is the
-archive name with the extension removed.
+@command{gzip}; if the value of the variable
+@code{dired-compress-files-default-suffix} is non-@code{nil}, a
+suitable command line will be pick up from
+@code{dired-compress-files-alist} to compress the directory.  To allow
+decompression of compressed directories, typing @kbd{Z} on a
+@file{.tar.gz} or @file{.tgz} archive file unpacks all the files in
+the archive into a directory whose name is the archive name with the
+extension removed.
 
 @findex dired-do-compress-to
 @kindex c @r{(Dired)}
diff --git a/etc/NEWS b/etc/NEWS
index fa8784d..e20beee 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -635,6 +635,12 @@ line, and allows truncating them (to preserve space on the mode line)
 or showing them literally, either instead of, or in addition to,
 displaying "by name" or "by date" sort order.
 
++++
+*** New user option 'dired-compress-files-default-suffix'.
+This user option controls default suffix for compressing directory.  If it's
+nil, the ".tar.gz" will be used. Refer the 'dired-compress-files-alist' for
+supported suffix list.
+
 ---
 *** Broken and circular links are shown with the 'dired-broken-symlink' face.
 
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index d5f4910..296c9fb 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1132,6 +1132,7 @@ dired-compress-file-suffixes
     ;; 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 -")
     ("\\.gz\\'" "" "gunzip")
     ("\\.lz\\'" "" "lzip -d")
@@ -1149,10 +1150,7 @@ dired-compress-file-suffixes
     ("\\.zst\\'" "" "unzstd --rm")
     ("\\.7z\\'" "" "7z x -aoa -o%o %i")
     ;; This item controls naming for compression.
-    ("\\.tar\\'" ".tgz" nil)
-    ;; This item controls the compression of directories.  Its REGEXP
-    ;; element should never match any valid file name.
-    ("\000" ".tar.gz" "tar -cf - %i | gzip -c9 > %o"))
+    ("\\.tar\\'" ".tgz" nil))
   "Control changes in file name suffixes for compression and uncompression.
 Each element specifies one transformation rule, and has the form:
   (REGEXP NEW-SUFFIX PROGRAM)
@@ -1168,6 +1166,14 @@ dired-compress-file-suffixes
 Otherwise, the rule is a compression rule, and compression is done with gzip.
 ARGS are command switches passed to PROGRAM.")
 
+(defcustom dired-compress-files-default-suffix nil
+  "Default suffix for compressing directory.
+If nil, the \".tar.gz\" will be used.  See `dired-compress-files-alist' for \
+the supported suffixes list."
+  :type 'string
+  :group 'dired
+  :version "28.1")
+
 (defvar dired-compress-files-alist
   '(("\\.tar\\.gz\\'" . "tar -cf - %i | gzip -c9 > %o")
     ("\\.tar\\.bz2\\'" . "tar -cf - %i | bzip2 -c9 > %o")
@@ -1275,20 +1281,28 @@ dired-compress-file
            ;; Try gzip; if we don't have that, use compress.
            (condition-case nil
                (if (file-directory-p file)
-                   (progn
-                     (setq suffix (cdr (assoc "\000" dired-compress-file-suffixes)))
-                     (when suffix
-                       (let ((out-name (concat file (car suffix)))
-                             (default-directory (file-name-directory file)))
-                         (dired-shell-command
-                          (replace-regexp-in-string
-                           "%o" (shell-quote-argument out-name)
-                           (replace-regexp-in-string
-                            "%i" (shell-quote-argument (file-name-nondirectory file))
-                            (cadr suffix)
-                            nil t)
-                           nil t))
-                         out-name)))
+                   (let* ((suffix
+                           (or dired-compress-files-default-suffix ".tar.gz"))
+                          (rule (cl-find-if
+                                 (lambda (x) (string-match-p (car x) suffix))
+                                 dired-compress-files-alist)))
+                     (if rule
+                         (let ((out-name (concat file suffix))
+                               (default-directory (file-name-directory file)))
+                           (dired-shell-command
+                            (replace-regexp-in-string
+                             "%o" (shell-quote-argument out-name)
+                             (replace-regexp-in-string
+                              "%i" (shell-quote-argument (file-name-nondirectory file))
+                              (cdr rule)
+                              nil t)
+                             nil t))
+                           out-name)
+                       (user-error
+                        "No compression rule found for \
+`dired-compress-files-default-suffix' %s, see `dired-compress-files-alist' for\
+ the supported suffixes list."
+                        dired-compress-files-default-suffix)))
                  (let ((out-name (concat file ".gz")))
                    (and (or (not (file-exists-p out-name))
                             (y-or-n-p
-- 
2.7.0