GNU bug report logs - #22322
New Feature -- dired: Option to create a directory when copying/moving.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 22322 in the body.
You can then email your comments to 22322 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Keith David Bershatsky <esq <at> lawlist.com>
To: bug-gnu-emacs <at> gnu.org
Subject: New Feature -- dired: Option to create a directory when
 copying/moving.
Date: Wed, 06 Jan 2016 12:13:38 -0800

As a suggestion, perhaps the Emacs team would be interested in presenting the user with an option to create a new directory when copying/moving in dired-mode.  This is something I use quite frequently in my own setup, because it saves me an extra step by obviating the need to create the directory beforehand.

The following is a working example of the above-mentioned concept, which is not intended to be a patch per se.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

Message #8 received at 22322 <at> debbugs.gnu.org (full text, mbox):

From: John Wiegley <jwiegley <at> gmail.com>
To: Keith David Bershatsky <esq <at> lawlist.com>
Cc: 22322 <at> debbugs.gnu.org
Subject: Re: bug#22322: New Feature -- dired: Option to create a directory
 when copying/moving.
Date: Wed, 06 Jan 2016 12:15:35 -0800

>>>>> Keith David Bershatsky <esq <at> lawlist.com> writes:

> As a suggestion, perhaps the Emacs team would be interested in presenting
> the user with an option to create a new directory when copying/moving in
> dired-mode.

I've wanted that before: When attempting to copy/move multiple files to a
destination that does not exist, prompt to create that destination as a
directory.

-- 
John Wiegley                  GPG fingerprint = 4710 CF98 AF9B 327B B80F
http://newartisans.com                          60E1 46C4 BD1A 7AC1 4BA2

Message #11 received at 22322 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Keith David Bershatsky <esq <at> lawlist.com>
Cc: 22322 <at> debbugs.gnu.org
Subject: Re: bug#22322: New Feature -- dired: Option to create a directory
 when copying/moving.
Date: Sun, 07 Feb 2021 18:06:50 +0100

Keith David Bershatsky <esq <at> lawlist.com> writes:

> As a suggestion, perhaps the Emacs team would be interested in
> presenting the user with an option to create a new directory when
> copying/moving in dired-mode.  This is something I use quite
> frequently in my own setup, because it saves me an extra step by
> obviating the need to create the directory beforehand.
>
> The following is a working example of the above-mentioned concept,
> which is not intended to be a patch per se.

(I'm going through old bug reports that unfortunately got little response at
the time.)

Sounds like a good idea to me.  Could you work your code into a patch?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Message #16 received at 22322 <at> debbugs.gnu.org (full text, mbox):

From: Protesilaos Stavrou <info <at> protesilaos.com>
To: Lars Ingebrigtsen <larsi <at> gnus.org>
Cc: 22322 <at> debbugs.gnu.org, Keith David Bershatsky <esq <at> lawlist.com>
Subject: Re: bug#22322: New Feature -- dired: Option to create a directory
 when copying/moving.
Date: Sun, 07 Feb 2021 19:55:47 +0200

On 2021-02-07, 18:06 +0100, Lars Ingebrigtsen <larsi <at> gnus.org> wrote:

> Keith David Bershatsky <esq <at> lawlist.com> writes:
>
>> As a suggestion, perhaps the Emacs team would be interested in
>> presenting the user with an option to create a new directory when
>> copying/moving in dired-mode.  This is something I use quite
>> frequently in my own setup, because it saves me an extra step by
>> obviating the need to create the directory beforehand.
>>
>> The following is a working example of the above-mentioned concept,
>> which is not intended to be a patch per se.
>
> (I'm going through old bug reports that unfortunately got little response at
> the time.)
>
> Sounds like a good idea to me.  Could you work your code into a patch?

Hi Lars!  Is this not already covered by dired-create-destination-dirs?

-- 
Protesilaos Stavrou
protesilaos.com

Message #19 received at 22322 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Protesilaos Stavrou <info <at> protesilaos.com>
Cc: 22322 <at> debbugs.gnu.org, Keith David Bershatsky <esq <at> lawlist.com>
Subject: Re: bug#22322: New Feature -- dired: Option to create a directory
 when copying/moving.
Date: Sun, 07 Feb 2021 18:57:40 +0100

Protesilaos Stavrou <info <at> protesilaos.com> writes:

>> Sounds like a good idea to me.  Could you work your code into a patch?
>
> Hi Lars!  Is this not already covered by dired-create-destination-dirs?

Oh, indeed it is.

So I'm closing this bug report, then.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.