bug#24150: 26.0.50; New command: dired-create-empty-file

[Tino Calancha]

Drew Adams <drew.adams@oracle.com> writes:

>> > FWIW:
>> > I'd rather not see this command bound to a key.  How about just
>> > putting it in a menu?
>>
>> That's a nice suggestion.  Thank you.

>> Having the command defined in Emacs means that users just need 1 line
>> in their config file to set their binding of choice.  That's cheap.
>
> Thank you, Tino.

I came to this issue again after a long time.
I redid my patch.
I have tested it in a remote machine.

IIRC, Eli wanted the command to be general, as `make-directory' its,
i.e., not been exclusive of dired, instead lying on files.el.

I did that.
In addition I also implemented one command in dired-aux.el.
It's worth to have it so that the dired buffer is updated, and you
see your new created file.

That is consistent with the current master branch:
* `make-directory' in files.el
* `dired-create-directory' in dired-aux.el

The patch adds the following:
* `make-empty-file' in files.el
* `dired-create-empty-file' in dired-aux.el

The patch adds an entry for the second command in the dired menu. No new 
keybinding.

I see many colleagues using similar command in other editors.  I would
like Emacs also have one.

Let's discuss this patch.

--8<-----------------------------cut here---------------start------------->8---
commit 099ac754a2222776c00a7bacab6dfda3a4fe9cb4
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Tue Jul 10 14:35:25 2018 +0900

    New commands to create an empty file
    
    Similarly as `create-directory', `dired-create-directory',
    the new commands create the parent dirs as needed.
    * lisp/dired-aux.el (dired-create-empty-file): New command.
    (dired--create-empty-file-or-directory):
    New defun extracted from `dired-create-directory'.
    (dired-create-directory, dired-create-empty-file): Use it.
    
    * lisp/files.el (make-empty-file): New command.
    (make--empty-file-or-directory):
    New function extracted from `make-directory'.
    
    (make-directory, make-empty-file): Use it.
    
    * lisp/dired.el (dired-mode-map): Add menu entry for `make-empty-file'.

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 925a7d50d6..cd997ef17e 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1989,26 +1989,49 @@ dired-dwim-target-defaults
       dired-dirs)))
 
 
-;;;###autoload
-(defun dired-create-directory (directory)
-  "Create a directory called DIRECTORY.
-Parent directories of DIRECTORY are created as needed.
-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))
+(defun 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))))
-    (make-directory expanded t)
+            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.
+Parent directories of DIRECTORY are created as needed.
+If DIRECTORY already exists, signal an error."
+  (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.
+Parent directories of DIRECTORY are created as needed.
+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)
        (not (file-symlink-p target))))
diff --git a/lisp/dired.el b/lisp/dired.el
index 1348df6934..090fa4ad1a 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1802,6 +1802,9 @@ dired-mode-map
     (define-key map [menu-bar immediate create-directory]
       '(menu-item "Create Directory..." dired-create-directory
                  :help "Create a directory"))
+    (define-key map [menu-bar immediate make-empty-file]
+      '(menu-item "Create Empty file..." make-empty-file
+                 :help "Create an empty file"))
     (define-key map [menu-bar immediate wdired-mode]
       '(menu-item "Edit File Names" wdired-change-to-wdired-mode
                  :help "Put a Dired buffer in a mode in which filenames are 
editable"
diff --git a/lisp/files.el b/lisp/files.el
index eabb3c0e06..31e67a2946 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5477,6 +5477,54 @@ files--ensure-directory
      (unless (file-directory-p dir)
        (signal (car err) (cdr err))))))
 
+(defun make--empty-file-or-directory (fname &optional parents empty-file)
+  ;; If default-directory is a remote directory,
+  ;; make sure we find its make-directory handler.
+  (setq fname (expand-file-name fname))
+  (let ((handler (find-file-name-handler fname 'make-directory)))
+    (cond (handler
+           (if (null empty-file)
+               (funcall handler 'make-directory fname parents)
+             ;; There is no tramp handler for `make-empty-file' yet.
+             ;; One work around is to create the file in 2 steps:
+             ;; first the parent dirs, second the file.
+             ;;
+             ;; If the new file is in the current directory we just
+             ;; need to call `write-region'.
+             (if (equal default-directory (file-name-directory fname))
+                 (write-region "" nil fname nil 0)
+               ;; We must create parents dirs first
+               (funcall handler 'make-directory (file-name-directory fname) 
parents)
+               (write-region "" nil fname nil 0))))
+          (t
+           (let ((create-fn (lambda (file)
+                              (write-region "" nil file nil 0))))
+             (if (not parents)
+                 (cond ((not empty-file) (make-directory-internal fname))
+                       (t (funcall create-fn fname)))
+               (let* ((expanded (directory-file-name (expand-file-name fname)))
+                      (try expanded)
+                      create-list new last)
+                 ;; new: topmost nonexistent parent dir.
+                 (while (and (not (file-exists-p try))
+                             ;; If directory is its own parent, then we can't
+                             ;; keep looping forever
+                             (not (equal new try)))
+                   (setq new try
+                         create-list (cons new create-list)
+                         try (directory-file-name (file-name-directory try))))
+                 (setq last (car (last create-list))
+                       create-list (nbutlast create-list))
+                 (while create-list
+                   (make-directory-internal (car create-list))
+                   (setq create-list (cdr create-list)))
+                 (when last
+                   (if (not empty-file) (make-directory-internal last)
+                     (funcall create-fn last)))
+                 (when (and new (derived-mode-p 'dired-mode) empty-file)
+                   (dired-add-file new)
+                   (dired-move-to-filename) nil))))))))
+
 (defun make-directory (dir &optional parents)
   "Create the directory DIR and optionally any nonexistent parent dirs.
 If DIR already exists as a directory, signal an error, unless
@@ -5496,28 +5544,17 @@ make-directory
    (list (read-file-name "Make directory: " default-directory default-directory
                         nil nil)
         t))
-  ;; If default-directory is a remote directory,
-  ;; make sure we find its make-directory handler.
-  (setq dir (expand-file-name dir))
-  (let ((handler (find-file-name-handler dir 'make-directory)))
-    (if handler
-       (funcall handler 'make-directory dir parents)
-      (if (not parents)
-         (make-directory-internal dir)
-       (let ((dir (directory-file-name (expand-file-name dir)))
-             create-list parent)
-         (while (progn
-                  (setq parent (directory-file-name
-                                (file-name-directory dir)))
-                  (condition-case ()
-                      (files--ensure-directory dir)
-                    (file-missing
-                     ;; Do not loop if root does not exist (Bug#2309).
-                     (not (string= dir parent)))))
-           (setq create-list (cons dir create-list)
-                 dir parent))
-         (dolist (dir create-list)
-            (files--ensure-directory dir)))))))
+  (make--empty-file-or-directory dir parents))
+
+(defun make-empty-file (fname &optional parents)
+  "Create an empty file FNAME.
+Optional arg PARENTS, if non-nil then creates parent dirs as needed.
+
+If called interactively, then PARENTS is non-nil."
+  (interactive
+   (let ((fname (read-file-name "Create empty file: ")))
+     (list fname t)))
+  (make--empty-file-or-directory fname parents 'empty-file))
 
 (defconst directory-files-no-dot-files-regexp
   "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"

--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 27.0.50 (build 5, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2018-07-10 built
Repository revision: cc74539a19229ee7e70055b00e8334bd6abc0841