Menu
I'm looking for some suggestions, please, to create a custom function for dired-mode relating copying and moving files so that a directory may be created if it does not yet exist. The default behavior is to simply generate an error message if the directory does not yet exist.
STICKING POINT: The sticking point in my mind will be dealing with an erroneous attempt to create more than one directory. For example, let's say that we want to copy files from the home directory ~/ to /tmp/test/one/ -- the directory /tmp/test/ already exists, but /tmp/test/one/ does not yet exist. Instead of typing /tmp/test/one/, I erroneously type /tmp/tesst/one -- in this circumstance, there should be an error message stating something like -- Hey, you cannot do that because /tmp/tesst/ must first exist before you can create /tmp/tesst/one. Of course, things would have gone smoothly had I correctly typed /tmp/test/one because /tmp/test/ already existed in this example.
And, lastly, I am assuming that I should just create a new function based on dired-do-create-files -- modifying the following section of code:
(if (not (or dired-one-file into-dir))
(error "Marked %s: target must be a directory: %s" operation target))
Any guidance getting past the sticking point, or any other hazards that I haven't thought of, would be greatly appreciated.
865
Go to the Dired buffer that lists the files you want to copy. Mark those files. Use C (command dired-do-copy ) to copy the marked files.
The command + ( dired-create-directory ) reads a directory's name, and creates that directory.
M-x copy-file copies the contents of the file old to the file new . M-x copy-directory copies directories, similar to the cp -r shell command. If new is a directory name, it creates a copy of the old directory and puts it in new . Otherwise it copies all the contents of old into a new directory named new .
In order to invoke Dired in Emacs, all you need to do is type C-x C-f . In the “minibuffer” at the bottom of your Emacs frame, you'll see “Find file:” and a prompt to enter a directory path. Press RET after entering your directory and you will see a listing for that directory. This is where the fun begins.
The following answer was made possible (in part) based upon the helpful comments of Drew and phils underneath the original question -- their help is greatly appreciated!
(require 'dired-aux)
(defalias 'dired-do-create-files 'lawlist-dired-do-create-files)
(defun lawlist-dired-do-create-files (op-symbol file-creator operation arg
&optional marker-char op1 how-to)
"(1) If the path entered by the user in the mini-buffer ends in a trailing
forward slash /, then the code assumes the path is a directory -- to be
created if it does not already exist.; (2) if the trailing forward slash
is omitted, the code prompts the user to specify whether that path is a
directory."
(or op1 (setq op1 operation))
(let* (
skip-overwrite-confirmation
(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
(if dired-one-file
(dired-get-file-for-visit) ;; filename if one file
(dired-dwim-target-directory))) ;; directory of multiple files
(default (and dired-one-file
(expand-file-name (file-name-nondirectory (car fn-list))
target-dir)) )
(defaults (dired-dwim-target-defaults fn-list target-dir))
(target (expand-file-name ; fluid variable inside dired-create-files
(minibuffer-with-setup-hook (lambda ()
(set (make-local-variable 'minibuffer-default-add-function) nil)
(setq minibuffer-default defaults))
(dired-mark-read-file-name
(concat (if dired-one-file op1 operation) " %s to: ")
target-dir op-symbol arg rfn-list default))))
(unmodified-initial-target target)
(into-dir (cond ((null how-to)
(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)))
(apply (car into-dir) operation rfn-list fn-list target (cdr into-dir))
(or into-dir (setq target (directory-file-name target)))
;; create new directories if they do not exist.
(when
(and
(not (file-directory-p (file-name-directory target)))
(file-exists-p (directory-file-name (file-name-directory target))))
(let ((debug-on-quit nil))
(signal 'quit `(
"A file with the same name as the proposed directory already exists."))))
(when
(and
(not (file-exists-p (directory-file-name (expand-file-name target))))
(or
(and
(null dired-one-file)
(not (string-match "\\(.*\\)\\(/$\\)" unmodified-initial-target)))
(not (file-directory-p (file-name-directory target)))
(string-match "\\(.*\\)\\(/$\\)" unmodified-initial-target)) )
(let* (
new
list-of-directories
list-of-shortened-directories
string-of-directories-a
string-of-directories-b
(max-mini-window-height 3)
(expanded (directory-file-name (expand-file-name target)))
(try expanded) )
;; Find the topmost nonexistent parent dir (variable `new')
(while (and try (not (file-exists-p try)) (not (equal new try)))
(push try list-of-directories)
(setq new try
try (directory-file-name (file-name-directory try))))
(setq list-of-shortened-directories
(mapcar
(lambda (x) (concat "..." (car (cdr (split-string x try)))))
list-of-directories))
(setq string-of-directories-a
(combine-and-quote-strings list-of-shortened-directories))
(setq string-of-directories-b (combine-and-quote-strings
(delete (car (last list-of-shortened-directories))
list-of-shortened-directories)))
(if
(and
(not (string-match "\\(.*\\)\\(/$\\)" unmodified-initial-target))
;; (cdr list-of-directories)
dired-one-file
(file-exists-p dired-one-file)
(not (file-directory-p dired-one-file)))
(if (y-or-n-p
(format "Is `%s` a directory?" (car (last list-of-directories))))
(progn
(or (y-or-n-p (format "@ `%s`, create: %s" try string-of-directories-a))
(let ((debug-on-quit nil))
(signal 'quit `("You have exited the function."))))
(make-directory expanded t)
(setq into-dir t))
(if (equal (file-name-directory target) (file-name-directory dired-one-file))
(setq new nil)
(or (y-or-n-p
(format "@ `%s`, create: %s" try string-of-directories-b))
(let ((debug-on-quit nil))
(signal 'quit `("You have exited the function."))))
(make-directory (car (split-string
(car (last list-of-directories))
(concat "/" (file-name-nondirectory target)))) t)
(setq target (file-name-directory target))
(setq into-dir t) ))
(or (y-or-n-p (format "@ `%s`, create: %s" try string-of-directories-a))
(let ((debug-on-quit nil))
(signal 'quit `("You have exited the function."))))
(make-directory expanded t)
(setq into-dir t) )
(when new
(dired-add-file new)
(dired-move-to-filename))
(setq skip-overwrite-confirmation t) ))
(lawlist-dired-create-files file-creator operation fn-list
(if into-dir ; target is a directory
(function (lambda (from)
(expand-file-name (file-name-nondirectory from) target)))
(function (lambda (_from) target)))
marker-char skip-overwrite-confirmation ))))
(defun lawlist-dired-create-files (file-creator operation fn-list name-constructor
&optional marker-char skip-overwrite-confirmation)
(let (dired-create-files-failures failures
skipped (success-count 0) (total (length fn-list)))
(let (to overwrite-query overwrite-backup-query)
(dolist (from fn-list)
(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 (not skip-overwrite-confirmation)
(let ((help-form '(format "\
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))))
(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)
(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 "%s failed for %d file%s in %d requests"
operation (length failures)
(dired-plural-s (length failures))
total)
failures))
(failures
(dired-log-summary
(format "%s failed for %d of %d file%s"
operation (length failures)
total (dired-plural-s total))
failures))
(skipped
(dired-log-summary
(format "%s: %d of %d file%s skipped"
operation (length skipped) total
(dired-plural-s total))
skipped))
(t
(message "%s: %s file%s"
operation success-count (dired-plural-s success-count)))))
(dired-move-to-filename))
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With