X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2f14b48d341021458b98dbb367e086e5996e85d8..6b124390359d516800bc41ba5a9a66b1dd1e5bb9:/lisp/dired-aux.el

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 98f8a0dde3..4a2d893245 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1,15 +1,15 @@
-;; dired-aux.el --- directory browsing command support
-;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
+;;; dired-aux.el --- less commonly used parts of dired  -*-byte-compile-dynamic: t;-*-
+
+;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000 Free Software Foundation, Inc.
 
 ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Version: 5.234
-;; Last-Modified: 14 Jul 1992
+;; Maintainer: FSF
 
 ;; 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 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -18,17 +18,25 @@
 ;; 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:
 
+;; The parts of dired mode not normally used.  This is a space-saving hack
+;; to avoid having to load a large mode when all that's wanted are a few
+;; functions.
+
 ;; Rewritten in 1990/1991 to add tree features, file marking and
 ;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
 ;; Finished up by rms in 1992.
 
 ;;; Code:
 
+;; We need macros in dired.el to compile properly.
+(eval-when-compile (require 'dired))
+
 ;;; 15K
 ;;;###begin dired-cmd.el
 ;; Diffing and compressing
@@ -38,22 +46,25 @@
   "Compare file at point with file FILE using `diff'.
 FILE defaults to the file at the mark.
 The prompted-for file is the first file given to `diff'.
-Prefix arg lets you edit the diff switches.  See the command `diff'."
+With prefix arg, prompt for second argument SWITCHES,
+ which is options for `diff'."
   (interactive
-   (let ((default (if (mark)
-		      (save-excursion (goto-char (mark))
+   (let ((default (if (mark t)
+		      (save-excursion (goto-char (mark t))
 				      (dired-get-filename t t)))))
+     (require 'diff)
      (list (read-file-name (format "Diff %s with: %s"
 				   (dired-get-filename t)
 				   (if default
 				       (concat "(default " default ") ")
 				     ""))
 			   (dired-current-directory) default t)
-	   (if (fboundp 'diff-read-switches)
-	       (diff-read-switches "Options for diff: ")))))
-  (if switches				; Emacs 19's diff has but two
-      (diff file (dired-get-filename t) switches) ; args (yet ;-)
-    (diff file (dired-get-filename t))))
+	   (if current-prefix-arg
+	       (read-string "Options for diff: "
+			    (if (stringp diff-switches)
+				diff-switches
+			      (mapconcat 'identity diff-switches " ")))))))
+  (diff file (dired-get-filename t) switches))
 
 ;;;###autoload
 (defun dired-backup-diff (&optional switches)
@@ -61,42 +72,15 @@ Prefix arg lets you edit the diff switches.  See the command `diff'."
 Uses the latest backup, if there are several numerical backups.
 If this file is a backup, diff it with its original.
 The backup file is the first file given to `diff'.
-Prefix arg lets you edit the diff switches.  See the command `diff'."
-  (interactive (list (if (fboundp 'diff-read-switches)
-			 (diff-read-switches "Diff with switches: "))))
-  (let (bak ori (file (dired-get-filename)))
-    (if (backup-file-name-p file)
-	(setq bak file
-	      ori (file-name-sans-versions file))
-      (setq bak (or (dired-latest-backup-file file)
-		    (error "No backup found for %s" file))
-	    ori file))
-    (if switches
-	(diff bak ori switches)
-      (diff bak ori))))
-
-(defun dired-latest-backup-file (fn)	; actually belongs into files.el
-  "Return the latest existing backup of FILE, or nil."
-  ;; First try simple backup, then the highest numbered of the
-  ;; numbered backups.
-  ;; Ignore the value of version-control because we look for existing
-  ;; backups, which maybe were made earlier or by another user with
-  ;; a different value of version-control.
-  (setq fn (expand-file-name fn))
-  (or
-   (let ((bak (make-backup-file-name fn)))
-     (if (file-exists-p bak) bak))
-   (let* ((dir (file-name-directory fn))
-	  (base-versions (concat (file-name-nondirectory fn) ".~"))
-	  (bv-length (length base-versions)))
-     (concat dir
-	     (car (sort
-		   (file-name-all-completions base-versions dir)
-		   ;; bv-length is a fluid var for backup-extract-version:
-		   (function
-		    (lambda (fn1 fn2)
-		      (> (backup-extract-version fn1)
-			 (backup-extract-version fn2))))))))))
+With prefix arg, prompt for argument SWITCHES which is options for `diff'."
+  (interactive
+    (if current-prefix-arg
+	(list (read-string "Options for diff: "
+			   (if (stringp diff-switches)
+			       diff-switches
+			     (mapconcat 'identity diff-switches " "))))
+      nil))
+  (diff-backup (dired-get-filename) switches))
 
 (defun dired-do-chxxx (attribute-name program op-symbol arg)
   ;; Change file attributes (mode, group, owner) of marked files and
@@ -115,7 +99,10 @@ Prefix arg lets you edit the diff switches.  See the command `diff'."
     (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
@@ -128,18 +115,22 @@ Prefix arg lets you edit the diff switches.  See the command `diff'."
   "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")
+  (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")
+  (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,
@@ -160,7 +151,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed."
 	;; and this file won't fit in the length limit, process now.
 	(if (and pending (> (+ thislength pending-length) max))
 	    (setq failures
-		  (nconc (apply function (append args pending) pending)
+		  (nconc (apply function (append args pending))
 			 failures)
 		  pending nil
 		  pending-length 0))
@@ -170,7 +161,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed."
 	(setq pending files)
 	(setq pending-length (+ thislength pending-length))
 	(setq files rest)))
-    (nconc (apply function (append args pending) pending)
+    (nconc (apply function (append args pending))
 	   failures)))
 
 ;;;###autoload
@@ -182,7 +173,12 @@ Uses the shell command coming from variables `lpr-command' and
   (let* ((file-list (dired-get-marked-files t arg))
 	 (command (dired-mark-read-string
 		   "Print %s with: "
-		   (apply 'concat lpr-command " " lpr-switches)
+ 		   (mapconcat 'identity
+			      (cons lpr-command
+				    (if (stringp lpr-switches)
+					(list lpr-switches)
+				      lpr-switches))
+			      " ")
 		   'print arg file-list)))
     (dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
 
@@ -203,19 +199,99 @@ Uses the shell command coming from variables `lpr-command' and
    (function read-string)
    (format prompt (dired-mark-prompt arg files)) initial))
 
+;;; Cleaning a directory: flagging some backups for deletion.
+
+(defvar dired-file-version-alist)
+
+(defun dired-clean-directory (keep)
+  "Flag numerical backups for deletion.
+Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
+Positive prefix arg KEEP overrides `dired-kept-versions';
+Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
+
+To clear the flags on these files, you can use \\[dired-flag-backup-files]
+with a prefix argument."
+  (interactive "P")
+  (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
+  (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
+	(late-retention (if (<= keep 0) dired-kept-versions keep))
+	(dired-file-version-alist ()))
+    (message "Cleaning numerical backups (keeping %d late, %d old)..."
+	     late-retention early-retention)
+    ;; Look at each file.
+    ;; If the file has numeric backup versions,
+    ;; put on dired-file-version-alist an element of the form
+    ;; (FILENAME . VERSION-NUMBER-LIST)
+    (dired-map-dired-file-lines (function dired-collect-file-versions))
+    ;; Sort each VERSION-NUMBER-LIST,
+    ;; and remove the versions not to be deleted.
+    (let ((fval dired-file-version-alist))
+      (while fval
+	(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
+	       (v-count (length sorted-v-list)))
+	  (if (> v-count (+ early-retention late-retention))
+	      (rplacd (nthcdr early-retention sorted-v-list)
+		      (nthcdr (- v-count late-retention)
+			      sorted-v-list)))
+	  (rplacd (car fval)
+		  (cdr sorted-v-list)))
+	(setq fval (cdr fval))))
+    ;; Look at each file.  If it is a numeric backup file,
+    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
+    (dired-map-dired-file-lines (function dired-trample-file-versions))
+    (message "Cleaning numerical backups...done")))
+
+;;; Subroutines of dired-clean-directory.
+
+(defun dired-map-dired-file-lines (fun)
+  ;; Perform FUN with point at the end of each non-directory line.
+  ;; FUN takes one argument, the absolute filename.
+  (save-excursion
+    (let (file buffer-read-only)
+      (goto-char (point-min))
+      (while (not (eobp))
+	(save-excursion
+	  (and (not (looking-at dired-re-dir))
+	       (not (eolp))
+	       (setq file (dired-get-filename nil t)) ; nil on non-file
+	       (progn (end-of-line)
+		      (funcall fun file))))
+	(forward-line 1)))))
+
+(defun dired-collect-file-versions (fn)
+  (let ((fn (file-name-sans-versions fn)))
+    ;; Only do work if this file is not already in the alist.
+    (if (assoc fn dired-file-version-alist)
+	nil
+      ;; If it looks like file FN has versions, return a list of the versions.
+      ;;That is a list of strings which are file names.
+      ;;The caller may want to flag some of these files for deletion.
+      (let* ((base-versions
+	      (concat (file-name-nondirectory fn) ".~"))
+	     (backup-extract-version-start (length base-versions))
+	     (possibilities (file-name-all-completions
+			     base-versions
+			     (file-name-directory fn)))
+	     (versions (mapcar 'backup-extract-version possibilities)))
+	(if versions
+	    (setq dired-file-version-alist
+		  (cons (cons fn versions)
+			dired-file-version-alist)))))))
+
+(defun dired-trample-file-versions (fn)
+  (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
+	 base-version-list)
+    (and start-vn
+	 (setq base-version-list	; there was a base version to which
+	       (assoc (substring fn 0 start-vn)	; this looks like a
+		      dired-file-version-alist))	; subversion
+	 (not (memq (string-to-int (substring fn (+ 2 start-vn)))
+		    base-version-list))	; this one doesn't make the cut
+	 (progn (beginning-of-line)
+		(delete-char 1)
+		(insert dired-del-marker)))))
+
 ;;; 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 wierd 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).
@@ -225,51 +301,61 @@ Uses the shell command coming from variables `lpr-command' and
   (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
-(defun dired-do-shell-command (&optional arg in-background)
-  "Run a shell command on the marked files.
+(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.
+The prompt mentions the file(s) or the marker, as appropriate.
+
 If there is output, it goes to a separate buffer.
+
 Normally the command is run on each file individually.
 However, if there is a `*' in the command then it is run
 just once with the entire file list substituted there.
 
-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.
-The prompt mentions the file(s) or the marker, as appropriate.
+If there is no `*', but a `?' in the command then it is still run
+on each file individually but with the filename substituted there
+instead of att the end of the command.
 
-No automatic redisplay is attempted, as the file names may have
-changed.  Type \\[dired-do-redisplay] to redisplay the marked files.
+No automatic redisplay of dired buffers is attempted, as there's no
+telling what files the command may have changed.  Type
+\\[dired-do-redisplay] to redisplay the marked files.
 
 The shell command has the top level directory as working directory, so
-output files usually are created there instead of in a subdir."
+output files usually are created there instead of in a subdir.
+
+In a noninteractive call (from Lisp code), you must specify
+the list of file names explicitly with the FILE-LIST argument."
 ;;Functions dired-run-shell-command and dired-shell-stuff-it do the
 ;;actual work and can be redefined for customization.
-  (interactive "P")
-  (let* ((on-each (not (string-match "\\*" command)))
-	 (prompt (concat (if in-background "& on " "! on ")
-			 (if on-each "each " "")
-			 "%s: "))
-	 (file-list (dired-get-marked-files t arg))
-	 ;; Want to give feedback whether this file or marked files are used:
-	 (command (dired-read-shell-command
-		   prompt arg file-list)))
+  (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))
 	 (function (lambda (&rest files)
 		     (dired-run-shell-command
-		      (dired-shell-stuff-it command files t arg))
-		     in-background))
+		      (dired-shell-stuff-it command files t arg))))
 	 nil
 	 file-list)
       ;; execute the shell command
       (dired-run-shell-command
-       (dired-shell-stuff-it command file-list nil arg)
-       in-background))))
+       (dired-shell-stuff-it command file-list nil arg)))))
 
 ;; Might use {,} for bash or csh:
 (defvar dired-mark-prefix ""
@@ -288,35 +374,47 @@ output files usually are created there instead of in a subdir."
 ;; (coming from interactive P and currently ignored) to decide what to do.
 ;; Smart would be a way to access basename or extension of file names.
 ;; See dired-trns.el for an approach to this.
-  ;; Bug: There is no way to quote a *
-  ;; On the other hand, you can never accidentally get a * into your cmd.
+  ;; Bug: There is no way to quote a * or a ?
+  ;; On the other hand, you can never accidentally get a * or a ? into
+  ;; your cmd.
   (let ((stuff-it
-	 (if (string-match "\\*" command)
-	     (function (lambda (x)
-			 (dired-replace-in-string "\\*" x command)))
-	   (function (lambda (x) (concat command " " x))))))
+	 (cond ((string-match "\\*" command)
+		(function (lambda (x)
+			    (dired-replace-in-string "\\*" x command))))
+	       ((string-match "\\?" command)
+		(function (lambda (x)
+			     (dired-replace-in-string "\\?" x command))))
+	       (t (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)))
 	(funcall stuff-it fns)))))
 
 ;; This is an extra function so that it can be redefined by ange-ftp.
