;;; dired-aux.el --- less commonly used parts of dired
-;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2011
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2014
;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: files
;; Package: emacs
;;;###autoload
(defun dired-diff (file &optional switches)
"Compare file at point with file FILE using `diff'.
-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'."
+If called interactively, prompt for FILE. If the file at point
+has a backup file, use that as the default. If the file at point
+is a backup file, use its original. If the mark is active
+in Transient Mark mode, use the file at the mark as the default.
+\(That's the mark set by \\[set-mark-command], not by Dired's
+\\[dired-mark] command.)
+
+FILE is the first file given to `diff'. The file at point
+is the second file given to `diff'.
+
+With prefix arg, prompt for second argument SWITCHES, which is
+the string of command switches for the third argument of `diff'."
(interactive
(let* ((current (dired-get-filename t))
+ ;; Get the latest existing backup file or its original.
+ (oldf (if (backup-file-name-p current)
+ (file-name-sans-versions current)
+ (diff-latest-backup-file current)))
;; Get the file at the mark.
- (file-at-mark (if (mark t)
+ (file-at-mark (if (and transient-mark-mode mark-active)
(save-excursion (goto-char (mark t))
(dired-get-filename t t))))
+ (default-file (or file-at-mark
+ (and oldf (file-name-nondirectory oldf))))
;; Use it as default if it's not the same as the current file,
- ;; and the target dir is the current dir or the mark is active.
- (default (if (and (not (equal file-at-mark current))
+ ;; and the target dir is current or there is a default file.
+ (default (if (and (not (equal default-file current))
(or (equal (dired-dwim-target-directory)
(dired-current-directory))
- mark-active))
- file-at-mark))
+ default-file))
+ default-file))
(target-dir (if default
(dired-current-directory)
(dired-dwim-target-directory)))
(defaults (dired-dwim-target-defaults (list current) target-dir)))
- (require 'diff)
(list
(minibuffer-with-setup-hook
(lambda ()
(equal (expand-file-name current file)
(expand-file-name current))))
(error "Attempt to compare the file to itself"))
- (diff file current switches)))
+ (if (and (backup-file-name-p current)
+ (equal file (file-name-sans-versions current)))
+ (diff current file switches)
+ (diff file current switches))))
;;;###autoload
(defun dired-backup-diff (&optional switches)
(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))))))
+ (let* ((file2 (car list))
+ (fa1 (car (cddr file1)))
+ (fa2 (car (cddr file2))))
+ (or
+ (not (equal (car file1) (car file2)))
+ (eval predicate
+ `((fa1 . ,fa1)
+ (fa2 . ,fa2)
+ (size1 . ,(nth 7 fa1))
+ (size2 . ,(nth 7 fa2))
+ (mtime1
+ . ,(float-time (nth 5 fa1)))
+ (mtime2
+ . ,(float-time (nth 5 fa2)))
+ )))))
(setq list (cdr list)))
list)
- (setq res (cons file1 res))))
+ (push file1 res)))
(nreverse res))))
(defun dired-files-attributes (dir)
(file-attributes full-file-name))))
(directory-files dir)))
\f
-
-(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)))
+;;; Change file attributes
(defun dired-do-chxxx (attribute-name program op-symbol arg)
- ;; Change file attributes (mode, group, owner, timestamp) of marked files and
+ ;; Change file attributes (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.
- ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
- ;; ARG describes which files to use, as in dired-get-marked-files.
+ ;; OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up').
+ ;; ARG describes which files to use, as in `dired-get-marked-files'.
(let* ((files (dired-get-marked-files t arg))
- (new-attribute
- (dired-mark-read-string
- (concat "Change " attribute-name " of %s to: ")
- (if (eq op-symbol 'touch) (dired-touch-initial files))
- op-symbol arg files))
+ ;; The source of default file attributes is the file at point.
+ (default-file (dired-get-filename t t))
+ (default (when default-file
+ (cond ((eq op-symbol 'touch)
+ (format-time-string
+ "%Y%m%d%H%M.%S"
+ (nth 5 (file-attributes default-file))))
+ ((eq op-symbol 'chown)
+ (nth 2 (file-attributes default-file 'string)))
+ ((eq op-symbol 'chgrp)
+ (nth 3 (file-attributes default-file 'string))))))
+ (prompt (concat "Change " attribute-name " of %s to"
+ (if (eq op-symbol 'touch)
+ " (default now): "
+ ": ")))
+ (new-attribute (dired-mark-read-string prompt nil op-symbol
+ arg files default
+ (cond ((eq op-symbol 'chown)
+ (system-users))
+ ((eq op-symbol 'chgrp)
+ (system-groups)))))
(operation (concat program " " new-attribute))
failures)
(setq failures
(function dired-check-process)
(append
(list operation program)
- (if (eq op-symbol 'touch)
- '("-t") nil)
- (list new-attribute)
- (if (string-match "gnu" system-configuration)
+ (unless (or (string-equal new-attribute "")
+ ;; Use `eq' instead of `equal'
+ ;; to detect empty input (bug#12399).
+ (eq new-attribute default))
+ (if (eq op-symbol 'touch)
+ (list "-t" new-attribute)
+ (list new-attribute)))
+ (if (string-match-p "gnu" system-configuration)
'("--") nil))
files))
(dired-do-redisplay arg);; moves point if ARG is an integer
;;;###autoload
(defun dired-do-chmod (&optional arg)
"Change the mode of the marked (or next ARG) files.
-Symbolic modes like `g+w' are allowed."
+Symbolic modes like `g+w' are allowed.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(let* ((files (dired-get-marked-files t arg))
- (modestr (and (stringp (car files))
- (nth 8 (file-attributes (car files)))))
+ ;; The source of default file attributes is the file at point.
+ (default-file (dired-get-filename t t))
+ (modestr (when default-file
+ (nth 8 (file-attributes default-file))))
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
(match-string 2 modestr)
(match-string 3 modestr)))))
(modes (dired-mark-read-string
- "Change mode of %s to: " nil
- 'chmod arg files default))
- (num-modes (if (string-match "^[0-7]+" modes)
- (string-to-number modes 8))))
+ "Change mode of %s to: "
+ nil 'chmod arg files default))
+ num-modes)
+ (cond ((or (equal modes "")
+ ;; Use `eq' instead of `equal'
+ ;; to detect empty input (bug#12399).
+ (eq modes default))
+ ;; We used to treat empty input as DEFAULT, but that is not
+ ;; such a good idea (Bug#9361).
+ (error "No file mode specified"))
+ ((string-match-p "^[0-7]+" modes)
+ (setq num-modes (string-to-number modes 8))))
+
(dolist (file files)
(set-file-modes
file
;;;###autoload
(defun dired-do-chgrp (&optional arg)
- "Change the group of the marked (or next ARG) files."
+ "Change the group of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
(error "chgrp not supported on this system"))
;;;###autoload
(defun dired-do-chown (&optional arg)
- "Change the owner of the marked (or next ARG) files."
+ "Change the owner of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
(error "chown not supported on this system"))
;;;###autoload
(defun dired-do-touch (&optional arg)
"Change the timestamp of the marked (or next ARG) files.
-This calls touch."
+This calls touch.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
;; Do the operation and record failures.
failures (nconc (apply function (append args pending))
failures)
- ;; Transfer the elemens of PENDING onto PAST
+ ;; Transfer the elements 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)
`lpr-switches' as default."
(interactive "P")
(let* ((file-list (dired-get-marked-files t arg))
+ (lpr-switches
+ (if (and (stringp printer-name)
+ (string< "" printer-name))
+ (cons (concat lpr-printer-switch printer-name)
+ lpr-switches)
+ lpr-switches))
(command (dired-mark-read-string
"Print %s with: "
(mapconcat 'identity
'print arg file-list)))
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
-;; Read arguments for a marked-files command that wants a string
-;; that is not a file name,
-;; perhaps popping up the list of marked files.
-;; ARG is the prefix arg and indicates whether the files came from
-;; 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)).
-
-(defun dired-mark-read-string (prompt initial op-symbol arg files &optional default)
- ;; PROMPT for a string, with INITIAL input and DEFAULT value.
- ;; Other args are used to give user feedback and pop-up:
- ;; OP-SYMBOL of command, prefix ARG, marked FILES.
- (dired-mark-pop-up
- nil op-symbol files
- (function read-string)
- (format prompt (dired-mark-prompt arg files)) initial nil default))
+(defun dired-mark-read-string (prompt initial op-symbol arg files
+ &optional default-value collection)
+ "Read args for a Dired marked-files command, prompting with PROMPT.
+Return the user input (a string).
+
+INITIAL, if non-nil, is the initial minibuffer input.
+OP-SYMBOL is an operation symbol (see `dired-no-confirm').
+ARG is normally the prefix argument for the calling command;
+it is passed as the first argument to `dired-mark-prompt'.
+FILES should be a list of marked files' names.
+
+Optional arg DEFAULT-VALUE is a default value or list of default
+values, passed as the seventh arg to `completing-read'.
+
+Optional arg COLLECTION is a collection of possible completions,
+passed as the second arg to `completing-read'."
+ (dired-mark-pop-up nil op-symbol files
+ 'completing-read
+ (format prompt (dired-mark-prompt arg files))
+ collection nil nil initial nil default-value nil))
\f
;;; Cleaning a directory: flagging some backups for deletion.
(goto-char (point-min))
(while (not (eobp))
(save-excursion
- (and (not (looking-at dired-re-dir))
+ (and (not (looking-at-p dired-re-dir))
(not (eolp))
(setq file (dired-get-filename nil t)) ; nil on non-file
(progn (end-of-line)
dired-file-version-alist)))))))
(defun dired-trample-file-versions (fn)
- (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
+ (let* ((start-vn (string-match-p "\\.~[0-9]+~$" fn))
base-version-list)
(and start-vn
(setq base-version-list ; there was a base version to which
;; This is an extra function so that you can redefine it, e.g., to use gmhist.
(defun dired-read-shell-command (prompt arg files)
- "Read a dired shell command prompting with PROMPT.
-Passes the prefix argument ARG to `dired-mark-prompt', so that it
-can be used in the prompt to indicate which FILES are affected.
-Normally reads the command with `read-shell-command', but if the
-`dired-x' packages is loaded, uses `dired-guess-shell-command' to offer
-a smarter default choice of shell command."
+ "Read a dired shell command.
+PROMPT should be a format string with one \"%s\" format sequence,
+which is replaced by the value returned by `dired-mark-prompt',
+with ARG and FILES as its arguments. FILES should be a list of
+file names. The result is used as the prompt.
+
+This normally reads using `read-shell-command', but if the
+`dired-x' package is loaded, use `dired-guess-shell-command' to
+offer a smarter default choice of shell command."
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function)
'minibuffer-default-add-dired-shell-commands))
(setq prompt (format prompt (dired-mark-prompt arg files)))
- (if (featurep 'dired-x)
+ (if (functionp 'dired-guess-shell-command)
(dired-mark-pop-up nil 'shell files
- #'dired-guess-shell-command prompt files)
+ 'dired-guess-shell-command prompt files)
(dired-mark-pop-up nil 'shell files
- #'read-shell-command prompt nil nil))))
+ 'read-shell-command prompt nil nil))))
;;;###autoload
(defun dired-do-async-shell-command (command &optional arg file-list)
"Run a shell command COMMAND on the marked files asynchronously.
-Like `dired-do-shell-command' but if COMMAND doesn't end in ampersand,
-adds `* &' surrounded by whitespace and executes the command asynchronously.
+Like `dired-do-shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
+When operating on multiple files, asynchronous commands
+are executed in the background on each file in parallel.
+In shell syntax this means separating the individual commands
+with `&'. However, when COMMAND ends in `;' or `;&' then commands
+are executed in the background on each file sequentially waiting
+for each command to terminate before running the next command.
+In shell syntax this means separating the individual commands with `;'.
+
The output appears in the buffer `*Async Shell Command*'."
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg)))
(dired-read-shell-command "& on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (unless (string-match "[*?][ \t]*\\'" command)
- (setq command (concat command " *")))
- (unless (string-match "&[ \t]*\\'" command)
+ (unless (string-match-p "&[ \t]*\\'" command)
(setq command (concat command " &")))
(dired-do-shell-command command arg file-list))
-;; 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 file-list)
"Run a shell command COMMAND on the marked files.
-If no files are marked or a specific numeric prefix arg is given,
+If no files are marked or a 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.
`*' 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 `*\"\"'.
+normally to the shell, but you must confirm first.
-If COMMAND produces output, it goes to a separate buffer.
+If you want to use `*' as a shell wildcard with whitespace around
+it, write `*\"\"' in place of just `*'. This is equivalent to just
+`*' in the shell, but avoids Dired's special handling.
+
+If COMMAND ends in `&', `;', or `;&', it is executed in the
+background asynchronously, and the output appears in the buffer
+`*Async Shell Command*'. When operating on multiple files and COMMAND
+ends in `&', the shell command is executed on each file in parallel.
+However, when COMMAND ends in `;' or `;&' then commands are executed
+in the background on each file sequentially waiting for each command
+to terminate before running the next command. You can also use
+`dired-do-async-shell-command' that automatically adds `&'.
+
+Otherwise, COMMAND is executed synchronously, and the output
+appears in the buffer `*Shell Command Output*'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
(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)
+ (dired-read-shell-command "! 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))))
+ (let* ((on-each (not (string-match-p dired-star-subst-regexp command)))
+ (no-subst (not (string-match-p dired-quark-subst-regexp command)))
+ (star (string-match-p "\\*" command))
+ (qmark (string-match-p "\\?" 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))
+ (if (cond ((not (or on-each no-subst))
(error "You can not combine `*' and `?' substitution marks"))
- ((and star (not on-each))
+ ((and star on-each)
(y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
- ((and qmark (not subst))
+ ((and qmark no-subst)
(y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
(t))
(if on-each
;; 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.
- (let ((stuff-it
- (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 ((files (mapconcat 'shell-quote-argument
- file-list dired-mark-separator)))
- (if (> (length file-list) 1)
- (setq files (concat dired-mark-prefix files dired-mark-postfix)))
- (funcall stuff-it files)))))
+ (let* ((in-background (string-match "[ \t]*&[ \t]*\\'" command))
+ (command (if in-background
+ (substring command 0 (match-beginning 0))
+ command))
+ (sequentially (string-match "[ \t]*;[ \t]*\\'" command))
+ (command (if sequentially
+ (substring command 0 (match-beginning 0))
+ command))
+ (stuff-it
+ (if (or (string-match-p dired-star-subst-regexp command)
+ (string-match-p 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)))))
+ (concat
+ (if on-each
+ (mapconcat stuff-it (mapcar 'shell-quote-argument file-list)
+ (if (and in-background (not sequentially)) "&" ";"))
+ (let ((files (mapconcat 'shell-quote-argument
+ file-list dired-mark-separator)))
+ (if (> (length file-list) 1)
+ (setq files (concat dired-mark-prefix files dired-mark-postfix)))
+ (funcall stuff-it files)))
+ (if in-background "&" ""))))
;; This is an extra function so that it can be redefined by ange-ftp.
;;;###autoload
;; Commands that delete or redisplay part of the dired buffer.
(defun dired-kill-line (&optional arg)
+ "Kill the current line (not the files).
+With a prefix argument, kill that many lines starting with the current line.
+\(A negative argument kills backward.)"
(interactive "P")
(setq arg (prefix-numeric-value arg))
(let (buffer-read-only file)
(if new-file
(let ((start (point)))
;; Remove any preexisting entry for the name NEW-FILE.
- (condition-case nil
- (dired-remove-entry new-file)
- (error nil))
+ (ignore-errors (dired-remove-entry new-file))
(goto-char start)
;; Now replace the current line with an entry for NEW-FILE.
(dired-update-file-line new-file) nil)
(concat (apply 'format prompt args)
(if help-form
(format " [Type yn!q or %s] "
- (key-description
- (char-to-string help-char)))
+ (key-description (vector help-char)))
" [Type y, n, q or !] ")))
(set sym (setq char (read-char-choice prompt char-choices)))
(if (memq char '(?y ?\s ?!)) t)))))
(dired-uncache
(if (consp dired-directory) (car dired-directory) dired-directory))
(dired-map-over-marks (let ((fname (dired-get-filename))
- ;; Postphone readin hook till we map
+ ;; Postpone readin hook till we map
;; over all marked files (Bug#6810).
(dired-after-readin-hook nil))
(message "Redisplaying... %s" fname)
;; Avoid calling ls for files that are going to be omitted anyway.
(let ((omit-re (dired-omit-regexp)))
(or (string= omit-re "")
- (not (string-match omit-re
- (cond
- ((eq 'no-dir dired-omit-localp)
- filename)
- ((eq t dired-omit-localp)
- (dired-make-relative filename))
- (t
- (dired-make-absolute
- filename
- (file-name-directory filename)))))))))
+ (not (string-match-p omit-re
+ (cond
+ ((eq 'no-dir dired-omit-localp)
+ filename)
+ ((eq t dired-omit-localp)
+ (dired-make-relative filename))
+ (t
+ (dired-make-absolute
+ filename
+ (file-name-directory filename)))))))))
;; Do it!
(progn
(setq filename (directory-file-name filename))
;; else try to find correct place to insert
(if (dired-goto-subdir directory)
(progn ;; unhide if necessary
- (if (looking-at "\r")
+ (if (looking-at-p "\r")
;; Point is at end of subdir line.
(dired-unhide-subdir))
;; found - skip subdir and `total' line
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
+ (when (and (eq t (car (file-attributes from)))
+ (file-in-directory-p to from))
+ (error "Cannot copy `%s' into its subdirectory `%s'" from to))
(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.
(copy-directory from to preserve-time)
- ;; Not a directory.
(or top (dired-handle-overwrite to))
(condition-case err
(if (stringp (car attrs))
argument, the name of an old file, and returning either the
corresponding new file name or nil to skip.
-Optional MARKER-CHAR is a character with which to mark every
-newfile's entry, or t to use the current marker character if the
-old file was marked."
+If optional argument MARKER-CHAR is non-nil, mark each
+newly-created file's Dired entry with the character MARKER-CHAR,
+or with the current marker character if MARKER-CHAR is t."
(let (dired-create-files-failures failures
skipped (success-count 0) (total (length fn-list)))
(let (to overwrite-query
(cond ((integerp marker-char) marker-char)
(marker-char (dired-file-marker from)) ; slow
(t nil))))
- (when (and (file-directory-p from)
- (file-directory-p to)
- (eq file-creator 'dired-copy-file))
- (setq to (file-name-directory to)))
+ ;; Handle the `dired-copy-file' file-creator specially
+ ;; When copying a directory to another directory or
+ ;; possibly to itself or one of its subdirectories.
+ ;; e.g "~/foo/" => "~/test/"
+ ;; or "~/foo/" =>"~/foo/"
+ ;; or "~/foo/ => ~/foo/bar/")
+ ;; In this case the 'name-constructor' have set the destination
+ ;; TO to "~/test/foo" because the old emacs23 behavior
+ ;; of `copy-directory' was to not create the subdirectory
+ ;; and instead copy the contents.
+ ;; With the new behavior of `copy-directory'
+ ;; (similar to the `cp' shell command) we don't
+ ;; need such a construction of the target directory,
+ ;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
+ (let ((destname (file-name-directory to)))
+ (when (and (file-directory-p from)
+ (file-directory-p to)
+ (eq file-creator 'dired-copy-file))
+ (setq to destname))
+ ;; If DESTNAME is a subdirectory of FROM, not a symlink,
+ ;; and the method in use is copying, signal an error.
+ (and (eq t (car (file-attributes destname)))
+ (eq file-creator 'dired-copy-file)
+ (file-in-directory-p destname from)
+ (error "Cannot copy `%s' into its subdirectory `%s'"
+ from to)))
(condition-case err
(progn
(funcall file-creator from to dired-overwrite-confirmed)
&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 also 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'.
+Prompt user for a target directory in which to create the new
+ files. The target may also be a non-directory file, if only
+ one file is marked. The initial suggestion for target is the
+ Dired buffer's current directory (or, if `dired-dwim-target' is
+ non-nil, the current directory of a neighboring Dired window).
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'.
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 determiness how to treat the target.
+Optional arg HOW-TO determines how to treat the target.
If HOW-TO is nil, use `file-directory-p' to determine if the
target is a directory. If so, the marked file(s) are created
inside that directory. Otherwise, the target is a plain file;
;;;###autoload
(defun dired-do-copy (&optional arg)
"Copy all marked (or next ARG) files, or copy the current file.
-This normally preserves the last-modified date when copying.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory,
-and new copies of these files are made in that directory
-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.
+When operating on just the current file, prompt for the new name.
-This command copies symbolic links by creating new ones,
-like `cp -d'."
+When operating on multiple or marked files, prompt for a target
+directory, and make the new copies in that directory, with the
+same names as the original files. The initial suggestion for the
+target directory is the Dired buffer's current directory (or, if
+`dired-dwim-target' is non-nil, the current directory of a
+neighboring Dired window).
+
+If `dired-copy-preserve-time' is non-nil, this command preserves
+the modification time of each old file in the copy, similar to
+the \"-p\" option for the \"cp\" shell command.
+
+This command copies symbolic links by creating new ones, similar
+to the \"-d\" option for the \"cp\" shell command."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
(dired-do-create-files 'copy (function dired-copy-file)
(arg
(if whole-name nil current-prefix-arg))
(regexp
- (dired-read-regexp
- (concat (if whole-name "Abs. " "") operation " from (regexp): ")))
+ (read-regexp
+ (concat (if whole-name "Abs. " "") operation " from (regexp): ")
+ nil 'dired-regexp-history))
(newname
(read-string
(concat (if whole-name "Abs. " "") operation " " regexp " to: "))))
;;;###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,
- else inserts it at its natural place (as `ls -lR' would have done).
+ "Insert this subdirectory into the same Dired buffer.
+If it is already present, overwrite the previous entry;
+ otherwise, insert it at its natural place (as `ls -lR' would
+ have done).
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.
(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)))
+ (if (setq switches-have-R (and switches (string-match-p "R" switches)))
;; avoid duplicated subdirs
(setq mark-alist (dired-kill-tree dirname t)))
(if elt
(mapcar
(function
(lambda (x)
- (or (eq (null (string-match x real-switches))
- (null (string-match x dired-actual-switches)))
+ (or (eq (null (string-match-p x real-switches))
+ (null (string-match-p x dired-actual-switches)))
(error
"Can't have dirs with and without -%s switches together" x))))
;; all switches that make a difference to dired-get-filename:
(defun dired-insert-subdir-newpos (new-dir)
;; Find pos for new subdir, according to tree order.
;;(goto-char (point-max))
- (let ((alist dired-subdir-alist) elt dir pos new-pos)
+ (let ((alist dired-subdir-alist) elt dir new-pos)
(while alist
(setq elt (car alist)
alist (cdr alist)
(and selective-display
(save-excursion
(dired-goto-subdir dir)
- (looking-at "\r"))))
+ (looking-at-p "\r"))))
;;;###autoload
(defun dired-hide-subdir (arg)
:group 'dired
:version "23.1")
-(defvar dired-isearch-filter-predicate-orig nil)
-
-(defun dired-isearch-filenames-toggle ()
+(define-minor-mode dired-isearch-filenames-mode
"Toggle file names searching on or off.
When on, Isearch skips matches outside file names using the predicate
`dired-isearch-filter-filenames' that matches only at file names.
When off, it uses the original predicate."
- (interactive)
- (setq isearch-filter-predicate
- (if (eq isearch-filter-predicate 'dired-isearch-filter-filenames)
- dired-isearch-filter-predicate-orig
- 'dired-isearch-filter-filenames))
- (setq isearch-success t isearch-adjusted t)
- (isearch-update))
+ nil nil nil
+ (if dired-isearch-filenames-mode
+ (add-function :before-while (local 'isearch-filter-predicate)
+ #'dired-isearch-filter-filenames
+ '((isearch-message-prefix . "filename ")))
+ (remove-function (local 'isearch-filter-predicate)
+ #'dired-isearch-filter-filenames))
+ (when isearch-mode
+ (setq isearch-success t isearch-adjusted t)
+ (isearch-update)))
;;;###autoload
(defun dired-isearch-filenames-setup ()
(when (or (eq dired-isearch-filenames t)
(and (eq dired-isearch-filenames 'dwim)
(get-text-property (point) 'dired-filename)))
- (setq isearch-message-prefix-add "filename ")
- (define-key isearch-mode-map "\M-sf" 'dired-isearch-filenames-toggle)
- (setq dired-isearch-filter-predicate-orig
- (default-value 'isearch-filter-predicate))
- (setq-default isearch-filter-predicate 'dired-isearch-filter-filenames)
+ (define-key isearch-mode-map "\M-sff" 'dired-isearch-filenames-mode)
+ (dired-isearch-filenames-mode 1)
(add-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end nil t)))
(defun dired-isearch-filenames-end ()
"Clean up the Dired file name search after terminating isearch."
- (setq isearch-message-prefix-add nil)
- (define-key isearch-mode-map "\M-sf" nil)
- (setq-default isearch-filter-predicate dired-isearch-filter-predicate-orig)
+ (define-key isearch-mode-map "\M-sff" nil)
+ (dired-isearch-filenames-mode -1)
(remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t))
(defun dired-isearch-filter-filenames (beg end)
- "Test whether the current search hit is a visible file name.
+ "Test whether the current search hit is a file name.
Return non-nil if the text from BEG to END is part of a file
-name (has the text property `dired-filename') and is visible."
- (and (isearch-filter-visible beg end)
- (if dired-isearch-filenames
- (text-property-not-all (min beg end) (max beg end)
- 'dired-filename nil)
- t)))
+name (has the text property `dired-filename')."
+ (text-property-not-all (min beg end) (max beg end)
+ 'dired-filename nil))
;;;###autoload
(defun dired-isearch-filenames ()
"Search for a string using Isearch only in file names in the Dired buffer."
(interactive)
(let ((dired-isearch-filenames t))
- (isearch-forward)))
+ (isearch-forward nil t)))
;;;###autoload
(defun dired-isearch-filenames-regexp ()
"Search for a regexp using Isearch only in file names in the Dired buffer."
(interactive)
(let ((dired-isearch-filenames t))
- (isearch-forward-regexp)))
+ (isearch-forward-regexp nil t)))
\f
;; Functions for searching in tags style among marked files.
;;;###autoload
(defun dired-show-file-type (file &optional deref-symlinks)
"Print the type of FILE, according to the `file' command.
-If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
-true then the type of the file linked to by FILE is printed instead."
+If you give a prefix to this command, and FILE is a symbolic
+link, then the type of the file linked to by FILE is printed
+instead."
(interactive (list (dired-get-filename t) current-prefix-arg))
(let (process-file-side-effects)
(with-temp-buffer