Function: dired-create-files
dired-create-files is a byte-compiled function defined in
dired-aux.el.gz.
Signature
(dired-create-files FILE-CREATOR OPERATION FN-LIST NAME-CONSTRUCTOR &optional MARKER-CHAR)
Documentation
Create one or more new files from a list of existing files FN-LIST.
This function also handles querying the user, updating Dired buffers, and displaying a success or failure message.
FILE-CREATOR should be a function. It is called once for each
file in FN-LIST, and must create a new file, querying the user
and updating Dired buffers as necessary. It should accept three
arguments: the old file name, the new name, and an argument
OK-IF-ALREADY-EXISTS with the same meaning as in copy-file.
OPERATION should be a capitalized string describing the operation
performed (e.g. Copy). It is used for error logging.
FN-LIST is the list of files to copy (full absolute file names).
NAME-CONSTRUCTOR should be a function accepting a single argument, the name of an old file, and returning either the corresponding new file name or nil to skip.
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.
Source Code
;; Defined in /usr/src/emacs/lisp/dired-aux.el.gz
;;; The basic function for half a dozen variations on cp/mv/ln/ln -s
(defun dired-create-files (file-creator operation fn-list name-constructor
&optional marker-char)
"Create one or more new files from a list of existing files FN-LIST.
This function also handles querying the user, updating Dired
buffers, and displaying a success or failure message.
FILE-CREATOR should be a function. It is called once for each
file in FN-LIST, and must create a new file, querying the user
and updating Dired buffers as necessary. It should accept three
arguments: the old file name, the new name, and an argument
OK-IF-ALREADY-EXISTS with the same meaning as in `copy-file'.
OPERATION should be a capitalized string describing the operation
performed (e.g. `Copy'). It is used for error logging.
FN-LIST is the list of files to copy (full absolute file names).
NAME-CONSTRUCTOR should be a function accepting a single
argument, the name of an old file, and returning either the
corresponding new file name or nil to skip.
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
overwrite-backup-query) ; for dired-handle-overwrite
(dolist (from fn-list)
;; Position point on the current file -- this is useful if
;; handling a number of files to show where we're working at.
(dired-goto-file from)
(setq to (funcall name-constructor from))
(if (equal to from)
(progn
(setq to nil)
(dired-log "Cannot %s to same file: %s\n"
(downcase operation) from)))
(if (not to)
(setq skipped (cons (dired-make-relative from) skipped))
(let* ((overwrite (file-exists-p to))
(dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
(let ((help-form (format-message
(substitute-command-keys "\
Type \\`SPC' or \\`y' to overwrite file `%s',
\\`DEL' or \\`n' to skip to next,
\\`ESC' or \\`q' to not overwrite any of the remaining files,
\\`!' to overwrite all remaining files with no more questions.") to)))
(dired-query 'overwrite-query
"Overwrite `%s'?" to))))
;; must determine if FROM is marked before file-creator
;; gets a chance to delete it (in case of a move).
(actual-marker-char
(cond ((integerp marker-char) marker-char)
(marker-char (dired-file-marker from)) ; slow
(t nil))))
;; 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 (file-attribute-type (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)))
;; Check, that `dired-do-symlink' does not create symlinks
;; on different hosts.
(when (and (eq file-creator 'make-symbolic-link)
(not (equal (file-remote-p from) (file-remote-p to))))
(error "Cannot symlink `%s' to `%s' on another host" from to))
(condition-case err
(progn
(funcall file-creator from to dired-overwrite-confirmed)
(if overwrite
;; If we get here, file-creator hasn't been aborted
;; and the old entry (if any) has to be deleted
;; before adding the new entry.
(dired-remove-file to))
(setq success-count (1+ success-count))
(message "%s: %d of %d" operation success-count total)
(dired-add-file to actual-marker-char))
(file-error ; FILE-CREATOR aborted
(progn
(push (dired-make-relative from)
failures)
(dired-log "%s: `%s' to `%s' failed:\n%s\n"
operation from to err))))))))
(cond
(dired-create-files-failures
(setq failures (nconc failures dired-create-files-failures))
(dired-log-summary
(format (ngettext "%s failed for %d file in %d requests"
"%s failed for %d files in %d requests"
(length failures))
operation (length failures) total)
failures))
(failures
(dired-log-summary
(format (ngettext "%s: %d of %d file failed"
"%s: %d of %d files failed"
total)
operation (length failures) total)
failures))
(skipped
(dired-log-summary
(format (ngettext "%s: %d of %d file skipped"
"%s: %d of %d files skipped"
total)
operation (length skipped) total)
skipped))
(t
(message (ngettext "%s: %d file done"
"%s: %d files done"
success-count)
operation success-count))))
(dired-move-to-filename))