bug#27952: 26.0.50; Combine archive-int-to-mode and tar-grind-file-mode

[Tino Calancha <tino.calancha@gmail.com>]

On Mon, 4 May 2020, Stefan Kangas wrote:

> Just another friendly ping, 6 months later.  Please let us know if
> there has been any progress here.  Thanks in advance.
Thank you for the reminder!
As I pointed out before, I wasn't really satisfied with my original
patch; the one adding a function with > 1 arguments: too complex and I
suspect failing side cases.

Instead, I propose the following easy one:

--8<-----------------------------cut here---------------start------------->8---
commit dc126c15c181afed9d236f4c1077e2c7f02b01df
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Fri May 8 21:29:05 2020 +0200

     Combine archive-int-to-mode and tar-grind-file-mode

     Add a new function, file-modes-number-to-symbolic.
     Make archive-int-to-mode and alias of it; use it
     to define tar-grind-file-mode (Bug#27952).

     * lisp/files.el (file-modes-number-to-symbolic): New defun.
     * lisp/arc-mode.el (archive-int-to-mode): Make it an alias.
     * lisp/tar-mode.el (tar-grind-file-mode):
     Use file-modes-number-to-symbolic.

     * test/lisp/arc-mode-tests.el (arc-mode-test-archive-int-to-mode)
     * test/lisp/tar-mode-tests.el (tar-mode-test-tar-grind-file-mode):
     Update test.

     * test/lisp/files-tests.el (files-tests-file-modes-symbolic-to-number)
     (files-tests-file-modes-number-to-symbolic): New tests.

     * doc/lispref/files.texi (Changing Files): Document the new funtion.
     * etc/NEWS (Lisp Changes in Emacs 28.1): Announce it.

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index b3ad9b9964..686dbdb1ca 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1909,6 +1909,11 @@ Changing Files
  all.
  @end defun

+@defun file-modes-number-to-symbolic modes
+This function converts a numeric file mode specification in
+@var{modes} into the equivalent symbolic form.
+@end defun
+
  @defun set-file-times filename &optional time flag
  This function sets the access and modification times of @var{filename}
  to @var{time}.  The return value is @code{t} if the times are successfully
diff --git a/etc/NEWS b/etc/NEWS
index ac93a76ff9..26426fc42b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -372,6 +372,10 @@ Use macro 'with-current-buffer-window' with action alist entry 'body-function'.

  * Lisp Changes in Emacs 28.1

++++
+** New function 'file-modes-number-to-symbolic' to convert a numeric
+file mode specification into symbolic form.
+
  ** New macro 'dlet' to dynamically bind variables.

  ** The variable 'force-new-style-backquotes' has been removed.
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index c918f06c80..0c801c67a5 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -563,28 +563,7 @@ archive-l-e
  		      (aref str (- len i)))))
      result))

-(defun archive-int-to-mode (mode)
-  "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------."
-  ;; FIXME: merge with tar-grind-file-mode.
-  (if (null mode)
-      "??????????"
-    (string
-     (if (zerop (logand  8192 mode))
-	 (if (zerop (logand 16384 mode)) ?- ?d)
-       ?c)                              ; completeness
-     (if (zerop (logand   256 mode)) ?- ?r)
-     (if (zerop (logand   128 mode)) ?- ?w)
-     (if (zerop (logand    64 mode))
-	 (if (zerop (logand  2048 mode)) ?- ?S)
-       (if (zerop (logand  2048 mode)) ?x ?s))
-     (if (zerop (logand    32 mode)) ?- ?r)
-     (if (zerop (logand    16 mode)) ?- ?w)
-     (if (zerop (logand     8 mode))
-	 (if (zerop (logand  1024 mode)) ?- ?S)
-       (if (zerop (logand  1024 mode)) ?x ?s))
-     (if (zerop (logand     4 mode)) ?- ?r)
-     (if (zerop (logand     2 mode)) ?- ?w)
-     (if (zerop (logand     1 mode)) ?- ?x))))
+(defalias 'archive-int-to-mode 'file-modes-number-to-symbolic)

  (defun archive-calc-mode (oldmode newmode)
    "From the integer OLDMODE and the string NEWMODE calculate a new file mode.
diff --git a/lisp/files.el b/lisp/files.el
index c34fe00388..dba704f7a4 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7552,6 +7552,27 @@ file-modes-rights-to-number
  	      op char-right)))
      num-rights))

