X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/d63a6ae0d09a3f5a8373c852732d88dd603b99bd..36e0285064805bbeda924947399b988501c76cd9:/lisp/dired-aux.el diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 69ea15922c..b4cb893319 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,8 +1,11 @@ ;;; 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, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006 Free Software Foundation, Inc. ;; Author: Sebastian Kremer . +;; Maintainer: FSF +;; Keywords: files ;; This file is part of GNU Emacs. @@ -18,8 +21,8 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -40,24 +43,37 @@ ;;;###begin dired-cmd.el ;; Diffing and compressing +(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)") +(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)") + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with file FILE using `diff'. -FILE defaults to the file at the mark. +FILE defaults to the file at the mark. (That's the mark set by +\\[set-mark-command], not by Dired's \\[dired-mark] command.) The prompted-for file is the first file given to `diff'. With prefix arg, prompt for second argument SWITCHES, - which is options for `diff'." +which is options for `diff'." (interactive - (let ((default (if (mark t) + (let ((current (dired-get-filename t)) + (default (if (mark t) (save-excursion (goto-char (mark t)) (dired-get-filename t t))))) + (if (or (equal default current) + (and (not (equal (dired-dwim-target-directory) + (dired-current-directory))) + (not mark-active))) + (setq default nil)) (require 'diff) - (list (read-file-name (format "Diff %s with: %s" - (dired-get-filename t) + (list (read-file-name (format "Diff %s with%s: " + current (if default - (concat "(default " default ") ") + (concat " (default " default ")") "")) - (dired-current-directory) default t) + (if default + (dired-current-directory) + (dired-dwim-target-directory)) + default t) (if current-prefix-arg (read-string "Options for diff: " (if (stringp diff-switches) @@ -81,8 +97,124 @@ With prefix arg, prompt for argument SWITCHES which is options for `diff'." nil)) (diff-backup (dired-get-filename) switches)) +;;;###autoload +(defun dired-compare-directories (dir2 predicate) + "Mark files with different file attributes in two dired buffers. +Compare file attributes of files in the current directory +with file attributes in directory DIR2 using PREDICATE on pairs of files +with the same name. Mark files for which PREDICATE returns non-nil. +Mark files with different names if PREDICATE is nil (or interactively +with empty input at the predicate prompt). + +PREDICATE is a Lisp expression that can refer to the following variables: + + size1, size2 - file size in bytes + mtime1, mtime2 - last modification time in seconds, as a float + fa1, fa2 - list of file attributes + returned by function `file-attributes' + + where 1 refers to attribute of file in the current dired buffer + and 2 to attribute of file in second dired buffer. + +Examples of PREDICATE: + + (> mtime1 mtime2) - mark newer files + (not (= size1 size2)) - mark files with different sizes + (not (string= (nth 8 fa1) (nth 8 fa2))) - mark files with different modes + (not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID + (= (nth 3 fa1) (nth 3 fa2)))) and GID." + (interactive + (list (read-directory-name (format "Compare %s with: " + (dired-current-directory)) + (dired-dwim-target-directory) + (dired-dwim-target-directory)) + (read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil"))) + (let* ((dir1 (dired-current-directory)) + (file-alist1 (dired-files-attributes dir1)) + (file-alist2 (dired-files-attributes dir2)) + file-list1 file-list2) + (setq file-alist1 (delq (assoc "." file-alist1) file-alist1)) + (setq file-alist1 (delq (assoc ".." file-alist1) file-alist1)) + (setq file-alist2 (delq (assoc "." file-alist2) file-alist2)) + (setq file-alist2 (delq (assoc ".." file-alist2) file-alist2)) + (setq file-list1 (mapcar + 'cadr + (dired-file-set-difference + file-alist1 file-alist2 + predicate)) + file-list2 (mapcar + 'cadr + (dired-file-set-difference + file-alist2 file-alist1 + predicate))) + (dired-fun-in-all-buffers + dir1 nil + (lambda () + (dired-mark-if + (member (dired-get-filename nil t) file-list1) nil))) + (dired-fun-in-all-buffers + dir2 nil + (lambda () + (dired-mark-if + (member (dired-get-filename nil t) file-list2) nil))) + (message "Marked in dir1: %s files, in dir2: %s files" + (length file-list1) + (length file-list2)))) + +(defun dired-file-set-difference (list1 list2 predicate) + "Combine LIST1 and LIST2 using a set-difference operation. +The result list contains all file items that appear in LIST1 but not LIST2. +This is a non-destructive function; it makes a copy of the data if necessary +to avoid corrupting the original LIST1 and LIST2. +PREDICATE (see `dired-compare-directories') is an additional match +condition. Two file items are considered to match if they are equal +*and* PREDICATE evaluates to t." + (if (or (null list1) (null list2)) + list1 + (let (res) + (dolist (file1 list1) + (unless (let ((list list2)) + (while (and list + (not (let* ((file2 (car list)) + (fa1 (car (cddr file1))) + (fa2 (car (cddr file2))) + (size1 (nth 7 fa1)) + (size2 (nth 7 fa2)) + (mtime1 (float-time (nth 5 fa1))) + (mtime2 (float-time (nth 5 fa2)))) + (and + (equal (car file1) (car file2)) + (not (eval predicate)))))) + (setq list (cdr list))) + list) + (setq res (cons file1 res)))) + (nreverse res)))) + +(defun dired-files-attributes (dir) + "Return a list of all file names and attributes from DIR. +List has a form of (file-name full-file-name (attribute-list))" + (mapcar + (lambda (file-name) + (let ((full-file-name (expand-file-name file-name dir))) + (list file-name + full-file-name + (file-attributes full-file-name)))) + (directory-files dir))) + + +(defun dired-touch-initial (files) + "Create initial input value for `touch' command." + (let (initial) + (while files + (let ((current (nth 5 (file-attributes (car files))))) + (if (and initial (not (equal initial current))) + (setq initial (current-time) files nil) + (setq initial current)) + (setq files (cdr files)))) + (format-time-string "%Y%m%d%H%M.%S" initial))) + (defun dired-do-chxxx (attribute-name program op-symbol arg) - ;; Change file attributes (mode, group, owner) of marked files and + ;; Change file attributes (mode, group, owner, timestamp) of marked files and ;; refresh their file lines. ;; ATTRIBUTE-NAME is a string describing the attribute to the user. ;; PROGRAM is the program used to change the attribute. @@ -92,13 +224,20 @@ With prefix arg, prompt for argument SWITCHES which is options for `diff'." (new-attribute (dired-mark-read-string (concat "Change " attribute-name " of %s to: ") - nil op-symbol arg files)) + (if (eq op-symbol 'touch) (dired-touch-initial files)) + op-symbol arg files)) (operation (concat program " " new-attribute)) failures) (setq failures (dired-bunch-files 10000 (function dired-check-process) - (list operation program new-attribute) + (append + (list operation program) + (if (eq op-symbol 'touch) + '("-t") nil) + (list new-attribute) + (if (string-match "gnu" system-configuration) + '("--") nil)) files)) (dired-do-redisplay arg);; moves point if ARG is an integer (if failures @@ -118,7 +257,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed." "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.")) + (error "chgrp not supported on this system")) (dired-do-chxxx "Group" "chgrp" 'chgrp arg)) ;;;###autoload @@ -126,15 +265,23 @@ This calls chmod, thus symbolic modes like `g+w' are allowed." "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.")) + (error "chown not supported on this system")) (dired-do-chxxx "Owner" dired-chown-program 'chown arg)) +;;;###autoload +(defun dired-do-touch (&optional arg) + "Change the timestamp of the marked (or next ARG) files. +This calls touch." + (interactive "P") + (dired-do-chxxx "Timestamp" dired-touch-program 'touch arg)) + ;; Process all the files in FILES in batches of a convenient size, ;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...). ;; Batches are chosen to need less than MAX chars for the file names, ;; allowing 3 extra characters of separator per file name. (defun dired-bunch-files (max function args files) (let (pending + past (pending-length 0) failures) ;; Accumulate files as long as they fit in MAX chars, @@ -146,9 +293,15 @@ This calls chmod, thus symbolic modes like `g+w' are allowed." ;; If we have at least 1 pending file ;; 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)) - failures) + (setq pending (nreverse pending) + ;; The elements of PENDING are now in forward order. + ;; Do the operation and record failures. + failures (nconc (apply function (append args pending)) + failures) + ;; Transfer the elemens of PENDING onto PAST + ;; and clear it out. Now PAST contains the first N files + ;; specified (for some N), and FILES contains the rest. + past (nconc past pending) pending nil pending-length 0)) ;; Do (setq pending (cons thisfile pending)) @@ -157,8 +310,12 @@ 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)) - failures))) + (setq pending (nreverse pending)) + (prog1 + (nconc (apply function (append args pending)) + failures) + ;; Now the original list FILES has been put back as it was. + (nconc past pending)))) ;;;###autoload (defun dired-do-print (&optional arg) @@ -199,6 +356,7 @@ Uses the shell command coming from variables `lpr-command' and (defvar dired-file-version-alist) +;;;###autoload (defun dired-clean-directory (keep) "Flag numerical backups for deletion. Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest. @@ -241,7 +399,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)) @@ -264,7 +422,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) ".~")) - (bv-length (length base-versions)) + (backup-extract-version-start (length base-versions)) (possibilities (file-name-all-completions base-versions (file-name-directory fn))) @@ -281,25 +439,13 @@ with a prefix argument." (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))) + (not (memq (string-to-number (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 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). @@ -315,47 +461,76 @@ with a prefix argument." ;; 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. The prompt mentions the file(s) or the marker, as appropriate. -If there is output, it goes to a separate buffer. +If there is a `*' in COMMAND, surrounded by whitespace, this runs +COMMAND just once with the entire file list substituted there. + +If there is no `*', but there is a `?' in COMMAND, surrounded by +whitespace, this runs COMMAND on each file individually with the +file name substituted for `?'. -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. +Otherwise, this runs COMMAND on each file individually with the +file name added at the end of COMMAND (separated by a space). -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. +`*' and `?' when not surrounded by whitespace have no special +significance for `dired-do-shell-command', and are passed through +normally to the shell, but you must confirm first. To pass `*' by +itself to the shell as a wildcard, type `*\"\"'. -The shell command has the top level directory as working directory, so -output files usually are created there instead of in a subdir." +If COMMAND produces output, it goes to a separate buffer. + +This feature does not try to redisplay Dired buffers afterward, as +there's no telling what files COMMAND may have changed. +Type \\[dired-do-redisplay] to redisplay the marked files. + +When COMMAND runs, its working directory is the top-level directory of +the Dired buffer, so 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, which +can be produced by `dired-get-marked-files', for example." ;;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))) - (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)))) - nil - file-list) - ;; execute the shell command - (dired-run-shell-command - (dired-shell-stuff-it command file-list nil 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 dired-star-subst-regexp command))) + (subst (not (string-match dired-quark-subst-regexp command))) + (star (not (string-match "\\*" command))) + (qmark (not (string-match "\\?" command)))) + ;; Get confirmation for wildcards that may have been meant + ;; to control substitution of a file name or the file name list. + (if (cond ((not (or on-each subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((and star (not on-each)) + (y-or-n-p "Confirm--do you mean to use `*' as a wildcard? ")) + ((and qmark (not subst)) + (y-or-n-p "Confirm--do you mean to use `?' as a wildcard? ")) + (t)) + (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)))) + nil + file-list) + ;; execute the shell command + (dired-run-shell-command + (dired-shell-stuff-it command file-list nil arg)))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" @@ -373,25 +548,32 @@ output files usually are created there instead of in a subdir." ;; Might be redefined for smarter things and could then use RAW-ARG ;; (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. (let ((stuff-it - (if (string-match "\\*" command) - (function (lambda (x) - (dired-replace-in-string "\\*" x command))) - (function (lambda (x) (concat command " " x)))))) + (if (or (string-match dired-star-subst-regexp command) + (string-match dired-quark-subst-regexp command)) + (lambda (x) + (let ((retval command)) + (while (string-match + "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval) + (setq retval (replace-match x t t retval 2))) + retval)) + (lambda (x) (concat command dired-mark-separator x))))) (if on-each - (mapconcat stuff-it (mapcar 'dired-shell-quote file-list) ";") - (let ((fns (mapconcat 'dired-shell-quote - file-list dired-mark-separator))) + (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";") + (let ((files (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))))) + (setq files (concat dired-mark-prefix files dired-mark-postfix))) + (funcall stuff-it files))))) ;; This is an extra function so that it can be redefined by ange-ftp. +;;;###autoload (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) @@ -423,8 +605,8 @@ output files usually are created there instead of in a subdir." (set-buffer err-buffer) (erase-buffer) (setq default-directory dir ; caller's default-directory - err (/= 0 - (apply (function dired-call-process) program nil arguments))) + err (not (eq 0 + (apply (function dired-call-process) program nil arguments)))) (if err (progn (dired-log (concat program " " (prin1-to-string arguments) "\n")) @@ -443,7 +625,7 @@ output files usually are created there instead of in a subdir." (while (/= 0 arg) (setq file (dired-get-filename nil t)) (if (not file) - (error "Can only kill file lines.") + (error "Can only kill file lines") (save-excursion (and file (dired-goto-subdir file) (dired-kill-subdir))) @@ -459,9 +641,14 @@ output files usually are created there instead of in a subdir." (defun dired-do-kill-lines (&optional arg fmt) "Kill all marked lines (not the files). 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)." +\(A negative argument kills backward.) +If you use this command with a prefix argument to kill the line +for a file that is a directory, which you have inserted in the +Dired buffer as a subdirectory, then it deletes that subdirectory +from the buffer as well. +To kill an entire subdirectory \(without killing its line in the +parent directory), 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") (if arg @@ -470,23 +657,14 @@ and use this command with a prefix argument (the value does not matter)." (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 (point) (save-excursion - (forward-line 1) - (point)))))) + (let (buffer-read-only + (count 0) + (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)))) (or (equal "" fmt) (message (or fmt "Killed %d line%s.") count (dired-plural-s count))) count)))) @@ -521,6 +699,9 @@ 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") + ("\\.dz\\'" "" "dictunzip") + ("\\.tbz\\'" ".tar" "bunzip2") + ("\\.bz2\\'" "" "bunzip2") ;; This item controls naming for compression. ("\\.tar\\'" ".tgz" nil)) "Control changes in file name suffixes for compression and uncompression. @@ -548,7 +729,7 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") (setq suffix (car suffixes) suffixes nil)) (setq suffixes (cdr suffixes)))) ;; If so, compute desired new name. - (if suffix + (if suffix (setq newname (concat (substring file 0 (match-beginning 0)) (nth 1 suffix)))) (cond (handler @@ -589,8 +770,12 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") ;; 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) + ;; Pass t for DISTINGUISH-ONE-MARKED so that a single file which + ;; is marked pops up a window. That will help the user see + ;; it isn't the current line file. + (let ((files (dired-get-marked-files t arg nil t)) (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) @@ -632,10 +817,11 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") '((?\y . y) (?\040 . y) ; `y' or SPC means accept once (?n . n) (?\177 . n) ; `n' or DEL skips once (?! . yes) ; `!' accepts rest - (?q. no) (?\e . no) ; `q' or ESC skips rest + (?q . no) (?\e . no) ; `q' or ESC skips rest ;; None of these keys quit - use C-g for that. )) +;;;###autoload (defun dired-query (qs-var qs-prompt &rest qs-args) ;; Query user and return nil or t. ;; Store answer in symbol VAR (which must initially be bound to nil). @@ -665,6 +851,9 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") (sit-for 1) (apply 'message qprompt qs-args) (setq char (set qs-var (read-char)))) + ;; Display the question with the answer. + (message "%s" (concat (apply 'format qprompt qs-args) + (char-to-string char))) (memq (cdr elt) '(t y yes))))))) ;;;###autoload @@ -722,13 +911,27 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") (defun dired-do-redisplay (&optional arg test-for-subdir) "Redisplay all marked (or next ARG) files. If on a subdir line, redisplay that subdirectory. In that case, -a prefix arg lets you edit the `ls' switches used for the new listing." +a prefix arg lets you edit the `ls' switches used for the new listing. + +Dired remembers switches specified with a prefix arg, so that reverting +the buffer will not reset them. However, using `dired-undo' to re-insert +or delete subdirectories can bypass this machinery. Hence, you sometimes +may have to reset some subdirectory switches after a `dired-undo'. +You can reset all subdirectory switches to the default using +\\\\[dired-reset-subdir-switches]. +See Info node `(emacs)Subdir switches' for more details." ;; Moves point if the next ARG files are redisplayed. (interactive "P\np") (if (and test-for-subdir (dired-get-subdir)) - (dired-insert-subdir - (dired-get-subdir) - (if arg (read-string "Switches for listing: " dired-actual-switches))) + (let* ((dir (dired-get-subdir)) + (switches (cdr (assoc-string dir dired-switches-alist)))) + (dired-insert-subdir + dir + (when arg + (read-string "Switches for listing: " + (or switches + dired-subdir-switches + dired-actual-switches))))) (message "Redisplaying...") ;; message much faster than making dired-map-over-marks show progress (dired-uncache @@ -739,6 +942,12 @@ a prefix arg lets you edit the `ls' switches used for the new listing." arg) (dired-move-to-filename) (message "Redisplaying...done"))) + +(defun dired-reset-subdir-switches () + "Set `dired-switches-alist' to nil and revert dired buffer." + (interactive) + (setq dired-switches-alist nil) + (revert-buffer)) (defun dired-update-file-line (file) ;; Delete the current line, and insert an entry for FILE. @@ -752,36 +961,19 @@ 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 - (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) - ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS. - ;; Return list of buffers where FUN succeeded (i.e., returned non-nil). - (let ((buf-list (dired-buffers-for-dir (expand-file-name directory))) - (obuf (current-buffer)) - buf success-list) - (while buf-list - (setq buf (car buf-list) - buf-list (cdr buf-list)) - (unwind-protect - (progn - (set-buffer buf) - (if (apply fun args) - (setq success-list (cons (buffer-name buf) success-list)))) - (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 @@ -791,12 +983,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)) - (cur-dir (dired-current-directory)) - (orig-file-name filename) - (directory (file-name-directory filename)) - reason) - (setq filename (file-name-nondirectory filename) + (let* ((opoint (point)) + (cur-dir (dired-current-directory)) + (orig-file-name filename) + (directory (if relative cur-dir (file-name-directory filename))) + reason) + (setq filename + (if relative + (file-relative-name filename directory) + (file-name-nondirectory filename)) reason (catch 'not-found (if (string= directory cur-dir) @@ -811,8 +1006,8 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (goto-char p)))) ;; else try to find correct place to insert (if (dired-goto-subdir directory) - (progn;; unhide if necessary - (if (looking-at "\r");; point is at end of subdir line + (progn ;; unhide if necessary + (if (looking-at "\r") ;; point is at end of subdir line (dired-unhide-subdir)) ;; found - skip subdir and `total' line ;; and uninteresting files like . and .. @@ -823,29 +1018,37 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (let (buffer-read-only opoint) (beginning-of-line) (setq opoint (point)) - (dired-add-entry-do-indentation marker-char) - ;; don't expand `.'. Show just the file name within directory. + ;; Don't expand `.'. Show just the file name within directory. (let ((default-directory directory)) - (insert-directory filename - (concat dired-actual-switches "d"))) + (dired-insert-directory directory + (concat dired-actual-switches "d") + (list filename))) + (goto-char opoint) + ;; Put in desired marker char. + (when marker-char + (let ((dired-marker-char + (if (integerp marker-char) marker-char dired-marker-char))) + (dired-mark nil))) ;; 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))) + (goto-char opoint) + (let ((inserted-name (dired-get-filename 'verbatim))) (if (file-name-directory inserted-name) - (progn + (let (props) (end-of-line) - (delete-char (- (length inserted-name))) - (insert filename) + (forward-char (- (length inserted-name))) + (setq props (text-properties-at (point))) + (delete-char (length inserted-name)) + (let ((pt (point))) + (insert filename) + (set-text-properties pt (point) props)) (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) - (if dired-after-readin-hook;; the subdir-alist is not affected... - (save-excursion;; ...so we can run it right now: + (if dired-after-readin-hook ;; the subdir-alist is not affected... + (save-excursion ;; ...so we can run it right now: (save-restriction (beginning-of-line) (narrow-to-region (point) (save-excursion @@ -854,17 +1057,9 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (dired-move-to-filename)) ;; return nil if all went well nil)) - (if reason ; don't move away on failure + (if reason ; don't move away on failure (goto-char opoint)) - (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) - ;; two spaces or a marker plus a space: - (insert (if marker-char - (if (integerp marker-char) marker-char dired-marker-char) - ?\040) - ?\040)) + (not reason))) ; return t on success, nil else (defun dired-after-subdir-garbage (dir) ;; Return pos of first file line of DIR, skipping header and total @@ -883,7 +1078,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 - (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 @@ -894,12 +1090,14 @@ a prefix arg lets you edit the `ls' switches used for the new listing." ;;;###autoload (defun dired-relist-file (file) + "Create or update the line for FILE in all Dired buffers it would belong in." (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, @@ -915,14 +1113,18 @@ 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-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. + ;; Save old version of file TO that is to be overwritten. ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars ;; from dired-create-files. (let (backup) @@ -931,7 +1133,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)))) + "Make backup for existing file `%s'? " + to))) (progn (rename-file to backup 0) ; confirm overwrite of old backup (dired-relist-entry backup))))) @@ -939,27 +1142,54 @@ Special value `always' suppresses confirmation.") ;;;###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) + (let ((attrs (file-attributes from))) + (if (and recursive + (eq t (car attrs)) + (or (eq recursive 'always) + (yes-or-no-p (format "Recursive copies of %s? " from)))) + ;; This is a directory. + (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)))) + ;; Not a directory. + (or top (dired-handle-overwrite to)) + (if (stringp (car attrs)) + ;; It is a symlink + (make-symbolic-link (car attrs) to ok-flag) + (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 +(defun dired-rename-file (file newname ok-if-already-exists) + (dired-handle-overwrite newname) + (rename-file file newname ok-if-already-exists) ; 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)))) - (dired-remove-file from) + (and (get-file-buffer file) + (with-current-buffer (get-file-buffer file) + (set-visited-file-name newname nil t))) + (dired-remove-file file) ;; See if it's an inserted subdir, and rename that, too. - (dired-rename-subdir from to)) + (dired-rename-subdir file newname)) (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)) @@ -1010,9 +1240,10 @@ Special value `always' suppresses confirmation.") (dired-advertise))))) (defun dired-rename-subdir-2 (elt dir to) - ;; Update the headerline and dired-subdir-alist element of directory - ;; described by alist-element ELT to reflect the moving of DIR to TO. - ;; Thus, ELT describes either DIR itself or a subdir of DIR. + ;; Update the headerline and dired-subdir-alist element, as well as + ;; dired-switches-alist element, of directory described by + ;; alist-element ELT to reflect the moving of DIR to TO. Thus, ELT + ;; describes either DIR itself or a subdir of DIR. (save-excursion (let ((regexp (regexp-quote (directory-file-name dir))) (newtext (directory-file-name to)) @@ -1026,10 +1257,12 @@ Special value `always' suppresses confirmation.") (if (re-search-forward regexp (match-end 1) t) (replace-match newtext t t) (error "Expected to find `%s' in headerline of %s" dir (car elt)))) - ;; Update buffer-local dired-subdir-alist - (setcar elt - (dired-normalize-subdir - (dired-replace-in-string regexp newtext (car elt))))))) + ;; Update buffer-local dired-subdir-alist and dired-switches-alist + (let ((cons (assoc-string (car elt) dired-switches-alist)) + (cur-dir (dired-normalize-subdir + (dired-replace-in-string regexp newtext (car elt))))) + (setcar elt cur-dir) + (when cons (setcar cons cur-dir)))))) ;; 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 @@ -1051,7 +1284,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 @@ -1127,57 +1360,94 @@ ESC or `q' to not overwrite any of the remaining files, (dired-move-to-filename)) (defun dired-do-create-files (op-symbol file-creator operation arg - &optional marker-char op1 - how-to) - ;; Create a new file for each marked file. - ;; Prompts user for target, which is a directory in which to create - ;; 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 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 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, - ;; 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 - ;; links to directories are not to be considered as directories - ;; (as file-directory-p would if HOW-TO had been nil). + &optional marker-char op1 + how-to) + "Create a new file for each marked file. +Prompts user for target, which is a directory in which to create + the new files. Target may be a plain file if only one marked + file exists. The way the default for the target directory is + computed depends on the value of `dired-dwim-target-directory'. +OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up' + 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 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 generalized + 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 + links to directories are not to be considered as directories + (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-dir (dired-dwim-target-directory)) + (default (and dired-one-file + (expand-file-name (file-name-nondirectory (car fn-list)) + target-dir))) + (target (expand-file-name ; fluid variable inside dired-create-files (dired-mark-read-file-name - (concat (if (= 1 fn-count) 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)) + (concat (if dired-one-file op1 operation) " %s to: ") + target-dir op-symbol arg rfn-list default))) + (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 cygwin)) + (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. @@ -1185,12 +1455,15 @@ ESC or `q' to not overwrite any of the remaining files, ;; marks (ARG=nil) or a repeat factor (integerp ARG). ;; If the current file was used, the list has but one element and ARG ;; does not matter. (It is non-nil, non-integer in that case, namely '(4)). +;; DEFAULT is the default value to return if the user just hits RET; +;; if it is omitted or nil, then the name of the directory is used. -(defun dired-mark-read-file-name (prompt dir op-symbol arg files) +(defun dired-mark-read-file-name (prompt dir op-symbol arg files + &optional default) (dired-mark-pop-up nil op-symbol files (function read-file-name) - (format prompt (dired-mark-prompt arg files)) dir)) + (format prompt (dired-mark-prompt arg files)) dir default)) (defun dired-dwim-target-directory () ;; Try to guess which target directory the user may want. @@ -1234,6 +1507,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. @@ -1241,11 +1518,15 @@ 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 copies of these files are made in that directory -with the same names that the files currently have." +with the same names that the files currently have. The default +suggested for the target directory depends on the value of +`dired-dwim-target', which see." (interactive "P") - (dired-do-create-files 'copy (function dired-copy-file) - (if dired-copy-preserve-time "Copy [-p]" "Copy") - arg dired-keep-marker-copy)) + (let ((dired-recursive-copies dired-recursive-copies)) + (dired-do-create-files 'copy (function dired-copy-file) + "Copy" + arg dired-keep-marker-copy + nil dired-copy-how-to-fn))) ;;;###autoload (defun dired-do-symlink (&optional arg) @@ -1253,7 +1534,9 @@ with the same names that the files currently have." 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 -with the same names that the files currently have." +with the same names that the files currently have. The default +suggested for the target directory depends on the value of +`dired-dwim-target', which see." (interactive "P") (dired-do-create-files 'symlink (function make-symbolic-link) "Symlink" arg dired-keep-marker-symlink)) @@ -1264,16 +1547,28 @@ with the same names that the files currently have." 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 hard links are made in that directory -with the same names that the files currently have." +with the same names that the files currently have. The default +suggested for the target directory depends on the value of +`dired-dwim-target', which see." (interactive "P") - (dired-do-create-files 'hardlink (function add-name-to-file) + (dired-do-create-files 'hardlink (function dired-hardlink) "Hardlink" arg dired-keep-marker-hardlink)) +(defun dired-hardlink (file newname &optional ok-if-already-exists) + (dired-handle-overwrite newname) + ;; error is caught in -create-files + (add-name-to-file file newname ok-if-already-exists) + ;; Update the link count + (dired-relist-file file)) + ;;;###autoload (defun dired-do-rename (&optional arg) "Rename current file or all marked (or next ARG) files. When renaming just the current file, you specify the new name. -When renaming multiple or marked files, you specify a directory." +When renaming multiple or marked files, you specify a directory. +This command also renames any buffers that are visiting the files. +The default suggested for the target directory depends on the value +of `dired-dwim-target', which see." (interactive "P") (dired-do-create-files 'move (function dired-rename-file) "Move" arg dired-keep-marker-rename "Rename")) @@ -1282,13 +1577,13 @@ When renaming multiple or marked files, you specify a directory." ;;; 5K ;;;###begin dired-re.el (defun dired-do-create-files-regexp - (file-creator operation arg regexp newname &optional whole-path marker-char) + (file-creator operation arg regexp newname &optional whole-name marker-char) ;; Create a new file for each marked file using regexps. ;; FILE-CREATOR and OPERATION as in dired-create-files. ;; 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-NAME 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)) @@ -1301,7 +1596,7 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next, (downcase operation))) (regexp-name-constructor ;; Function to construct new filename using REGEXP and NEWNAME: - (if whole-path ; easy (but rare) case + (if whole-name ; easy (but rare) case (function (lambda (from) (let ((to (dired-string-replace-match regexp from newname)) @@ -1316,7 +1611,7 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next, to) (dired-log "%s: %s did not match regexp %s\n" operation from regexp))))) - ;; not whole-path, replace non-directory part only + ;; not whole-name, replace non-directory part only (function (lambda (from) (let* ((new (dired-string-replace-match @@ -1339,61 +1634,67 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next, (defun dired-mark-read-regexp (operation) ;; Prompt user about performing OPERATION. - ;; Read and return list of: regexp newname arg whole-path. - (let* ((whole-path + ;; Read and return list of: regexp newname arg whole-name. + (let* ((whole-name (equal 0 (prefix-numeric-value current-prefix-arg))) (arg - (if whole-path nil current-prefix-arg)) + (if whole-name nil current-prefix-arg)) (regexp (dired-read-regexp - (concat (if whole-path "Path " "") operation " from (regexp): "))) + (concat (if whole-name "Abs. " "") operation " from (regexp): "))) (newname (read-string - (concat (if whole-path "Path " "") operation " " regexp " to: ")))) - (list regexp newname arg whole-path))) + (concat (if whole-name "Abs. " "") operation " " regexp " to: ")))) + (list regexp newname arg whole-name))) ;;;###autoload -(defun dired-do-rename-regexp (regexp newname &optional arg whole-path) - "Rename marked files containing REGEXP to NEWNAME. +(defun dired-do-rename-regexp (regexp newname &optional arg whole-name) + "Rename selected files whose names match REGEXP to NEWNAME. + +With non-zero prefix argument ARG, the command operates on the next ARG +files. Otherwise, it operates on all the marked files, or the current +file if none are marked. + 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 \\=\\ 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) - "Rename" arg regexp newname whole-path dired-keep-marker-rename)) + "Rename" arg regexp newname whole-name dired-keep-marker-rename)) ;;;###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." +(defun dired-do-copy-regexp (regexp newname &optional arg whole-name) + "Copy selected files whose names match REGEXP to NEWNAME. +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-name 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." +(defun dired-do-hardlink-regexp (regexp newname &optional arg whole-name) + "Hardlink selected files whose names match REGEXP to NEWNAME. +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) - "HardLink" arg regexp newname whole-path dired-keep-marker-hardlink)) + "HardLink" arg regexp newname whole-name dired-keep-marker-hardlink)) ;;;###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." +(defun dired-do-symlink-regexp (regexp newname &optional arg whole-name) + "Symlink selected files whose names match REGEXP to NEWNAME. +See function `dired-do-rename-regexp' for more info." (interactive (dired-mark-read-regexp "SymLink")) (dired-do-create-files-regexp (function make-symbolic-link) - "SymLink" arg regexp newname whole-path dired-keep-marker-symlink)) + "SymLink" arg regexp newname whole-name dired-keep-marker-symlink)) (defun dired-create-files-non-directory (file-creator basename-constructor operation arg) @@ -1453,11 +1754,20 @@ If it is already present, just move to it (type \\[dired-do-redisplay] to refres With a prefix arg, you may edit the ls switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. -This function takes some pains to conform to `ls -lR' output." +This function takes some pains to conform to `ls -lR' output. + +Dired remembers switches specified with a prefix arg, so that reverting +the buffer will not reset them. However, using `dired-undo' to re-insert +or delete subdirectories can bypass this machinery. Hence, you sometimes +may have to reset some subdirectory switches after a `dired-undo'. +You can reset all subdirectory switches to the default using +\\\\[dired-reset-subdir-switches]. +See Info node `(emacs)Subdir switches' for more details." (interactive (list (dired-get-filename) (if current-prefix-arg - (read-string "Switches for listing: " dired-actual-switches)))) + (read-string "Switches for listing: " + (or dired-subdir-switches dired-actual-switches))))) (let ((opoint (point))) ;; We don't need a marker for opoint as the subdir is always ;; inserted *after* opoint. @@ -1469,6 +1779,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, @@ -1483,14 +1794,19 @@ This function takes some pains to conform to `ls -lR' output." (interactive (list (dired-get-filename) (if current-prefix-arg - (read-string "Switches for listing: " dired-actual-switches)))) + (read-string "Switches for listing: " + (or dired-subdir-switches dired-actual-switches))))) (setq dirname (file-name-as-directory (expand-file-name dirname))) - (dired-insert-subdir-validate dirname switches) (or no-error-if-not-dir-p (file-directory-p dirname) (error "Attempt to insert a non-directory: %s" dirname)) (let ((elt (assoc dirname dired-subdir-alist)) - switches-have-R mark-alist case-fold-search buffer-read-only) + (cons (assoc-string dirname dired-switches-alist)) + (modflag (buffer-modified-p)) + (old-switches switches) + switches-have-R mark-alist case-fold-search buffer-read-only) + (and (not switches) cons (setq switches (cdr cons))) + (dired-insert-subdir-validate dirname switches) ;; case-fold-search is nil now, so we can test for capital `R': (if (setq switches-have-R (and switches (string-match "R" switches))) ;; avoid duplicated subdirs @@ -1501,9 +1817,23 @@ This function takes some pains to conform to `ls -lR' output." (dired-insert-subdir-newpos dirname)) ; else compute new position (dired-insert-subdir-doupdate dirname elt (dired-insert-subdir-doinsert dirname switches)) - (if switches-have-R (dired-build-subdir-alist)) + (when old-switches + (if cons + (setcdr cons switches) + (push (cons dirname switches) dired-switches-alist))) + (when switches-have-R + (dired-build-subdir-alist switches) + (setq switches (dired-replace-in-string "R" "" switches)) + (dolist (cur-ass dired-subdir-alist) + (let ((cur-dir (car cur-ass))) + (and (dired-in-this-tree cur-dir dirname) + (let ((cur-cons (assoc-string cur-dir dired-switches-alist))) + (if cur-cons + (setcdr cur-cons switches) + (push (cons cur-dir switches) dired-switches-alist))))))) (dired-initial-position dirname) - (save-excursion (dired-mark-remembered mark-alist)))) + (save-excursion (dired-mark-remembered mark-alist)) + (restore-buffer-modified-p modflag))) ;; This is a separate function for dired-vms. (defun dired-insert-subdir-validate (dirname &optional switches) @@ -1511,17 +1841,18 @@ This function takes some pains to conform to `ls -lR' output." ;; Signal an error if invalid (e.g. user typed `i' on `..'). (or (dired-in-this-tree dirname (expand-file-name default-directory)) (error "%s: not in this directory tree" dirname)) - (if switches + (let ((real-switches (or switches dired-subdir-switches))) + (when real-switches (let (case-fold-search) (mapcar (function (lambda (x) - (or (eq (null (string-match x switches)) + (or (eq (null (string-match x real-switches)) (null (string-match x dired-actual-switches))) - (error "Can't have dirs with and without -%s switches together" - x)))) + (error + "Can't have dirs with and without -%s switches together" x)))) ;; all switches that make a difference to dired-get-filename: - '("F" "b"))))) + '("F" "b")))))) (defun dired-alist-add (dir new-marker) ;; Add new DIR at NEW-MARKER. Sort alist. @@ -1536,19 +1867,23 @@ This function takes some pains to conform to `ls -lR' output." (> (dired-get-subdir-min elt1) (dired-get-subdir-min elt2))))))) -(defun dired-kill-tree (dirname &optional remember-marks) - ;;"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)) +(defun dired-kill-tree (dirname &optional remember-marks kill-root) + "Kill all proper subdirs of DIRNAME, excluding DIRNAME itself. +Interactively, you can kill DIRNAME as well by using a prefix argument. +In interactive use, the command prompts for DIRNAME. + +When called from Lisp, if REMEMBER-MARKS is non-nil, return an alist +of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well." + (interactive "DKill tree below directory: \ni\nP") + (setq dirname (file-name-as-directory (expand-file-name dirname))) (let ((s-alist dired-subdir-alist) dir m-alist) (while s-alist (setq dir (car (car s-alist)) s-alist (cdr s-alist)) - (if (and (not (string-equal dir dirname)) - (dired-in-this-tree dir dirname) - (dired-goto-subdir dir)) - (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist)))) + (and (or kill-root (not (string-equal dir dirname))) + (dired-in-this-tree dir dirname) + (dired-goto-subdir dir) + (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist)))) m-alist)) (defun dired-insert-subdir-newpos (new-dir) @@ -1585,33 +1920,20 @@ This function takes some pains to conform to `ls -lR' output." (delete-region begin-marker (point))))) (defun dired-insert-subdir-doinsert (dirname switches) - ;; Insert ls output after point and put point on the correct - ;; position for the subdir alist. + ;; Insert ls output after point. ;; Return the boundary of the inserted text (as list of BEG and END). - (let ((begin (point)) end) - (message "Reading directory %s..." dirname) - (let ((dired-actual-switches - (or switches - (dired-replace-in-string "R" "" dired-actual-switches)))) - (if (equal dirname (car (car (reverse dired-subdir-alist)))) - ;; top level directory may contain wildcards: - (dired-readin-insert dired-directory) - (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) - ;; call dired-insert-headerline afterwards, as under VMS dired-ls - ;; does insert the headerline itself and the insert function just - ;; moves point. - ;; Need a marker for END as this inserts text. - (goto-char begin) - (dired-insert-headerline dirname) - ;; point is now like in dired-build-subdir-alist - (prog1 - (list begin (marker-position end)) - (set-marker end nil)))) + (save-excursion + (let ((begin (point))) + (let ((dired-actual-switches + (or switches + dired-subdir-switches + (dired-replace-in-string "R" "" dired-actual-switches)))) + (if (equal dirname (car (car (last dired-subdir-alist)))) + ;; If doing the top level directory of the buffer, + ;; redo it as specified in dired-directory. + (dired-readin-insert) + (dired-insert-directory dirname dired-actual-switches nil nil t))) + (list begin (point))))) (defun dired-insert-subdir-doupdate (dirname elt beg-end) ;; Point is at the correct subdir alist position for ELT, @@ -1634,7 +1956,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 @@ -1740,7 +2062,9 @@ The next char is either \\n, or \\r if DIR is hidden." ;;;###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)))) @@ -1751,10 +2075,12 @@ The next char is either \\n, or \\r if DIR is hidden." Lower levels are unaffected." ;; With optional REMEMBER-MARKS, return a mark-alist. (interactive) - (let ((beg (dired-subdir-min)) - (end (dired-subdir-max)) - buffer-read-only cur-dir) - (setq cur-dir (dired-current-directory)) + (let* ((beg (dired-subdir-min)) + (end (dired-subdir-max)) + (modflag (buffer-modified-p)) + (cur-dir (dired-current-directory)) + (cons (assoc-string cur-dir dired-switches-alist)) + buffer-read-only) (if (equal cur-dir default-directory) (error "Attempt to kill top level directory")) (prog1 @@ -1762,7 +2088,10 @@ Lower levels are unaffected." (delete-region beg end) (if (eobp) ; don't leave final blank line (delete-char -1)) - (dired-unsubdir cur-dir)))) + (dired-unsubdir cur-dir) + (when cons + (setq dired-switches-alist (delete cons dired-switches-alist))) + (restore-buffer-modified-p modflag)))) (defun dired-unsubdir (dir) ;; Remove DIR from the alist @@ -1779,7 +2108,7 @@ Lower levels are unaffected." dir (file-name-directory (directory-file-name dir)))) ;;(setq dir (expand-file-name dir)) (or (dired-goto-subdir dir) - (error "Cannot go up to %s - not in this tree." dir)))) + (error "Cannot go up to %s - not in this tree" dir)))) ;;;###autoload (defun dired-tree-down () @@ -1821,19 +2150,21 @@ Optional prefix arg is a repeat factor. Use \\[dired-hide-all] to (un)hide all directories." (interactive "p") (dired-hide-check) - (while (>= (setq arg (1- arg)) 0) - (let* ((cur-dir (dired-current-directory)) - (hidden-p (dired-subdir-hidden-p cur-dir)) - (elt (assoc cur-dir dired-subdir-alist)) - (end-pos (1- (dired-get-subdir-max elt))) - buffer-read-only) - ;; keep header line visible, hide rest - (goto-char (dired-get-subdir-min elt)) - (skip-chars-forward "^\n\r") - (if hidden-p - (subst-char-in-region (point) end-pos ?\r ?\n) - (subst-char-in-region (point) end-pos ?\n ?\r))) - (dired-next-subdir 1 t))) + (let ((modflag (buffer-modified-p))) + (while (>= (setq arg (1- arg)) 0) + (let* ((cur-dir (dired-current-directory)) + (hidden-p (dired-subdir-hidden-p cur-dir)) + (elt (assoc cur-dir dired-subdir-alist)) + (end-pos (1- (dired-get-subdir-max elt))) + buffer-read-only) + ;; keep header line visible, hide rest + (goto-char (dired-get-subdir-min elt)) + (skip-chars-forward "^\n\r") + (if hidden-p + (subst-char-in-region (point) end-pos ?\r ?\n) + (subst-char-in-region (point) end-pos ?\n ?\r))) + (dired-next-subdir 1 t)) + (restore-buffer-modified-p modflag))) ;;;###autoload (defun dired-hide-all (arg) @@ -1842,7 +2173,8 @@ If there is already something hidden, make everything visible again. Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." (interactive "P") (dired-hide-check) - (let (buffer-read-only) + (let ((modflag (buffer-modified-p)) + buffer-read-only) (if (save-excursion (goto-char (point-min)) (search-forward "\r" nil t)) @@ -1851,7 +2183,7 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." ;; hide (let ((pos (point-max)) ; pos of end of last directory (alist dired-subdir-alist)) - (while alist ; while there are dirs before pos + (while alist ; while there are dirs before pos (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir (save-excursion (goto-char pos) ; current dir @@ -1860,7 +2192,8 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." (point)) ?\n ?\r) (setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir - (setq alist (cdr alist))))))) + (setq alist (cdr alist))))) + (restore-buffer-modified-p modflag))) ;;;###end dired-ins.el @@ -1873,19 +2206,45 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." 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))) + (tags-search regexp '(dired-get-marked-files nil nil 'dired-nondirectory-p))) ;;;###autoload -(defun dired-do-query-replace (from to &optional delimited) +(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 +If you exit (\\[keyboard-quit], RET or q), 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))) + (let ((common + (query-replace-read-args + "Query replace regexp in marked files" t t))) + (list (nth 0 common) (nth 1 common) (nth 2 common)))) + (dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p)) + (let ((buffer (get-file-buffer file))) + (if (and buffer (with-current-buffer buffer + buffer-read-only)) + (error "File `%s' is visited read-only" file)))) + (tags-query-replace from to delimited + '(dired-get-marked-files nil nil 'dired-nondirectory-p))) + +(defun dired-nondirectory-p (file) + (not (file-directory-p file))) +;;;###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 "%s" (buffer-string)))) (provide 'dired-aux) +;;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60 ;;; dired-aux.el ends here