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

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

[-- Attachment #1.1: Type: text/plain, Size: 1371 bytes --]

 There is another user option `compress-file-default-suffix` that allow user custom default suffix for compressing file in dired-mode.

These two patch allow user custom suffix for compressing folder and file in dired-mode by pressing "Z".

Both two patches are attached.     On Tuesday, March 23, 2021, 11:16:13 PM GMT+8, Lin Sun <lin.sun@zoom.us> wrote:  
 
 #yiv1694401698 #yiv1694401698 -- filtered {}#yiv1694401698 filtered {}#yiv1694401698 filtered {}#yiv1694401698 filtered {}#yiv1694401698 p.yiv1694401698MsoNormal, #yiv1694401698 li.yiv1694401698MsoNormal, #yiv1694401698 div.yiv1694401698MsoNormal {margin:0in;margin-bottom:.0001pt;font-size:11.0pt;font-family:sans-serif;}#yiv1694401698 .yiv1694401698MsoChpDefault {}#yiv1694401698 filtered {}#yiv1694401698 div.yiv1694401698WordSection1 {}#yiv1694401698 
Hi Eli,

  

Sorry for my misunderstanding for your preview comments.

  

> but wouldn't it be better to use symbols instead of strings?

The new option `dired-compress-files-default-suffix` can be “.tar.gz” or “.tar.xz”… and it should work with variable ` dired-compress-file-suffixes` while this variable maybe extended by user. So the type:string is simple for implementation.

  

And yes, the document need update, changes are available in the attachment.

  

Please help to review the new patch. Thanks.
  

[-- Attachment #1.2: Type: text/html, Size: 2384 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-dired-new-user-option-dired-compress-files-default-s.patch --]
[-- Type: text/x-patch, Size: 5100 bytes --]

From 1a55db2623e9cdb3d55c538a2518178cc6b280f9 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 1/2] [*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.
---
 etc/NEWS          |  6 ++++++
 lisp/dired-aux.el | 49 +++++++++++++++++++++++++++++++------------------
 2 files changed, 37 insertions(+), 18 deletions(-)

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..237182e 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,13 @@ 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."
+  :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 +1280,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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-dired-new-user-option-dired-compress-file-default-su.patch --]
[-- Type: text/x-patch, Size: 5423 bytes --]

From 0dc4c7b00573c7baa4f4c5848810599f81ac6f5c Mon Sep 17 00:00:00 2001
From: Lin Sun <lin.sun@zoom.us>
Date: Mon, 15 Mar 2021 09:43:54 +0800
Subject: [PATCH 2/2] [*dired] new user option
 'dired-compress-file-default-suffix'

*dired-aux.el: user option 'dired-compress-file-default-suffix' for
default suffix for compressing file in dired-mode.
---
 etc/NEWS          |  6 +++++
 lisp/dired-aux.el | 68 +++++++++++++++++++++++++++++++++++++++++--------------
 2 files changed, 57 insertions(+), 17 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index e20beee..340538d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -641,6 +641,12 @@ 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.
 
++++
+*** New user option 'dired-compress-file-default-suffix'.
+This user option controls default suffix for compressing files.  If it's
+nil, the ".gz" will be used. Refer the 'dired-compress-file-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 237182e..c1f51a5 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1166,6 +1166,27 @@ 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-file-default-suffix nil
+  "Default suffix for compressing single file.
+If nil, the \".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"))
+  "Control 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-files-default-suffix nil
   "Default suffix for compressing directory.
 If nil, the \".tar.gz\" will be used."
@@ -1302,23 +1323,36 @@ dired-compress-file
 `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
-                             (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))))
+                 (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
+                            "%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))
-- 
2.7.0