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: Thu, 18 Jan 2018 00:56:57 +0200 Organization: LINKOV.NET Message-ID: <87inc0yt1y.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> <874lno10di.fsf@mail.linkov.net> <83k1wjzokj.fsf@gnu.org> <87efmqaeea.fsf@mail.linkov.net> <83a7xdy9eo.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 1516231137 27757 195.159.176.226 (17 Jan 2018 23:18:57 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 17 Jan 2018 23:18:57 +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, tino.calancha@gmail.com To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Thu Jan 18 00:18:53 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 1ebwyW-0005oQ-Eo for geb-bug-gnu-emacs@m.gmane.org; Thu, 18 Jan 2018 00:18:33 +0100 Original-Received: from localhost ([::1]:42324 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ebx0W-0008Ir-7w for geb-bug-gnu-emacs@m.gmane.org; Wed, 17 Jan 2018 18:20:36 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:60739) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ebx02-00080w-Cr for bug-gnu-emacs@gnu.org; Wed, 17 Jan 2018 18:20:08 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ebwzz-0002EL-BO for bug-gnu-emacs@gnu.org; Wed, 17 Jan 2018 18:20:06 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:52798) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ebwzz-0002E4-72 for bug-gnu-emacs@gnu.org; Wed, 17 Jan 2018 18:20:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ebwzz-0001ei-02 for bug-gnu-emacs@gnu.org; Wed, 17 Jan 2018 18:20:03 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 17 Jan 2018 23:20: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.15162311896334 (code B ref 30073); Wed, 17 Jan 2018 23:20:02 +0000 Original-Received: (at 30073) by debbugs.gnu.org; 17 Jan 2018 23:19:49 +0000 Original-Received: from localhost ([127.0.0.1]:60694 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ebwzl-0001e6-4v for submit@debbugs.gnu.org; Wed, 17 Jan 2018 18:19:49 -0500 Original-Received: from sub3.mail.dreamhost.com ([69.163.253.7]:59750 helo=homiemail-a100.g.dreamhost.com) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ebwzj-0001dy-LN for 30073@debbugs.gnu.org; Wed, 17 Jan 2018 18:19:48 -0500 Original-Received: from homiemail-a100.g.dreamhost.com (localhost [127.0.0.1]) by homiemail-a100.g.dreamhost.com (Postfix) with ESMTP id 2DA4631A073; Wed, 17 Jan 2018 15:19:47 -0800 (PST) Original-Received: from localhost.linkov.net (m91-129-98-183.cust.tele2.ee [91.129.98.183]) (using TLSv1 with cipher DHE-RSA-AES128-SHA (128/128 bits)) (No client certificate requested) (Authenticated sender: jurta@jurta.org) by homiemail-a100.g.dreamhost.com (Postfix) with ESMTPSA id 60B5231A070; Wed, 17 Jan 2018 15:19:45 -0800 (PST) In-Reply-To: <83a7xdy9eo.fsf@gnu.org> (Eli Zaretskii's message of "Tue, 16 Jan 2018 19:56:47 +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:142243 Archived-At: >> Regarding a new multiple options reading function =E2=80=98read-answer= =E2=80=99, I'm >> not sure where to put it. > > How many callers does it have now, and which callers are those? Currently it will have just one caller in =E2=80=98dired-delete-file=E2=80= =99, but it's possible to gradually replace all callers that are using =E2=80=98yes-or-no-p=E2=80=99 and =E2=80=98y-or-n-p=E2=80=99 with equival= ent calls of =E2=80=98read-answer=E2=80=99 with the argument '(("yes" ?y) ("no" ?n)) that will accept either long or short answer depending on the new customizable variable. In this patch I placed new code to map-ynp.el because in loadup.el "emacs-lisp/map-ynp" is loaded immediately after loading "custom", so map-ynp.el is the first file that allows using defcustom. Most importantly, a new function is logically related to map-y-or-n-p, and grouping related functions in one file is much better than polluting file namespace with separate files such as map-ynp.el, rmc.el, crm.el... diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index 2a7edde..85ed9e0 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -256,4 +256,86 @@ map-y-or-n-p ;; Return the number of actions that were taken. actions)) =20 +=0C +;; For backward compatibility check if short y/n answers are preferred. +(defcustom read-answer-short (eq (symbol-function 'yes-or-no-p) 'y-or-n-= p) + "If non-nil, accept short answers to the question." + :type 'boolean + :version "27.1" + :group 'minibuffer) + +(defun read-answer (question answers) + "Read an answer either as a complete word or its character abbreviatio= n. +Ask QUESTION and accept an answer from the list of possible ANSWERS. +This list contains lists in the following format: + (LONG-ANSWER SHORT-ANSWER HELP-MESSAGE) +where + LONG-ANSWER is a complete answer, + SHORT-ANSWER is an abbreviated one-letter answer, + HELP-MESSAGE is a string describing the meaning of the answer. + +Example: + '((\"yes\" ?y \"perform the action\") + (\"no\" ?n \"skip to the next\") + (\"all\" ?! \"accept all remaining without more questions\") + (\"quit\" ?q \"exit\")) + +When `read-answer-short' is non-nil, accept short answers. + +Return a long answer even in case of accepting short ones." + (custom-reevaluate-setting 'read-answer-short) + (let* ((short read-answer-short) + (answers-with-help (append answers '(("help" ?? "show this help= message")))) + (prompt (format "%s(%s) " question + (mapconcat (lambda (a) + (if short (format "%c=3D%s" (nth 1= a) (nth 0 a)) (nth 0 a))) + answers-with-help ", "))) + (message (format "Please answer %s." + (mapconcat (lambda (a) + (format "`%s'" (if short (string = (nth 1 a)) (nth 0 a)))) + answers-with-help " or "))) + (short-answer-map (when short + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-m= ap) + (dolist (answer answers-with-help) + (define-key map (vector (nth 1 answer)) + (lambda () + (interactive) + (delete-minibuffer-contents) + (insert (nth 0 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 (cond (short + (read-from-minibuffer + prompt nil short-answer-map)= ) + (t + (read-from-minibuffer + prompt nil nil nil + 'yes-or-no-p-history)))) + answers)) + (if (string=3D answer "help") + (with-help-window "*Help*" + (with-current-buffer "*Help*" + (insert "Type:\n" + (mapconcat (lambda (a) + (format "`%s' to %s" + (if short + (format "%c (%s)" (nth 1 = a) (nth 0 a)) + (nth 0 a)) + (nth 2 a))) + answers-with-help ",\n") + ".\n"))) + (beep) + (message message) + (sleep-for 2))) + answer)) + ;;; map-ynp.el ends here diff --git a/lisp/dired.el b/lisp/dired.el index b853d64..9a412d0 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2997,37 +2998,6 @@ dired-recursive-deletes ;; Match anything but `.' and `..'. (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*") =20 -(defconst dired-delete-help - "Type: -`yes' to delete recursively the current directory, -`no' to skip to next, -`all' to delete all remaining directories with no more questions, -`quit' to exit, -`help' 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? '. -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") - (beep) - (message "Please answer `yes' or `no' or `all' or `quit'") - (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,11 +3027,17 @@ dired-delete-file "trash" "delete") (dired-make-relative file)))) - (pcase (dired--yes-no-all-quit-help prompt) ; Prompt = user. + (pcase (read-answer + prompt + '(("yes" ?y "delete recursively the current = directory") + ("no" ?n "skip to next") + ("all" ?! "delete all remaining directorie= s with no more questions") + ("quit" ?q "exit"))) ('"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 diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index c024213..bb0e1bc 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -384,9 +384,9 @@ dired-test-with-temp-dirs (dired-test-with-temp-dirs 'just-empty-dirs (let (asked) - (advice-add 'dired--yes-no-all-quit-help + (advice-add 'read-answer :override - (lambda (_) (setq asked t) "") + (lambda (_q _a) (setq asked t) "") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) @@ -395,44 +395,44 @@ dired-test-with-temp-dirs (progn (should-not asked) (should-not (dired-get-marked-files))) ; All dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-= advice)))) + (advice-remove 'read-answer 'dired-test-bug27940-advice)))) ;; Answer yes (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes") + (advice-add 'read-answer :override (lambda (_q _a) "yes") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) (dired-do-delete nil) (unwind-protect (should-not (dired-get-marked-files)) ; All dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-ad= vice))) + (advice-remove 'read-answer 'dired-test-bug27940-advice))) ;; Answer no (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no") + (advice-add 'read-answer :override (lambda (_q _a) "no") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) (dired-do-delete nil) (unwind-protect (should (=3D 5 (length (dired-get-marked-files)))) ; Just the emp= ty dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-ad= vice))) + (advice-remove 'read-answer 'dired-test-bug27940-advice))) ;; Answer all (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all") + (advice-add 'read-answer :override (lambda (_q _a) "all") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) (dired-do-delete nil) (unwind-protect (should-not (dired-get-marked-files)) ; All dirs deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-ad= vice))) + (advice-remove 'read-answer 'dired-test-bug27940-advice))) ;; Answer quit (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit"= ) + (advice-add 'read-answer :override (lambda (_q _a) "quit") '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) @@ -440,7 +440,7 @@ dired-test-with-temp-dirs (dired-do-delete nil)) (unwind-protect (should (=3D 6 (length (dired-get-marked-files)))) ; All empty di= rs but zeta-empty-dir deleted. - (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-ad= vice)))) + (advice-remove 'read-answer 'dired-test-bug27940-advice)))) =20 =20 (provide 'dired-tests)