-(defun dired-run-shell-command (command &optional in-background)
-  (if (not in-background)
-      (shell-command command)
-    ;; We need this only in Emacs 18 (19's shell command has `&').
-    ;; comint::background is defined in emacs-19.el.
-    (comint::background command)))
+(defun dired-run-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)
 
 ;; In Emacs 19 this will return program's exit status.
 ;; This is a separate function so that ange-ftp can redefine it.
 (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.
@@ -346,17 +444,6 @@ output files usually are created there instead of in a subdir."
 
 ;; Commands that delete or redisplay part of the dired buffer.
 
-;;;###autoload
-(defun dired-kill-line-or-subdir (&optional arg)
-  "Kill this line (but don't delete its file).
-Optional prefix argument is a repeat factor.
-If file is displayed as in situ subdir, kill that as well.
-If on a subdir headerline, kill whole subdir."
-  (interactive "p")
-  (if (dired-get-subdir)
-      (dired-kill-subdir)
-    (dired-kill-line arg)))
-
 (defun dired-kill-line (&optional arg)
   (interactive "P")
   (setq arg (prefix-numeric-value arg))
@@ -379,31 +466,38 @@ If on a subdir headerline, kill whole subdir."
 ;;;###autoload
 (defun dired-do-kill-lines (&optional arg fmt)
   "Kill all marked lines (not the files).
-With a prefix arg, kill all lines not marked or flagged."
+With a prefix argument, kill that many lines starting with the current line.
+\(A negative argument kills lines before the current line.)
+To kill an entire subdirectory, go to its directory header line
+and use this command with a prefix argument (the value does not matter)."
   ;; Returns count of killed lines.  FMT="" suppresses message.
   (interactive "P")
-  (save-excursion
-    (goto-char (point-min))
-    (let (buffer-read-only (count 0))
-      (if (not arg)			; kill marked lines
-	  (let ((regexp (dired-marker-regexp)))
-	    (while (and (not (eobp))
-			(re-search-forward regexp nil t))
+  (if arg
+      (if (dired-get-subdir)
+	  (dired-kill-subdir)
+	(dired-kill-line arg))
+    (save-excursion
+      (goto-char (point-min))
+      (let (buffer-read-only (count 0))
+	(if (not arg)			; kill marked lines
+	    (let ((regexp (dired-marker-regexp)))
+	      (while (and (not (eobp))
+			  (re-search-forward regexp nil t))
+		(setq count (1+ count))
+		(delete-region (progn (beginning-of-line) (point))
+			       (progn (forward-line 1) (point)))))
+	  ;; else kill unmarked lines
+	  (while (not (eobp))
+	    (if (or (dired-between-files)
+		    (not (looking-at "^  ")))
+		(forward-line 1)
 	      (setq count (1+ count))
-	      (delete-region (progn (beginning-of-line) (point))
-			     (progn (forward-line 1) (point)))))
-	;; else kill unmarked lines
-	(while (not (eobp))
-	  (if (or (dired-between-files)
-		  (not (looking-at "^  ")))
-	      (forward-line 1)
-	    (setq count (1+ count))
-	    (delete-region (point) (save-excursion
-				     (forward-line 1)
-				     (point))))))
-      (or (equal "" fmt)
-	  (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
-      count)))
+	      (delete-region (point) (save-excursion
+				       (forward-line 1)
+				       (point))))))
+	(or (equal "" fmt)
+	    (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
+	count))))
 
 ;;;###end dired-cmd.el
 
@@ -414,24 +508,89 @@ With a prefix arg, kill all lines not marked or flagged."
   ;; Compress or uncompress the current file.
   ;; Return nil for success, offending filename else.
   (let* (buffer-read-only
-	 (from-file (dired-get-filename)))
-    (cond ((save-excursion (beginning-of-line)
-			   (looking-at dired-re-sym))
-	   (dired-log (concat "Attempt to compress a symbolic link:\n"
-			      from-file))
-	   (dired-make-relative from-file))
-	  ((string-match "\\.Z$" from-file)
-	   (if (dired-check-process (concat "Uncompressing " from-file)
-				    "uncompress" from-file)
-	       (dired-make-relative from-file)
-	     (dired-update-file-line (substring from-file 0 -2))))
+	 (from-file (dired-get-filename))
+	 (new-file (dired-compress-file from-file)))
+    (if new-file
+	(let ((start (point)))
+	  ;; Remove any preexisting entry for the name NEW-FILE.
+	  (condition-case nil
+	      (dired-remove-entry new-file)
+	    (error nil))
+	  (goto-char start)
+	  ;; Now replace the current line with an entry for NEW-FILE.
+	  (dired-update-file-line new-file) nil)
+      (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")
+    ("\\.bz2\\'" "" "bunzip2")
+    ;; 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.
+  (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)
+	  ((and suffix (nth 2 suffix))
+	   ;; We found an uncompression rule.
+	   (if (not (dired-check-process (concat "Uncompressing " file)
+					 (nth 2 suffix) file))
+	       newname))
 	  (t
-	   (if (dired-check-process (concat "Compressing " from-file)
-				    "compress" "-f" from-file)
-	       ;; Errors from the process are already logged.
-	       (dired-make-relative from-file)
-	     (dired-update-file-line (concat from-file ".Z")))))
-    nil))
+	   ;;; 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))
+		   (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))
+		  ;; Don't use NEWNAME with `compress'.
+		  (concat file ".Z"))))))))
 
 (defun dired-mark-confirm (op-symbol arg)
   ;; Request confirmation from the user that the operation described
@@ -439,10 +598,13 @@ With a prefix arg, kill all lines not marked or flagged."
   ;; 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)
