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: Mon, 15 Jan 2018 00:53:45 +0200 Organization: LINKOV.NET Message-ID: <874lno10di.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> <87y3l1e68y.fsf@mail.linkov.net> <871sis66w1.fsf@gmail.com> 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 1515973095 28116 195.159.176.226 (14 Jan 2018 23:38:15 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sun, 14 Jan 2018 23:38:15 +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: Tino Calancha Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Mon Jan 15 00:38:10 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 1earqq-0006us-U7 for geb-bug-gnu-emacs@m.gmane.org; Mon, 15 Jan 2018 00:38:09 +0100 Original-Received: from localhost ([::1]:46711 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1earsq-0001om-O7 for geb-bug-gnu-emacs@m.gmane.org; Sun, 14 Jan 2018 18:40:12 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51931) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1earsj-0001o9-M7 for bug-gnu-emacs@gnu.org; Sun, 14 Jan 2018 18:40:06 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1earsg-0005Fu-Ie for bug-gnu-emacs@gnu.org; Sun, 14 Jan 2018 18:40:05 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:48570) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1earsg-0005Fm-EQ for bug-gnu-emacs@gnu.org; Sun, 14 Jan 2018 18:40:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1earsg-0004jI-1S for bug-gnu-emacs@gnu.org; Sun, 14 Jan 2018 18:40: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: Sun, 14 Jan 2018 23:40:01 +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.151597315118120 (code B ref 30073); Sun, 14 Jan 2018 23:40:01 +0000 Original-Received: (at 30073) by debbugs.gnu.org; 14 Jan 2018 23:39:11 +0000 Original-Received: from localhost ([127.0.0.1]:56467 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1earrr-0004iC-7Y for submit@debbugs.gnu.org; Sun, 14 Jan 2018 18:39:11 -0500 Original-Received: from sub3.mail.dreamhost.com ([69.163.253.7]:46592 helo=homiemail-a17.g.dreamhost.com) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1earrp-0004i4-2S for 30073@debbugs.gnu.org; Sun, 14 Jan 2018 18:39:09 -0500 Original-Received: from homiemail-a17.g.dreamhost.com (localhost [127.0.0.1]) by homiemail-a17.g.dreamhost.com (Postfix) with ESMTP id D42D02B206A; Sun, 14 Jan 2018 15:39:07 -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-a17.g.dreamhost.com (Postfix) with ESMTPSA id 429002B2065; Sun, 14 Jan 2018 15:39:06 -0800 (PST) In-Reply-To: <871sis66w1.fsf@gmail.com> (Tino Calancha's message of "Sun, 14 Jan 2018 20:01:50 +0900") 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:142159 Archived-At: >> Thanks for the idea. Here is the first version of its implementation: > Thank you for the patch. I like it. But I don't like it :-) Neither (fset 'yes-or-no-p 'y-or-n-p) nor (advice-add 'yes-or-no-p :override #'y-or-n-p) are good methods of customization, so dired-deletion-confirmer and dired-recursive-deletion-confirmer are equally bad. What I'm thinking about is introducing a boolean customizable variable that would define whether abbreviated answers are preferred by the user. Then a new minibuffer-reading function could accept a list of abbreviatio= ns and map them to long full answers. Something like =E2=80=98read-multiple-choice=E2=80=99 or =E2=80=98map-y-o= r-n-p=E2=80=99, but that would allow either long or short answers depending on customization like =E2=80=98rmail-confirm-expunge=E2=80=99, =E2=80=98url-confirmation-f= unc=E2=80=99, =E2=80=98org-confirm-shell-link-function=E2=80=99, =E2=80=98org-confirm-e= lisp-link-function=E2=80=99, or on its argument like =E2=80=98strong-query=E2=80=99 in =E2=80=98custom= -command-apply=E2=80=99. WDYT? diff --git a/lisp/dired.el b/lisp/dired.el index b853d64..0ce24d0 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3005,27 +3006,60 @@ dired-delete-help `quit' to exit, `help' to show this help message.") =20 -(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? '. -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'." - (let ((valid-answers (list "yes" "no" "all" "quit")) - (answer "") - (input-fn (lambda () - (read-string - (format "%s [yes, no, all, quit, help] " prompt))))) - (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))))) - (while (not (member answer valid-answers)) - (unless (string=3D answer "help") +(defcustom read-answers-short nil + "If non-nil, accept short answers to the question." + :version "27.1" + :type 'boolean) + +(defun read-answers (prompt answers &optional help-msg short) + (let* ((short (or short read-answers-short)) + (prompt (format "%s [%s] " prompt + (mapconcat (lambda (a) + (if short (cadr a) (car a))) + answers ", "))) + (message (format "Please answer %s" + (mapconcat (lambda (a) + (format "`%s'" (if short (cadr a)= (car a)))) + answers " or "))) + (short-answer-map (when short + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-m= ap) + (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-comman= d] + (lambda () + (interactive) + (delete-minibuffer-contents) + (beep) + (message message) + (sleep-for 2))) + map))) + answer) + (while (not (assoc (setq answer + (if short + (read-from-minibuffer + prompt nil short-answer-map) + (read-string prompt))) + answers)) + (if (and (string=3D answer "help") (stringp help-msg)) + (with-help-window "*Help*" + (with-current-buffer "*Help*" + (insert (if short + (seq-reduce (lambda (msg a) + (replace-regexp-in-string + (format "`%s'" (car a)) + (format "`%s'" (cadr a)) + msg nil t)) + answers help-msg) + help-msg)))) (beep) - (message "Please answer `yes' or `no' or `all' or `quit'") - (sleep-for 2)) - (setq answer (funcall input-fn))) + (message message) + (sleep-for 2))) answer)) =20 ;; Delete file, possibly delete a directory and all its files. @@ -3057,11 +3091,16 @@ dired-delete-file "trash" "delete") (dired-make-relative file)))) - (pcase (dired--yes-no-all-quit-help prompt) ; Prompt = user. + (pcase (read-answers prompt '(("yes" "y") + ("no" "n") + ("all" "!") + ("quit" "q")) + dired-delete-help) ('"all" (setq recursive 'always dired-recursive-del= etes recursive)) ('"yes" (if (eq recursive 'top) (setq recursive 'al= ways))) ('"no" (setq recursive nil)) - ('"quit" (keyboard-quit))))) + ('"quit" (keyboard-quit)) + (_ (keyboard-quit))))) ; catch all unknown answers (setq recursive nil)) ; Empty dir or recursive is nil. (delete-directory file recursive trash)))) =20