unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Tino Calancha <tino.calancha@gmail.com>
To: 24150@debbugs.gnu.org
Subject: bug#24150: 25.1.50; New command: dired-create-empty-file
Date: Thu, 4 Aug 2016 22:25:10 +0900 (JST)	[thread overview]
Message-ID: <alpine.DEB.2.20.1608042223340.11938@calancha-pc> (raw)


Hi all,

It might be useful having a Dired command creating
an empty file with a name provided by the user; something
like 'dired-create-directory' ('+') but for files.

Following patch propose a new command 'dired-create-empty-file'
bound to 'M-+'.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
From 96b5bfe9f33e7fea5296f83649dd4b6a48bafb06 Mon Sep 17 00:00:00 2001
From: Tino Calancha <tino.calancha@gmail.com>
Date: Thu, 4 Aug 2016 22:07:00 +0900
Subject: [PATCH] New command dired-create-empty-file

* lisp/dired-aux.el (dired--create-empty-file-or-directory):
New macro to create a new empty file or directory.
(dired-create-directory): Use it.
(dired-create-empty-file): New command; as 'dired-create-directory'
but it creates an empty file instead of a dir.
* lisp/dired.el (dired-mode-map): Bind 'dired-create-empty-file'
to 'M-+'.
* doc/emacs/dired.texi: Document the new command in the manual.
* etc/NEWS: Add entry for this new feature.
---
  doc/emacs/dired.texi |  6 ++++++
  etc/NEWS             |  5 +++++
  lisp/dired-aux.el    | 50 
++++++++++++++++++++++++++++++++++++--------------
  lisp/dired.el        |  1 +
  4 files changed, 48 insertions(+), 14 deletions(-)

diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 2cda51a..c2de114 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -1410,6 +1410,12 @@ Misc Dired Features
  directory name, and creates that directory.  It signals an error if
  the directory already exists.

+@kindex M-+ @r{(Dired)}
+@findex dired-create-empty-file
+  The command @kbd{M-+} (@code{dired-create-empty-file}) reads a
+file name, and creates an empty file with that name.  It signals
+an error if the file already exists.
+
  @cindex searching multiple files via Dired
  @kindex M-s a C-s @r{(Dired)}
  @kindex M-s a M-C-s @r{(Dired)}
diff --git a/etc/NEWS b/etc/NEWS
index fadf4c2..394b9f8 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -249,6 +249,11 @@ whose content matches a regexp; bound to '% g'.
  ** Dired

  +++
+*** A new command 'dired-create-empty-file' similar as
+'dired-create-directory' but it creates a new empty file;
+bound to 'M-+'.
+
++++
  *** A New option 'dired-always-read-filesystem' default to nil.
  If non-nil, buffers visiting files are reverted before search them;
  for instance, in 'dired-mark-files-containing-regexp' a non-nil value
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 4732d9c..84b0c35 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1888,24 +1888,46 @@ dired-dwim-target-defaults
        dired-dirs)))


