Emacs - dired 복사/파일 이동 - 필요한 경우 디렉토리 만들기

Question

dired-mode에 대한 사용자 정의 기능을 작성하여 파일 복사 및 이동과 관련이 없으면 디렉토리를 작성할 수 있습니다. 아직 존재합니다. 기본 동작은 디렉토리가 아직 존재하지 않으면 단순히 오류 메시지를 생성하는 것입니다.

스틱 포인트 : 내 마음에 고착 지점은 하나 이상의 디렉토리를 만드는 잘못된 시도를 다룰 것입니다. 예를 들어, 홈 디렉토리 ~/에서 /tmp/test/one/으로 파일을 복사하려고합니다. /tmp/test/ 디렉토리가 이미 존재하지만 /tmp/test/one/은 이 아니며이 아직 존재하지 않습니다. 을 입력하는 대신 실수로 다음을 입력합니다 : /tmp/tesst/one -이 경우에는 - 과 같은 오류 메시지가 나타납니다. /tmp/tesst/이 먼저 존재해야하므로 앞에을 입력해야합니다. /tmp/tesst/one을 만들 수 있습니다. 이 이미이 예제에 존재했기 때문에 물론 /tmp/test/one을 올바르게 입력 했더라도 문제가 발생하지 않았습니다.

그리고, 마지막으로, 난 그냥 dired-do-create-files을 기반으로 새 기능을 작성해야한다고 가정하고 - 코드의 다음 섹션을 수정을 :

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

모든 지침이 난제 점점 과거, 또는 내가 생각지 못했던 다른 위험은 크게 감사 할 것입니다.

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