Fix typos.
[bpt/emacs.git] / lisp / wdired.el
index 2471ab9..1c5ac2f 100644 (file)
@@ -1,6 +1,7 @@
 ;;; wdired.el --- Rename files editing their names in dired buffers
 
-;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
+;;   Free Software Foundation, Inc.
 
 ;; Filename: wdired.el
 ;; Author: Juan León Lahoz García <juanleon1@gmail.com>
 
 ;; This file is part of GNU Emacs.
 
-;; 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) any later version.
+;; 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 3 of the License, 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.
+;; GNU Emacs 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.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 (defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var
 
+(eval-when-compile (require 'cl))
 (require 'dired)
 (autoload 'dired-do-create-files-regexp "dired-aux")
-(autoload 'dired-call-process "dired-aux")
 
 (defgroup wdired nil
   "Mode to rename files by editing their names in dired buffers."
@@ -130,8 +129,8 @@ is not nil."
   "If t, the \"up\" and \"down\" movement works as in Dired mode.
 That is, always move the point to the beginning of the filename at line.
 
-If `sometimes, only move to the beginning of filename if the point is
-before it, and `track-eol' is honored.  This behavior is very handy
+If `sometimes', only move to the beginning of filename if the point is
+before it, and `track-eol' is non-nil.  This behavior is very handy
 when editing several filenames.
 
 If nil, \"up\" and \"down\" movement is done as in any other buffer."
@@ -157,7 +156,7 @@ changed.  Anyway, the point is advanced one position, so, for example,
 you can keep the <x> key pressed to give execution permissions to
 everybody to that file.
 
-If `advanced, the bits are freely editable.  You can use
+If `advanced', the bits are freely editable.  You can use
 `string-rectangle', `query-replace', etc.  You can put any value (even
 newlines), but if you want your changes to be useful, you better put a
 intelligible value.
@@ -175,6 +174,7 @@ program `dired-chmod-program', which must exist."
     (define-key map "\C-c\C-c" 'wdired-finish-edit)
     (define-key map "\C-c\C-k" 'wdired-abort-changes)
     (define-key map "\C-c\C-[" 'wdired-abort-changes)
+    (define-key map "\C-x\C-q" 'wdired-exit)
     (define-key map "\C-m"     'ignore)
     (define-key map "\C-j"     'ignore)
     (define-key map "\C-o"     'ignore)
@@ -237,6 +237,8 @@ in disk.
 
 See `wdired-mode'."
   (interactive)
+  (or (eq major-mode 'dired-mode)
+      (error "Not a Dired buffer"))
   (set (make-local-variable 'wdired-old-content)
        (buffer-substring (point-min) (point-max)))
   (set (make-local-variable 'wdired-old-point) (point))
@@ -270,7 +272,7 @@ or \\[wdired-abort-changes] to abort changes")))
 ;; Protect the buffer so only the filenames can be changed, and put
 ;; properties so filenames (old and new) can be easily found.
 (defun wdired-preprocess-files ()
-  (put-text-property 1 2 'front-sticky t)
+  (put-text-property (point-min) (1+ (point-min))'front-sticky t)
   (save-excursion
     (goto-char (point-min))
     (let ((b-protection (point))
@@ -280,10 +282,13 @@ or \\[wdired-abort-changes] to abort changes")))
         (when (and filename
                   (not (member (file-name-nondirectory filename) '("." ".."))))
          (dired-move-to-filename)
-         (put-text-property (- (point) 2) (1- (point)) 'old-name filename)
-         (put-text-property b-protection (1- (point)) 'read-only t)
-         (setq b-protection (dired-move-to-end-of-filename t)))
-       (put-text-property (point) (1+ (point)) 'end-name t)
+         ;; The rear-nonsticky property below shall ensure that text preceding
+         ;; the filename can't be modified.
+         (add-text-properties
+          (1- (point)) (point) `(old-name ,filename rear-nonsticky (read-only)))
+         (put-text-property b-protection (point) 'read-only t)
+         (setq b-protection (dired-move-to-end-of-filename t))
+         (put-text-property (point) (1+ (point)) 'end-name t))
         (forward-line))
       (put-text-property b-protection (point-max) 'read-only t))))
 
@@ -309,28 +314,35 @@ relies on WDired buffer's properties.  Optional arg NO-DIR with value
 non-nil means don't include directory.  Optional arg OLD with value
 non-nil means return old filename."
   ;; FIXME: Use dired-get-filename's new properties.
-  (let* ((end (line-end-position))
-         (beg (next-single-property-change
-               (line-beginning-position) 'old-name nil end)))
-    (unless (eq beg end)
-      (let ((file
-             (if old
-                 (get-text-property beg 'old-name)
-               (wdired-normalize-filename
-                (buffer-substring-no-properties
-                 (+ 2 beg) (next-single-property-change (1+ beg) 'end-name))))))
-        (if (or no-dir old)
-            file
-          (and file (> (length file) 0)
-               (concat (dired-current-directory) file)))))))
+  (let (beg end file)
+    (save-excursion
+      (setq end (line-end-position))
+      (beginning-of-line)
+      (setq beg (next-single-property-change (point) 'old-name nil end))
+      (unless (eq beg end)
+       (if old
+           (setq file (get-text-property beg 'old-name))
+         ;; In the following form changed `(1+ beg)' to `beg' so that
+         ;; the filename end is found even when the filename is empty.
+         ;; Fixes error and spurious newlines when marking files for
+         ;; deletion.
+         (setq end (next-single-property-change beg 'end-name))
+         (setq file (buffer-substring-no-properties (1+ beg) end)))
+       (and file (setq file (wdired-normalize-filename file))))
+      (if (or no-dir old)
+         file
+       (and file (> (length file) 0)
+             (concat (dired-current-directory) file))))))
 
 
 (defun wdired-change-to-dired-mode ()
   "Change the mode back to dired."
+  (or (eq major-mode 'wdired-mode)
+      (error "Not a Wdired buffer"))
   (let ((inhibit-read-only t))
-    (remove-text-properties (point-min) (point-max)
-                           '(read-only nil local-map nil)))
-  (put-text-property 1 2 'front-sticky nil)
+    (remove-text-properties
+     (point-min) (point-max)
+     '(front-sticky nil rear-nonsticky nil read-only nil keymap nil)))
   (use-local-map dired-mode-map)
   (force-mode-line-update)
   (setq buffer-read-only t)
@@ -357,68 +369,141 @@ non-nil means return old filename."
   "Actually rename files based on your editing in the Dired buffer."
   (interactive)
   (wdired-change-to-dired-mode)
-  (let ((overwrite (or (not wdired-confirm-overwrite) 1))
-       (changes nil)
-       (files-deleted nil)
+  (let ((changes nil)
        (errors 0)
-       file-ori file-new tmp-value)
+       files-deleted
+       files-renamed
+       some-file-names-unchanged
+       file-old file-new tmp-value)
     (save-excursion
-      (if (and wdired-allow-to-redirect-links
-              (fboundp 'make-symbolic-link))
-         (progn
-           (setq tmp-value (wdired-do-symlink-changes))
-           (setq errors (cdr tmp-value))
-           (setq changes (car tmp-value))))
-      (if (and wdired-allow-to-change-permissions
-              (boundp 'wdired-col-perm)) ; could have been changed
-         (progn
-           (setq tmp-value (wdired-do-perm-changes))
-           (setq errors (+ errors (cdr tmp-value)))
-           (setq changes (or changes (car tmp-value)))))
+      (when (and wdired-allow-to-redirect-links
+                (fboundp 'make-symbolic-link))
+       (setq tmp-value (wdired-do-symlink-changes))
+       (setq errors (cdr tmp-value))
+       (setq changes (car tmp-value)))
+      (when (and wdired-allow-to-change-permissions
+                (boundp 'wdired-col-perm)) ; could have been changed
+       (setq tmp-value (wdired-do-perm-changes))
+       (setq errors (+ errors (cdr tmp-value)))
+       (setq changes (or changes (car tmp-value))))
       (goto-char (point-max))
       (while (not (bobp))
-       (setq file-ori (wdired-get-filename nil t))
-       (if file-ori
-           (setq file-new (wdired-get-filename)))
-       (if (and file-ori (not (equal file-new file-ori)))
-           (progn
-             (setq changes t)
-             (if (not file-new) ;empty filename!
-                 (setq files-deleted (cons file-ori files-deleted))
-               (progn
-                 (setq file-new (substitute-in-file-name file-new))
-                 (if wdired-use-interactive-rename
-                     (wdired-search-and-rename file-ori file-new)
-                    ;; If dired-rename-file autoloads dired-aux while
-                    ;; dired-backup-overwrite is locally bound,
-                    ;; dired-backup-overwrite won't be initialized.
-                    ;; So we must ensure dired-aux is loaded.
-                    (require 'dired-aux)
-                   (condition-case err
-                       (let ((dired-backup-overwrite nil))
-                         (dired-rename-file file-ori file-new
-                                            overwrite))
-                     (error
-                      (setq errors (1+ errors))
-                      (dired-log (concat "Rename `" file-ori "' to `"
-                                         file-new "' failed:\n%s\n")
-                                 err))))))))
+       (setq file-old (wdired-get-filename nil t))
+       (when file-old
+         (setq file-new (wdired-get-filename))
+          (if (equal file-new file-old)
+             (setq some-file-names-unchanged t)
+            (setq changes t)
+            (if (not file-new)         ;empty filename!
+                (push file-old files-deleted)
+              (push (cons file-old (substitute-in-file-name file-new))
+                    files-renamed))))
        (forward-line -1)))
+    (when files-renamed
+      (setq errors (+ errors (wdired-do-renames files-renamed))))
     (if changes
-        (revert-buffer) ;The "revert" is necessary to re-sort the buffer
+       (progn
+         ;; If we are displaying a single file (rather than the
+         ;; contents of a directory), change dired-directory if that
+         ;; file was renamed.  (This ought to be generalized to
+         ;; handle the multiple files case, but that's less trivial).
+         (when (and (stringp dired-directory)
+                    (not (file-directory-p dired-directory))
+                    (null some-file-names-unchanged)
+                    (= (length files-renamed) 1))
+           (setq dired-directory (cdr (car files-renamed))))
+         ;; Re-sort the buffer.
+         (revert-buffer))
       (let ((inhibit-read-only t))
        (remove-text-properties (point-min) (point-max)
                                '(old-name nil end-name nil old-link nil
                                           end-link nil end-perm nil
                                           old-perm nil perm-changed nil))
        (message "(No changes to be performed)")))
-    (if files-deleted
-        (wdired-flag-for-deletion files-deleted))
-    (if (> errors 0)
-        (dired-log-summary (format "%d rename actions failed" errors) nil)))
+    (when files-deleted
+      (wdired-flag-for-deletion files-deleted))
+    (when (> errors 0)
+      (dired-log-summary (format "%d rename actions failed" errors) nil)))
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil))
 
+(defun wdired-do-renames (renames)
+  "Perform RENAMES in parallel."
+  (let ((residue ())
+        (progress nil)
+        (errors 0)
+        (overwrite (or (not wdired-confirm-overwrite) 1)))
+    (while (or renames
+               ;; We've done one round through the renames, we have found
+               ;; some residue, but we also made some progress, so maybe
+               ;; some of the residue were resolved: try again.
+               (prog1 (setq renames residue)
+                 (setq progress nil)
+                 (setq residue nil)))
+      (let* ((rename (pop renames))
+             (file-new (cdr rename)))
+        (cond
+         ((rassoc file-new renames)
+          (error "Trying to rename 2 files to the same name"))
+         ((assoc file-new renames)
+          ;; Renaming to a file name that already exists but will itself be
+          ;; renamed as well.  Let's wait until that one gets renamed.
+          (push rename residue))
+         ((and (assoc file-new residue)
+               ;; Make sure the file really exists: if it doesn't it's
+               ;; not really a conflict.  It might be a temp-file generated
+               ;; specifically to break a circular renaming.
+               (file-exists-p file-new))
+          ;; Renaming to a file name that already exists, needed to be renamed,
+          ;; but whose renaming could not be performed right away.
+          (if (or progress renames)
+              ;; There's still a chance the conflict will be resolved.
+              (push rename residue)
+            ;; We have not made any progress and we've reached the end of
+            ;; the renames, so we really have a circular conflict, and we
+            ;; have to forcefully break the cycle.
+            (message "Circular renaming: using temporary file name")
+            (let ((tmp (make-temp-name file-new)))
+              (push (cons (car rename) tmp) renames)
+              (push (cons tmp file-new) residue))))
+         (t
+          (setq progress t)
+          (let ((file-ori (car rename)))
+            (if wdired-use-interactive-rename
+                (wdired-search-and-rename file-ori file-new)
+              ;; If dired-rename-file autoloads dired-aux while
+              ;; dired-backup-overwrite is locally bound,
+              ;; dired-backup-overwrite won't be initialized.
+              ;; So we must ensure dired-aux is loaded.
+              (require 'dired-aux)
+              (condition-case err
+                  (let ((dired-backup-overwrite nil))
+                    (dired-rename-file file-ori file-new
+                                       overwrite))
+                (error
+                 (setq errors (1+ errors))
+                 (dired-log (concat "Rename `" file-ori "' to `"
+                                    file-new "' failed:\n%s\n")
+                            err)))))))))
+    errors))
+
+
+(defun wdired-exit ()
+  "Exit wdired and return to dired mode.
+Just return to dired mode if there are no changes.  Otherwise,
+ask a yes-or-no question whether to save or cancel changes,
+and proceed depending on the answer."
+  (interactive)
+  (if (buffer-modified-p)
+      (if (y-or-n-p (format "Buffer %s modified; save changes? "
+                           (current-buffer)))
+         (wdired-finish-edit)
+       (wdired-abort-changes))
+    (wdired-change-to-dired-mode)
+    (set-buffer-modified-p nil)
+    (setq buffer-undo-list nil)
+    (message "(No changes need to be saved)")))
+
 ;; Rename a file, searching it in a modified dired buffer, in order
 ;; to be able to use `dired-do-create-files-regexp' and get its
 ;; "benefits".
@@ -426,14 +511,13 @@ non-nil means return old filename."
   (save-excursion
     (goto-char (point-max))
     (forward-line -1)
-    (let ((exit-while nil)
+    (let ((done nil)
          curr-filename)
-      (while (not exit-while)
-        (setq curr-filename (wdired-get-filename))
-        (if (and curr-filename
-                 (equal (substitute-in-file-name curr-filename) filename-new))
+      (while (and (not done) (not (bobp)))
+        (setq curr-filename (wdired-get-filename nil t))
+        (if (equal curr-filename filename-ori)
             (progn
-              (setq exit-while t)
+              (setq done t)
               (let ((inhibit-read-only t))
                 (dired-move-to-filename)
                 (search-forward (wdired-get-filename t) nil t)
@@ -441,10 +525,7 @@ non-nil means return old filename."
               (dired-do-create-files-regexp
                (function dired-rename-file)
                "Move" 1 ".*" filename-new nil t))
-          (progn
-            (forward-line -1)
-            (beginning-of-line)
-            (setq exit-while (= 1 (point)))))))))
+         (forward-line -1))))))
 
 ;; marks a list of files for deletion
 (defun wdired-flag-for-deletion (filenames-ori)
@@ -472,14 +553,14 @@ Optional arguments are ignored."
   (if (and
        (buffer-modified-p)
        (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
-      (error nil)))
+      (error "Error")))
 
 (defun wdired-next-line (arg)
   "Move down lines then position at filename or the current column.
 See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
 says how many lines to move; default is one line."
   (interactive "p")
-  (next-line arg)
+  (with-no-warnings (next-line arg))
   (if (or (eq wdired-use-dired-vertical-movement t)
          (and wdired-use-dired-vertical-movement
               (< (current-column)
@@ -492,7 +573,7 @@ says how many lines to move; default is one line."
 See `wdired-use-dired-vertical-movement'.  Optional prefix ARG
 says how many lines to move; default is one line."
   (interactive "p")
-  (previous-line arg)
+  (with-no-warnings (previous-line arg))
   (if (or (eq wdired-use-dired-vertical-movement t)
          (and wdired-use-dired-vertical-movement
               (< (current-column)
@@ -513,7 +594,10 @@ says how many lines to move; default is one line."
                                 (1- (match-beginning 1)) 'old-link
                                 (match-string-no-properties 1))
               (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
-             (put-text-property (1- (match-beginning 1))
+              (put-text-property (1- (match-beginning 1))
+                                (match-beginning 1)
+                                'rear-nonsticky '(read-only))
+             (put-text-property (match-beginning 1)
                                 (match-end 1) 'read-only nil)))
         (forward-line)
        (beginning-of-line)))))
@@ -522,15 +606,18 @@ says how many lines to move; default is one line."
 (defun wdired-get-previous-link (&optional old move)
   "Return the next symlink target.
 If OLD, return the old target.  If MOVE, move point before it."
-  (let ((beg (previous-single-property-change (point) 'old-link nil)))
-    (when beg
-      (let ((target
-             (if old
-                 (get-text-property (1- beg) 'old-link)
-               (buffer-substring-no-properties
-                (1+ beg) (next-single-property-change beg 'end-link)))))
-        (if move (goto-char (1- beg)))
-        (and target (wdired-normalize-filename target))))))
+  (let (beg end target)
+    (setq beg (previous-single-property-change (point) 'old-link nil))
+    (if beg
+       (progn
+         (if old
+             (setq target (get-text-property (1- beg) 'old-link))
+           (setq end (next-single-property-change beg 'end-link))
+           (setq target (buffer-substring-no-properties (1+ beg) end)))
+         (if move (goto-char (1- beg)))))
+    (and target (wdired-normalize-filename target))))
+
+(declare-function make-symbolic-link "fileio.c")
 
 ;; Perform the changes in the target of the changed links.
 (defun wdired-do-symlink-changes ()
@@ -567,8 +654,11 @@ If OLD, return the old target.  If MOVE, move point before it."
             (funcall command 1)
             (setq arg (1- arg)))
         (error
-         (if (not (forward-word 1))
-             (setq arg 0)))))))
+         (if (forward-word)
+            ;; Skip any non-word characters to avoid triggering a read-only
+            ;; error which would cause skipping the next word characters too.
+            (skip-syntax-forward "^w")
+          (setq arg 0)))))))
 
 (defun wdired-downcase-word (arg)
   "WDired version of `downcase-word'.
@@ -608,29 +698,34 @@ Like original function but it skips read-only words."
     (define-key map [down-mouse-1] 'wdired-mouse-toggle-bit)
     map))
 
-;; Put a local-map to the permission bits of the files, and store the
+;; Put a keymap property to the permission bits of the files, and store the
 ;; original name and permissions as a property
 (defun wdired-preprocess-perms ()
-  (let ((inhibit-read-only t)
-       filename)
+  (let ((inhibit-read-only t))
     (set (make-local-variable 'wdired-col-perm) nil)
     (save-excursion
       (goto-char (point-min))
       (while (not (eobp))
-       (if (and (not (looking-at dired-re-sym))
-                (setq filename (wdired-get-filename)))
-           (progn
-             (re-search-forward dired-re-perms)
-             (or wdired-col-perm
-                 (setq wdired-col-perm (- (current-column) 9)))
-             (if (eq wdired-allow-to-change-permissions 'advanced)
-                 (put-text-property (match-beginning 0) (match-end 0)
-                                    'read-only nil)
-               (put-text-property (1+ (match-beginning 0)) (match-end 0)
-                                  'keymap wdired-perm-mode-map))
-             (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t)
-             (put-text-property (match-beginning 0) (1+ (match-beginning 0))
-                                'old-perm (match-string-no-properties 0))))
+       (when (and (not (looking-at dired-re-sym))
+                  (wdired-get-filename)
+                  (re-search-forward dired-re-perms (line-end-position) 'eol))
+         (let ((begin (match-beginning 0))
+               (end (match-end 0)))
+           (unless wdired-col-perm
+             (setq wdired-col-perm (- (current-column) 9)))
+           (if (eq wdired-allow-to-change-permissions 'advanced)
+               (progn
+                 (put-text-property begin end 'read-only nil)
+                 ;; make first permission bit writable
+                 (put-text-property
+                  (1- begin) begin 'rear-nonsticky '(read-only)))
+             ;; avoid that keymap applies to text following permissions
+             (add-text-properties
+              (1+ begin) end
+              `(keymap ,wdired-perm-mode-map rear-nonsticky (keymap))))
+           (put-text-property end (1+ end) 'end-perm t)
+           (put-text-property
+            begin (1+ begin) 'old-perm (match-string-no-properties 0))))
         (forward-line)
        (beginning-of-line)))))
 
@@ -647,33 +742,36 @@ Like original function but it skips read-only words."
 (defun wdired-set-bit ()
   "Set a permission bit character."
   (interactive)
-  (if (wdired-perm-allowed-in-pos last-command-char
+  (if (wdired-perm-allowed-in-pos last-command-event
                                   (- (current-column) wdired-col-perm))
-      (let ((new-bit (char-to-string last-command-char))
+      (let ((new-bit (char-to-string last-command-event))
             (inhibit-read-only t)
            (pos-prop (- (point) (- (current-column) wdired-col-perm))))
         (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
         (put-text-property 0 1 'read-only t new-bit)
         (insert new-bit)
         (delete-char 1)
-       (put-text-property pos-prop (1- pos-prop) 'perm-changed t))
+       (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
+       (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap)))
     (forward-char 1)))
 
 (defun wdired-toggle-bit ()
   "Toggle the permission bit at point."
   (interactive)
   (let ((inhibit-read-only t)
-       (new-bit (cond
-                  ((not (eq (char-after (point)) ?-)) "-")
-                  ((= (% (- (current-column) wdired-col-perm) 3) 0) "r")
-                  ((= (% (- (current-column) wdired-col-perm) 3) 1) "w")
-                  (t "x")))
+       (new-bit "-")
        (pos-prop (- (point) (- (current-column) wdired-col-perm))))
+    (if (eq (char-after (point)) ?-)
+       (setq new-bit
+             (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
+               (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
+                 "x"))))
     (put-text-property 0 1 'keymap wdired-perm-mode-map new-bit)
     (put-text-property 0 1 'read-only t new-bit)
     (insert new-bit)
     (delete-char 1)
-    (put-text-property pos-prop (1- pos-prop) 'perm-changed t)))
+    (put-text-property (1- pos-prop) pos-prop 'perm-changed t)
+    (put-text-property (1- (point)) (point) 'rear-nonsticky '(keymap))))
 
 (defun wdired-mouse-toggle-bit (event)
   "Toggle the permission bit that was left clicked."
@@ -685,28 +783,23 @@ Like original function but it skips read-only words."
 ;; Allowed chars for 2000 bit are Ssl in position 6
 ;; Allowed chars for 1000 bit are Tt  in position 9
 (defun wdired-perms-to-number (perms)
-  (+
-   (if (= (elt perms 1) ?-) 0 400)
-   (if (= (elt perms 2) ?-) 0 200)
-   (case (elt perms 3)
-     (?- 0)
-     (?S 4000)
-     (?s 4100)
-     (t 100))
-   (if (= (elt perms 4) ?-) 0 40)
-   (if (= (elt perms 5) ?-) 0 20)
-   (case (elt perms 6)
-     (?- 0)
-     (?S 2000)
-     (?s 2010)
-     (t 10))
-   (if (= (elt perms 7) ?-) 0 4)
-   (if (= (elt perms 8) ?-) 0 2)
-   (case (elt perms 9)
-     (?- 0)
-     (?T 1000)
-     (?t 1001)
-     (t 1))))
+  (let ((nperm 0777))
+    (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
+    (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
+    (let ((p-bit (elt perms 3)))
+      (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
+      (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
+    (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
+    (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
+    (let ((p-bit (elt perms 6)))
+      (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
+      (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
+    (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
+    (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
+    (let ((p-bit (elt perms 9)))
+      (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
+      (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
+    nperm))
 
 ;; Perform the changes in the permissions of the files that have
 ;; changed.
@@ -729,8 +822,8 @@ Like original function but it skips read-only words."
             (progn
               (setq perm-tmp
                     (int-to-string (wdired-perms-to-number perms-new)))
-              (unless (equal 0 (dired-call-process dired-chmod-program
-                                                   t perm-tmp filename))
+              (unless (equal 0 (process-file dired-chmod-program
+                                            nil nil nil perm-tmp filename))
                 (setq errors (1+ errors))
                 (dired-log (concat dired-chmod-program " " perm-tmp
                                    " `" filename "' failed\n\n"))))