]> code.delx.au - gnu-emacs/blobdiff - lisp/dired-aux.el
(disassemble-1): Move the call to
[gnu-emacs] / lisp / dired-aux.el
index 9785b6cffb661e34e8e5cebfe5a5fa91f4b73a6e..175e48cd1fc01519956c40b75b2b2326462d6adf 100644 (file)
@@ -1,8 +1,9 @@
 ;;; dired-aux.el --- less commonly used parts of dired  -*-byte-compile-dynamic: t;-*-
 
 ;;; dired-aux.el --- less commonly used parts of dired  -*-byte-compile-dynamic: t;-*-
 
-;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1994, 1998 Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
+;; Maintainer: FSF
 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 
@@ -17,8 +18,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 
@@ -97,7 +99,10 @@ With prefix arg, prompt for argument SWITCHES which is options for `diff'."
     (setq failures
          (dired-bunch-files 10000
                             (function dired-check-process)
     (setq failures
          (dired-bunch-files 10000
                             (function dired-check-process)
-                            (list operation program new-attribute)
+                            (append 
+                             (list operation program new-attribute)
+                             (if (string-match "gnu" system-configuration)
+                                 '("--") nil))
                             files))
     (dired-do-redisplay arg);; moves point if ARG is an integer
     (if failures
                             files))
     (dired-do-redisplay arg);; moves point if ARG is an integer
     (if failures
@@ -110,18 +115,22 @@ With prefix arg, prompt for argument SWITCHES which is options for `diff'."
   "Change the mode of the marked (or next ARG) files.
 This calls chmod, thus symbolic modes like `g+w' are allowed."
   (interactive "P")
   "Change the mode of the marked (or next ARG) files.
 This calls chmod, thus symbolic modes like `g+w' are allowed."
   (interactive "P")
