]> code.delx.au - gnu-emacs/blobdiff - lisp/wdired.el
Shorten and clarify usual mode line mouse help string.
[gnu-emacs] / lisp / wdired.el
index c22a8dff633e0dcd0e14495fdba62c01b983e976..bc70e0ddcfd8b6410b57fa74d0b1f95ba6b1fe60 100644 (file)
@@ -1,6 +1,6 @@
 ;;; wdired.el --- Rename files editing their names in dired buffers
 
-;; Copyright (C) 2001, 2004, 2005  Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Filename: wdired.el
 ;; Author: Juan León Lahoz García <juanleon1@gmail.com>
 ;; renaming files.
 ;;
 ;; Have you ever wished to use C-x r t (string-rectangle), M-%
-;; (query-replace), M-c (capitalize-word), etc. to change the name of
+;; (query-replace), M-c (capitalize-word), etc... to change the name of
 ;; the files in a "dired" buffer? Now you can do this.  All the power
 ;; of Emacs commands are available to renaming files!
-;; 
+;;
 ;; This package provides a function that makes the filenames of a a
 ;; dired buffer editable, by changing the buffer mode (which inhibits
 ;; all of the commands of dired mode). Here you can edit the names of
 ;;; Code:
 
 (defvar dired-backup-overwrite) ; Only in Emacs 20.x this is a custom var
-(eval-when-compile
-  (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"))
+(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."
   :group 'dired)
 
 (defcustom wdired-use-interactive-rename nil
-  "*If non-nil, WDired requires confirmation before actually renaming files.
+  "If non-nil, WDired requires confirmation before actually renaming files.
 If nil, WDired doesn't require confirmation to change the file names,
 and the variable `wdired-confirm-overwrite' controls whether it is ok
 to overwrite files without asking."
@@ -123,14 +121,14 @@ to overwrite files without asking."
   :group 'wdired)
 
 (defcustom wdired-confirm-overwrite t
-  "*If nil the renames can overwrite files without asking. 
+  "If nil the renames can overwrite files without asking.
 This variable has no effect at all if `wdired-use-interactive-rename'
 is not nil."
   :type 'boolean
   :group 'wdired)
 
 (defcustom wdired-use-dired-vertical-movement nil
-  "*If t, the \"up\" and \"down\" movement works as in Dired mode.
+  "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
@@ -144,14 +142,14 @@ If nil, \"up\" and \"down\" movement is done as in any other buffer."
   :group 'wdired)
 
 (defcustom wdired-allow-to-redirect-links t
-  "*If non-nil, the target of the symbolic links are editable.
+  "If non-nil, the target of the symbolic links are editable.
 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 are editable.
+  "If non-nil, the permissions bits of the files are editable.
 
 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
@@ -193,16 +191,15 @@ program `dired-chmod-program', which must exist."
     (define-key map [menu-bar wdired dashes]
       '("--"))
     (define-key map [menu-bar wdired wdired-abort-changes]
-      '("Abort Changes" . wdired-abort-changes))
+      '(menu-item "Abort Changes" wdired-abort-changes
+                 :help "Abort changes and return to dired mode"))
     (define-key map [menu-bar wdired wdired-finish-edit]
       '("Commit Changes" . wdired-finish-edit))
-    ;; FIXME: Use the new remap trick.
-    (substitute-key-definition 'upcase-word 'wdired-upcase-word
-                              map global-map)
-    (substitute-key-definition 'capitalize-word 'wdired-capitalize-word
-                              map global-map)
-    (substitute-key-definition 'downcase-word 'wdired-downcase-word
-                              map global-map)
+
+    (define-key map [remap upcase-word] 'wdired-upcase-word)
+    (define-key map [remap capitalize-word] 'wdired-capitalize-word)
+    (define-key map [remap downcase-word] 'wdired-downcase-word)
+
     map))
 
 (defvar wdired-mode-hook nil
@@ -211,6 +208,7 @@ program `dired-chmod-program', which must exist."
 ;; Local variables (put here to avoid compilation gripes)
 (defvar wdired-col-perm) ;; Column where the permission bits start
 (defvar wdired-old-content)
+(defvar wdired-old-point)
 
 
 (defun wdired-mode ()
@@ -240,8 +238,11 @@ 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))
   (set (make-local-variable 'query-replace-skip-read-only) t)
   (use-local-map wdired-mode-map)
   (force-mode-line-update)
@@ -264,7 +265,8 @@ See `wdired-mode'."
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
   (run-mode-hooks 'wdired-mode-hook)
-  (message (substitute-command-keys "Press \\[wdired-finish-edit] when finished \
+  (message "%s" (substitute-command-keys
+                "Press \\[wdired-finish-edit] when finished \
 or \\[wdired-abort-changes] to abort changes")))
 
 
@@ -310,25 +312,26 @@ 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 (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))
-      (unless (eq beg end)
-       (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))))))
+  (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)))))))
 
 
 (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)))
@@ -340,7 +343,7 @@ non-nil means return old filename."
   (setq mode-name "Dired")
   (dired-advertise)
   (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
-  (setq revert-buffer-function 'dired-revert))
+  (set (make-local-variable 'revert-buffer-function) 'dired-revert))
 
 
 (defun wdired-abort-changes ()
@@ -348,7 +351,8 @@ non-nil means return old filename."
   (interactive)
   (let ((inhibit-read-only t))
     (erase-buffer)
-    (insert wdired-old-content))
+    (insert wdired-old-content)
+    (goto-char wdired-old-point))
   (wdired-change-to-dired-mode)
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
@@ -407,7 +411,7 @@ non-nil means return old filename."
        (forward-line -1)))
     (if changes
         (revert-buffer) ;The "revert" is necessary to re-sort the buffer
-      (let ((buffer-read-only nil))
+      (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
@@ -420,9 +424,9 @@ non-nil means return old filename."
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil))
 
-;; Renames a file, searching it in a modified dired buffer, in order
+;; 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"
+;; "benefits".
 (defun wdired-search-and-rename (filename-ori filename-new)
   (save-excursion
     (goto-char (point-max))
@@ -523,21 +527,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 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))))
-
-
+  (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))))))
 
 ;; Perform the changes in the target of the changed links.
-(defun wdired-do-symlink-changes()
+(defun wdired-do-symlink-changes ()
   (let ((changes nil)
        (errors 0)
        link-to-ori link-to-new link-from)
@@ -545,36 +546,34 @@ If OLD, return the old target.  If MOVE, move point before it."
     (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 "") ;empty filename!
-                (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))
-                  (dired-log (concat "Link `" link-from "' to `"
-                                     link-to-new "' failed:\n%s\n")
-                             err))))))
+      (unless (equal link-to-new link-to-ori)
+        (setq changes t)
+        (if (equal link-to-new "") ;empty filename!
+            (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))
+           (dired-log (concat "Link `" link-from "' to `"
+                              link-to-new "' failed:\n%s\n")
+                      err)))))
     (cons changes errors)))
 
 ;; Perform a "case command" skipping read-only words.
 (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))))))))
