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#28525: 26.0.60; dired-delete-file: Accept y/n if yes-or-no-p is aliased to y-or-n-p Date: Wed, 20 Sep 2017 18:51:52 +0900 Message-ID: <87mv5pn1dz.fsf@calancha-pc> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1505924294 6303 195.159.176.226 (20 Sep 2017 16:18:14 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 20 Sep 2017 16:18:14 +0000 (UTC) Cc: npostavs@users.sourceforge.net To: 28525@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Wed Sep 20 18:18:10 2017 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 1duhhR-0001K6-9H for geb-bug-gnu-emacs@m.gmane.org; Wed, 20 Sep 2017 18:18:09 +0200 Original-Received: from localhost ([::1]:49446 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1duhhY-0006B9-Kt for geb-bug-gnu-emacs@m.gmane.org; Wed, 20 Sep 2017 12:18:16 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:37909) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dugjZ-0004W4-Ek for bug-gnu-emacs@gnu.org; Wed, 20 Sep 2017 11:17:11 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dugiQ-00006h-2o for bug-gnu-emacs@gnu.org; Wed, 20 Sep 2017 11:16:17 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:41650) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dugiP-00006M-U9 for bug-gnu-emacs@gnu.org; Wed, 20 Sep 2017 11:15:06 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dugiP-0004C8-Bu; Wed, 20 Sep 2017 11:15:05 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: npostavs@users.sourceforge.net, bug-gnu-emacs@gnu.org Resent-Date: Wed, 20 Sep 2017 15:15:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 28525 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org X-Debbugs-Original-Xcc: npostavs@users.sourceforge.net Original-Received: via spool by submit@debbugs.gnu.org id=B.150592047816028 (code B ref -1); Wed, 20 Sep 2017 15:15:03 +0000 Original-Received: (at submit) by debbugs.gnu.org; 20 Sep 2017 15:14:38 +0000 Original-Received: from localhost ([127.0.0.1]:50318 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dughy-0004AR-AG for submit@debbugs.gnu.org; Wed, 20 Sep 2017 11:14:38 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:43910) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dughw-00049n-Dm for submit@debbugs.gnu.org; Wed, 20 Sep 2017 11:14:37 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dugg9-0004jb-Td for submit@debbugs.gnu.org; Wed, 20 Sep 2017 11:14:31 -0400 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:36381) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1dugg9-0002wh-I1 for submit@debbugs.gnu.org; Wed, 20 Sep 2017 11:12:45 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51915) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dufZ5-0007MW-KJ for bug-gnu-emacs@gnu.org; Wed, 20 Sep 2017 10:01:25 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dufYy-0007wH-V7 for bug-gnu-emacs@gnu.org; Wed, 20 Sep 2017 10:01:23 -0400 Original-Received: from mail-pf0-x235.google.com ([2607:f8b0:400e:c00::235]:54340) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dufYy-0007vk-M5 for bug-gnu-emacs@gnu.org; Wed, 20 Sep 2017 10:01:16 -0400 Original-Received: by mail-pf0-x235.google.com with SMTP id d187so1563753pfg.11 for ; Wed, 20 Sep 2017 07:01:15 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:subject:date:message-id:mime-version; bh=t5Z5OOXYnUbey5PTr76s0mDMsH6/qQ5ViccUPZ+ntNQ=; b=WAyctgU7vDt51YcKe7P6lyMDcxxnaZ3hpelrFSKypSodxYRx6BCmL7IAAlNm7MnMj4 N7sXyd2ZLbiSsocEMCboAWrKKNjUG71Pgm38JeFM7Mr6mmD0cB2diJVvAf1AAyR6DMQi BLtHTjeI5OXNnTPUbfzJADDj0afbeAUOIfA1VAQ0qsQWaGlOWzimafKIKnCucghSOHUZ S/MT+7gqVPosuFEfP1SLo2+phARaVPFD9Vl9Hwqrf7408b2y+3LslhEuhDTTddrGWNFd V2wb0VKyNZe4rS4eJwQR8zRmfkUHEo1I+y1x97ywwUhQG+73R8bMBz3cqiUy6Suls2pF 9nJA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:date:message-id:mime-version; bh=t5Z5OOXYnUbey5PTr76s0mDMsH6/qQ5ViccUPZ+ntNQ=; b=jWf0IRmekqbgs6psWkPj9+bKCKEvsk/d3iMXca1I2VP03UW5rWwX6GCgMD2zDWpryY 42BYM39LlJyuQDefWbMS6h6J0zrXIPKgxiylkCoEpNkd9V137ooBP3YPzvAbpvvPCkfM Ldvkmj5UzED+DsFLw17ROxbbDe/DlN7cMtQxYLr6ouyVppMSma+uyuDgiMGmsA1BAMr+ CCxWw6j+AIHp/1/OnjToaDiXminSf8W5VVO/BTv/neXvhhVnB6SdQOATwIee3SeJUBw+ XGYs2CIZG9DUXwa/O2SoodintyEfPzGq8X+Dft2YD0h4/RClW009YrfBba9N6xR1B5Ho QapA== X-Gm-Message-State: AHPjjUgO5uqDthj49m5i6MolTqSe+vIl6iWSBpeyOjgpY5tbgHRsON1T MSl7W2uN7kU2PSOBMPDMTCkH/w== X-Google-Smtp-Source: AOwi7QCHThntgCRewifQK/4rj83jVM9JtapfbTP6s7bKJbSPtM2ip7BeZ6V64ey8aw14dkVFSFk1pg== X-Received: by 10.98.29.199 with SMTP id d190mr1603595pfd.74.1505901116539; Wed, 20 Sep 2017 02:51:56 -0700 (PDT) Original-Received: from calancha-pc ([103.5.140.188]) by smtp.gmail.com with ESMTPSA id e69sm7034494pfc.79.2017.09.20.02.51.54 for (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Wed, 20 Sep 2017 02:51:55 -0700 (PDT) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x 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:137179 Archived-At: X-Debbugs-CC: npostavs@users.sourceforge.net Tags: patch The following commit dired-do-delete: Allow to delete dirs recursively without prompts (cbea38e5c4af5386192fb9a48ef4fca5080d6561) doesn't consider the case when an user has aliased 'yes-or-no-p' to 'y-or-n-p'. That's annoying if you are used to the previous behaviour. I do. Recently, I had a private communication with an user whom complained about this recent change. Not sure about the ideal fix. The following patch work around the issue adding a new function 'dired-y-or-n-or-a-p', which is called when yes-or-no-p is aliased to y-or-n-p. This function is y-or-n-p with an additional possible answer '!' (aka, automatic), as in query-replace. --8<-----------------------------cut here---------------start------------->8--- commit d764d51c311a8bf6517f558bbdd5f11dff41a0ba Author: Tino Calancha Date: Wed Sep 20 18:28:52 2017 +0900 dired-delete-file: Accept y/n if yes-or-no-p is aliased to y-or-n-p Some users like to redefine yes-or-no-p as an alias of y-or-n-p. For backward compatibility 'dired-delete-file' must behave as usual in that case. * lisp/dired.el (defun dired-y-or-n-or-a-p): New defun. (dired--yes-no-all-quit-help): If yes-or-no-p is fset to y-or-n-p then call defun dired-y-or-n-or-a-p. (dired-delete-file): Update the pcase: it must handle 3 inputs (symbols): 'automatic, t or nil. (dired-delete-help): Delete variable. * test/lisp/dired-tests.el (dired-test-bug27940): Update test. diff --git a/lisp/dired.el b/lisp/dired.el index 782d8ffa51..80c2b9055f 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2994,36 +2994,110 @@ dired-recursive-deletes ;; Match anything but `.' and `..'. (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*") -(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-y-or-n-or-a-p (prompt) + "Ask user a \"y or n or a\" question. +This is like `y-or-n-p' with an additional answer '!' to +proceed automatically with no mre questions." + (let ((answer 'recenter) + (padded (lambda (prompt &optional dialog) + (let ((l (length prompt))) + (concat prompt + (if (or (zerop l) (eq ?\s (aref prompt (1- l)))) + "" " ") + (if dialog "" "(y or n or !) ")))))) + (cond + (noninteractive + (setq prompt (funcall padded prompt)) + (let ((temp-prompt prompt)) + (while (not (memq answer '(act skip automatic))) + (let ((str (read-string temp-prompt))) + (cond ((member str '("y" "Y")) (setq answer 'act)) + ((member str '("!")) (setq answer 'automatic)) + ((member str '("n" "N")) (setq answer 'skip)) + (t (setq temp-prompt (concat "Please answer y or n or !. " + prompt)))))))) + ((and (display-popup-menus-p) + last-input-event ; not during startup + (listp last-nonmenu-event) + use-dialog-box) + (setq prompt (funcall padded prompt t) + answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip) ("!" . automatic))))) + (t + (setq prompt (funcall padded prompt)) + (while + (let* ((scroll-actions '(recenter scroll-up scroll-down + scroll-other-window scroll-other-window-down)) + (key + (let ((cursor-in-echo-area t)) + (when minibuffer-auto-raise + (raise-frame (window-frame (minibuffer-window)))) + (read-key (propertize (if (memq answer scroll-actions) + prompt + (concat "Please answer y or n or !. " + prompt)) + 'face 'minibuffer-prompt))))) + (setq answer (lookup-key query-replace-map (vector key) t)) + (cond + ((memq answer '(skip act automatic)) nil) + ((eq answer 'recenter) + (recenter) t) + ((eq answer 'scroll-up) + (ignore-errors (scroll-up-command)) t) + ((eq answer 'scroll-down) + (ignore-errors (scroll-down-command)) t) + ((eq answer 'scroll-other-window) + (ignore-errors (scroll-other-window)) t) + ((eq answer 'scroll-other-window-down) + (ignore-errors (scroll-other-window-down)) t) + ((or (memq answer '(exit-prefix quit)) (eq key ?\e)) + (signal 'quit nil) t) + (t t))) + (ding) + (discard-input)))) + (let ((ret (cond ((eq answer 'act)) + (t (and (eq answer 'automatic) 'automatic))))) + (unless noninteractive + (message "%s%c" prompt (cond ((eq ret 'automatic) ?!) (t (if ret ?y ?n))))) + ret))) (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= 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= answer "help") - (beep) - (message "Please answer `yes' or `no' or `all' or `quit'") - (sleep-for 2)) - (setq answer (funcall input-fn))) - answer)) + ;; Some people redefine 'yes-or-no-p as 'y-or-n-p; for backward + ;; compatibility we must check if that is the case. + (if (eq (symbol-function 'yes-or-no-p) 'y-or-n-p) + (dired-y-or-n-or-a-p prompt) + (let* ((valid-answers (list 'act 'skip 'automatic)) + (input-fn (lambda () + (let ((str + (read-string + (format "%s [yes, no, automatic, help] " prompt)))) + (cond ((string-match "\\`yes\\'" str) 'act) + ((string-match "\\`no\\'" str) 'skip) + ((string-match "\\`automatic\\'" str) 'automatic) + ((string-match "\\`help\\'" str) 'help))))) + (dired-delete-help + (format "Type: +`%s' to delete recursively the current directory, +`%s' to skip to next, +`%s' to delete automatic remaining directories with no more questions, +`%s' to show this help message." + "yes" "no" "automatic" "help"))) + (let ((answer (funcall input-fn))) + (when (eq answer 'help) + (with-help-window "*Help*" + (with-current-buffer "*Help*" + (insert (or help-msg dired-delete-help))))) + (while (not (member answer valid-answers)) + (unless (eq answer 'help) + (beep) + (message "Please answer `yes' or `no' or `automatic'") + (sleep-for 2)) + (setq answer (funcall input-fn))) + (cond ((eq answer 'act)) + (t (and (eq answer 'automatic) 'automatic))))))) ;; Delete file, possibly delete a directory and all its files. ;; This function is useful outside of dired. One could change its name @@ -3055,10 +3129,9 @@ dired-delete-file "delete") (dired-make-relative file)))) (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user. - ('"all" (setq recursive 'always dired-recursive-deletes recursive)) - ('"yes" (if (eq recursive 'top) (setq recursive 'always))) - ('"no" (setq recursive nil)) - ('"quit" (keyboard-quit))))) + ('automatic (setq recursive 'always dired-recursive-deletes recursive)) + ('t (if (eq recursive 'top) (setq recursive 'always))) + ('nil (setq recursive nil))))) (setq recursive nil)) ; Empty dir or recursive is nil. (delete-directory file recursive trash)))) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 99006eca3e..fb9988ee06 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -399,7 +399,7 @@ dired-test-with-temp-dirs ;; Answer yes (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes") + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) t) '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) @@ -410,7 +410,7 @@ dired-test-with-temp-dirs ;; Answer no (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no") + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) nil) '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) @@ -418,10 +418,10 @@ dired-test-with-temp-dirs (unwind-protect (should (= 5 (length (dired-get-marked-files)))) ; Just the empty dirs deleted. (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) - ;; Answer all + ;; Answer automatic (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all") + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) 'automatic) '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) @@ -432,7 +432,7 @@ dired-test-with-temp-dirs ;; Answer quit (dired-test-with-temp-dirs nil - (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit") + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) (signal 'quit nil)) '((name . dired-test-bug27940-advice))) (dired default-directory) (dired-toggle-marks) --8<-----------------------------cut here---------------end--------------->8--- In GNU Emacs 27.0.50 (build 10, x86_64-pc-linux-gnu, GTK+ Version 3.22.11) of 2017-09-20 built on calancha-pc Repository revision: b1f83c10df7d1bbb16f4e13d18119ad4aa1a2137