]> code.delx.au - gnu-emacs/blobdiff - lisp/dired-aux.el
(dired-insert-subdir): Add autoload cookie.
[gnu-emacs] / lisp / dired-aux.el
index 175e48cd1fc01519956c40b75b2b2326462d6adf..0dbe65007a82bd40658126594afddc05550af54e 100644 (file)
@@ -245,7 +245,7 @@ with a prefix argument."
 
 (defun dired-map-dired-file-lines (fun)
   ;; Perform FUN with point at the end of each non-directory line.
-  ;; FUN takes one argument, the filename (complete pathname).
+  ;; FUN takes one argument, the absolute filename.
   (save-excursion
     (let (file buffer-read-only)
       (goto-char (point-min))
@@ -319,12 +319,19 @@ 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 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 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
@@ -367,13 +374,17 @@ 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 'shell-quote-argument file-list) ";")
       (let ((fns (mapconcat 'shell-quote-argument
@@ -518,6 +529,7 @@ and use this command with a prefix argument (the value does not matter)."
     ;; 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.
@@ -906,7 +918,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 
 (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,
@@ -922,6 +934,19 @@ a prefix arg lets you edit the `ls' switches used for the new listing."
 \f
 ;;; Copy, move/rename, making hard and symbolic links
 
+(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."
@@ -942,7 +967,8 @@ Special value `always' suppresses confirmation."
             (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))))
+                             (format "Make backup for existing file `%s'? "
+                                     to))))
        (progn
          (rename-file to backup 0)     ; confirm overwrite of old backup
          (dired-relist-entry backup)))))
@@ -951,10 +977,31 @@ Special value `always' suppresses confirmation."
 (defun dired-copy-file (from to ok-flag)
   (dired-handle-overwrite to)
   (condition-case ()
-      (copy-file from to ok-flag dired-copy-preserve-time)
+      (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)
@@ -1062,7 +1109,7 @@ Special value `always' suppresses confirmation."
 ;; 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
@@ -1148,17 +1195,28 @@ ESC or `q' to not overwrite any of the remaining files,
   ;;   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
@@ -1166,29 +1224,33 @@ 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))))
+                   op-symbol arg rfn-list)))
         (into-dir (cond ((null how-to) (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.
@@ -1245,6 +1307,10 @@ 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.
@@ -1254,9 +1320,11 @@ 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)
-                          (if dired-copy-preserve-time "Copy [-p]" "Copy")
-                          arg dired-keep-marker-copy))
+n  (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
+                            nil dired-copy-how-to-fn)))
 
 ;;;###autoload
 (defun dired-do-symlink (&optional arg)
@@ -1299,7 +1367,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))
@@ -1370,9 +1438,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)
@@ -1381,17 +1449,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)
@@ -1400,7 +1469,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)
@@ -1480,6 +1549,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,
@@ -1618,7 +1688,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))
@@ -1645,7 +1716,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