-  (dired-do-chxxx "Mode" "chmod" 'chmod arg))
+  (dired-do-chxxx "Mode" dired-chmod-program 'chmod arg))
 
 ;;;###autoload
 (defun dired-do-chgrp (&optional arg)
   "Change the group of the marked (or next ARG) files."
   (interactive "P")
 
 ;;;###autoload
 (defun dired-do-chgrp (&optional arg)
   "Change the group of the marked (or next ARG) files."
   (interactive "P")
+  (if (memq system-type '(ms-dos windows-nt))
+      (error "chgrp not supported on this system."))
   (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
 
 ;;;###autoload
 (defun dired-do-chown (&optional arg)
   "Change the owner of the marked (or next ARG) files."
   (interactive "P")
   (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
 
 ;;;###autoload
 (defun dired-do-chown (&optional arg)
   "Change the owner of the marked (or next ARG) files."
   (interactive "P")
+  (if (memq system-type '(ms-dos windows-nt))
+      (error "chown not supported on this system."))
   (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
 
 ;; Process all the files in FILES in batches of a convenient size,
   (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
 
 ;; Process all the files in FILES in batches of a convenient size,
@@ -259,7 +268,7 @@ with a prefix argument."
       ;;The caller may want to flag some of these files for deletion.
       (let* ((base-versions
              (concat (file-name-nondirectory fn) ".~"))
       ;;The caller may want to flag some of these files for deletion.
       (let* ((base-versions
              (concat (file-name-nondirectory fn) ".~"))
-            (bv-length (length base-versions))
+            (backup-extract-version-start (length base-versions))
             (possibilities (file-name-all-completions
                             base-versions
                             (file-name-directory fn)))
             (possibilities (file-name-all-completions
                             base-versions
                             (file-name-directory fn)))
@@ -283,18 +292,6 @@ with a prefix argument."
                (insert dired-del-marker)))))
 \f
 ;;; Shell commands
                (insert dired-del-marker)))))
 \f
 ;;; Shell commands
-;;>>> install (move this function into simple.el)
-(defun dired-shell-quote (filename)
-  "Quote a file name for inferior shell (see variable `shell-file-name')."
-  ;; Quote everything except POSIX filename characters.
-  ;; This should be safe enough even for really weird shells.
-  (let ((result "") (start 0) end)
-    (while (string-match "[^-0-9a-zA-Z_./]" filename start)
-      (setq end (match-beginning 0)
-           result (concat result (substring filename start end)
-                          "\\" (substring filename end (1+ end)))
-           start (1+ end)))
-    (concat result (substring filename start))))
 
 (defun dired-read-shell-command (prompt arg files)
 ;;  "Read a dired shell command prompting with PROMPT (using read-string).
 
 (defun dired-read-shell-command (prompt arg files)
 ;;  "Read a dired shell command prompting with PROMPT (using read-string).
@@ -304,12 +301,13 @@ with a prefix argument."
   (dired-mark-pop-up
    nil 'shell files
    (function read-string)
   (dired-mark-pop-up
    nil 'shell files
    (function read-string)
-   (format prompt (dired-mark-prompt arg files))))
+   (format prompt (dired-mark-prompt arg files))
+   nil 'shell-command-history))
 
 ;; The in-background argument is only needed in Emacs 18 where
 ;; shell-command doesn't understand an appended ampersand `&'.
 ;;;###autoload
 
 ;; The in-background argument is only needed in Emacs 18 where
 ;; shell-command doesn't understand an appended ampersand `&'.
 ;;;###autoload
-(defun dired-do-shell-command (command &optional arg)
+(defun dired-do-shell-command (command &optional arg file-list)
   "Run a shell command COMMAND on the marked files.
 If no files are marked or a specific numeric prefix arg is given,
 the next ARG files are used.  Just \\[universal-argument] means the current file.
   "Run a shell command COMMAND on the marked files.
 If no files are marked or a specific numeric prefix arg is given,
 the next ARG files are used.  Just \\[universal-argument] means the current file.
@@ -329,16 +327,17 @@ The shell command has the top level directory as working directory, so
 output files usually are created there instead of in a subdir."
 ;;Functions dired-run-shell-command and dired-shell-stuff-it do the
 ;;actual work and can be redefined for customization.
 output files usually are created there instead of in a subdir."
 ;;Functions dired-run-shell-command and dired-shell-stuff-it do the
 ;;actual work and can be redefined for customization.
-  (interactive (list
-               ;; Want to give feedback whether this file or marked files are used:
-               (dired-read-shell-command (concat "! on "
-                                                 "%s: ")
-                                         current-prefix-arg
-                                         (dired-get-marked-files
-                                          t current-prefix-arg))
-               current-prefix-arg))
-  (let* ((on-each (not (string-match "\\*" command)))
-        (file-list (dired-get-marked-files t arg)))
+  (interactive
+   (let ((files (dired-get-marked-files t current-prefix-arg)))
+     (list
+      ;; Want to give feedback whether this file or marked files are used:
+      (dired-read-shell-command (concat "! on "
+                                       "%s: ")
+                               current-prefix-arg
+                               files)
+      current-prefix-arg
+      files)))
+  (let* ((on-each (not (string-match "\\*" command))))
     (if on-each
        (dired-bunch-files
         (- 10000 (length command))
     (if on-each
        (dired-bunch-files
         (- 10000 (length command))
@@ -376,8 +375,8 @@ output files usually are created there instead of in a subdir."
                         (dired-replace-in-string "\\*" x command)))
           (function (lambda (x) (concat command " " x))))))
     (if on-each
                         (dired-replace-in-string "\\*" x command)))
           (function (lambda (x) (concat command " " x))))))
     (if on-each
-       (mapconcat stuff-it (mapcar 'dired-shell-quote file-list) ";")
-      (let ((fns (mapconcat 'dired-shell-quote
+       (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";")
+      (let ((fns (mapconcat 'shell-quote-argument
                            file-list dired-mark-separator)))
        (if (> (length file-list) 1)
            (setq fns (concat dired-mark-prefix fns dired-mark-postfix)))
                            file-list dired-mark-separator)))
        (if (> (length file-list) 1)
            (setq fns (concat dired-mark-prefix fns dired-mark-postfix)))
@@ -385,7 +384,11 @@ output files usually are created there instead of in a subdir."
 
 ;; This is an extra function so that it can be redefined by ange-ftp.
 (defun dired-run-shell-command (command)
 
 ;; This is an extra function so that it can be redefined by ange-ftp.
 (defun dired-run-shell-command (command)
-  (shell-command command)
+  (let ((handler
+        (find-file-name-handler (directory-file-name default-directory)
+                                'shell-command)))
+    (if handler (apply handler 'shell-command (list command))
+      (shell-command command)))
   ;; Return nil for sake of nconc in dired-bunch-files.
   nil)
 \f
   ;; Return nil for sake of nconc in dired-bunch-files.
   nil)
 \f
@@ -394,7 +397,13 @@ output files usually are created there instead of in a subdir."
 (defun dired-call-process (program discard &rest arguments)
 ;  "Run PROGRAM with output to current buffer unless DISCARD is t.
 ;Remaining arguments are strings passed as command arguments to PROGRAM."
 (defun dired-call-process (program discard &rest arguments)
 ;  "Run PROGRAM with output to current buffer unless DISCARD is t.
 ;Remaining arguments are strings passed as command arguments to PROGRAM."
-  (apply 'call-process program nil (not discard) nil arguments))
+  ;; Look for a handler for default-directory in case it is a remote file name.
+  (let ((handler
+        (find-file-name-handler (directory-file-name default-directory)
+                                'dired-call-process)))
+    (if handler (apply handler 'dired-call-process
+                      program discard arguments)
+      (apply 'call-process program nil (not discard) nil arguments))))
 
 (defun dired-check-process (msg program &rest arguments)
 ;  "Display MSG while running PROGRAM, and check for output.
 
 (defun dired-check-process (msg program &rest arguments)
 ;  "Display MSG while running PROGRAM, and check for output.
@@ -502,45 +511,73 @@ and use this command with a prefix argument (the value does not matter)."
       (dired-log (concat "Failed to compress" from-file))
       from-file)))
 
       (dired-log (concat "Failed to compress" from-file))
       from-file)))
 
+(defvar dired-compress-file-suffixes
+  '(("\\.gz\\'" "" "gunzip")
+    ("\\.tgz\\'" ".tar" "gunzip")
+    ("\\.Z\\'" "" "uncompress")
+    ;; For .z, try gunzip.  It might be an old gzip file,
+    ;; or it might be from compact? pack? (which?) but gunzip handles both.
+    ("\\.z\\'" "" "gunzip")
+    ;; This item controls naming for compression.
+    ("\\.tar\\'" ".tgz" nil))
+  "Control changes in file name suffixes for compression and uncompression.
+Each element specifies one transformation rule, and has the form:
+  (REGEXP NEW-SUFFIX PROGRAM)
+The rule applies when the old file name matches REGEXP.
+The new file name is computed by deleting the part that matches REGEXP
+ (as well as anything after that), then adding NEW-SUFFIX in its place.
+If PROGRAM is non-nil, the rule is an uncompression rule,
+and uncompression is done by running PROGRAM.
+Otherwise, the rule is a compression rule, and compression is done with gzip.")
+
 ;;;###autoload
 (defun dired-compress-file (file)
   ;; Compress or uncompress FILE.
   ;; Return the name of the compressed or uncompressed file.
   ;; Return nil if no change in files.
 ;;;###autoload
 (defun dired-compress-file (file)
   ;; Compress or uncompress FILE.
   ;; Return the name of the compressed or uncompressed file.
   ;; Return nil if no change in files.
-  (let ((handler (find-file-name-handler file 'dired-compress-file)))
+  (let ((handler (find-file-name-handler file 'dired-compress-file))
+       suffix newname
+       (suffixes dired-compress-file-suffixes))
+    ;; See if any suffix rule matches this file name.
+    (while suffixes
+      (let (case-fold-search)
+       (if (string-match (car (car suffixes)) file)
+           (setq suffix (car suffixes) suffixes nil))
+       (setq suffixes (cdr suffixes))))
+    ;; If so, compute desired new name.
+    (if suffix 
+       (setq newname (concat (substring file 0 (match-beginning 0))
+                             (nth 1 suffix))))
     (cond (handler
           (funcall handler 'dired-compress-file file))
          ((file-symlink-p file)
           nil)
     (cond (handler
           (funcall handler 'dired-compress-file file))
          ((file-symlink-p file)
           nil)
-         ((let (case-fold-search)
-            (string-match "\\.Z$" file))
-          (if (not (dired-check-process (concat "Uncompressing " file)
-                                        "uncompress" file))
-              (substring file 0 -2)))
-         ((let (case-fold-search)
-            (string-match "\\.gz$" file))
-          (if (not (dired-check-process (concat "Uncompressing " file)
-                                        "gunzip" file))
-              (substring file 0 -3)))
-         ;; For .z, try gunzip.  It might be an old gzip file,
-         ;; or it might be from compact? pack? (which?) but gunzip handles
-         ;; both.
-         ((let (case-fold-search)
-            (string-match "\\.z$" file))
+         ((and suffix (nth 2 suffix))
+          ;; We found an uncompression rule.
           (if (not (dired-check-process (concat "Uncompressing " file)
           (if (not (dired-check-process (concat "Uncompressing " file)
-                                        "gunzip" file))
-              (substring file 0 -2)))
+                                        (nth 2 suffix) file))
+              newname))
          (t
          (t
+          ;;; We don't recognize the file as compressed, so compress it.
           ;;; Try gzip; if we don't have that, use compress.
           (condition-case nil
               (if (not (dired-check-process (concat "Compressing " file)
                                             "gzip" "-f" file))
           ;;; Try gzip; if we don't have that, use compress.
           (condition-case nil
               (if (not (dired-check-process (concat "Compressing " file)
                                             "gzip" "-f" file))
-                  (cond ((file-exists-p (concat file ".gz"))
-                         (concat file ".gz"))
-                        (t (concat file ".z"))))
+                  (let ((out-name
+                         (if (file-exists-p (concat file ".gz"))
+                             (concat file ".gz")
+                           (concat file ".z"))))
+                    ;; Rename the compressed file to NEWNAME
+                    ;; if it hasn't got that name already.
+                    (if (and newname (not (equal newname out-name)))
+                        (progn
+                          (rename-file out-name newname t)
+                          newname)
+                      out-name)))
             (file-error
              (if (not (dired-check-process (concat "Compressing " file)
                                            "compress" "-f" file))
             (file-error
              (if (not (dired-check-process (concat "Compressing " file)
                                            "compress" "-f" file))
+                 ;; Don't use NEWNAME with `compress'.
                  (concat file ".Z"))))))))
 \f
 (defun dired-mark-confirm (op-symbol arg)
                  (concat file ".Z"))))))))
 \f
 (defun dired-mark-confirm (op-symbol arg)
@@ -549,7 +586,8 @@ and use this command with a prefix argument (the value does not matter)."
   ;; Confirmation consists in a y-or-n question with a file list
   ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
   ;; The files used are determined by ARG (as in dired-get-marked-files).
   ;; Confirmation consists in a y-or-n question with a file list
   ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
   ;; The files used are determined by ARG (as in dired-get-marked-files).
-  (or (memq op-symbol dired-no-confirm)
+  (or (eq dired-no-confirm t)
+      (memq op-symbol dired-no-confirm)
       (let ((files (dired-get-marked-files t arg))
            (string (if (eq op-symbol 'compress) "Compress or uncompress"
                      (capitalize (symbol-name op-symbol)))))
       (let ((files (dired-get-marked-files t arg))
            (string (if (eq op-symbol 'compress) "Compress or uncompress"
                      (capitalize (symbol-name op-symbol)))))
@@ -644,6 +682,8 @@ and use this command with a prefix argument (the value does not matter)."
       (error
        (setq failure err)))
     (setq elc-file (byte-compile-dest-file filename))
       (error
        (setq failure err)))
     (setq elc-file (byte-compile-dest-file filename))
+    (or (file-exists-p elc-file)
+       (setq failure t))
     (if failure
        (progn
          (dired-log "Byte compile error for %s:\n%s\n" filename failure)
     (if failure
        (progn
          (dired-log "Byte compile error for %s:\n%s\n" filename failure)
@@ -689,6 +729,8 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
        (if arg (read-string "Switches for listing: " dired-actual-switches)))
     (message "Redisplaying...")
     ;; message much faster than making dired-map-over-marks show progress
        (if arg (read-string "Switches for listing: " dired-actual-switches)))
     (message "Redisplaying...")
     ;; message much faster than making dired-map-over-marks show progress
+    (dired-uncache
+     (if (consp dired-directory) (car dired-directory) dired-directory))
     (dired-map-over-marks (let ((fname (dired-get-filename)))
                            (message "Redisplaying... %s" fname)
                            (dired-update-file-line fname))
     (dired-map-over-marks (let ((fname (dired-get-filename)))
                            (message "Redisplaying... %s" fname)
                            (dired-update-file-line fname))
@@ -708,16 +750,20 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
     (delete-region (point) (progn (forward-line 1) (point)))
     (if file
        (progn
     (delete-region (point) (progn (forward-line 1) (point)))
     (if file
        (progn
-         (dired-add-entry file)
+         (dired-add-entry file nil t)
          ;; Replace space by old marker without moving point.
          ;; Faster than goto+insdel inside a save-excursion?
          (subst-char-in-region opoint (1+ opoint) ?\040 char))))
   (dired-move-to-filename))
 
          ;; Replace space by old marker without moving point.
          ;; Faster than goto+insdel inside a save-excursion?
          (subst-char-in-region opoint (1+ opoint) ?\040 char))))
   (dired-move-to-filename))
 
-(defun dired-fun-in-all-buffers (directory fun &rest args)
+(defun dired-fun-in-all-buffers (directory file fun &rest args)
   ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
   ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
+  ;; If the buffer has a wildcard pattern, check that it matches FILE.
+  ;; (FILE does not include a directory component.)
+  ;; FILE may be nil, in which case ignore it.
   ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
   ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
-  (let ((buf-list (dired-buffers-for-dir (expand-file-name directory)))
+  (let ((buf-list (dired-buffers-for-dir (expand-file-name directory)
+                                        file))
        (obuf (current-buffer))
        buf success-list)
     (while buf-list
        (obuf (current-buffer))
        buf success-list)
     (while buf-list
@@ -734,10 +780,10 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 ;;;###autoload
 (defun dired-add-file (filename &optional marker-char)
   (dired-fun-in-all-buffers
 ;;;###autoload
 (defun dired-add-file (filename &optional marker-char)
   (dired-fun-in-all-buffers
-   (file-name-directory filename)
+   (file-name-directory filename) (file-name-nondirectory filename)
    (function dired-add-entry) filename marker-char))
 
    (function dired-add-entry) filename marker-char))
 
-(defun dired-add-entry (filename &optional marker-char)
+(defun dired-add-entry (filename &optional marker-char relative)
   ;; Add a new entry for FILENAME, optionally marking it
   ;; with MARKER-CHAR (a character, else dired-marker-char is used).
   ;; Note that this adds the entry `out of order' if files sorted by
   ;; Add a new entry for FILENAME, optionally marking it
   ;; with MARKER-CHAR (a character, else dired-marker-char is used).
   ;; Note that this adds the entry `out of order' if files sorted by
@@ -747,12 +793,15 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
   ;; Hidden subdirs are exposed if a file is added there.
   (setq filename (directory-file-name filename))
   ;; Entry is always for files, even if they happen to also be directories
   ;; Hidden subdirs are exposed if a file is added there.
   (setq filename (directory-file-name filename))
   ;; Entry is always for files, even if they happen to also be directories
-  (let ((opoint (point))
+  (let* ((opoint (point))
        (cur-dir (dired-current-directory))
        (orig-file-name filename)
        (cur-dir (dired-current-directory))
        (orig-file-name filename)
-       (directory (file-name-directory filename))
+       (directory (if relative cur-dir (file-name-directory filename)))
        reason)
        reason)
-    (setq filename (file-name-nondirectory filename)
+    (setq filename
+         (if relative
+             (file-relative-name filename directory)
+           (file-name-nondirectory filename))
          reason
          (catch 'not-found
            (if (string= directory cur-dir)
          reason
          (catch 'not-found
            (if (string= directory cur-dir)
@@ -839,7 +888,8 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 ;;;###autoload
 (defun dired-remove-file (file)
   (dired-fun-in-all-buffers
 ;;;###autoload
 (defun dired-remove-file (file)
   (dired-fun-in-all-buffers
-   (file-name-directory file) (function dired-remove-entry) file))
+   (file-name-directory file) (file-name-nondirectory file)
+   (function dired-remove-entry) file))
 
 (defun dired-remove-entry (file)
   (save-excursion
 
 (defun dired-remove-entry (file)
   (save-excursion
@@ -851,6 +901,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 ;;;###autoload
 (defun dired-relist-file (file)
   (dired-fun-in-all-buffers (file-name-directory file)
 ;;;###autoload
 (defun dired-relist-file (file)
   (dired-fun-in-all-buffers (file-name-directory file)
+                           (file-name-nondirectory file)
                            (function dired-relist-entry) file))
 
 (defun dired-relist-entry (file)
                            (function dired-relist-entry) file))
 
 (defun dired-relist-entry (file)
@@ -871,9 +922,13 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 \f
 ;;; Copy, move/rename, making hard and symbolic links
 
 \f
 ;;; Copy, move/rename, making hard and symbolic links
 
-(defvar dired-backup-overwrite nil
+(defcustom dired-backup-overwrite nil
   "*Non-nil if Dired should ask about making backups before overwriting files.
   "*Non-nil if Dired should ask about making backups before overwriting files.
-Special value `always' suppresses confirmation.")
+Special value `always' suppresses confirmation."
+  :type '(choice (const :tag "off" nil)
+                (const :tag "suppress" always)
+                (other :tag "ask" t))
+  :group 'dired)
 
 (defvar dired-overwrite-confirmed)
 
 
 (defvar dired-overwrite-confirmed)
 
@@ -881,19 +936,24 @@ Special value `always' suppresses confirmation.")
   ;; Save old version of a to be overwritten file TO.
   ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
   ;; from dired-create-files.
   ;; Save old version of a to be overwritten file TO.
   ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
   ;; from dired-create-files.
-  (if (and dired-backup-overwrite
-          dired-overwrite-confirmed
-          (or (eq 'always dired-backup-overwrite)
-              (dired-query 'overwrite-backup-query
-                       (format "Make backup for existing file `%s'? " to))))
-      (let ((backup (car (find-backup-file-name to))))
-       (rename-file to backup 0)       ; confirm overwrite of old backup
-       (dired-relist-entry backup))))
+  (let (backup)
+    (if (and dired-backup-overwrite
+            dired-overwrite-confirmed
+            (setq backup (car (find-backup-file-name to)))
+            (or (eq 'always dired-backup-overwrite)
+                (dired-query 'overwrite-backup-query
+                             (format "Make backup for existing file `%s'? " to))))
+       (progn
+         (rename-file to backup 0)     ; confirm overwrite of old backup
+         (dired-relist-entry backup)))))
 
 ;;;###autoload
 (defun dired-copy-file (from to ok-flag)
   (dired-handle-overwrite to)
 
 ;;;###autoload
 (defun dired-copy-file (from to ok-flag)
   (dired-handle-overwrite to)
-  (copy-file from to ok-flag dired-copy-preserve-time))
+  (condition-case ()
+      (copy-file from to ok-flag dired-copy-preserve-time)
+    (file-date-error (message "Can't set date")
+                    (sit-for 1))))
 
 ;;;###autoload
 (defun dired-rename-file (from to ok-flag)
 
 ;;;###autoload
 (defun dired-rename-file (from to ok-flag)
@@ -901,11 +961,8 @@ Special value `always' suppresses confirmation.")
   (rename-file from to ok-flag)                ; error is caught in -create-files
   ;; Silently rename the visited file of any buffer visiting this file.
   (and (get-file-buffer from)
   (rename-file from to ok-flag)                ; error is caught in -create-files
   ;; Silently rename the visited file of any buffer visiting this file.
   (and (get-file-buffer from)
-       (save-excursion
-        (set-buffer (get-file-buffer from))
-        (let ((modflag (buffer-modified-p)))
-          (set-visited-file-name to)
-          (set-buffer-modified-p modflag))))
+       (with-current-buffer (get-file-buffer from)
+        (set-visited-file-name to nil t)))
   (dired-remove-file from)
   ;; See if it's an inserted subdir, and rename that, too.
   (dired-rename-subdir from to))
   (dired-remove-file from)
   ;; See if it's an inserted subdir, and rename that, too.
   (dired-rename-subdir from to))
@@ -913,7 +970,7 @@ Special value `always' suppresses confirmation.")
 (defun dired-rename-subdir (from-dir to-dir)
   (setq from-dir (file-name-as-directory from-dir)
        to-dir (file-name-as-directory to-dir))
 (defun dired-rename-subdir (from-dir to-dir)
   (setq from-dir (file-name-as-directory from-dir)
        to-dir (file-name-as-directory to-dir))
-  (dired-fun-in-all-buffers from-dir
+  (dired-fun-in-all-buffers from-dir nil
                            (function dired-rename-subdir-1) from-dir to-dir)
   ;; Update visited file name of all affected buffers
   (let ((expanded-from-dir (expand-file-name from-dir))
                            (function dired-rename-subdir-1) from-dir to-dir)
   ;; Update visited file name of all affected buffers
   (let ((expanded-from-dir (expand-file-name from-dir))
@@ -985,39 +1042,6 @@ Special value `always' suppresses confirmation.")
              (dired-normalize-subdir
               (dired-replace-in-string regexp newtext (car elt)))))))
 \f
              (dired-normalize-subdir
               (dired-replace-in-string regexp newtext (car elt)))))))
 \f
-(defun dired-expand-newtext (string newtext)
-  ;; Expand \& and \1..\9 (referring to STRING) in NEWTEXT, using match data.
-  ;; Note that in Emacs 18 match data are clipped to current buffer
-  ;; size...so the buffer should better not be smaller than STRING.
-  (let ((pos 0)
-       (len (length newtext))
-       (expanded-newtext ""))
-    (while (< pos len)
-      (setq expanded-newtext
-           (concat expanded-newtext
-                   (let ((c (aref newtext pos)))
-                     (if (= ?\\ c)
-                         (cond ((= ?\& (setq c
-                                             (aref newtext
-                                                   (setq pos (1+ pos)))))
-                                (substring string
-                                           (match-beginning 0)
-                                           (match-end 0)))
-                               ((and (>= c ?1) (<= c ?9))
-                                ;; return empty string if N'th
-                                ;; sub-regexp did not match:
-                                (let ((n (- c ?0)))
-                                  (if (match-beginning n)
-                                      (substring string
-                                                 (match-beginning n)
-                                                 (match-end n))
-                                    "")))
-                               (t
-                                (char-to-string c)))
-                       (char-to-string c)))))
-      (setq pos (1+ pos)))
-    expanded-newtext))
-\f
 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
 (defun dired-create-files (file-creator operation fn-list name-constructor
                                        &optional marker-char)
 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
 (defun dired-create-files (file-creator operation fn-list name-constructor
                                        &optional marker-char)
@@ -1032,7 +1056,7 @@ Special value `always' suppresses confirmation.")
 ;; which will be added.  The user will be queried if the file already
 ;; exists.  If oldfile is removed by FILE-CREATOR (i.e, it is a
 ;; rename), it is FILE-CREATOR's responsibility to update dired
 ;; which will be added.  The user will be queried if the file already
 ;; exists.  If oldfile is removed by FILE-CREATOR (i.e, it is a
 ;; rename), it is FILE-CREATOR's responsibility to update dired
-;; buffers.  FILE-CREATOR must abort by signalling a file-error if it
+;; buffers.  FILE-CREATOR must abort by signaling a file-error if it
 ;; could not create newfile.  The error is caught and logged.
 
 ;; OPERATION (a capitalized string, e.g. `Copy') describes the
 ;; could not create newfile.  The error is caught and logged.
 
 ;; OPERATION (a capitalized string, e.g. `Copy') describes the
@@ -1226,8 +1250,8 @@ ESC or `q' to not overwrite any of the remaining files,
   "Copy all marked (or next ARG) files, or copy the current file.
 This normally preserves the last-modified date when copying.
 When operating on just the current file, you specify the new name.
   "Copy all marked (or next ARG) files, or copy the current file.
 This normally preserves the last-modified date when copying.
 When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory
-and new symbolic links are made in that directory
+When operating on multiple or marked files, you specify a directory,
+and new copies of these files are made in that directory
 with the same names that the files currently have."
   (interactive "P")
   (dired-do-create-files 'copy (function dired-copy-file)
 with the same names that the files currently have."
   (interactive "P")
   (dired-do-create-files 'copy (function dired-copy-file)
@@ -1727,7 +1751,9 @@ The next char is either \\n, or \\r if DIR is hidden."
 \f
 ;;;###autoload
 (defun dired-mark-subdir-files ()
 \f
 ;;;###autoload
 (defun dired-mark-subdir-files ()
-  "Mark all files except `.' and `..'."
+  "Mark all files except `.' and `..' in current subdirectory.
+If the Dired buffer shows multiple directories, this command
+marks the files listed in the subdirectory that point is in."
   (interactive)
   (let ((p-min (dired-subdir-min)))
     (dired-mark-files-in-region p-min (dired-subdir-max))))
   (interactive)
   (let ((p-min (dired-subdir-min)))
     (dired-mark-files-in-region p-min (dired-subdir-max))))
@@ -1855,7 +1881,7 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
 ;; Functions for searching in tags style among marked files.
 
 ;;;###autoload
 ;; Functions for searching in tags style among marked files.
 
 ;;;###autoload
-(defun dired-do-tags-search (regexp)
+(defun dired-do-search (regexp)
   "Search through all marked files for a match for REGEXP.
 Stops when a match is found.
 To continue searching for next match, use command \\[tags-loop-continue]."
   "Search through all marked files for a match for REGEXP.
 Stops when a match is found.
 To continue searching for next match, use command \\[tags-loop-continue]."
@@ -1863,10 +1889,10 @@ To continue searching for next match, use command \\[tags-loop-continue]."
   (tags-search regexp '(dired-get-marked-files)))
 
 ;;;###autoload
   (tags-search regexp '(dired-get-marked-files)))
 
 ;;;###autoload
-(defun dired-do-tags-query-replace (from to &optional delimited)
-  "Query-replace-regexp FROM with TO through all marked files.
+(defun dired-do-query-replace (from to &optional delimited)
+  "Do `query-replace-regexp' of FROM with TO, on all marked files.
 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
 Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
-If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
+If you exit (\\[keyboard-quit] or ESC), you can resume the query replace
 with the command \\[tags-loop-continue]."
   (interactive
    "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")
 with the command \\[tags-loop-continue]."
   (interactive
    "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")