From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.bugs Subject: bug#24150: 26.0.50; New command: dired-create-empty-file Date: Tue, 10 Jul 2018 16:01:18 +0900 Message-ID: <87bmbfwp4x.fsf@calancha-pc.dy.bbexcite.jp> References: <87mv8m3yya.fsf@calancha-pc> <83wp7mn3go.fsf@gnu.org> <97b67d5a-fc1e-47ea-b6b1-4154206ed5f9@default> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1531206018 28538 195.159.176.226 (10 Jul 2018 07:00:18 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 10 Jul 2018 07:00:18 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) Cc: tzz@lifelogs.com, clement.pit@gmail.com, Michael Albinus , sdl.web@gmail.com To: 24150@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Jul 10 09:00:13 2018 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fcmd9-0007IN-V1 for geb-bug-gnu-emacs@m.gmane.org; Tue, 10 Jul 2018 09:00:12 +0200 Original-Received: from localhost ([::1]:46186 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fcmfG-0007Zf-WA for geb-bug-gnu-emacs@m.gmane.org; Tue, 10 Jul 2018 03:02:23 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:56493) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1fcmf0-0007XR-Av for bug-gnu-emacs@gnu.org; Tue, 10 Jul 2018 03:02:10 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1fcmew-0004T6-Mr for bug-gnu-emacs@gnu.org; Tue, 10 Jul 2018 03:02:05 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:45092) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1fcmew-0004T0-HV for bug-gnu-emacs@gnu.org; Tue, 10 Jul 2018 03:02:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1fcmew-0007Pv-3r for bug-gnu-emacs@gnu.org; Tue, 10 Jul 2018 03:02:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 10 Jul 2018 07:02:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 24150 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 24150-submit@debbugs.gnu.org id=B24150.153120609328476 (code B ref 24150); Tue, 10 Jul 2018 07:02:02 +0000 Original-Received: (at 24150) by debbugs.gnu.org; 10 Jul 2018 07:01:33 +0000 Original-Received: from localhost ([127.0.0.1]:52989 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fcmeR-0007PC-So for submit@debbugs.gnu.org; Tue, 10 Jul 2018 03:01:33 -0400 Original-Received: from mail-pl0-f65.google.com ([209.85.160.65]:44875) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1fcmeP-0007Oy-Hk for 24150@debbugs.gnu.org; Tue, 10 Jul 2018 03:01:30 -0400 Original-Received: by mail-pl0-f65.google.com with SMTP id m16-v6so7198458pls.11 for <24150@debbugs.gnu.org>; Tue, 10 Jul 2018 00:01:29 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=HsSnJuRQ4NF3fvea4VBF7N8oefpHl7oiBR1Cn4UHd7g=; b=Bwa+JtwTNsm17vub3arYL9+No/CTxfeA2Irc7bQAhdaA9oB4hA6kGoV0175lY1lmqH ZpAzhaeiFw9ITANDcUEemWsc2kVHkb82VvpQMF9cMWOk1IjhXCjnOG0+Qj6w9+/nZHAD g5HSExiBqmTw+Z/9Xaa1y7c7fEX7J2rkUz8azHNrrAEb86jMytw35hCG60DcUVxcVPcu nzspsDqHl782sAKske2BJPfmjfwJA5kZjhgF9wG1GSo8Ri/kGRyUo9o/CKQc8gDa29oX q8BOOssRgtmgc8G3VazC6sOuFu68BB2StHx9qwHR89CAvxUi7G+DdGi69Ma6Itd6Uwsi 813g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=HsSnJuRQ4NF3fvea4VBF7N8oefpHl7oiBR1Cn4UHd7g=; b=WqwoQpIpT2ovfopR5tkl9lVlFRiiwupJVKolE745JfQTz0TQJyxUhCxH0yGTOQIJJc vgQTbqWMl3RdpdfN0zFzISWv4REcdvkPXpsUA7BFPYIJoP+u+Nn2bMOP/tdsCyS4EzWr cGW1Mi19Ump/OHlXKaxqLt/hOnpv3UiUxIJZhtaS+yM+VRkzQE7rzBkLcdfHVJL4CBRi 95zcMfEKQ9HZxXlzs/gFznI+GfR+9GDi2JDUOGzpRrbjcL/P8J7gun/2zryxfmyxSXOh l2d39kJFNMxn7u47lEThuU7HdHbRWESo64ppAIvtchFPng92HkNyx/SGVqGmLxdUYPWP 5Q0g== X-Gm-Message-State: APt69E1LX3N4Pnr6ufwn8tuL+gjiSWktJGN3rY+Z2VyU6BZ8pBnk77Fy 7/2HLf2YzzRd8EJdcxGa4w4= X-Google-Smtp-Source: AAOMgpeVjCpMVE4SplUqAYOkFu83vAVAv+6XQzo44Gk7jIJ+pt/opDTgaE4swDE/LhZG8K2LStV5BQ== X-Received: by 2002:a17:902:3181:: with SMTP id x1-v6mr23397649plb.198.1531206083502; Tue, 10 Jul 2018 00:01:23 -0700 (PDT) Original-Received: from calancha-pc.dy.bbexcite.jp (102.92.100.220.dy.bbexcite.jp. [220.100.92.102]) by smtp.gmail.com with ESMTPSA id n7-v6sm27913110pfn.175.2018.07.10.00.01.20 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 10 Jul 2018 00:01:22 -0700 (PDT) In-Reply-To: (Drew Adams's message of "Fri, 7 Jul 2017 04:11:30 -0700 (PDT)") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:148403 Archived-At: Drew Adams 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 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