我正在寻找一些建议，为dired-mode创建一个与复制和移动文件相关的自定义函数，以便在目录尚不存在的情况下创建目录。如果目录尚不存在，则默认行为是简单地生成错误消息。
STICKING POINT ：我脑海中的关键点是处理错误的创建多个目录的尝试。例如，假设我们要将文件从主目录~/复制到/tmp/test/one/ - 目录/tmp/test/已存在，但/tmp/test/one/ 不< / em>还存在。我没有输入/tmp/test/one/，而是错误地输入/tmp/tesst/one - 在这种情况下，应该会出现一条错误消息，指出类似的内容 - 嘿，你不能这样做，因为/tmp/tesst/必须首先存在之前你可以创建/tmp/tesst/one。当然，如果我正确输入/tmp/test/one，事情就会顺利进行，因为/tmp/test/已经存在示例
最后，我假设我应该基于dired-do-create-files创建一个新函数 - 修改以下代码部分：
(if (not (or dired-one-file into-dir))
(error "Marked %s: target must be a directory: %s" operation target))
任何超越关键点的指导，或任何其他我未曾想到的危险，都将不胜感激。
答案 0 :(得分：1)
根据Drew和phils在原始问题下的有用评论，以下答案成为可能（部分） - 非常感谢他们的帮助！
(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))
答案 1 :(得分：0)
@lawlist对我来说，这段代码在Dired中创建了一个错误。如果文件是目录中的最后一个文件，并且尝试使用此代码在点式emacs中移动或复制该文件，则会出现以下错误：
dired-get-file-for-visit: No file on this line