Subject: bug#28525: closed (Re: bug#30073: 27.0.50; dired-do-delete ignores customization for short answers)

From: [email-masked] (GNU bug Tracking System)
Date: Sun, 21 Jan 2018 21:48:03 +0000

Your bug report

#30073: 26.0.60; dired-delete-file: Accept y/n if yes-or-no-p is aliased to y-or-n-p

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
30073: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=30073
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#30073: 27.0.50; dired-do-delete ignores customization for short answers
From: Juri Linkov <[email-masked]>
To: Eli Zaretskii <[email-masked]>
Cc: [email-masked], [email-masked], [email-masked]
Date: Sun, 21 Jan 2018 23:46:01 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

>> Thanks for working on this.
>
> Here is a quite final patch I believe.  At least, it works
> without noticed problems in my tests.

Done.

Subject: 26.0.60; dired-delete-file: Accept y/n if yes-or-no-p is aliased to y-or-n-p
From: Tino Calancha <[email-masked]>
To: [email-masked]
Date: Wed, 20 Sep 2017 18:51:52 +0900
List-Id: <debbugs-submit.debbugs.gnu.org>

X-Debbugs-CC: [email-masked]
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 <[email-masked]>
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