]> code.delx.au - gnu-emacs/blobdiff - lisp/files.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / files.el
index 4c68ac94b40e25c070d7f8b4de24f98f9f7a17dc..be28dec4c409b8d42784b2f3e0685f9e15a1612d 100644 (file)
@@ -10,7 +10,7 @@
 
 ;; GNU Emacs 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)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -59,8 +59,9 @@ FROM with TO when it appears in a directory name.  This replacement is
 done when setting up the default directory of a newly visited file.
 *Every* FROM string should start with `^'.
 
-Do not use `~' in the TO strings.
-They should be ordinary absolute directory names.
+FROM and TO should be equivalent names, which refer to the
+same directory.  Do not use `~' in the TO strings;
+they should be ordinary absolute directory names.
 
 Use this feature when you have directories which you normally refer to
 via absolute symbolic links.  Make TO the name of the link, and FROM
@@ -162,7 +163,7 @@ The truename of a file is found by chasing all links
 both at the file level and at the levels of the containing directories."
   :type 'boolean
   :group 'find-file)
-(put 'find-file-visit-truename 'safe-local-variable 'boolean)
+(put 'find-file-visit-truename 'safe-local-variable 'booleanp)
 
 (defcustom revert-without-query nil
   "Specify which files should be reverted without query.
@@ -554,7 +555,7 @@ See Info node `(elisp)Standard File Names' for more details."
            (start 0))
        ;; Replace invalid filename characters with !
        (while (string-match "[?*:<>|\"\000-\037]" name start)
-         (aset name (match-beginning 0) ?!)
+              (aset name (match-beginning 0) ?!)
          (setq start (match-end 0)))
        name)
     filename))
