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 obsolete 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 obsolete 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.
This commit is contained in:
parent
4af8b17149
commit
3a284e5786
8 changed files with 74 additions and 41 deletions
|
@ -1909,6 +1909,11 @@ omitted or @code{nil}, it defaults to 0, i.e., no access rights at
|
|||
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
|
||||
|
|
4
etc/NEWS
4
etc/NEWS
|
@ -400,6 +400,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.
|
||||
|
|
|
@ -563,28 +563,8 @@ in which case a second argument, length LEN, should be supplied."
|
|||
(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))))
|
||||
(define-obsolete-function-alias 'archive-int-to-mode
|
||||
'file-modes-number-to-symbolic "28.1")
|
||||
|
||||
(defun archive-calc-mode (oldmode newmode)
|
||||
"From the integer OLDMODE and the string NEWMODE calculate a new file mode.
|
||||
|
|
|
@ -7552,6 +7552,27 @@ as in \"og+rX-w\"."
|
|||
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
|
||||
|
|
|
@ -480,23 +480,9 @@ checksum before doing the check."
|
|||
|
||||
(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'."
|
||||
|
|
|
@ -28,7 +28,7 @@
|
|||
(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)
|
||||
|
|
|
@ -1164,6 +1164,42 @@ works as expected if the default directory is quoted."
|
|||
(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
|
||||
|
|
|
@ -29,7 +29,8 @@
|
|||
(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)))))))
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue