Download
(eval-when-compile
(require 'advice)
(defvar make-symbolic-link)
(defvar dired-backup-overwrite)
(set (make-local-variable 'byte-compile-dynamic) t))
(eval-and-compile
(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."
:group 'dired)
(defcustom wdired-use-interactive-rename nil
"*If t, confirmation is required before actually rename the files.
Confirmation is required also for overwriting files. If nil, no
confirmation is required for change the file names, and the variable
`wdired-is-ok-overwrite' is used to see if it is ok to overwrite files
without asking."
:type 'boolean
:group 'wdired)
(defcustom wdired-is-ok-overwrite nil
"*If non-nil the renames can overwrite files without asking.
This variable is used only if `wdired-use-interactive-rename' is nil."
:type 'boolean
:group 'wdired)
(defcustom wdired-always-move-to-filename-beginning nil
"*If t the \"up\" and \"down\" movement is done 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
when editing several filenames.
If nil, \"up\" and \"down\" movement is done as in any other buffer."
:type '(choice (const :tag "As in any other mode" nil)
(const :tag "Smart cursor placement" sometimes)
(other :tag "As in dired mode" t))
:group 'wdired)
(defcustom wdired-advise-functions t
"*If t some editing commands are advised when wdired is loaded.
The advice only has effect in wdired mode. These commands are
`query-replace' `query-replace-regexp' `replace-string', and the
advice makes them to ignore read-only regions, so no attempts to
modify these regions are done by them, and so they don't end
prematurely.
Setting this to nil does not unadvise the functions, if they are
already advised, but new Emacs will not advise them"
:type 'boolean
:group 'wdired)
(defcustom wdired-allow-to-redirect-links t
"*If non-nil, the target of the symbolic links can be changed also.
In systems without symbolic links support, this variable has no effect
at all."
:type 'boolean
:group 'wdired)
(defcustom wdired-allow-to-change-permissions nil
"*If non-nil, the permissions bits of the files can be changed also.
If t, to change a single bit, put the cursor over it and press the
space bar, or left click over it. You can also hit the letter you want
to set: if this value is allowed, the character in the buffer will be
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
`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.
Anyway, the real change of the permissions is done with the external
program `dired-chmod-program', which must exist."
:type '(choice (const :tag "Not allowed" nil)
(const :tag "Toggle/set bits" t)
(other :tag "Bits freely editable" advanced))
:group 'wdired)
(defvar wdired-running-xemacs (featurep 'xemacs))
(require 'dired)
(if (not wdired-running-xemacs)
(define-key dired-mode-map [menu-bar immediate
wdired-change-to-wdired-mode]
'("Edit File Names" . wdired-change-to-wdired-mode))
(add-hook 'dired-mode-hook
(lambda ()
(add-menu-button
'("Do") (vector "Edit File Names"
'wdired-change-to-wdired-mode))) t))
(defvar wdired-mode-map nil)
(unless wdired-mode-map
(setq wdired-mode-map (make-sparse-keymap))
(define-key wdired-mode-map "\C-x\C-s" 'wdired-finish-edit)
(define-key wdired-mode-map "\C-c\C-c" 'wdired-finish-edit)
(define-key wdired-mode-map "\C-c\C-k" 'wdired-abort-changes)
(define-key wdired-mode-map "\C-c\C-[" 'wdired-abort-changes)
(define-key wdired-mode-map [return] 'wdired-newline)
(define-key wdired-mode-map "\C-j" 'wdired-newline)
(define-key wdired-mode-map "\C-o" 'wdired-newline)
(define-key wdired-mode-map [up] 'wdired-previous-line)
(define-key wdired-mode-map "\C-p" 'wdired-previous-line)
(define-key wdired-mode-map [down] 'wdired-next-line)
(define-key wdired-mode-map "\C-n" 'wdired-next-line)
(if wdired-running-xemacs
(setq wdired-xemacs-menu '("WDired"
["Options" wdired-customize]
"---"
["Abort Changes" wdired-abort-changes]
["Commit Changes" wdired-finish-edit]))
(define-key wdired-mode-map [menu-bar wdired]
(cons "WDired" (make-sparse-keymap "WDired")))
(define-key wdired-mode-map [menu-bar wdired wdired-customize]
'("Options" . wdired-customize))
(define-key wdired-mode-map [menu-bar wdired dashes]
'("--"))
(define-key wdired-mode-map [menu-bar wdired wdired-abort-changes]
'("Abort Changes" . wdired-abort-changes))
(define-key wdired-mode-map [menu-bar wdired wdired-finish-edit]
'("Commit Changes" . wdired-finish-edit)))
(substitute-key-definition 'upcase-word 'wdired-upcase-word
wdired-mode-map global-map)
(substitute-key-definition 'capitalize-word 'wdired-capitalize-word
wdired-mode-map global-map)
(substitute-key-definition 'downcase-word 'wdired-downcase-word
wdired-mode-map global-map))
(defvar wdired-mode-hooks nil
"Hooks run when changing to wdired mode.")
(defvar wdired-load-hooks nil
"Hooks run after loading wdired code.")
(defvar wdired-col-perm)
(defvar wdired-old-content)
(or (fboundp 'buffer-substring-no-properties)
(fset 'buffer-substring-no-properties 'buffer-substring))
(or (fboundp 'match-string-no-properties)
(defun match-string-no-properties (number)
"Return string of text matched by last search."
(buffer-substring-no-properties (match-beginning number)
(match-end number))))
(defun wdired-mode ()
"\\<wdired-mode-map>File Names Editing mode.
Press \\[wdired-finish-edit] to make the changes to take effect and
exit. To abort the edit, use \\[wdired-abort-changes].
In this mode you can edit the names of the files, the target of the
links and the permission bits of the files. You can `customize-group'
wdired.
Editing things out of the filenames, or adding or deleting lines is
not allowed, because the rest of the buffer is read-only."
(interactive)
(error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
(put 'wdired-mode 'mode-class 'special)
(defun wdired-change-to-wdired-mode ()
"Put a dired buffer in a mode in which filenames are editable.
In this mode the names of the files can be changed, and after
typing C-c C-c the files and directories in disk are renamed.
See `wdired-mode'."
(interactive)
(set (make-local-variable 'wdired-old-content)
(buffer-substring (point-min) (point-max)))
(use-local-map wdired-mode-map)
(if wdired-running-xemacs
(add-submenu nil wdired-xemacs-menu)
(menu-bar-mode (or menu-bar-mode -1)))
(setq buffer-read-only nil)
(dired-unadvertise default-directory)
(add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
(setq major-mode 'wdired-mode)
(setq mode-name "Edit filenames")
(setq revert-buffer-function 'wdired-revert)
(buffer-disable-undo)
(wdired-preprocess-files)
(if wdired-allow-to-change-permissions
(wdired-preprocess-perms))
(if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
(wdired-preprocess-symlinks))
(buffer-enable-undo)
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
(run-hooks wdired-mode-hooks)
(message "Press C-c C-c when finished"))
(defun wdired-preprocess-files ()
(put-text-property 1 2 'front-sticky t)
(save-excursion
(goto-char (point-min))
(let ((b-protection (point))
(dot-dirs (concat (list directory-sep-char) "\\.\\.?$"))
filename)
(while (not (eobp))
(setq filename (dired-get-filename nil t))
(when (and filename (not (string-match dot-dirs 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)))
(put-text-property (point) (1+ (point)) 'end-name t)
(forward-line))
(put-text-property b-protection (point-max) 'read-only t))))
(defsubst wdired-normalize-filename (file)
(when (or (not wdired-running-xemacs) (memq ?b dired-internal-switches))
(setq file
(read (concat "\""
(or (dired-string-replace-match
"\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
file)
"\""))))
(and file
(boundp 'buffer-file-coding-system) buffer-file-coding-system
(not file-name-coding-system)
(or
(not (boundp 'default-file-name-coding-system))
(not default-file-name-coding-system))
(setq file (encode-coding-string file
buffer-file-coding-system)))
file)
(defun wdired-get-filename (&optional no-dir old)
"Return the filename at line.
Similar to `dired-get-filename' but it doesn't rely on regexps. It
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."
(let (beg end file)
(save-excursion
(setq end (progn (end-of-line) (point)))
(beginning-of-line)
(setq beg (next-single-property-change (point) 'old-name nil end))
(if (not (eq beg end))
(progn
(if old
(setq file (get-text-property beg 'old-name))
(setq end (next-single-property-change (1+ beg) 'end-name))
(setq file (buffer-substring-no-properties (+ 2 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."
(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)
(use-local-map dired-mode-map)
(if wdired-running-xemacs
(delete-menu-item '("WDired"))
(menu-bar-mode (or menu-bar-mode -1)))
(setq buffer-read-only t)
(setq major-mode 'dired-mode)
(setq mode-name "Dired")
(dired-advertise)
(remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
(setq revert-buffer-function 'dired-revert))
(defun wdired-abort-changes ()
"Abort changes and return to dired mode."
(interactive)
(let ((inhibit-read-only t))
(erase-buffer)
(insert wdired-old-content))
(wdired-change-to-dired-mode)
(set-buffer-modified-p nil)
(setq buffer-undo-list nil))
(defun wdired-log (log &rest args)
"Calls dired-log, with a `BUFFER-NAME' parameter under XEmacs"
(if wdired-running-xemacs
(dired-log (buffer-name) log args)
(dired-log log args)))
(defun wdired-finish-edit ()
"Actually rename files based on your editing in the Dired buffer."
(interactive)
(wdired-change-to-dired-mode)
(let ((overwrite (or wdired-is-ok-overwrite 1))
(changes nil)
(files-deleted nil)
(errors 0)
file-ori 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))
(progn
(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)
(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)
(condition-case err
(let ((dired-backup-overwrite nil))
(dired-rename-file file-ori file-new
overwrite))
(error
(setq errors (1+ errors))
(wdired-log (concat "Rename `" file-ori "' to `"
file-new "' failed:\n%s\n")
err))))))))
(forward-line -1)))
(if changes
(revert-buffer)
(let ((buffer-read-only nil))
(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)
(if wdired-running-xemacs
(dired-log-summary (buffer-name)
(format "%d rename actions failed" errors) nil)
(dired-log-summary (format "%d rename actions failed" errors) nil))))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil))
(defun wdired-search-and-rename (filename-ori filename-new)
(save-excursion
(goto-char (point-max))
(forward-line -1)
(let ((exit-while 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))
(progn
(setq exit-while t)
(let ((inhibit-read-only t))
(dired-move-to-filename)
(search-forward (wdired-get-filename t) nil t)
(replace-match (file-name-nondirectory filename-ori) t t))
(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)))))))))
(defun wdired-flag-for-deletion (filenames-ori)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (member (dired-get-filename nil t) filenames-ori)
(dired-flag-file-deletion 1)
(forward-line)))))
(defun wdired-customize ()
"Customize wdired options."
(interactive)
(customize-apropos "wdired" 'groups))
(defun wdired-revert (&optional arg noconfirm)
"Discard changes in the buffer and update the changes in the disk."
(wdired-change-to-dired-mode)
(revert-buffer)
(wdired-change-to-wdired-mode))
(defun wdired-check-kill-buffer ()
(if (and
(buffer-modified-p)
(not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
(error nil)))
(defun wdired-next-line (arg)
"Move down lines then position at filename or the current column.
See `wdired-always-move-to-filename-beginning'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "p")
(next-line arg)
(if (or (eq wdired-always-move-to-filename-beginning t)
(and wdired-always-move-to-filename-beginning
(< (current-column)
(save-excursion (dired-move-to-filename)
(current-column)))))
(dired-move-to-filename)))
(defun wdired-previous-line (arg)
"Move up lines then position at filename or the current column.
See `wdired-always-move-to-filename-beginning'. Optional prefix ARG
says how many lines to move; default is one line."
(interactive "p")
(previous-line arg)
(if (or (eq wdired-always-move-to-filename-beginning t)
(and wdired-always-move-to-filename-beginning
(< (current-column)
(save-excursion (dired-move-to-filename)
(current-column)))))
(dired-move-to-filename)))
(defun wdired-newline ()
"Do nothing."
(interactive))
(defun wdired-preprocess-symlinks ()
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (looking-at dired-re-sym)
(progn
(re-search-forward " -> \\(.*\\)$")
(put-text-property (- (match-beginning 1) 2)
(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))
(match-end 1) 'read-only nil)))
(forward-line)
(beginning-of-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 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))))
(defun wdired-do-symlink-changes()
(let ((changes nil)
(errors 0)
link-to-ori link-to-new link-from)
(goto-char (point-max))
(while (setq link-to-new (wdired-get-previous-link))
(setq link-to-ori (wdired-get-previous-link t t))
(setq link-from (wdired-get-filename nil t))
(if (not (equal link-to-new link-to-ori))
(progn
(setq changes t)
(if (equal link-to-new "")
(setq link-to-new "/dev/null"))
(condition-case err
(progn
(delete-file link-from)
(make-symbolic-link
(substitute-in-file-name link-to-new) link-from))
(error
(setq errors (1+ errors))
(wdired-log (concat "Link `" link-from "' to `"
link-to-new "' failed:\n%s\n")
err))))))
(cons changes errors)))
(defun wdired-xcase-word (command arg)
(if (< arg 0)
(funcall command arg)
(progn
(while (> arg 0)
(condition-case err
(progn
(funcall command 1)
(setq arg (1- arg)))
(error
(if (not (forward-word 1))
(setq arg 0))))))))
(defun wdired-downcase-word (arg)
"Wdired version of `downcase-word'.
Like original function but it skips read-only words."
(interactive "p")
(wdired-xcase-word 'downcase-word arg))
(defun wdired-upcase-word (arg)
"Wdired version of `upcase-word'.
Like original function but it skips read-only words."
(interactive "p")
(wdired-xcase-word 'upcase-word arg))
(defun wdired-capitalize-word (arg)
"Wdired version of `capitalize-word'.
Like original function but it skips read-only words."
(interactive "p")
(wdired-xcase-word 'capitalize-word arg))
(defun wdired-add-skip-in-replace (command)
"Advice COMMAND to skip matches while they have read-only properties.
This is useful to avoid \"read-only\" errors in search and replace
commands. This advice only has effect in wdired mode."
(eval
`(defadvice ,command (around wdired-discard-read-only activate)
,(format "Make %s to work better with wdired,\n%s." command
"skipping read-only matches when invoked without argument")
ad-do-it
(if (eq major-mode 'wdired-mode)
(while (and ad-return-value
(text-property-any
(max 1 (1- (match-beginning 0))) (match-end 0)
'read-only t))
ad-do-it))
ad-return-value)))
(defun wdired-add-replace-advice (command)
"Advice COMMAND to skip matches while they have read-only properties.
This is useful to avoid \"read-only\" errors in search and replace
commands. This advice only has effect in wdired mode."
(eval
`(defadvice ,command (around wdired-grok-read-only activate)
,(format "Make %s to work better with wdired,\n%s." command
"skipping read-only matches when invoked without argument")
(if (eq major-mode 'wdired-mode)
(progn
(wdired-add-skip-in-replace 'search-forward)
(wdired-add-skip-in-replace 're-search-forward)
(unwind-protect
ad-do-it
(progn
(ad-remove-advice 'search-forward
'around 'wdired-discard-read-only)
(ad-remove-advice 're-search-forward
'around 'wdired-discard-read-only)
(ad-update 'search-forward)
(ad-update 're-search-forward))))
ad-do-it)
ad-return-value)))
(if wdired-advise-functions
(progn
(mapcar 'wdired-add-replace-advice
'(query-replace query-replace-regexp replace-string))))
(defvar wdired-perm-mode-map nil)
(unless wdired-perm-mode-map
(setq wdired-perm-mode-map (copy-keymap wdired-mode-map))
(define-key wdired-perm-mode-map " " 'wdired-toggle-bit)
(define-key wdired-perm-mode-map "r" 'wdired-set-bit)
(define-key wdired-perm-mode-map "w" 'wdired-set-bit)
(define-key wdired-perm-mode-map "x" 'wdired-set-bit)
(define-key wdired-perm-mode-map "-" 'wdired-set-bit)
(define-key wdired-perm-mode-map "S" 'wdired-set-bit)
(define-key wdired-perm-mode-map "s" 'wdired-set-bit)
(define-key wdired-perm-mode-map "T" 'wdired-set-bit)
(define-key wdired-perm-mode-map "t" 'wdired-set-bit)
(define-key wdired-perm-mode-map "s" 'wdired-set-bit)
(define-key wdired-perm-mode-map "l" 'wdired-set-bit)
(define-key wdired-perm-mode-map [down-mouse-1] 'wdired-mouse-toggle-bit))
(defun wdired-preprocess-perms()
(let ((inhibit-read-only t)
filename)
(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)
'local-map 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))))
(forward-line)
(beginning-of-line)))))
(defun wdired-perm-allowed-in-pos (char pos)
(cond
((= char ?-) t)
((= char ?r) (= (% pos 3) 0))
((= char ?w) (= (% pos 3) 1))
((= char ?x) (= (% pos 3) 2))
((memq char '(?s ?S)) (memq pos '(2 5)))
((memq char '(?t ?T)) (= pos 8))
((= char ?l) (= pos 5))))
(defun wdired-set-bit ()
"Set a permission bit character."
(interactive)
(if (wdired-perm-allowed-in-pos last-command-char
(- (current-column) wdired-col-perm))
(let ((new-bit (char-to-string last-command-char))
(inhibit-read-only t)
(pos-prop (- (point) (- (current-column) wdired-col-perm))))
(put-text-property 0 1 'local-map 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))
(forward-char 1)))
(defun wdired-toggle-bit()
"Toggle the permission bit at point."
(interactive)
(let ((inhibit-read-only t)
(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 'local-map 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)))
(defun wdired-mouse-toggle-bit (event)
"Toggle the permission bit that was left clicked."
(interactive "e")
(mouse-set-point event)
(wdired-toggle-bit))
(defun wdired-perms-to-number (perms)
(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))
(defun wdired-do-perm-changes ()
(let ((changes nil)
(errors 0)
(prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
'old-perm 'perm-changed))
filename perms-ori perms-new perm-tmp)
(goto-char (next-single-property-change (point-min) prop-wanted
nil (point-max)))
(while (not (eobp))
(setq perms-ori (get-text-property (point) 'old-perm))
(setq perms-new (buffer-substring-no-properties
(point) (next-single-property-change (point) 'end-perm)))
(if (not (equal perms-ori perms-new))
(progn
(setq changes t)
(setq filename (wdired-get-filename nil t))
(if (= (length perms-new) 10)
(progn
(setq perm-tmp
(int-to-string (wdired-perms-to-number perms-new)))
(if (not (equal 0 (dired-call-process dired-chmod-program
t perm-tmp filename)))
(progn
(setq errors (1+ errors))
(wdired-log (concat dired-chmod-program " " perm-tmp
" `" filename "' failed\n\n")))))
(setq errors (1+ errors))
(wdired-log (concat "Cannot parse permission `" perms-new
"' for file `" filename "'\n\n")))))
(goto-char (next-single-property-change (1+ (point)) prop-wanted
nil (point-max))))
(cons changes errors)))
(provide 'wdired)
(run-hooks wdired-load-hooks)