@@ -643,7 +644,7 @@ The path separator is colon in GNU and GNU-like systems."
        (let ((trypath (parse-colon-path (getenv "CDPATH"))))
          (setq cd-path (or trypath (list "./")))))
     (if (not (catch 'found
-              (mapcar
+              (mapc
                (function (lambda (x)
                            (let ((f (expand-file-name (concat x dir))))
                              (if (file-directory-p f)
@@ -711,6 +712,28 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
        ((null action) (try-completion string names))
        (t (test-completion string names))))))
 
+(defun locate-dominating-file (file regexp)
+  "Look up the directory hierarchy from FILE for a file matching REGEXP."
+  (while (and file (not (file-directory-p file)))
+    (setq file (file-name-directory (directory-file-name file))))
+  (catch 'found
+    (let ((user (nth 2 (file-attributes file)))
+          ;; Abbreviate, so as to stop when we cross ~/.
+          (dir (abbreviate-file-name (file-name-as-directory file)))
+          files)
+      ;; As a heuristic, we stop looking up the hierarchy of directories as
+      ;; soon as we find a directory belonging to another user.  This should
+      ;; save us from looking in things like /net and /afs.  This assumes
+      ;; that all the files inside a project belong to the same user.
+      (while (and dir (equal user (nth 2 (file-attributes dir))))
+        (if (setq files (directory-files dir 'full regexp))
+            (throw 'found (car files))
+          (if (equal dir
+                     (setq dir (file-name-directory
+                                (directory-file-name dir))))
+              (setq dir nil))))
+      nil)))
+
 (defun executable-find (command)
   "Search for COMMAND in `exec-path' and return the absolute file name.
 Return nil if COMMAND is not found anywhere in `exec-path'."
@@ -727,17 +750,28 @@ This is an interface to the function `load'."
                          (cons load-path (get-load-suffixes)))))
   (load library))
 
-(defun file-remote-p (file)
+(defun file-remote-p (file &optional identification connected)
   "Test whether FILE specifies a location on a remote system.
 Return an identification of the system if the location is indeed
 remote.  The identification of the system may comprise a method
 to access the system and its hostname, amongst other things.
 
 For example, the filename \"/user@host:/foo\" specifies a location
-on the system \"/user@host:\"."
+on the system \"/user@host:\".
+
+IDENTIFICATION specifies which part of the identification shall
+be returned as string.  IDENTIFICATION can be the symbol
+`method', `user' or `host'; any other value is handled like nil
+and means to return the complete identification string.
+
+If CONNECTED is non-nil, the function returns an identification only
+if FILE is located on a remote system, and a connection is established
+to that remote system.
+
+`file-remote-p' will never open a connection on its own."
   (let ((handler (find-file-name-handler file 'file-remote-p)))
     (if handler
-       (funcall handler 'file-remote-p file)
+       (funcall handler 'file-remote-p file identification connected)
       nil)))
 
 (defun file-local-copy (file)
@@ -1051,6 +1085,12 @@ Recursive uses of the minibuffer will not be affected."
             ,@body)
         (remove-hook 'minibuffer-setup-hook ,hook)))))
 
+(defcustom find-file-confirm-nonexistent-file nil
+  "If non-nil, `find-file' requires confirmation before visiting a new file."
+  :group 'find-file
+  :version "23.1"
+  :type 'boolean)
+
 (defun find-file-read-args (prompt mustmatch)
   (list (let ((find-file-default
               (and buffer-file-name
@@ -1068,13 +1108,22 @@ Interactively, the default if you just type RET is the current directory,
 but the visited file name is available through the minibuffer history:
 type M-n to pull it into the minibuffer.
 
+You can visit files on remote machines by specifying something
+like /ssh:SOME_REMOTE_MACHINE:FILE for the file name.  You can
+also visit local files as a different user by specifying
+/sudo::FILE for the file name.
+See the Info node `(tramp)Filename Syntax' in the Tramp Info
+manual, for more about this.
+
 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
 expand wildcards (if any) and visit multiple files.  You can
 suppress wildcard expansion by setting `find-file-wildcards' to nil.
 
 To visit a file without any kind of conversion and without
 automatically choosing a major mode, use \\[find-file-literally]."
-  (interactive (find-file-read-args "Find file: " nil))
+  (interactive
+   (find-file-read-args "Find file: "
+                        (if find-file-confirm-nonexistent-file 'confirm-only)))
   (let ((value (find-file-noselect filename nil nil wildcards)))
     (if (listp value)
        (mapcar 'switch-to-buffer (nreverse value))
@@ -1082,8 +1131,9 @@ automatically choosing a major mode, use \\[find-file-literally]."
 
 (defun find-file-other-window (filename &optional wildcards)
   "Edit file FILENAME, in another window.
-May create a new window, or reuse an existing one.
-See the function `display-buffer'.
+
+Like \\[find-file] (which see), but creates a new window or reuses
+an existing one.  See the function `display-buffer'.
 
 Interactively, the default if you just type RET is the current directory,
 but the visited file name is available through the minibuffer history:
@@ -1091,7 +1141,9 @@ type M-n to pull it into the minibuffer.
 
 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
 expand wildcards (if any) and visit multiple files."
-  (interactive (find-file-read-args "Find file in other window: " nil))
+  (interactive
+   (find-file-read-args "Find file in other window: "
+                        (if find-file-confirm-nonexistent-file 'confirm-only)))
   (let ((value (find-file-noselect filename nil nil wildcards)))
     (if (listp value)
        (progn
@@ -1102,8 +1154,9 @@ expand wildcards (if any) and visit multiple files."
 
 (defun find-file-other-frame (filename &optional wildcards)
   "Edit file FILENAME, in another frame.
-May create a new frame, or reuse an existing one.
-See the function `display-buffer'.
+
+Like \\[find-file] (which see), but creates a new frame or reuses
+an existing one.  See the function `display-buffer'.
 
 Interactively, the default if you just type RET is the current directory,
 but the visited file name is available through the minibuffer history:
@@ -1111,7 +1164,9 @@ type M-n to pull it into the minibuffer.
 
 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
 expand wildcards (if any) and visit multiple files."
-  (interactive (find-file-read-args "Find file in other frame: " nil))
+  (interactive
+   (find-file-read-args "Find file in other frame: "
+                        (if find-file-confirm-nonexistent-file 'confirm-only)))
   (let ((value (find-file-noselect filename nil nil wildcards)))
     (if (listp value)
        (progn
@@ -1122,7 +1177,7 @@ expand wildcards (if any) and visit multiple files."
 
 (defun find-file-existing (filename)
    "Edit the existing file FILENAME.
-Like \\[find-file] but only allow a file that exists, and do not allow
+Like \\[find-file], but only allow a file that exists, and do not allow
 file names with wildcards."
    (interactive (nbutlast (find-file-read-args "Find existing file: " t)))
    (if (and (not (interactive-p)) (not (file-exists-p filename)))
@@ -1132,9 +1187,11 @@ file names with wildcards."
 
 (defun find-file-read-only (filename &optional wildcards)
   "Edit file FILENAME but don't allow changes.
-Like \\[find-file] but marks buffer as read-only.
+Like \\[find-file], but marks buffer as read-only.
 Use \\[toggle-read-only] to permit editing."
-  (interactive (find-file-read-args "Find file read-only: " nil))
+  (interactive
+   (find-file-read-args "Find file read-only: "
+                        (if find-file-confirm-nonexistent-file 'confirm-only)))
   (unless (or (and wildcards find-file-wildcards
                   (not (string-match "\\`/:" filename))
                   (string-match "[[*?]" filename))
@@ -1147,9 +1204,11 @@ Use \\[toggle-read-only] to permit editing."
 
 (defun find-file-read-only-other-window (filename &optional wildcards)
   "Edit file FILENAME in another window but don't allow changes.
-Like \\[find-file-other-window] but marks buffer as read-only.
+Like \\[find-file-other-window], but marks buffer as read-only.
 Use \\[toggle-read-only] to permit editing."
-  (interactive (find-file-read-args "Find file read-only other window: " nil))
+  (interactive
+   (find-file-read-args "Find file read-only other window: "
+                        (if find-file-confirm-nonexistent-file 'confirm-only)))
   (unless (or (and wildcards find-file-wildcards
                   (not (string-match "\\`/:" filename))
                   (string-match "[[*?]" filename))
@@ -1162,9 +1221,11 @@ Use \\[toggle-read-only] to permit editing."
 
 (defun find-file-read-only-other-frame (filename &optional wildcards)
   "Edit file FILENAME in another frame but don't allow changes.
-Like \\[find-file-other-frame] but marks buffer as read-only.
+Like \\[find-file-other-frame], but marks buffer as read-only.
 Use \\[toggle-read-only] to permit editing."
-  (interactive (find-file-read-args "Find file read-only other frame: " nil))
+  (interactive
+   (find-file-read-args "Find file read-only other frame: "
+                        (if find-file-confirm-nonexistent-file 'confirm-only)))
   (unless (or (and wildcards find-file-wildcards
                   (not (string-match "\\`/:" filename))
                   (string-match "[[*?]" filename))
@@ -1179,6 +1240,8 @@ Use \\[toggle-read-only] to permit editing."
   "Find file FILENAME as a replacement for the file in the next window.
 This command does not select that window.
 
+See \\[find-file] for the possible forms of the FILENAME argument.
+
 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
 expand wildcards (if any) and replace the file with multiple files."
   (interactive
@@ -1204,6 +1267,8 @@ expand wildcards (if any) and replace the file with multiple files."
 If the current buffer now contains an empty file that you just visited
 \(presumably by mistake), use this command to visit the file you really want.
 
+See \\[find-file] for the possible forms of the FILENAME argument.
+
 Interactively, or if WILDCARDS is non-nil in a call from Lisp,
 expand wildcards (if any) and replace the file with multiple files.
 
@@ -1268,11 +1333,14 @@ killed."
 (defun create-file-buffer (filename)
   "Create a suitably named buffer for visiting FILENAME, and return it.
 FILENAME (sans directory) is used unchanged if that name is free;
-otherwise a string <2> or <3> or ... is appended to get an unused name."
+otherwise a string <2> or <3> or ... is appended to get an unused name.
+Spaces at the start of FILENAME (sans directory) are removed."
   (let ((lastname (file-name-nondirectory filename)))
     (if (string= lastname "")
        (setq lastname filename))
-    (generate-new-buffer lastname)))
+    (save-match-data
+      (string-match "^ *\\(.*\\)" lastname)
+      (generate-new-buffer (match-string 1 lastname)))))
 
 (defun generate-new-buffer (name)
   "Create and return a buffer with a name based on NAME.
@@ -1886,7 +1954,7 @@ since only a single case-insensitive search through the alist is made."
   ;; c++-mode, java-mode and more) are added through autoload
   ;; directives in that file.  That way is discouraged since it
   ;; spreads out the definition of the initial value.
-  (mapc
+  (mapcar
    (lambda (elt)
      (cons (purecopy (car elt)) (cdr elt)))
    `(;; do this first, so that .html.pl is Polish html, not Perl
@@ -1924,7 +1992,7 @@ since only a single case-insensitive search through the alist is made."
      ("\\.[sS]\\'" . asm-mode)
      ("\\.asm\\'" . asm-mode)
      ("[cC]hange\\.?[lL]og?\\'" . change-log-mode)
-     ("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode)
+     ("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode)
      ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
      ("\\.scm\\.[0-9]*\\'" . scheme-mode)
      ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
@@ -1959,8 +2027,9 @@ since only a single case-insensitive search through the alist is made."
      ("\\.tar\\'" . tar-mode)
      ;; The list of archive file extensions should be in sync with
      ;; `auto-coding-alist' with `no-conversion' coding system.
-     ("\\.\\(arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\)\\'" . archive-mode)
-     ("\\.\\(ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\)\\'" . archive-mode)
+     ("\\.\\(\
+arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|\
+ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode)
      ("\\.\\(sx[dmicw]\\|odt\\)\\'" . archive-mode)    ; OpenOffice.org
      ;; Mailer puts message to be edited in
      ;; /tmp/Re.... or Message
@@ -1975,7 +2044,6 @@ since only a single case-insensitive search through the alist is made."
      ("\\.dtd\\'" . sgml-mode)
      ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
      ("\\.js\\'" . java-mode)          ; javascript-mode would be better
-     ("\\.x[bp]m\\'" . c-mode)
      ;; .emacs or .gnus or .viper following a directory delimiter in
      ;; Unix, MSDOG or VMS syntax.
      ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)
@@ -2012,6 +2080,9 @@ since only a single case-insensitive search through the alist is made."
      ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode)
      ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
      ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
+     ;; ChangeLog.old etc.  Other change-log-mode entries are above;
+     ;; this has lower priority to avoid matching changelog.sgml etc.
+     ("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode)
      ;; either user's dot-files or under /etc or some such
      ("/\\.?\\(?:gnokiirc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode)
      ;; alas not all ~/.*rc files are like this
@@ -2256,7 +2327,12 @@ we don't actually set it to the same mode the buffer already has."
     ;; Next compare the filename against the entries in auto-mode-alist.
     (unless done
       (if buffer-file-name
-         (let ((name buffer-file-name))
+         (let ((name buffer-file-name)
+               (remote-id (file-remote-p buffer-file-name)))
+           ;; Remove remote file name identification.
+           (when (and (stringp remote-id)
+                      (string-match (regexp-quote remote-id) name))
+             (setq name (substring name (match-end 0))))
            ;; Remove backup-suffixes from file name.
            (setq name (file-name-sans-versions name))
            (while name
@@ -2433,6 +2509,7 @@ asking you for confirmation."
        mode-line-mule-info
        mode-line-position
        mode-line-process
+       mode-line-remote
        mode-name
        outline-level
        overriding-local-map
@@ -2479,7 +2556,11 @@ asking you for confirmation."
 
 (put 'c-set-style 'safe-local-eval-function t)
 
-(defun hack-local-variables-confirm (vars unsafe-vars risky-vars)
+(defun hack-local-variables-confirm (all-vars unsafe-vars risky-vars)
+  "Get confirmation before setting up local variable values.
+ALL-VARS is the list of all variables to be set up.
+UNSAFE-VARS is the list of those that aren't marked as safe or risky.
+RISKY-VARS is the list of those that are marked as risky."
   (if noninteractive
       nil
     (let ((name (if buffer-file-name
@@ -2510,7 +2591,7 @@ n  -- to ignore the local variables list.")
 !  -- to apply the local variables list, and permanently mark these
       values (*) as safe (in the future, they will be set automatically.)\n\n")
            (insert "\n\n"))
-         (dolist (elt vars)
+         (dolist (elt all-vars)
            (cond ((member elt unsafe-vars)
                   (insert "  * "))
                  ((member elt risky-vars)
@@ -3120,17 +3201,22 @@ BACKUPNAME is the backup file name, which is the old file renamed."
          ;; loosen them later, whereas it's impossible to close the
          ;; time-window of loose permissions otherwise.
          (set-default-file-modes ?\700)
-         (while (condition-case ()
-                    (progn
-                      (condition-case nil
-                          (delete-file to-name)
-                        (file-error nil))
-                      (copy-file from-name to-name nil t)
-                      nil)
-                  (file-already-exists t))
-           ;; The file was somehow created by someone else between
-           ;; `delete-file' and `copy-file', so let's try again.
-           nil))
+         (when (condition-case nil
+                   ;; Try to overwrite old backup first.
+                   (copy-file from-name to-name t t)
+                 (error t))
+           (while (condition-case nil
+                      (progn
+                        (when (file-exists-p to-name)
+                          (delete-file to-name))
+                        (copy-file from-name to-name nil t)
+                        nil)
+                    (file-already-exists t))
+             ;; The file was somehow created by someone else between
+             ;; `delete-file' and `copy-file', so let's try again.
+             ;; rms says "I think there is also a possible race
+             ;; condition for making backup files" (emacs-devel 20070821).
+             nil)))
       ;; Reset the umask.
       (set-default-file-modes umask)))
   (and modes
@@ -3159,7 +3245,7 @@ we do not remove backup version numbers, only true file version numbers."
                         (length name))
                   (if keep-backup-version
                       (length name)
-                    (or (string-match "\\.~[0-9.]+~\\'" name)
+                    (or (string-match "\\.~[-[:alnum:]:#@^._]+~\\'" name)
                         (string-match "~\\'" name)
                         (length name))))))))
 
@@ -3934,8 +4020,9 @@ prints a message in the minibuffer.  Instead, use `set-buffer-modified-p'."
 
 (defun toggle-read-only (&optional arg)
   "Change whether this buffer is visiting its file read-only.
-With arg, set read-only iff arg is positive.
-If visiting file read-only and `view-read-only' is non-nil, enter view mode."
+With prefix argument ARG, make the buffer read-only if ARG is
+positive, otherwise make it writable.  If visiting file read-only
+and `view-read-only' is non-nil, enter view mode."
   (interactive "P")
   (if (and arg
            (if (> (prefix-numeric-value arg) 0) buffer-read-only
@@ -4019,6 +4106,8 @@ or multiple mail buffers, etc."
 
 (defun make-directory (dir &optional parents)
   "Create the directory DIR and any nonexistent parent dirs.
+If DIR already exists as a directory, do nothing.
+
 Interactively, the default choice of directory to create
 is the current default directory for file names.
 That is useful when you have visited a file in a nonexistent directory.
@@ -4390,6 +4479,14 @@ This command is used in the special Dired buffer created by
            (message "No files can be recovered from this session now")))
       (kill-buffer buffer))))
 
+(defun kill-buffer-ask (buffer)
+  "Kill buffer if confirmed."
+  (when (yes-or-no-p
+         (format "Buffer %s %s.  Kill? " (buffer-name buffer)
+                 (if (buffer-modified-p buffer)
+                     "HAS BEEN EDITED" "is unmodified")))
+    (kill-buffer buffer)))
+
 (defun kill-some-buffers (&optional list)
   "Kill some buffers.  Asks the user whether to kill each one of them.
 Non-interactively, if optional argument LIST is non-nil, it
@@ -4404,13 +4501,20 @@ specifies the list of buffers to kill, asking for approval for each one."
                                        ; if we killed the base buffer.
           (not (string-equal name ""))
           (/= (aref name 0) ?\s)
-          (yes-or-no-p
-           (format "Buffer %s %s.  Kill? "
-                   name
-                   (if (buffer-modified-p buffer)
-                       "HAS BEEN EDITED" "is unmodified")))
-          (kill-buffer buffer)))
+          (kill-buffer-ask buffer)))
     (setq list (cdr list))))
+
+(defun kill-matching-buffers (regexp &optional internal-too)
+  "Kill buffers whose name matches the specified regexp.
+The optional second argument indicates whether to kill internal buffers too."
+  (interactive "sKill buffers matching this regular expression: \nP")
+  (dolist (buffer (buffer-list))
+    (let ((name (buffer-name buffer)))
+      (when (and name (not (string-equal name ""))
+                 (or internal-too (/= (aref name 0) ?\s))
+                 (string-match regexp name))
+        (kill-buffer-ask buffer)))))
+
 \f
 (defun auto-save-mode (arg)
   "Toggle auto-saving of contents of current buffer.
@@ -4561,7 +4665,7 @@ FILENAME should lack slashes.  You can redefine this for customization."
 \f
 (defun wildcard-to-regexp (wildcard)
   "Given a shell file name pattern WILDCARD, return an equivalent regexp.
-The generated regexp will match a filename iff the filename
+The generated regexp will match a filename only if the filename
 matches that wildcard according to shell rules.  Only wildcards known
 by `sh' are supported."
   (let* ((i (string-match "[[.*+\\^$?]" wildcard))
@@ -5326,6 +5430,98 @@ only these files will be asked to be saved."
          (t
           (apply operation arguments)))))
 \f
+;; Symbolic modes and read-file-modes.
+
+(defun file-modes-char-to-who (char)
+  "Convert CHAR to a who-mask from a symbolic mode notation.
+CHAR is in [ugoa] and represents the users on which rights are applied."
+  (cond ((= char ?u) #o4700)
+       ((= char ?g) #o2070)
+       ((= char ?o) #o1007)
+       ((= char ?a) #o7777)
+       (t (error "%c: bad `who' character" char))))
+
+(defun file-modes-char-to-right (char &optional from)
+  "Convert CHAR to a right-mask from a symbolic mode notation.
+CHAR is in [rwxXstugo] and represents a right.
+If CHAR is in [Xugo], the value is extracted from FROM (or 0 if nil)."
+  (or from (setq from 0))
+  (cond ((= char ?r) #o0444)
+       ((= char ?w) #o0222)
+       ((= char ?x) #o0111)
+       ((= char ?s) #o1000)
+       ((= char ?t) #o6000)
+       ;; Rights relative to the previous file modes.
+       ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111))
+       ((= char ?u) (let ((uright (logand #o4700 from)))
+                      (+ uright (/ uright #o10) (/ uright #o100))))
+       ((= char ?g) (let ((gright (logand #o2070 from)))
+                      (+ gright (/ gright #o10) (* gright #o10))))
+       ((= char ?o) (let ((oright (logand #o1007 from)))
+                      (+ oright (* oright #o10) (* oright #o100))))
+       (t (error "%c: bad right character" char))))
+
+(defun file-modes-rights-to-number (rights who-mask &optional from)
+  "Convert a right string to a right-mask from a symbolic modes notation.
+RIGHTS is the right string, it should match \"([+=-][rwxXstugo]+)+\".
+WHO-MASK is the mask number of the users on which the rights are to be applied.
+FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+  (let* ((num-rights (or from 0))
+        (list-rights (string-to-list rights))
+        (op (pop list-rights)))
+    (while (memq op '(?+ ?- ?=))
+      (let ((num-right 0)
+           char-right)
+       (while (memq (setq char-right (pop list-rights))
+                    '(?r ?w ?x ?X ?s ?t ?u ?g ?o))
+         (setq num-right
+               (logior num-right
+                       (file-modes-char-to-right char-right num-rights))))
+       (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)))
+             op char-right)))
+    num-rights))
+
+(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
+\"[ugoa]*([+-=][rwxXstugo]+)+,...\".
+See (info \"(coreutils)File permissions\") for more information on this
+notation.
+FROM (or 0 if nil) is the orginal modes of the file to be chmod'ed."
+  (save-match-data
+    (let ((case-fold-search nil)
+         (num-modes (or from 0)))
+      (while (/= (string-to-char modes) 0)
+       (if (string-match "^\\([ugoa]*\\)\\([+=-][rwxXstugo]+\\)+\\(,\\|\\)" modes)
+           (let ((num-who (apply 'logior 0
+                                 (mapcar 'file-modes-char-to-who
+                                         (match-string 1 modes)))))
+             (when (= num-who 0)
+               (setq num-who (default-file-modes)))
+             (setq num-modes
+                   (file-modes-rights-to-number (substring modes (match-end 1))
+                                                num-who num-modes)
+                   modes (substring modes (match-end 3))))
+         (error "Parse error in modes near `%s'" (substring modes 0))))
+      num-modes)))
+
+(defun read-file-modes (&optional prompt orig-file)
+  "Read file modes in octal or symbolic notation.
+PROMPT is used as the prompt, default to `File modes (octal or symbolic): '.
+ORIG-FILE is the original file of which modes will be change."
+  (let* ((modes (or (if orig-file (file-modes orig-file) 0)
+                   (error "File not found")))
+        (value (read-string (or prompt "File modes (octal or symbolic): "))))
+    (save-match-data
+      (if (string-match "^[0-7]+" value)
+         (string-to-number value 8)
+       (file-modes-symbolic-to-number value modes)))))
+
+\f
 (define-key ctl-x-map "\C-f" 'find-file)
 (define-key ctl-x-map "\C-r" 'find-file-read-only)
 (define-key ctl-x-map "\C-v" 'find-alternate-file)