* lisp/files.el (file-modes-number-to-symbolic): Add filetype arg.

* lisp/tar-mode.el (tar-header-block-summarize): Use it.
(tar-grind-file-mode): Declare obsolete.
This commit is contained in:
Stefan Monnier 2021-04-12 12:46:47 -04:00
parent 9a6523dfd6
commit cf774fb8cc
3 changed files with 67 additions and 22 deletions

View file

@ -7633,6 +7633,9 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)."
;; Rights relative to the previous file modes.
((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
((= char ?u) (let ((uright (logand #o4700 from)))
;; FIXME: These divisions/shifts seem to be right
;; for the `7' part of the #o4700 mask, but not
;; for the `4' part. Same below for `g' and `o'.
(+ uright (/ uright #o10) (/ uright #o100))))
((= char ?g) (let ((gright (logand #o2070 from)))
(+ gright (/ gright #o10) (* gright #o10))))
@ -7667,11 +7670,28 @@ as in \"og+rX-w\"."
op char-right)))
num-rights))
(defun file-modes-number-to-symbolic (mode)
(defun file-modes-number-to-symbolic (mode &optional filetype)
"Return a string describing a a file's MODE.
For instance, if MODE is #o700, then it produces `-rwx------'.
FILETYPE if provided should be a character denoting the type of file,
such as `?d' for a directory, or `?l' for a symbolic link and will override
the leading `-' char."
(string
(if (zerop (logand 8192 mode))
(if (zerop (logand 16384 mode)) ?- ?d)
?c) ; completeness
(or filetype
(pcase (lsh mode -12)
;; POSIX specifies that the file type is included in st_mode
;; and provides names for the file types but values only for
;; the permissions (e.g., S_IWOTH=2).
;; (#o017 ??) ;; #define S_IFMT 00170000
(#o014 ?s) ;; #define S_IFSOCK 0140000
(#o012 ?l) ;; #define S_IFLNK 0120000
;; (8 ??) ;; #define S_IFREG 0100000
(#o006 ?b) ;; #define S_IFBLK 0060000
(#o004 ?d) ;; #define S_IFDIR 0040000
(#o002 ?c) ;; #define S_IFCHR 0020000
(#o001 ?p) ;; #define S_IFIFO 0010000
(_ ?-)))
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))

View file

@ -474,6 +474,7 @@ checksum before doing the check."
"Construct a `rw-r--r--' string indicating MODE.
MODE should be an integer which is a file mode value.
For instance, if mode is #o700, then it produces `rwx------'."
(declare (obsolete file-modes-number-to-symbolic "28.1"))
(substring (file-modes-number-to-symbolic mode) 1))
(defun tar-header-block-summarize (tar-hblock &optional mod-p)
@ -489,25 +490,26 @@ For instance, if mode is #o700, then it produces `rwx------'."
;; (ck (tar-header-checksum tar-hblock))
(type (tar-header-link-type tar-hblock))
(link-name (tar-header-link-name tar-hblock)))
(format "%c%c%s %7s/%-7s %7s%s %s%s"
(format "%c%s %7s/%-7s %7s%s %s%s"
(if mod-p ?* ? )
(cond ((or (eq type nil) (eq type 0)) ?-)
((eq type 1) ?h) ; link
((eq type 2) ?l) ; symlink
((eq type 3) ?c) ; char special
((eq type 4) ?b) ; block special
((eq type 5) ?d) ; directory
((eq type 6) ?p) ; FIFO/pipe
((eq type 20) ?*) ; directory listing
((eq type 28) ?L) ; next has longname
((eq type 29) ?M) ; multivolume continuation
((eq type 35) ?S) ; sparse
((eq type 38) ?V) ; volume header
((eq type 55) ?H) ; pax global extended header
((eq type 72) ?X) ; pax extended header
(t ?\s)
)
(tar-grind-file-mode mode)
(file-modes-number-to-symbolic
mode
(cond ((or (eq type nil) (eq type 0)) ?-)
((eq type 1) ?h) ; link
((eq type 2) ?l) ; symlink
((eq type 3) ?c) ; char special
((eq type 4) ?b) ; block special
((eq type 5) ?d) ; directory
((eq type 6) ?p) ; FIFO/pipe
((eq type 20) ?*) ; directory listing
((eq type 28) ?L) ; next has longname
((eq type 29) ?M) ; multivolume continuation
((eq type 35) ?S) ; sparse
((eq type 38) ?V) ; volume header
((eq type 55) ?H) ; pax global extended header
((eq type 72) ?X) ; pax extended header
(t ?\s)
))
(if (= 0 (length uname)) uid uname)
(if (= 0 (length gname)) gid gname)
size

View file

@ -0,0 +1,23 @@
;; Testing sexp-comments
(define a #;(hello) there)
(define a #;1 there)
(define a #;"asdf" there)
(define a ;; #;(hello
there)
(define a #;(hello
there) 2)
(define a #;(hello
#;(world))
and)
there) 2)
(define a #;(hello
#;"asdf" (world
and)
there) 2)