unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#27952: 26.0.50; Combine archive-int-to-mode and tar-grind-file-mode
@ 2017-08-04 12:32 Tino Calancha
  2017-08-16 11:43 ` Tino Calancha
  2019-06-24 20:35 ` Lars Ingebrigtsen
  0 siblings, 2 replies; 18+ messages in thread
From: Tino Calancha @ 2017-08-04 12:32 UTC (permalink / raw)
  To: 27952; +Cc: stefan monnier

Severity: wishlist
Tag: patch
X-Debbugs-CC: Stefan Monnier <monnier@iro.umontreal.ca>

These functions are almost identical; archive-int-to-mode has a FIXME
suggesting merging it with tar-grind-file-mode.

--8<-----------------------------cut here---------------start------------->8---
commit c6d36b04de7f6442653af7e4699bdad44ee57201
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Fri Aug 4 21:25:44 2017 +0900

    Combine archive-int-to-mode and tar-grind-file-mode
    
    These functions are almost identical.  Add a new function
    file-modes-number-to-symbolic; use it to define the other two.
    * lisp/files.el (file-modes-number-to-symbolic-1)
    (file-modes-number-to-symbolic): New defuns.
    * lisp/arc-mode.el (archive-int-to-mode): Define as a alias of
    file-modes-number-to-symbolic.
    * lisp/tar-mode.el (tar-grind-file-mode): Fix docstring.
    Use file-modes-number-to-symbolic.

diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index bd7548b704..8f3691b337 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -549,26 +549,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.
-  (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  1024 mode)) ?- ?S)
-      (if (zerop (logand  1024 mode)) ?x ?s))
-    (if (zerop (logand    32 mode)) ?- ?r)
-    (if (zerop (logand    16 mode)) ?- ?w)
-    (if (zerop (logand     8 mode))
-	(if (zerop (logand  2048 mode)) ?- ?S)
-      (if (zerop (logand  2048 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 &optional error)
   "From the integer OLDMODE and the string NEWMODE calculate a new file mode.
diff --git a/lisp/files.el b/lisp/files.el
index 89f6f9f44d..e776b00b91 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7188,6 +7188,65 @@ file-modes-symbolic-to-number
 	  (error "Parse error in modes near `%s'" (substring modes 0))))
       num-modes)))
 
+(defun file-modes-number-to-symbolic-1 (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  1024 mode)) ?- ?S)
+     (if (zerop (logand  1024 mode)) ?x ?s))
+   (if (zerop (logand    32 mode)) ?- ?r)
+   (if (zerop (logand    16 mode)) ?- ?w)
+   (if (zerop (logand     8 mode))
+       (if (zerop (logand  2048 mode)) ?- ?S)
+     (if (zerop (logand  2048 mode)) ?x ?s))
+   (if (zerop (logand     4 mode)) ?- ?r)
+   (if (zerop (logand     2 mode)) ?- ?w)
+   (if (zerop (logand     1 mode)) ?- ?x)))
+
+(defun file-modes-number-to-symbolic (mode &optional detailed from)
+  "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------.
+If optional arg DETAILED is non-nil, then use the format 'u=rwx,g=,o='.
+If optional argument FROM is non-nil, then it's the original file mode
+ to compare with MODE.  FROM is ignored unless DETAILED is non-nil.
+
+For instance, if MODE is 448, DETAILED is non-nil, and FROM is 400,
+the output is 'u+x,g-w'."
+  (let ((mode (file-modes-number-to-symbolic-1 mode))
+        (from (and from (substring (file-modes-number-to-symbolic-1 from) 1))))
+    (if (not detailed)
+        mode
+      (setq mode (substring mode 1))
+      (cond (from
+             (let ((res "u"))
+               (dotimes (i (length mode))
+                 (let ((x (aref mode i))
+                       (y (aref from i)))
+                   (when (= i 3) (setq res (concat res ",g")))
+                   (when (= i 6) (setq res (concat res ",o")))
+                   (setq res (concat res
+                                     (cond ((eq x y) "")
+                                           ((eq x ?-) (string ?- y))
+                                           ((eq y ?-) (string ?+ x)))))))
+               (replace-regexp-in-string
+                ",\\'" ""
+                (replace-regexp-in-string
+                 "u," ""
+                 (replace-regexp-in-string
+                  "g," ""
+                  (replace-regexp-in-string
+                   "o\\'" "" res))))))
+            (t
+             (replace-regexp-in-string
+              "-" ""
+              (format "u=%s,g=%s,o=%s"
+                      (substring mode 0 3)
+                      (substring mode 3 6)
+                      (substring mode 6))))))))
+
 (defun read-file-modes (&optional prompt orig-file)
   "Read file modes in octal or symbolic notation and return its numeric value.
 PROMPT is used as the prompt, default to \"File modes (octal or symbolic): \".
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 1d453d2980..f41cc25532 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -469,24 +469,12 @@ tar-clip-time-string
     (concat " " (substring str 4 16) (format-time-string " %Y" time))))
 
 (defun tar-grind-file-mode (mode)
-  "Construct a `-rw--r--r--' string indicating 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))))
+  (let ((str (substring (file-modes-number-to-symbolic mode) 1)))
+    (unless (zerop (logand 512 mode))
+      (aset mode 8 (if (zerop (logand 1 mode)) ?T ?t)))
+    str))
 
 (defun tar-header-block-summarize (tar-hblock &optional mod-p)
   "Return a line similar to the output of `tar -vtf'."

--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2017-08-04
Repository revision: db5d38ddb0de83d8f920b7a128fe3fd5156fdf85





^ permalink raw reply related	[flat|nested] 18+ messages in thread

end of thread, other threads:[~2020-05-15  6:22 UTC | newest]

Thread overview: 18+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-08-04 12:32 bug#27952: 26.0.50; Combine archive-int-to-mode and tar-grind-file-mode Tino Calancha
2017-08-16 11:43 ` Tino Calancha
2017-08-16 12:00   ` npostavs
2017-08-16 13:13     ` Tino Calancha
2017-08-16 12:08   ` Andreas Schwab
2017-08-16 13:10     ` Tino Calancha
2019-06-24 20:35 ` Lars Ingebrigtsen
2019-06-24 20:42   ` Tino Calancha
2019-11-11  3:07     ` Stefan Kangas
2019-11-13 16:58       ` Tino Calancha
2020-05-04 11:55         ` Stefan Kangas
2020-05-08 19:53           ` Tino Calancha
2020-05-08 20:06             ` Stefan Monnier
2020-05-08 20:20               ` Tino Calancha
2020-05-14 16:47               ` Tino Calancha
2020-05-14 17:23                 ` Eli Zaretskii
2020-05-14 20:08                   ` Tino Calancha
2020-05-15  6:22                     ` Eli Zaretskii

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).