master dac20f0: Allow specifying the default archive types to compress to in Dired

[Lars Ingebrigtsen]

branch: master
commit dac20f08fa8f6b9fbdb8251af0652a909dee9fc8
Author: Sun Lin <sunlin7@yahoo.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Allow specifying the default archive types to compress to in Dired
    
    * lisp/dired-aux.el (dired-compress-file-default-suffix):
    (dired-compress-directory-default-suffix): New user options
    (bug#47119).
    (dired-compress-file-alist): New variable.
    
    * lisp/dired-aux.el (dired-compress-file): Use them.
    (dired-compress-file-suffixes): Remove the directory item.
---
 doc/emacs/dired.texi |  23 +++++-----
 etc/NEWS             |  12 +++++
 lisp/dired-aux.el    | 121 ++++++++++++++++++++++++++++++++++++---------------
 3 files changed, 111 insertions(+), 45 deletions(-)

diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index f57606d..3625703 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -862,21 +862,24 @@ Compress the specified files (@code{dired-do-compress}).  
If the file
 appears to be a compressed file already, uncompress it instead.  Each
 marked file is compressed into its own archive; this uses the
 @command{gzip} program if it is available, otherwise it uses
-@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{compress}.
+
+On a directory name, this command produces a compressed archive
+depending on the @code{dired-compress-directory-default-suffix} user
+option.  The default is a @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.
 
 @findex dired-do-compress-to
 @kindex c @r{(Dired)}
 @item c
 Compress the specified files (@code{dired-do-compress-to}) into a
-single archive anywhere on the file system. The compression algorithm
-is determined by the extension of the archive, see
-@code{dired-compress-files-alist}.
+single archive anywhere on the file system.  The default archive is
+controlled by the @code{dired-compress-directory-default-suffix} user
+option.  Also see @code{dired-compress-files-alist}.
 
 @findex epa-dired-do-decrypt
 @kindex :d @r{(Dired)}
diff --git a/etc/NEWS b/etc/NEWS
index a619df1..ae8a864 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -712,6 +712,18 @@ 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-directory-default-suffix'.
+This user option controls default suffix for compressing a directory.
+If it's nil, ".tar.gz" will be used.  Refer to
+'dired-compress-files-alist' for a list of supported suffixes.
+
++++
+*** New user option 'dired-compress-file-default-suffix'.
+This user option controls the default suffix for compressing files.
+If it's nil, ".gz" will be used.  Refer to 'dired-compress-file-alist'
+for a list of supported suffixes.
+
 ---
 *** 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 8fce402..2e4ff93 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1132,6 +1132,7 @@ present.  A FMT of \"\" will suppress the messaging."
     ;; 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 @@ present.  A FMT of \"\" will suppress the messaging."
     ("\\.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,34 @@ output file.
 Otherwise, the rule is a compression rule, and compression is done with gzip.
 ARGS are command switches passed to PROGRAM.")
 
+(defcustom dired-compress-file-default-suffix nil
+  "Default suffix for compressing a single file.
+If nil, \".gz\" will be used."
+  :type 'string
+  :group 'dired
+  :version "28.1")
+
+(defvar dired-compress-file-alist
+  '(("\\.gz\\'" . "gzip -9f %i")
+    ("\\.bz2\\'" . "bzip2 -9f %i")
+    ("\\.xz\\'" . "xz -9f %i")
+    ("\\.zst\\'" . "zstd -qf -19 --rm -o %o %i"))
+  "Controls the compression shell command for `dired-do-compress-to'.
+
+Each element is (REGEXP . CMD), where REGEXP is the name of the
+archive to which you want to compress, and CMD is the
+corresponding command.
+
+Within CMD, %i denotes the input file(s), and %o denotes the
+output file.  %i path(s) are relative, while %o is absolute.")
+
+(defcustom dired-compress-directory-default-suffix nil
+  "Default suffix for compressing a directory.
+If nil, \".tar.gz\" will be used."
+  :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")
@@ -1177,7 +1203,7 @@ ARGS are command switches passed to PROGRAM.")
     ("\\.tar\\.lzo\\'" . "tar -cf - %i | lzop -c9 > %o")
     ("\\.zip\\'" . "zip %o -r --filesync %i")
     ("\\.pax\\'" . "pax -wf %o %i"))
-  "Control the compression shell command for `dired-do-compress-to'.
+  "Controls the compression shell command for `dired-do-compress-to'.
 
 Each element is (REGEXP . CMD), where REGEXP is the name of the
 archive to which you want to compress, and CMD is the
@@ -1275,37 +1301,62 @@ Return nil if no change in files."
            ;; 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)
+                   (let* ((suffix
+                           (or dired-compress-directory-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-directory-default-suffix' %s, see `dired-compress-files-alist' 
for\
+ the supported suffixes list."
+                        dired-compress-directory-default-suffix)))
+                 (let* ((suffix (or dired-compress-file-default-suffix ".gz"))
+                        (out-name (concat file suffix))
+                        (rule (cl-find-if
+                               (lambda (x) (string-match-p (car x) suffix))
+                               dired-compress-file-alist)))
+                   (if (not rule)
+                       (user-error "No compression rule found for suffix %s, \
+see `dired-compress-file-alist' for the supported suffixes list."
+                                   dired-compress-file-default-suffix)
+                     (and (or (not (file-exists-p out-name))
+                              (y-or-n-p
+                               (format
+                                "File %s already exists.  Really compress? "
+                                out-name)))
+                          (dired-shell-command
                            (replace-regexp-in-string
-                            "%i" (shell-quote-argument (file-name-nondirectory 
file))
-                            (cadr suffix)
-                            nil t)
-                           nil t))
-                         out-name)))
-                 (let ((out-name (concat file ".gz")))
-                   (and (or (not (file-exists-p out-name))
-                            (y-or-n-p
-                             (format "File %s already exists.  Really 
compress? "
-                                     out-name)))
-                        (not
-                         (dired-check-process (concat "Compressing " file)
-                                              "gzip" "-f" file))
-                        (or (file-exists-p out-name)
-                            (setq out-name (concat file ".z")))
-                        ;; Rename the compressed file to NEWNAME
-                        ;; if it hasn't got that name already.
-                        (if (and newname (not (equal newname out-name)))
-                            (progn
-                              (rename-file out-name newname t)
-                              newname)
-                          out-name))))
+                            "%o" (shell-quote-argument out-name)
+                            (replace-regexp-in-string
+                             "%i" (shell-quote-argument
+                                   (file-name-nondirectory file))
+                             (cdr rule)
+                             nil t)
+                            nil t))
+                          (or (file-exists-p out-name)
+                              (setq out-name (concat file ".z")))
+                          ;; Rename the compressed file to NEWNAME
+                          ;; if it hasn't got that name already.
+                          (if (and newname (not (equal newname out-name)))
+                              (progn
+                                (rename-file out-name newname t)
+                                newname)
+                            out-name)))))
              (file-error
               (if (not (dired-check-process (concat "Compressing " file)
                                             "compress" "-f" file))