Emacs - dired kopiować/przenosić pliki - w razie potrzeby utworzyć katalog

Question

Poszukuję sugestii, proszę, aby utworzyć funkcję niestandardową dla dired-mode w odniesieniu do kopiowania i przenoszenia plików, aby katalog mógł zostać utworzony, jeśli nie jest jeszcze istnieje. Domyślnym zachowaniem jest wygenerowanie komunikatu o błędzie, jeśli katalog jeszcze nie istnieje.

PUNKT NAKLEJKI: Punktem zwrotnym w moim umyśle będzie zajmowanie się błędną próbą stworzenia więcej niż jednego katalogu. Na przykład, powiedzmy, że chcemy skopiować pliki z katalogu macierzystego ~/ do /tmp/test/one/ - katalog /tmp/test/ już istnieje, ale istnieje jeszcze /tmp/test/one/, który nie ma jeszcze wartości ani . Zamiast wpisywać /tmp/test/one/, ja błędnie wpisać /tmp/tesst/one - w takich okolicznościach, nie powinno być komunikat o błędzie informujący coś podobnego - Hej, nie można tego zrobić, bo /tmp/tesst/ musi najpierw istnieć przed można utworzyć /tmp/tesst/one. Oczywiście, wszystko pójdzie gładko, gdybym poprawnie wpisał /tmp/test/one, ponieważ /tmp/test/ już istniało w tym przykładzie.

I wreszcie, jestem przy założeniu, że należy po prostu utworzyć nową funkcję w oparciu o dired-do-create-files - Modyfikacja następujący fragment kodu:

(if (not (or dired-one-file into-dir)) 
    (error "Marked %s: target must be a directory: %s" operation target)) 

Wszelkie wskazówki coraz przeszłości kłucia, lub dowolny inne zagrożenia, o których nie myślałem, byłyby bardzo docenione.

Answer 1

Poniższa odpowiedź była możliwa (częściowo) w oparciu o pomocne komentarze Drew i phils pod oryginalnym pytaniem - ich pomoc jest bardzo doceniana!

(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))