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

[Stefan Monnier]

branch: master
commit cf774fb8cc0404e00e284a75862d95b5cbc1e94d
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    * 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.
---
 lisp/files.el                 | 28 ++++++++++++++++++++++++----
 lisp/tar-mode.el              | 38 ++++++++++++++++++++------------------
 test/manual/indent/scheme.scm | 23 +++++++++++++++++++++++
 3 files changed, 67 insertions(+), 22 deletions(-)

diff --git a/lisp/files.el b/lisp/files.el
index 60d6034..9d9fbe1 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -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))
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index d9b2d42..3f0cca0 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -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
diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm
new file mode 100644
index 0000000..9053a87
--- /dev/null
+++ b/test/manual/indent/scheme.scm
@@ -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)