;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
-;; Copyright (C) 1985, 1986, 1992, 1994, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001
+;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Maintainer: FSF
+;; Keywords: files
;; This file is part of GNU Emacs.
;;;###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'."
(setq failures
(dired-bunch-files 10000
(function dired-check-process)
- (append
+ (append
(list operation program new-attribute)
(if (string-match "gnu" system-configuration)
'("--") nil))
"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
"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))
;; Process all the files in FILES in batches of a convenient size,
;; 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,
;; 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))
(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)
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."
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))))
- nil
- file-list)
- ;; execute the shell command
- (dired-run-shell-command
- (dired-shell-stuff-it command file-list nil arg)))))
+ (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 ""
;; 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 'shell-quote-argument file-list) ";")
- (let ((fns (mapconcat 'shell-quote-argument
- file-list dired-mark-separator)))
+ (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.
(defun dired-run-shell-command (command)
(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)))
(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
'((?\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.
))
(subst-char-in-region opoint (1+ opoint) ?\040 char))))
(dired-move-to-filename))
-(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 (expand-file-name directory)
- file))
- (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
(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 (if relative cur-dir (file-name-directory filename)))
- reason)
+ (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)
(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 ..
(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
(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
;;;###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))
(defcustom dired-recursive-copies nil
"*Decide whether recursive copies are allowed.
-Nil means no recursive copies.
+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."
(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)
(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)
- (with-current-buffer (get-file-buffer from)
- (set-visited-file-name to nil t)))
- (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)
(dired-move-to-filename))
\f
(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 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 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
- ;; 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))
(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 dired-one-file op1 operation) " %s to: ")
- (dired-dwim-target-directory)
- op-symbol arg rfn-list)))
- (into-dir (cond ((null how-to) (file-directory-p target))
+ 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 (consp into-dir) (functionp (car into-dir)))
;; 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.
;; symlinks.
(defvar dired-copy-how-to-fn nil
- "Nil or a function used by `dired-do-copy' to determine target.
+ "nil or a function used by `dired-do-copy' to determine target.
See HOW-TO argument for `dired-do-create-files'.")
;;;###autoload
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")
-n (let ((dired-recursive-copies dired-recursive-copies))
+ (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)))
+ (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)
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))
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"))
;;; 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 file name
+ ;; 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))
(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))
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
(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 \\=\\<n> or \\& as in `query-replace-regexp'.
(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.
+(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"))
(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)))
+ 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.
+(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.
+(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)
;; 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,
(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))
+ (if switches-have-R (dired-build-subdir-alist switches))
(dired-initial-position dirname)
(save-excursion (dired-mark-remembered mark-alist))))
(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."
+ "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)
(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)
- (if (not (looking-at "^ /.*:$"))
- (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)))
+ (message "Reading directory %s..." dirname)
+ (let ((dired-actual-switches
+ (or 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)))
+ (message "Reading directory %s...done" dirname)
+ (list begin (point)))))
(defun dired-insert-subdir-doupdate (dirname elt beg-end)
;; Point is at the correct subdir alist position for ELT,
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 ()
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)))
+ (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)))
\f
+;;;###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)
HCoop / bpt / emacs.git / blobdiff