+(defmacro dired--create-empty-file-or-directory (fname &optional 
create-file)
+  "Create an empty file or directory called FNAME.
+If FNAME already exists, signal an error.
+Optional arg CREATE-FILE if non-nil, then create a file.  Otherwise 
create
+a directory. "
+  `(let* ((expanded (directory-file-name (expand-file-name ,fname)))
+          (parent (directory-file-name (file-name-directory expanded)))
+          (try expanded) new)
+     (when ,create-file
+       (setq try parent
+             new expanded))
+     (when (file-exists-p expanded)
+       (error "Cannot create file %s: file exists" expanded))
+     ;; Find the topmost nonexistent parent dir (variable `new')
+     (while (and try (not (file-exists-p try)) (not (equal new try)))
+       (setq new try
+             try (directory-file-name (file-name-directory try))))
+     (cond (,create-file
+            (unless (file-exists-p parent)
+              (make-directory parent t))
+            (write-region "" nil expanded nil 0))
+           (t
+            (make-directory expanded t)))
+     (when new
+       (dired-add-file new)
+       (dired-move-to-filename))))
+
  ;;;###autoload
  (defun dired-create-directory (directory)
    "Create a directory called DIRECTORY.
  If DIRECTORY already exists, signal an error."
-  (interactive
-   (list (read-file-name "Create directory: " 
(dired-current-directory))))
-  (let* ((expanded (directory-file-name (expand-file-name directory)))
-	 (try expanded) new)
-    (if (file-exists-p expanded)
-	(error "Cannot create directory %s: file exists" expanded))
-    ;; Find the topmost nonexistent parent dir (variable `new')
-    (while (and try (not (file-exists-p try)) (not (equal new try)))
-      (setq new try
-	    try (directory-file-name (file-name-directory try))))
-    (make-directory expanded t)
-    (when new
-      (dired-add-file new)
-      (dired-move-to-filename))))
+  (interactive (list (read-file-name "Create directory: ")))
+  (dired--create-empty-file-or-directory directory))
+
+;;;###autoload
+(defun dired-create-empty-file (file)
+  "Create an empty file called FILE.
+If FILE already exists, signal an error."
+  (interactive (list (read-file-name "Create empty file: ")))
+  (dired--create-empty-file-or-directory file 'create-file))

  (defun dired-into-dir-with-symlinks (target)
    (and (file-directory-p target)
diff --git a/lisp/dired.el b/lisp/dired.el
index 7ead087..df5a61c 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1554,6 +1554,7 @@ dired-mode-map
      (define-key map "x" 'dired-do-flagged-delete)
      (define-key map "y" 'dired-show-file-type)
      (define-key map "+" 'dired-create-directory)
+    (define-key map "\M-+" 'dired-create-empty-file)
      ;; moving
      (define-key map "<" 'dired-prev-dirline)
      (define-key map ">" 'dired-next-dirline)
-- 
2.8.1


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

In GNU Emacs 25.1.50 (x86_64-pc-linux-gnu, GTK+ Version 3.20.6)
  of 2016-08-03 built
Repository revision: 7f9721d3990155bae83e4e4840f0ff4913868d50






             reply	other threads:[~2016-08-04 13:25 UTC|newest]

Thread overview: 38+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2016-08-04 13:25 Tino Calancha [this message]
2016-08-04 13:54 ` bug#24150: 25.1.50; New command: dired-create-empty-file Clément Pit--Claudel
2016-08-04 16:29 ` Leo Liu
2016-08-04 17:13   ` Ted Zlatanov
2016-08-04 17:29     ` Drew Adams
2016-08-05  6:03 ` Tino Calancha
2016-08-05 14:48   ` Drew Adams
2016-08-06 12:38     ` Tino Calancha
2016-08-05  6:07 ` Tino Calancha
2017-05-03  8:23 ` Tino Calancha
2017-07-03  4:51 ` bug#24150: 26.0.50; " Tino Calancha
2017-07-03 14:24   ` Eli Zaretskii
2017-07-03 15:04     ` Tino Calancha
2017-07-03 16:33       ` Eli Zaretskii
2017-07-03 20:18         ` Thien-Thi Nguyen
2017-07-07 13:13         ` Ted Zlatanov
2017-07-07 13:17           ` Drew Adams
2017-07-07 13:31             ` Ted Zlatanov
2017-07-03 15:12     ` Drew Adams
2017-07-05 18:28   ` Eli Zaretskii
2017-07-05 19:34     ` Drew Adams
2017-07-07  5:36       ` Tino Calancha
2017-07-07 11:11         ` Drew Adams
2018-07-10  7:01           ` Tino Calancha
2018-07-10  7:42             ` Phil Sainty
2018-07-17  7:39               ` Tino Calancha
2018-07-20  9:03                 ` Eli Zaretskii
2018-07-23  3:57                   ` Tino Calancha
2018-07-27  8:39                     ` Eli Zaretskii
2018-07-31  4:47                       ` Tino Calancha
2018-07-31 16:20                         ` Eli Zaretskii
2018-08-01  5:16                           ` Tino Calancha
2018-08-01  6:24                             ` Eli Zaretskii
2018-08-01  7:13                               ` Tino Calancha
2018-08-01  8:56                                 ` Eli Zaretskii
2018-08-01  9:31                                   ` Tino Calancha
2018-08-01 11:45                                     ` Eli Zaretskii
2018-08-02  4:34                                       ` Tino Calancha

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=alpine.DEB.2.20.1608042223340.11938@calancha-pc \
    --to=tino.calancha@gmail.com \
    --cc=24150@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
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).