+    (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'.
@@ -598,25 +597,25 @@ Like original function but it skips read-only words."
 ;; The following code deals with changing the access bits (or
 ;; permissions) of the files.
 
-(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))
+(defvar wdired-perm-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map " " 'wdired-toggle-bit)
+    (define-key map "r" 'wdired-set-bit)
+    (define-key map "w" 'wdired-set-bit)
+    (define-key map "x" 'wdired-set-bit)
+    (define-key map "-" 'wdired-set-bit)
+    (define-key map "S" 'wdired-set-bit)
+    (define-key map "s" 'wdired-set-bit)
+    (define-key map "T" 'wdired-set-bit)
+    (define-key map "t" 'wdired-set-bit)
+    (define-key map "s" 'wdired-set-bit)
+    (define-key map "l" 'wdired-set-bit)
+    (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
 ;; original name and permissions as a property
-(defun wdired-preprocess-perms()
+(defun wdired-preprocess-perms ()
   (let ((inhibit-read-only t)
        filename)
     (set (make-local-variable 'wdired-col-perm) nil)
@@ -633,7 +632,7 @@ Like original function but it skips read-only words."
                  (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))
+                                  '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))))
@@ -658,25 +657,24 @@ Like original function but it skips read-only words."
       (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 '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))
     (forward-char 1)))
 
-(defun wdired-toggle-bit()
+(defun wdired-toggle-bit ()
   "Toggle the permission bit at point."
   (interactive)
   (let ((inhibit-read-only t)
-       (new-bit "-")
+       (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")))
        (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 'keymap wdired-perm-mode-map new-bit)
     (put-text-property 0 1 'read-only t new-bit)
     (insert new-bit)
     (delete-char 1)
@@ -692,23 +690,28 @@ 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)
-  (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))
+  (+
+   (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))))
 
 ;; Perform the changes in the permissions of the files that have
 ;; changed.
@@ -724,28 +727,31 @@ Like original function but it skips read-only words."
       (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))
-                       (dired-log (concat dired-chmod-program " " perm-tmp
-                                          " `" filename "' failed\n\n")))))
-           (setq errors (1+ errors))
-           (dired-log (concat "Cannot parse permission `" perms-new
-                              "' for file `" filename "'\n\n")))))
+      (unless (equal perms-ori perms-new)
+        (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)))
+              (unless (equal 0 (dired-call-process dired-chmod-program
+                                                   t perm-tmp filename))
+                (setq errors (1+ errors))
+                (dired-log (concat dired-chmod-program " " perm-tmp
+                                   " `" filename "' failed\n\n"))))
+          (setq errors (1+ errors))
+          (dired-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)
 
+;; Local Variables:
+;; coding: latin-1
+;; byte-compile-dynamic: t
+;; End:
+
 ;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f
 ;;; wdired.el ends here