Index: lisp/ChangeLog =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/ChangeLog,v retrieving revision 1.8422 diff -c -r1.8422 ChangeLog *** lisp/ChangeLog 23 Oct 2005 13:30:15 -0000 1.8422 --- lisp/ChangeLog 23 Oct 2005 23:25:27 -0000 *************** *** 1,3 **** --- 1,8 ---- + 2005-10-24 Michael Cadilhac + + * file-modes.el: New. Implement file modes relative functions + with symbolic modes notation parsing. + 2005-10-23 Thien-Thi Nguyen * whitespace.el (whitespace-cleanup): Doc fix. Index: lispref/ChangeLog =================================================================== RCS file: /cvsroot/emacs/emacs/lispref/ChangeLog,v retrieving revision 1.509 diff -c -r1.509 ChangeLog *** lispref/ChangeLog 22 Oct 2005 16:41:55 -0000 1.509 --- lispref/ChangeLog 23 Oct 2005 23:25:27 -0000 *************** *** 1,3 **** --- 1,9 ---- + 2005-10-24 Michael Cadilhac + + * files.texi (Changing Files): Document the fact that + `set-file-modes' could take its mode argument as a + string. Document `file-modes-to-number'. + 2005-10-22 Eli Zaretskii * internals.texi (Building Emacs): Fix last change. Index: lispref/files.texi =================================================================== RCS file: /cvsroot/emacs/emacs/lispref/files.texi,v retrieving revision 1.87 diff -c -r1.87 files.texi *** lispref/files.texi 17 Oct 2005 06:47:26 -0000 1.87 --- lispref/files.texi 23 Oct 2005 23:25:27 -0000 *************** *** 1083,1098 **** @end group @group ! (set-file-modes "~/junk/diffs" 438) @result{} nil @end group @group - (format "%o" 438) - @result{} "666" ; @r{Convert to octal.} - @end group - - @group % ls -l diffs -rw-rw-rw- 1 lewis 0 3063 Oct 30 16:00 diffs @end group --- 1083,1093 ---- @end group @group ! (set-file-modes "~/junk/diffs" "a=rw") ; @r{Use symbolic notation.} @result{} nil @end group @group % ls -l diffs -rw-rw-rw- 1 lewis 0 3063 Oct 30 16:00 diffs @end group *************** *** 1480,1490 **** @var{string}. It is available only on VMS. @end defun ! @defun set-file-modes filename mode ! This function sets mode bits of @var{filename} to @var{mode} (which ! must be an integer). Only the low 12 bits of @var{mode} are used. ! This function recursively follows symbolic links at all levels for ! @var{filename}. @end defun @c Emacs 19 feature --- 1475,1493 ---- @var{string}. It is available only on VMS. @end defun ! @defun file-modes-to-number modes &optional from ! This function returns the numerical mode denoted by @var{modes}. ! @var{modes} could be a string (that represents the mode either in ! symbolic or octal representation) or an integer. @var{from} is used to ! compute relative rights ``X'', ``u'', ``g'', ``o''. ! @end defun ! ! @defun set-file-modes filename modes ! This function sets mode bits of @var{filename} to @var{modes}. ! @var{modes} could be a string (that represents the mode either in ! symbolic or octal representation) or an integer. Only the low 12 bits ! of the numerical representation of @var{modes} are used. This function ! recursively follows symbolic links at all levels for @var{filename}. @end defun @c Emacs 19 feature Index: src/ChangeLog =================================================================== RCS file: /cvsroot/emacs/emacs/src/ChangeLog,v retrieving revision 1.4669 diff -c -r1.4669 ChangeLog *** src/ChangeLog 21 Oct 2005 16:54:37 -0000 1.4669 --- src/ChangeLog 23 Oct 2005 23:25:29 -0000 *************** *** 1,3 **** --- 1,8 ---- + 2005-10-24 Michael Cadilhac + + * fileio.c: Rename `set-file-modes' to `set-file-modes-internal'. + `set-file-modes' is now a Lisp function. + 2005-10-21 Richard M. Stallman * lread.c (Fload): Simplify gcpro structure. Index: src/fileio.c =================================================================== RCS file: /cvsroot/emacs/emacs/src/fileio.c,v retrieving revision 1.557 diff -c -r1.557 fileio.c *** src/fileio.c 20 Oct 2005 15:03:10 -0000 1.557 --- src/fileio.c 23 Oct 2005 23:25:30 -0000 *************** *** 336,342 **** Lisp_Object Qfile_regular_p; Lisp_Object Qfile_accessible_directory_p; Lisp_Object Qfile_modes; ! Lisp_Object Qset_file_modes; Lisp_Object Qset_file_times; Lisp_Object Qfile_newer_than_file_p; Lisp_Object Qinsert_file_contents; --- 336,342 ---- Lisp_Object Qfile_regular_p; Lisp_Object Qfile_accessible_directory_p; Lisp_Object Qfile_modes; ! Lisp_Object Qset_file_modes_internal; Lisp_Object Qset_file_times; Lisp_Object Qfile_newer_than_file_p; Lisp_Object Qinsert_file_contents; *************** *** 3462,3469 **** return make_number (st.st_mode & 07777); } ! DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0, ! doc: /* Set mode bits of file named FILENAME to MODE (an integer). Only the 12 low bits of MODE are used. */) (filename, mode) Lisp_Object filename, mode; --- 3462,3471 ---- return make_number (st.st_mode & 07777); } ! DEFUN ("set-file-modes-internal", Fset_file_modes_internal, Sset_file_modes_internal, ! 2, 2, 0, ! doc: /* Internal use only. ! Set mode bits of file named FILENAME to MODE (an integer). Only the 12 low bits of MODE are used. */) (filename, mode) Lisp_Object filename, mode; *************** *** 3476,3484 **** /* If the file name has special constructs in it, call the corresponding file handler. */ ! handler = Ffind_file_name_handler (absname, Qset_file_modes); if (!NILP (handler)) ! return call3 (handler, Qset_file_modes, absname, mode); encoded_absname = ENCODE_FILE (absname); --- 3478,3486 ---- /* If the file name has special constructs in it, call the corresponding file handler. */ ! handler = Ffind_file_name_handler (absname, Qset_file_modes_internal); if (!NILP (handler)) ! return call3 (handler, Qset_file_modes_internal, absname, mode); encoded_absname = ENCODE_FILE (absname); *************** *** 6523,6529 **** Qfile_regular_p = intern ("file-regular-p"); Qfile_accessible_directory_p = intern ("file-accessible-directory-p"); Qfile_modes = intern ("file-modes"); ! Qset_file_modes = intern ("set-file-modes"); Qset_file_times = intern ("set-file-times"); Qfile_newer_than_file_p = intern ("file-newer-than-file-p"); Qinsert_file_contents = intern ("insert-file-contents"); --- 6525,6531 ---- Qfile_regular_p = intern ("file-regular-p"); Qfile_accessible_directory_p = intern ("file-accessible-directory-p"); Qfile_modes = intern ("file-modes"); ! Qset_file_modes_internal = intern ("set-file-modes-internal"); Qset_file_times = intern ("set-file-times"); Qfile_newer_than_file_p = intern ("file-newer-than-file-p"); Qinsert_file_contents = intern ("insert-file-contents"); *************** *** 6558,6564 **** staticpro (&Qfile_regular_p); staticpro (&Qfile_accessible_directory_p); staticpro (&Qfile_modes); ! staticpro (&Qset_file_modes); staticpro (&Qset_file_times); staticpro (&Qfile_newer_than_file_p); staticpro (&Qinsert_file_contents); --- 6560,6566 ---- staticpro (&Qfile_regular_p); staticpro (&Qfile_accessible_directory_p); staticpro (&Qfile_modes); ! staticpro (&Qset_file_modes_internal); staticpro (&Qset_file_times); staticpro (&Qfile_newer_than_file_p); staticpro (&Qinsert_file_contents); *************** *** 6791,6797 **** defsubr (&Sfile_accessible_directory_p); defsubr (&Sfile_regular_p); defsubr (&Sfile_modes); ! defsubr (&Sset_file_modes); defsubr (&Sset_file_times); defsubr (&Sset_default_file_modes); defsubr (&Sdefault_file_modes); --- 6793,6799 ---- defsubr (&Sfile_accessible_directory_p); defsubr (&Sfile_regular_p); defsubr (&Sfile_modes); ! defsubr (&Sset_file_modes_internal); defsubr (&Sset_file_times); defsubr (&Sset_default_file_modes); defsubr (&Sdefault_file_modes); Index: lisp/file-modes.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/file-modes.c,v retrieving revision 1.557 diff -c -r1.557 file-modes.el *** lisp/file-modes.el 2005-10-24 01:20:20.000000000 +0200 --- lisp/file-modes.el 2005-10-24 01:16:28.000000000 +0200 *************** *** 0 **** --- 1,148 ---- + ;;; file-modes.el --- Facilities for file modes. + + ;; Copyright (C) 2005 Free Software Foundation + + ;; Author: Michael Cadilhac + ;; Keywords: file modes + ;; Version: 0.1 + + ;; This program is free software; you can redistribute it and/or + ;; modify it under the terms of the GNU General Public License as + ;; published by the Free Software Foundation; either version 2, or (at + ;; your option) any later version. + + ;; This program is distributed in the hope that it will be useful, but + ;; WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + ;; General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + ;; Boston, MA 02110-1301, USA. + + ;;; Commentary: + + ;; This package implements functions related to file modes + ;; modification and symbolic notation modes parsing. + + ;; For more information about file modes notations see (info + ;; "(coreutils)File permissions"). + + + ;;; Code: + + ;; Specialized functions + + (defun char-to-who (c) + "Convert a char to a who-mask for symbolic modes notation. + C is in [ugoa] and represents users on which rights will apply." + (cond ((= c ?u) #o4700) + ((= c ?g) #o2070) + ((= c ?o) #o1007) + ((= c ?a) #o7777) + (t (error "%c: bad `who' character" c)))) + + (defun char-to-right (c &optional from) + "Convert a char to a right-mask for symbolic modes notation. + C is in [rwxXstugo] and represents a right. + FROM (0 if non set) is the current numeric mode to process + relative rights [Xugo]." + (unless from + (setq from 0)) + (cond ((= c ?r) #o0444) + ((= c ?w) #o0222) + ((= c ?x) #o0111) + ((= c ?s) #o1000) + ((= c ?t) #o6000) + ;; Original file-modes relative rights: + ((= c ?X) (if (= (logand from #o111) 0) 0 #o0111)) + ((= c ?u) (let ((uright (logand #o4700 from))) + (+ uright (/ uright #o10) (/ uright #o100)))) + ((= c ?g) (let ((gright (logand #o2070 from))) + (+ gright (/ gright #o10) (* gright #o10)))) + ((= c ?o) (let ((oright (logand #o1007 from))) + (+ oright (* oright #o10) (* oright #o100)))) + (t (error "%c: bad right character" c)))) + + + (defun rights-str-to-number (rights who-mask &optional from) + "Convert rights string to rights-mask for symbolic modes notation. + RIGHTS is the rights string, it should match \"([+=-][rwxXstugo]*)+\". + WHO-MASK is the mask returned by `char-to-who'. + FROM (0 if non set) is the current numeric modes considered." + (save-match-data + (let ((case-fold-search nil) + (num-rights (if from from 0)) + op) + (while (memq (setq op (string-to-char rights)) '(?+ ?- ?=)) + (if (string-match "^.\\([rwxXstugo]*\\)" rights) + (let* ((right (string-to-list (substring rights (match-beginning 1) (match-end 1)))) + (num-right (apply 'logior 0 + (mapcar (lambda (c) (char-to-right c num-rights)) right)))) + (setq num-right (logand who-mask num-right) + num-rights (cond ((= op ?+) (logior num-rights num-right)) + ((= op ?-) (logand num-rights (lognot num-right))) + (t (logior (logand num-rights (lognot who-mask)) + num-right))) + rights (substring rights (match-end 1)))) + (error "Parse error in rights string near `%s'" rights))) + num-rights))) + + (defun symbolic-modes-to-number (modes &optional from) + "Convert file modes denoted by symbolic notation to numeric modes. + MODES is the string to convert, it should match + \"[ugoa]*([+-=][rwxXstugo]*)+,...\". Look at + `(info \"(coreutils)File permissions\")' for more informations about this + notation. + FROM (0 if non set) is the current numeric modes considered." + (let ((case-fold-search nil) + (num-modes (if from from 0))) + (while (not (string= modes "")) + (if (string-match "^\\([ugoa]*\\)[^,]*\\(,\\|\\)" modes) + (let* ((who (string-to-list (substring modes (match-beginning 1) (match-end 1)))) + (num-who (apply 'logior 0 (mapcar 'char-to-who who)))) + (when (= num-who 0) + (setq num-who (default-file-modes))) + (setq num-modes + (rights-str-to-number (substring modes (match-end 1)) + num-who num-modes) + modes (substring modes (match-end 2)))) + (error "Parse error in modes near %s" modes))) + num-modes)) + + + ;; Main functions + + ;;;###autoload + (defun file-modes-to-number (modes &optional from) + "Convert file modes denoted by MODES to numeric modes. + MODES is either a string representing the modes in octal or in symbolic + notation, or a number. + FROM (0 if non set) is the numeric modes to which modes will refer is + the symbolic notation is used." + (if (stringp modes) + (if (string-match "^[0-7]+$" modes) + (string-to-number modes 8) + (symbolic-modes-to-number modes from)) + modes)) + + ;;;###autoload + (defalias 'chmod 'set-file-modes) + ;;;###autoload + (defun set-file-modes (filename modes) + "Set MODES to be the file modes of FILENAME. + MODES is either a string (symbolic or octal representation) or a number." + (interactive (list (read-file-name "Change mode: " nil nil t) + (read-string "File modes (symbolic or octal): "))) + (unless (file-exists-p filename) + (error "File %s doesn't exist" filename)) + (unless (and (stringp modes) (string= modes "")) + (set-file-modes-internal filename (file-modes-to-number modes (file-modes filename))))) + + + + (provide 'file-modes) + + ;;; arch-tag: 3cabd295-7f8a-4674-beae-fbfef54cca10 + ;;; file-modes.el ends here