+(defun file-modes-number-to-symbolic (mode)
+  (string
+   (if (zerop (logand  8192 mode))
+       (if (zerop (logand 16384 mode)) ?- ?d)
+     ?c) ; completeness
+   (if (zerop (logand   256 mode)) ?- ?r)
+   (if (zerop (logand   128 mode)) ?- ?w)
+   (if (zerop (logand    64 mode))
+       (if (zerop (logand  2048 mode)) ?- ?S)
+     (if (zerop (logand  2048 mode)) ?x ?s))
+   (if (zerop (logand    32 mode)) ?- ?r)
+   (if (zerop (logand    16 mode)) ?- ?w)
+   (if (zerop (logand     8 mode))
+       (if (zerop (logand  1024 mode)) ?- ?S)
+     (if (zerop (logand  1024 mode)) ?x ?s))
+   (if (zerop (logand     4 mode)) ?- ?r)
+   (if (zerop (logand     2 mode)) ?- ?w)
+   (if (zerop (logand 512 mode))
+       (if (zerop (logand   1 mode)) ?- ?x)
+     (if (zerop (logand   1 mode)) ?T ?t))))
+
  (defun file-modes-symbolic-to-number (modes &optional from)
    "Convert symbolic file modes to numeric file modes.
  MODES is the string to convert, it should match
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index a3c1715b1e..73978ffc4a 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -480,23 +480,9 @@ tar-clip-time-string

  (defun tar-grind-file-mode (mode)
    "Construct a `rw-r--r--' string indicating MODE.
-MODE should be an integer which is a file mode value."
-  (string
-   (if (zerop (logand 256 mode)) ?- ?r)
-   (if (zerop (logand 128 mode)) ?- ?w)
-   (if (zerop (logand 2048 mode))
-       (if (zerop (logand  64 mode)) ?- ?x)
-     (if (zerop (logand  64 mode)) ?S ?s))
-   (if (zerop (logand  32 mode)) ?- ?r)
-   (if (zerop (logand  16 mode)) ?- ?w)
-   (if (zerop (logand 1024 mode))
-       (if (zerop (logand   8 mode)) ?- ?x)
-     (if (zerop (logand   8 mode)) ?S ?s))
-   (if (zerop (logand   4 mode)) ?- ?r)
-   (if (zerop (logand   2 mode)) ?- ?w)
-   (if (zerop (logand 512 mode))
-       (if (zerop (logand   1 mode)) ?- ?x)
-     (if (zerop (logand   1 mode)) ?T ?t))))
+MODE should be an integer which is a file mode value.
+For instance, if mode is #o700, then it produces `rwx------'."
+  (substring (file-modes-number-to-symbolic mode) 1))

  (defun tar-header-block-summarize (tar-hblock &optional mod-p)
    "Return a line similar to the output of `tar -vtf'."
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index df658b9813..22ca7e2ec5 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -28,7 +28,7 @@ arc-mode-tests-data-directory
    (let ((alist (list (cons 448 "-rwx------")
                       (cons 420 "-rw-r--r--")
                       (cons 292 "-r--r--r--")
-                     (cons 512 "----------")
+                     (cons 512 "---------T")
                       (cons 1024 "------S---") ; Bug#28092
                       (cons 2048 "---S------"))))
      (dolist (x alist)
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 05d9ceebf1..4b902fd82a 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1164,6 +1164,42 @@ files-tests-file-attributes-equal
      (should-not (make-directory a/b t))
      (delete-directory dir 'recursive)))

+(ert-deftest files-tests-file-modes-symbolic-to-number ()
+  (let ((alist (list (cons "a=rwx" #o777)
+                     (cons "o=t" #o1000)
+                     (cons "o=xt" #o1001)
+                     (cons "o=tx" #o1001) ; Order doesn't matter.
+                     (cons "u=rwx,g=rx,o=rx" #o755)
+                     (cons "u=rwx,g=,o=" #o700)
+                     (cons "u=rwx" #o700) ; Empty permissions can be ignored.
+                     (cons "u=rw,g=r,o=r" #o644)
+                     (cons "u=rw,g=r,o=t" #o1640)
+                     (cons "u=rw,g=r,o=xt" #o1641)
+                     (cons "u=rwxs,g=rs,o=xt" #o7741)
+                     (cons "u=rws,g=rs,o=t" #o7640)
+                     (cons "u=rws,g=rs,o=r" #o6644)
+                     (cons "a=r" #o444)
+                     (cons "u=S" nil)
+                     (cons "u=T" nil)
+                     (cons "u=Z" nil))))
+    (dolist (x alist)
+      (if (cdr-safe x)
+          (should (equal (cdr x) (file-modes-symbolic-to-number (car x))))
+        (should-error (file-modes-symbolic-to-number (car x)))))))
+
+(ert-deftest files-tests-file-modes-number-to-symbolic ()
+  (let ((alist (list (cons #o755 "-rwxr-xr-x")
+                     (cons #o700 "-rwx------")
+                     (cons #o644 "-rw-r--r--")
+                     (cons #o1640 "-rw-r----T")
+                     (cons #o1641 "-rw-r----t")
+                     (cons #o7741 "-rwsr-S--t")
+                     (cons #o7640 "-rwSr-S--T")
+                     (cons #o6644 "-rwSr-Sr--")
+                     (cons #o444 "-r--r--r--"))))
+    (dolist (x alist)
+      (should (equal (cdr x) (file-modes-number-to-symbolic (car x)))))))
+
  (ert-deftest files-tests-no-file-write-contents ()
    "Test that `write-contents-functions' permits saving a file.
  Usually `basic-save-buffer' will prompt for a file name if the
diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el
index bc41b863da..f05389df60 100644
--- a/test/lisp/tar-mode-tests.el
+++ b/test/lisp/tar-mode-tests.el
@@ -29,7 +29,8 @@ tar-mode-tests-data-directory
                       (cons 420 "rw-r--r--")
                       (cons 292 "r--r--r--")
                       (cons 512 "--------T")
-                     (cons 1024 "-----S---"))))
+                     (cons 1024 "-----S---")
+                     (cons 2048 "--S------"))))
      (dolist (x alist)
        (should (equal (cdr x) (tar-grind-file-mode (car x)))))))


--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 28.0.50 (build 4, x86_64-pc-linux-gnu, GTK+ Version 3.24.5, cairo version 1.16.0)
  of 2020-05-08 built on calancha-pc.dy.bbexcite.jp
Repository revision: 4b8e6939bf7664fda33a7aaa03d2d8069358ff7b
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12004000
System Description: Debian GNU/Linux 10 (buster)