From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#30073: 27.0.50; dired-do-delete ignores customization for short answers Date: Sun, 14 Jan 2018 00:38:15 +0200 Organization: LINKOV.NET Message-ID: <87y3l1e68y.fsf@mail.linkov.net> References: <87bmi1cryh.fsf@mail.linkov.net> <87o9m1nlpl.fsf@gmail.com> <83po6g4cky.fsf@gnu.org> <87vag8f4da.fsf@mail.linkov.net> <83fu7b2yda.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: blaine.gmane.org 1515883162 8416 195.159.176.226 (13 Jan 2018 22:39:22 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 13 Jan 2018 22:39:22 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (x86_64-pc-linux-gnu) Cc: contovob@tcd.ie, 30073@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Jan 13 23:39:18 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 1eaUSF-0001UD-JL for geb-bug-gnu-emacs@m.gmane.org; Sat, 13 Jan 2018 23:39:11 +0100 Original-Received: from localhost ([::1]:43380 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eaUUE-00009a-UI for geb-bug-gnu-emacs@m.gmane.org; Sat, 13 Jan 2018 17:41:14 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48451) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eaUU6-00009P-Ff for bug-gnu-emacs@gnu.org; Sat, 13 Jan 2018 17:41:07 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eaUU2-0000UV-Vp for bug-gnu-emacs@gnu.org; Sat, 13 Jan 2018 17:41:06 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:47317) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eaUU2-0000U8-Rl for bug-gnu-emacs@gnu.org; Sat, 13 Jan 2018 17:41:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1eaUU2-0001cw-Gh for bug-gnu-emacs@gnu.org; Sat, 13 Jan 2018 17:41:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 13 Jan 2018 22:41:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 30073 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 30073-submit@debbugs.gnu.org id=B30073.15158832166194 (code B ref 30073); Sat, 13 Jan 2018 22:41:02 +0000 Original-Received: (at 30073) by debbugs.gnu.org; 13 Jan 2018 22:40:16 +0000 Original-Received: from localhost ([127.0.0.1]:55214 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eaUTI-0001bq-BJ for submit@debbugs.gnu.org; Sat, 13 Jan 2018 17:40:16 -0500 Original-Received: from sub3.mail.dreamhost.com ([69.163.253.7]:56479 helo=homiemail-a75.g.dreamhost.com) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1eaUTF-0001bh-Lj for 30073@debbugs.gnu.org; Sat, 13 Jan 2018 17:40:14 -0500 Original-Received: from homiemail-a75.g.dreamhost.com (localhost [127.0.0.1]) by homiemail-a75.g.dreamhost.com (Postfix) with ESMTP id A12815EC07C; Sat, 13 Jan 2018 14:40:12 -0800 (PST) Original-Received: from localhost.linkov.net (m91-129-109-142.cust.tele2.ee [91.129.109.142]) (using TLSv1 with cipher DHE-RSA-AES128-SHA (128/128 bits)) (No client certificate requested) (Authenticated sender: jurta@jurta.org) by homiemail-a75.g.dreamhost.com (Postfix) with ESMTPSA id 5991B5EC072; Sat, 13 Jan 2018 14:40:11 -0800 (PST) In-Reply-To: <83fu7b2yda.fsf@gnu.org> (Eli Zaretskii's message of "Fri, 12 Jan 2018 11:57:21 +0200") 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:142136 Archived-At: >> What is worse, it doesn't work at all - setting dired-deletion-confirm= er >> to y-or-n-p has no effect on the question =E2=80=9CRecursively delete = ...? =E2=80=9D. >> It still expects =E2=80=9C[yes, no, all, quit, help]=E2=80=9D answers,= not short ones >> like =E2=80=9Cy/n/!/q/?=E2=80=9D. > > If you want to use y-or-n-p there, you will have to replace > dired--yes-no-all-quit-help with your own function. Thanks for the idea. Here is the first version of its implementation: diff --git a/lisp/dired.el b/lisp/dired.el index b853d64..e6a7eeb 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2997,6 +2998,8 @@ dired-recursive-deletes ;; Match anything but `.' and `..'. (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*") =20 +(defvar dired-recursive-deletion-confirmer 'dired--yes-no-all-quit-help)= ;; or 'dired--y-n-!-q-? + (defconst dired-delete-help "Type: `yes' to delete recursively the current directory, @@ -3005,6 +3008,14 @@ dired-delete-help `quit' to exit, `help' to show this help message.") =20 +(defconst dired-delete-help-short + "Type: +`y' to delete recursively the current directory, +`n' to skip to next, +`!' to delete all remaining directories with no more questions, +`q' to exit, +`?' to show this help message.") + (defun dired--yes-no-all-quit-help (prompt &optional help-msg) "Ask a question with valid answers: yes, no, all, quit, help. PROMPT must end with '? ', for instance, 'Delete it? '. @@ -3028,6 +3039,56 @@ dired--yes-no-all-quit-help (setq answer (funcall input-fn))) answer)) =20 +(defvar read-short-answers + '(("y" "yes") + ("n" "no") + ("!" "all") + ("q" "quit") + ("?" "help"))) + +(defvar read-short-answer-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (dolist (answer read-short-answers) + (define-key map (car answer) + (lambda () + (interactive) + (delete-minibuffer-contents) + (insert (cadr answer)) + (exit-minibuffer)))) + (define-key map [remap self-insert-command] + (lambda () + (interactive) + (delete-minibuffer-contents) + (beep) + (message "Please answer `y' or `n' or `!' or `q'") + (sleep-for 2))) + map) + "Keymap used for non-blocking reading of short one-character answers."= ) + +(defun dired--y-n-!-q-? (prompt &optional help-msg) + "Ask a question with valid answers: y, n, !, q, ?. +PROMPT must end with '? ', for instance, 'Delete it? '. +If optional arg HELP-MSG is non-nil, then is a message to show when +the user answers '?'. Otherwise, default to `dired-delete-help-short'." + (let ((valid-answers (list "yes" "no" "all" "quit")) + (answer "") + (input-fn (lambda () + (read-from-minibuffer + (format "%s [y, n, !, q, ?] " prompt) nil read-shor= t-answer-map)))) + (setq answer (funcall input-fn)) + (when (string=3D answer "help") + (with-help-window "*Help*" + (with-current-buffer "*Help*" + (insert (or help-msg dired-delete-help-short))))) + (while (not (member answer valid-answers)) + (unless (string=3D answer "help") + (beep) + (message "Please answer `y' or `n' or `!' or `q'") + (sleep-for 2)) + (setq answer (funcall input-fn))) + answer)) + ;; Delete file, possibly delete a directory and all its files. ;; This function is useful outside of dired. One could change its name ;; to e.g. recursive-delete-file and put it somewhere else. @@ -3057,7 +3118,7 @@ dired-delete-file "trash" "delete") (dired-make-relative file)))) - (pcase (dired--yes-no-all-quit-help prompt) ; Prompt = user. + (pcase (apply dired-recursive-deletion-confirmer (lis= t prompt)) ; Prompt user. ('"all" (setq recursive 'always dired-recursive-del= etes recursive)) ('"yes" (if (eq recursive 'top) (setq recursive 'al= ways))) ('"no" (setq recursive nil)) ('"no" (setq recursive nil)) PS: and here is not a patch, but a diff that shows the difference between two functions to help to combine them into one later: @@ -1,22 +1,22 @@ -(defun dired--yes-no-all-quit-help (prompt &optional help-msg) - "Ask a question with valid answers: yes, no, all, quit, help. +(defun dired--y-n-!-q-? (prompt &optional help-msg) + "Ask a question with valid answers: y, n, !, q, ?. PROMPT must end with '? ', for instance, 'Delete it? '. If optional arg HELP-MSG is non-nil, then is a message to show when -the user answers 'help'. Otherwise, default to `dired-delete-help'." +the user answers '?'. Otherwise, default to `dired-delete-help-short'." (let ((valid-answers (list "yes" "no" "all" "quit")) (answer "") (input-fn (lambda () - (read-string - (format "%s [yes, no, all, quit, help] " prompt))))= ) + (read-from-minibuffer + (format "%s [y, n, !, q, ?] " prompt) nil read-shor= t-answer-map)))) (setq answer (funcall input-fn)) (when (string=3D answer "help") (with-help-window "*Help*" (with-current-buffer "*Help*" - (insert (or help-msg dired-delete-help))))) + (insert (or help-msg dired-delete-help-short))))) (while (not (member answer valid-answers)) (unless (string=3D answer "help") (beep) - (message "Please answer `yes' or `no' or `all' or `quit'") + (message "Please answer `y' or `n' or `!' or `q'") (sleep-for 2)) (setq answer (funcall input-fn))) answer))