* bug#22322: New Feature -- dired: Option to create a directory when copying/moving.
@ 2016-01-06 20:13 Keith David Bershatsky
2016-01-06 20:15 ` John Wiegley
2021-02-07 17:06 ` Lars Ingebrigtsen
0 siblings, 2 replies; 5+ messages in thread
From: Keith David Bershatsky @ 2016-01-06 20:13 UTC (permalink / raw)
To: 22322
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))
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#22322: New Feature -- dired: Option to create a directory when copying/moving.
2016-01-06 20:13 bug#22322: New Feature -- dired: Option to create a directory when copying/moving Keith David Bershatsky
@ 2016-01-06 20:15 ` John Wiegley
2021-02-07 17:06 ` Lars Ingebrigtsen
1 sibling, 0 replies; 5+ messages in thread
From: John Wiegley @ 2016-01-06 20:15 UTC (permalink / raw)
To: Keith David Bershatsky; +Cc: 22322
>>>>> Keith David Bershatsky <esq@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
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#22322: New Feature -- dired: Option to create a directory when copying/moving.
2016-01-06 20:13 bug#22322: New Feature -- dired: Option to create a directory when copying/moving Keith David Bershatsky
2016-01-06 20:15 ` John Wiegley
@ 2021-02-07 17:06 ` Lars Ingebrigtsen
2021-02-07 17:55 ` Protesilaos Stavrou
1 sibling, 1 reply; 5+ messages in thread
From: Lars Ingebrigtsen @ 2021-02-07 17:06 UTC (permalink / raw)
To: Keith David Bershatsky; +Cc: 22322
Keith David Bershatsky <esq@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
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#22322: New Feature -- dired: Option to create a directory when copying/moving.
2021-02-07 17:06 ` Lars Ingebrigtsen
@ 2021-02-07 17:55 ` Protesilaos Stavrou
2021-02-07 17:57 ` Lars Ingebrigtsen
0 siblings, 1 reply; 5+ messages in thread
From: Protesilaos Stavrou @ 2021-02-07 17:55 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 22322, Keith David Bershatsky
On 2021-02-07, 18:06 +0100, Lars Ingebrigtsen <larsi@gnus.org> wrote:
> Keith David Bershatsky <esq@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
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#22322: New Feature -- dired: Option to create a directory when copying/moving.
2021-02-07 17:55 ` Protesilaos Stavrou
@ 2021-02-07 17:57 ` Lars Ingebrigtsen
0 siblings, 0 replies; 5+ messages in thread
From: Lars Ingebrigtsen @ 2021-02-07 17:57 UTC (permalink / raw)
To: Protesilaos Stavrou; +Cc: 22322, Keith David Bershatsky
Protesilaos Stavrou <info@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
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2021-02-07 17:57 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-01-06 20:13 bug#22322: New Feature -- dired: Option to create a directory when copying/moving Keith David Bershatsky
2016-01-06 20:15 ` John Wiegley
2021-02-07 17:06 ` Lars Ingebrigtsen
2021-02-07 17:55 ` Protesilaos Stavrou
2021-02-07 17:57 ` Lars Ingebrigtsen
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).