-      (let ((files (dired-get-marked-files t arg)))
+  (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)))))
 	(dired-mark-pop-up nil op-symbol files (function y-or-n-p)
-			   (concat (capitalize (symbol-name op-symbol)) " "
+			   (concat string " "
 				   (dired-mark-prompt arg files) "? ")))))
 
 (defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
@@ -464,15 +626,16 @@ With a prefix arg, kill all lines not marked or flagged."
 	      (dired-map-over-marks (funcall fun) arg show-progress))
 	     (total (length total-list))
 	     (failures (delq nil total-list))
-	     (count (length failures)))
+	     (count (length failures))
+	     (string (if (eq op-symbol 'compress) "Compress or uncompress"
+		       (capitalize (symbol-name op-symbol)))))
 	(if (not failures)
 	    (message "%s: %d file%s."
-		     (capitalize (symbol-name op-symbol))
-		     total (dired-plural-s total))
+		     string total (dired-plural-s total))
 	  ;; end this bunch of errors:
 	  (dired-log-summary
 	   (format "Failed to %s %d of %d file%s"
-		   (symbol-name op-symbol) count total (dired-plural-s total))
+		   (downcase string) count total (dired-plural-s total))
 	   failures)))))
 
 (defvar dired-query-alist
@@ -487,7 +650,7 @@ With a prefix arg, kill all lines not marked or flagged."
   ;; Query user and return nil or t.
   ;; Store answer in symbol VAR (which must initially be bound to nil).
   ;; Format PROMPT with ARGS.
-  ;; Binding variable help-form will help the user who types C-h.
+  ;; Binding variable help-form will help the user who types the help key.
   (let* ((char (symbol-value qs-var))
 	 (action (cdr (assoc char dired-query-alist))))
     (cond ((eq 'yes action)
@@ -525,15 +688,14 @@ With a prefix arg, kill all lines not marked or flagged."
 (defun dired-byte-compile ()
   ;; Return nil for success, offending file name else.
   (let* ((filename (dired-get-filename))
-	 (elc-file
-	  (if (eq system-type 'vax-vms)
-	      (concat (substring filename 0 (string-match ";" filename)) "c")
-	    (concat filename "c")))
-	 buffer-read-only failure)
+	 elc-file buffer-read-only failure)
     (condition-case err
 	(save-excursion (byte-compile-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)
@@ -579,6 +741,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
+    (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))
@@ -593,20 +757,25 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
   ;; here is faster than with dired-add-entry's optional arg).
   ;; Does not update other dired buffers.  Use dired-relist-entry for that.
   (beginning-of-line)
-  (let ((char (following-char)) (opoint (point)))
+  (let ((char (following-char)) (opoint (point))
+	(buffer-read-only))
     (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))
 
-(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.
+  ;; 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).
-  (let ((buf-list (dired-buffers-for-dir directory))
+  (let ((buf-list (dired-buffers-for-dir (expand-file-name directory)
+					 file))
 	(obuf (current-buffer))
 	buf success-list)
     (while buf-list
@@ -620,12 +789,13 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 	(set-buffer obuf)))
     success-list))
 
+;;;###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))
 
-(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
@@ -635,11 +805,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
-  (let ((opoint (point))
+  (let* ((opoint (point))
 	(cur-dir (dired-current-directory))
-	(directory (file-name-directory filename))
+	(orig-file-name filename)
+	(directory (if relative cur-dir (file-name-directory filename)))
 	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)
@@ -663,19 +837,30 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 		    (dired-goto-next-nontrivial-file))
 		;; not found
 		(throw 'not-found "Subdir not found")))
-	    ;; found and point is at The Right Place:
-	    (let (buffer-read-only)
+	    (let (buffer-read-only opoint)
 	      (beginning-of-line)
+	      (setq opoint (point))
 	      (dired-add-entry-do-indentation marker-char)
-	      (dired-ls (dired-make-absolute filename directory);; don't expand `.' !
-			(concat dired-actual-switches "d"))
+	      ;; don't expand `.'.  Show just the file name within directory.
+	      (let ((default-directory directory))
+		(insert-directory filename
+				  (concat dired-actual-switches "d")))
+	      ;; Compensate for a bug in ange-ftp.
+	      ;; It inserts the file's absolute name, rather than
+	      ;; the relative one.  That may be hard to fix since it
+	      ;; is probably controlled by something in ftp.
+	      (goto-char opoint)	
+	      (let ((inserted-name (dired-get-filename 'no-dir)))
+		(if (file-name-directory inserted-name)
+		    (progn
+		      (end-of-line)
+		      (delete-char (- (length inserted-name)))
+		      (insert filename)
+		      (forward-char 1))
+		  (forward-line 1)))
+	      ;; Give each line a text property recording info about it.
+	      (dired-insert-set-properties opoint (point))
 	      (forward-line -1)
-	      ;; We want to have the non-directory part, only:
-	      (let* ((beg (dired-move-to-filename t)) ; error for strange output
-		     (end (dired-move-to-end-of-filename)))
-		(setq filename (buffer-substring beg end))
-		(delete-region beg end)
-		(insert (file-name-nondirectory filename)))
 	      (if dired-after-readin-hook;; the subdir-alist is not affected...
 		  (save-excursion;; ...so we can run it right now:
 		    (save-restriction
@@ -688,7 +873,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 	    nil))
     (if reason				; don't move away on failure
 	(goto-char opoint))
-    (not reason)))			; return t on succes, nil else
+    (not reason)))			; return t on success, nil else
 
 ;; This is a separate function for the sake of nested dired format.
 (defun dired-add-entry-do-indentation (marker-char)
@@ -712,9 +897,11 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 	(forward-line 1))
     (point)))
 
+;;;###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
@@ -723,13 +910,15 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 	   (delete-region (progn (beginning-of-line) (point))
 			  (save-excursion (forward-line 1) (point)))))))
 
+;;;###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)
   ;; Relist the line for FILE, or just add it if it did not exist.
-  ;; FILE must be an absolute pathname.
+  ;; FILE must be an absolute file name.
   (let (buffer-read-only marker)
     ;; If cursor is already on FILE's line delete-region will cause
     ;; save-excursion to fail because of floating makers,
@@ -745,37 +934,82 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 
 ;;; Copy, move/rename, making hard and symbolic links
 
-(defvar dired-backup-overwrite nil
+(defcustom dired-recursive-copies nil
+  "*Decide whether recursive copies are allowed.
+Nil means no recursive copies.
+`always' means copy recursively without asking.
+`top' means ask for each directory at top level.
+Anything else means ask for each directory."
+  :type '(choice :tag "Copy directories"
+		 (const :tag "No recursive copies" nil)
+		 (const :tag "Ask for each directory" t)
+		 (const :tag "Ask for each top directory only" top)
+		 (const :tag "Copy directories without asking" always))
+  :group 'dired)
+
+(defcustom dired-backup-overwrite nil
   "*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)
 
 (defun dired-handle-overwrite (to)
   ;; Save old version of a to be overwritten file TO.
-  ;; `overwrite-confirmed' and `overwrite-backup-query' are fluid vars
+  ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
   ;; from dired-create-files.
-  (if (and dired-backup-overwrite
-	   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)
-  (copy-file from to ok-flag dired-copy-preserve-time))
+  (condition-case ()
+      (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
+				 dired-recursive-copies)
+    (file-date-error (message "Can't set date")
+		     (sit-for 1))))
+
+(defun dired-copy-file-recursive (from to ok-flag &optional
+				       preserve-time top recursive)
+  (if (and recursive
+	   (eq t (car (file-attributes from))) ; A directory, no symbolic link.
+	   (or (eq recursive 'always)
+	       (yes-or-no-p (format "Recursive copies of %s " from))))
+      (let ((files (directory-files from nil dired-re-no-dot)))
+	(if (eq recursive 'top) (setq recursive 'always)) ; Don't ask any more.
+	(if (file-exists-p to)
+	    (or top (dired-handle-overwrite to))
+	  (make-directory to))
+	(while files
+	  (dired-copy-file-recursive
+	   (expand-file-name (car files) from)
+	   (expand-file-name (car files) to)
+	   ok-flag preserve-time nil recursive)
+	  (setq files (cdr files))))
+    (or top (dired-handle-overwrite to)) ; Just a file.
+    (copy-file from to ok-flag dired-copy-preserve-time)))
 
+;;;###autoload
 (defun dired-rename-file (from to ok-flag)
   (dired-handle-overwrite to)
   (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))
@@ -783,15 +1017,16 @@ 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))
-  (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 ((blist (buffer-list)))
+  (let ((expanded-from-dir (expand-file-name from-dir))
+	(blist (buffer-list)))
     (while blist
       (save-excursion
-        (set-buffer (car blist))
+	(set-buffer (car blist))
 	(if (and buffer-file-name
-		 (dired-in-this-tree buffer-file-name from-dir))
+		 (dired-in-this-tree buffer-file-name expanded-from-dir))
 	    (let ((modflag (buffer-modified-p))
 		  (to-file (dired-replace-in-string
 			    (concat "^" (regexp-quote from-dir))
@@ -804,12 +1039,13 @@ Special value `always' suppresses confirmation.")
 (defun dired-rename-subdir-1 (dir to)
   ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
   ;; one of its subdirectories is expanded in this buffer.
-  (let ((alist dired-subdir-alist)
+  (let ((expanded-dir (expand-file-name dir))
+	(alist dired-subdir-alist)
 	(elt nil))
     (while alist
       (setq elt (car alist)
 	    alist (cdr alist))
-      (if (dired-in-this-tree (car elt) dir)
+      (if (dired-in-this-tree (car elt) expanded-dir)
 	  ;; ELT's subdir is affected by the rename
 	  (dired-rename-subdir-2 elt dir to)))
     (if (equal dir default-directory)
@@ -853,69 +1089,6 @@ Special value `always' suppresses confirmation.")
 	      (dired-normalize-subdir
 	       (dired-replace-in-string regexp newtext (car elt)))))))
 
-;; Cloning replace-match to work on strings instead of in buffer:
-;; The FIXEDCASE parameter of replace-match is not implemented.
-;;;###autoload
-(defun dired-string-replace-match (regexp string newtext
-					  &optional literal global)
-  "Replace first match of REGEXP in STRING with NEWTEXT.
-If it does not match, nil is returned instead of the new string.
-Optional arg LITERAL means to take NEWTEXT literally.
-Optional arg GLOBAL means to replace all matches."
-  (if global
-        (let ((result "") (start 0) mb me)
-	  (while (string-match regexp string start)
-	    (setq mb (match-beginning 0)
-		  me (match-end 0)
-		  result (concat result
-				 (substring string start mb)
-				 (if literal
-				     newtext
-				   (dired-expand-newtext string newtext)))
-		  start me))
-	  (if mb			; matched at least once
-	      (concat result (substring string start))
-	    nil))
-    ;; not GLOBAL
-    (if (not (string-match regexp string 0))
-	nil
-      (concat (substring string 0 (match-beginning 0))
-	      (if literal newtext (dired-expand-newtext string newtext))
-	      (substring string (match-end 0))))))
-
-(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))
-
 ;; 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)
@@ -930,13 +1103,13 @@ Optional arg GLOBAL means to replace all matches."
 ;; 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
 ;; operation performed.  It is used for error logging.
 
-;; FN-LIST is the list of files to copy (full absolute pathnames).
+;; FN-LIST is the list of files to copy (full absolute file names).
 
 ;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
 ;; skip.  If it skips files for other reasons than a direct user
@@ -961,7 +1134,7 @@ Optional arg GLOBAL means to replace all matches."
 	  (if (not to)
 	      (setq skipped (cons (dired-make-relative from) skipped))
 	    (let* ((overwrite (file-exists-p to))
-		   (overwrite-confirmed	; for dired-handle-overwrite
+		   (dired-overwrite-confirmed	; for dired-handle-overwrite
 		    (and overwrite
 			 (let ((help-form '(format "\
 Type SPC or `y' to overwrite file `%s',
@@ -978,7 +1151,7 @@ ESC or `q' to not overwrite any of the remaining files,
 			   (t nil))))
 	      (condition-case err
 		  (progn
-		    (funcall file-creator from to overwrite-confirmed)
+		    (funcall file-creator from to dired-overwrite-confirmed)
 		    (if overwrite
 			;; If we get here, file-creator hasn't been aborted
 			;; and the old entry (if any) has to be deleted
@@ -1019,20 +1192,31 @@ ESC or `q' to not overwrite any of the remaining files,
   ;;   the new files.  Target may be a plain file if only one marked
   ;;   file exists.
   ;; OP-SYMBOL is the symbol for the operation.  Function `dired-mark-pop-up'
-  ;;   will determine wether pop-ups are appropriate for this OP-SYMBOL.
+  ;;   will determine whether pop-ups are appropriate for this OP-SYMBOL.
   ;; FILE-CREATOR and OPERATION as in dired-create-files.
   ;; ARG as in dired-get-marked-files.
+  ;; Optional arg MARKER-CHAR as in dired-create-files.
   ;; Optional arg OP1 is an alternate form for OPERATION if there is
   ;;   only one file.
-  ;; Optional arg MARKER-CHAR as in dired-create-files.
-  ;; Optional arg HOW-TO determines how to treat target:
-  ;;   If HOW-TO is not given (or nil), and target is a directory, the
-  ;;     file(s) are created inside the target directory.  If target
-  ;;     is not a directory, there must be exactly one marked file,
-  ;;     else error.
-  ;;   If HOW-TO is t, then target is not modified.  There must be
-  ;;     exactly one marked file, else error.
-  ;; Else HOW-TO is assumed to be a function of one argument, target,
+  ;; Optional arg HOW-TO is used to set the value of the into-dir variable
+  ;;   which determines how to treat target.
+  ;;   If into-dir is set to nil then target is not regarded as a directory,
+  ;;     there must be exactly one marked file, else error.
+  ;;   Else if into-dir is set to a list, then target is a genearlized
+  ;;     directory (e.g. some sort of archive).  The first element of into-dir
+  ;;     must be a function with at least four arguments:
+  ;;       operation as OPERATION above.
+  ;;       rfn-list a list of the relative names for the marked files.
+  ;;       fn-list a list of the absolute names for the marked files.
+  ;;       target.
+  ;;       The rest of into-dir are optional arguments.
+  ;;   Else into-dir is not a list.  Target is a directory.
+  ;;     The marked file(s) are created inside the target directory.
+  ;;
+  ;;   If HOW-TO is not given (or nil), then into-dir is set to true if
+  ;;     target is a directory and otherwise to nil.
+  ;;   Else if HOW-TO is t, then into-dir is set to nil.
+  ;;   Else HOW-TO is assumed to be a function of one argument, target,
   ;;     that looks at target and returns a value for the into-dir
   ;;     variable.  The function dired-into-dir-with-symlinks is provided
   ;;     for the case (common when creating symlinks) that symbolic
@@ -1040,29 +1224,51 @@ ESC or `q' to not overwrite any of the remaining files,
   ;;     (as file-directory-p would if HOW-TO had been nil).
   (or op1 (setq op1 operation))
   (let* ((fn-list (dired-get-marked-files nil arg))
-	 (fn-count (length fn-list))
-	 (target (expand-file-name
+	 (rfn-list (mapcar (function dired-make-relative) fn-list))
+	 (dired-one-file	; fluid variable inside dired-create-files
+	  (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
+	 (target (expand-file-name ; fluid variable inside dired-create-files
 		   (dired-mark-read-file-name
-		    (concat (if (= 1 fn-count) op1 operation) " %s to: ")
+		    (concat (if dired-one-file op1 operation) " %s to: ")
 		    (dired-dwim-target-directory)
-		    op-symbol arg (mapcar (function dired-make-relative) fn-list))))
-	 (into-dir (cond ((null how-to) (file-directory-p target))
+		    op-symbol arg rfn-list)))
+	 (into-dir (cond ((null how-to)
+			  ;; Allow DOS/Windows users to change the letter
+			  ;; case of a directory.  If we don't test these
+			  ;; conditions up front, file-directory-p below
+			  ;; will return t because the filesystem is
+			  ;; case-insensitive, and Emacs will try to move
+			  ;; foo -> foo/foo, which fails.
+			  (if (and (memq system-type '(ms-dos windows-nt))
+				   (eq op-symbol 'move)
+				   dired-one-file
+				   (string= (downcase
+					     (expand-file-name (car fn-list)))
+					    (downcase
+					     (expand-file-name target)))
+				   (not (string=
+					 (file-name-nondirectory (car fn-list))
+					 (file-name-nondirectory target))))
+			      nil
+			    (file-directory-p target)))
 			 ((eq how-to t) nil)
 			 (t (funcall how-to target)))))
-    (if (and (> fn-count 1)
-	     (not into-dir))
-	(error "Marked %s: target must be a directory: %s" operation target))
-    ;; rename-file bombs when moving directories unless we do this:
-    (or into-dir (setq target (directory-file-name target)))
-    (dired-create-files
-     file-creator operation fn-list
-     (if into-dir			; target is a directory
-	 ;; This function uses fluid vars into-dir and target when called
-	 ;; inside dired-create-files:
-	 (function (lambda (from)
-		     (expand-file-name (file-name-nondirectory from) target)))
-       (function (lambda (from) target)))
-     marker-char)))
+    (if (and (consp into-dir) (functionp (car into-dir)))
+	(apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
+      (if (not (or dired-one-file into-dir))
+	  (error "Marked %s: target must be a directory: %s" operation target))
+      ;; rename-file bombs when moving directories unless we do this:
+      (or into-dir (setq target (directory-file-name target)))
+      (dired-create-files
+       file-creator operation fn-list
+       (if into-dir			; target is a directory
+	   ;; This function uses fluid variable target when called
+	   ;; inside dired-create-files:
+	   (function
+	    (lambda (from)
+	      (expand-file-name (file-name-nondirectory from) target)))
+	 (function (lambda (from) target)))
+       marker-char))))
 
 ;; Read arguments for a marked-files command that wants a file name,
 ;; perhaps popping up the list of marked files.
@@ -1119,18 +1325,24 @@ ESC or `q' to not overwrite any of the remaining files,
 ;; just have to remove that symlink by hand before making your marked
 ;; symlinks.
 
+(defvar dired-copy-how-to-fn nil
+  "Nil or a function used by `dired-do-copy' to determine target.
+See HOW-TO argument for `dired-do-create-files'.")
+
 ;;;###autoload
 (defun dired-do-copy (&optional arg)
   "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)
+  (let ((dired-recursive-copies dired-recursive-copies))
+    (dired-do-create-files 'copy (function dired-copy-file)
 			   (if dired-copy-preserve-time "Copy [-p]" "Copy")
-			   arg dired-keep-marker-copy))
+			   arg dired-keep-marker-copy
+			   nil dired-copy-how-to-fn)))
 
 ;;;###autoload
 (defun dired-do-symlink (&optional arg)
@@ -1173,7 +1385,7 @@ When renaming multiple or marked files, you specify a directory."
   ;; ARG as in dired-get-marked-files.
   ;; Matches each marked file against REGEXP and constructs the new
   ;;   filename from NEWNAME (like in function replace-match).
-  ;; Optional arg WHOLE-PATH means match/replace the whole pathname
+  ;; Optional arg WHOLE-PATH means match/replace the whole file name
   ;;   instead of only the non-directory part of the file.
   ;; Optional arg MARKER-CHAR as in dired-create-files.
   (let* ((fn-list (dired-get-marked-files nil arg))
@@ -1231,8 +1443,7 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next,
 	  (if whole-path nil current-prefix-arg))
 	 (regexp
 	  (dired-read-regexp
-	   (concat (if whole-path "Path " "") operation " from (regexp): ")
-	   dired-flagging-regexp))
+	   (concat (if whole-path "Path " "") operation " from (regexp): ")))
 	 (newname
 	  (read-string
 	   (concat (if whole-path "Path " "") operation " " regexp " to: "))))
@@ -1245,9 +1456,9 @@ As each match is found, the user must type a character saying
   what to do with it.  For directions, type \\[help-command] at that time.
 NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
 REGEXP defaults to the last regexp used.
-With a zero prefix arg, renaming by regexp affects the complete
-  pathname - usually only the non-directory part of file names is used
-  and changed."
+
+With a zero prefix arg, renaming by regexp affects the absolute file name.
+Normally, only the non-directory part of the file name is used and changed."
   (interactive (dired-mark-read-regexp "Rename"))
   (dired-do-create-files-regexp
    (function dired-rename-file)
@@ -1256,17 +1467,18 @@ With a zero prefix arg, renaming by regexp affects the complete
 ;;;###autoload
 (defun dired-do-copy-regexp (regexp newname &optional arg whole-path)
   "Copy all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
+See function `dired-do-rename-regexp' for more info."
   (interactive (dired-mark-read-regexp "Copy"))
-  (dired-do-create-files-regexp
-   (function dired-copy-file)
-   (if dired-copy-preserve-time "Copy [-p]" "Copy")
-   arg regexp newname whole-path dired-keep-marker-copy))
+  (let ((dired-recursive-copies nil))	; No recursive copies.
+    (dired-do-create-files-regexp
+     (function dired-copy-file)
+     (if dired-copy-preserve-time "Copy [-p]" "Copy")
+     arg regexp newname whole-path dired-keep-marker-copy)))
 
 ;;;###autoload
 (defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path)
   "Hardlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
+See function `dired-do-rename-regexp' for more info."
   (interactive (dired-mark-read-regexp "HardLink"))
   (dired-do-create-files-regexp
    (function add-name-to-file)
@@ -1275,7 +1487,7 @@ See function `dired-rename-regexp' for more info."
 ;;;###autoload
 (defun dired-do-symlink-regexp (regexp newname &optional arg whole-path)
   "Symlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
+See function `dired-do-rename-regexp' for more info."
   (interactive (dired-mark-read-regexp "SymLink"))
   (dired-do-create-files-regexp
    (function make-symbolic-link)
@@ -1355,6 +1567,7 @@ This function takes some pains to conform to `ls -lR' output."
     ;; insert message so that the user sees the `Mark set' message.
     (push-mark opoint)))
 
+;;;###autoload
 (defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
   "Insert this subdirectory into the same dired buffer.
 If it is already present, overwrites previous entry,
@@ -1395,7 +1608,7 @@ This function takes some pains to conform to `ls -lR' output."
 (defun dired-insert-subdir-validate (dirname &optional switches)
   ;; Check that it is valid to insert DIRNAME with SWITCHES.
   ;; Signal an error if invalid (e.g. user typed `i' on `..').
-  (or (dired-in-this-tree dirname default-directory)
+  (or (dired-in-this-tree dirname (expand-file-name default-directory))
       (error  "%s: not in this directory tree" dirname))
   (if switches
       (let (case-fold-search)
@@ -1426,6 +1639,7 @@ This function takes some pains to conform to `ls -lR' output."
   ;;"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
   ;; With optional arg REMEMBER-MARKS, return an alist of marked files."
   (interactive "DKill tree below directory: ")
+  (setq dirname (expand-file-name dirname))
   (let ((s-alist dired-subdir-alist) dir m-alist)
     (while s-alist
       (setq dir (car (car s-alist))
@@ -1481,7 +1695,9 @@ This function takes some pains to conform to `ls -lR' output."
       (if (equal dirname (car (car (reverse dired-subdir-alist))))
 	  ;; top level directory may contain wildcards:
 	  (dired-readin-insert dired-directory)
-	(dired-ls dirname dired-actual-switches nil t)))
+	(let ((opoint (point)))
+	  (insert-directory dirname dired-actual-switches nil t)
+	  (dired-insert-set-properties opoint (point)))))
     (message "Reading directory %s...done" dirname)
     (setq end (point-marker))
     (indent-rigidly begin end 2)
@@ -1490,7 +1706,8 @@ This function takes some pains to conform to `ls -lR' output."
     ;;  moves point.
     ;;  Need a marker for END as this inserts text.
     (goto-char begin)
-    (dired-insert-headerline dirname)
+    (if (not (looking-at "^  /.*:$"))
+	(dired-insert-headerline dirname))
     ;; point is now like in dired-build-subdir-alist
     (prog1
 	(list begin (marker-position end))
@@ -1517,7 +1734,7 @@ This function takes some pains to conform to `ls -lR' output."
 	    (run-hooks 'dired-after-readin-hook))))))
 
 (defun dired-tree-lessp (dir1 dir2)
-  ;; Lexicographic order on pathname components, like `ls -lR':
+  ;; Lexicographic order on file name components, like `ls -lR':
   ;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
   ;;   i.e., iff DIR1 is a (grand)parent dir of DIR2,
   ;;   or DIR1 and DIR2 are in the same parentdir and their last
@@ -1580,38 +1797,6 @@ is always equal to STRING."
 
 ;;; moving by subdirectories
 
-(defun dired-subdir-index (dir)
-  ;; Return an index into alist for use with nth
-  ;; for the sake of subdir moving commands.
-  (let (found (index 0) (alist dired-subdir-alist))
-    (while alist
-      (if (string= dir (car (car alist)))
-	  (setq alist nil found t)
-	(setq alist (cdr alist) index (1+ index))))
-    (if found index nil)))
-
-;;;###autoload
-(defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
-  "Go to next subdirectory, regardless of level."
-  ;; Use 0 arg to go to this directory's header line.
-  ;; NO-SKIP prevents moving to end of header line, returning whatever
-  ;; position was found in dired-subdir-alist.
-  (interactive "p")
-  (let ((this-dir (dired-current-directory))
-	pos index)
-    ;; nth with negative arg does not return nil but the first element
-    (setq index (- (dired-subdir-index this-dir) arg))
-    (setq pos (if (>= index 0)
-		  (dired-get-subdir-min (nth index dired-subdir-alist))))
-    (if pos
-	(progn
-	  (goto-char pos)
-	  (or no-skip (skip-chars-forward "^\n\r"))
-	  (point))
-      (if no-error-if-not-found
-	  nil				; return nil if not found
-	(error "%s directory" (if (> arg 0) "Last" "First"))))))
-
 ;;;###autoload
 (defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
   "Go to previous subdirectory, regardless of level.
@@ -1655,8 +1840,10 @@ The next char is either \\n, or \\r if DIR is hidden."
 
 ;;;###autoload
 (defun dired-mark-subdir-files ()
-  "Mark all files except `.' and `..'."
-  (interactive "P")
+  "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))))
 
@@ -1779,4 +1966,41 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
 
 ;;;###end dired-ins.el
 
-;;; dired-aux.el ends here
\ No newline at end of file
+
+;; Functions for searching in tags style among marked files.
+
+;;;###autoload
+(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]."
+  (interactive "sSearch marked files (regexp): ")
+  (tags-search regexp '(dired-get-marked-files)))
+
+;;;###autoload
+(defun dired-do-query-replace-regexp (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.
+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")
+  (tags-query-replace from to delimited '(dired-get-marked-files)))
+
+;;;###autoload
+(defun dired-show-file-type (file &optional deref-symlinks)
+  "Print the type of FILE, according to the `file' command.
+If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
+true then the type of the file linked to by FILE is printed instead." 
+  (interactive (list (dired-get-filename t) current-prefix-arg))
+  (with-temp-buffer 
+    (if deref-symlinks
+	(call-process "file" nil t t "-L" file)
+      (call-process "file" nil t t file))
+    (when (bolp)
+      (backward-delete-char 1))
+    (message (buffer-string))))
+
+(provide 'dired-aux)
+
+;;; dired-aux.el ends here