unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#31782: 26.1; dired-recursive-deletes broken
@ 2018-06-11  5:09 Leo Liu
  2018-06-11 14:33 ` Noam Postavsky
  0 siblings, 1 reply; 15+ messages in thread
From: Leo Liu @ 2018-06-11  5:09 UTC (permalink / raw)
  To: 31782


Sigh!

I am annoyed to answer this question in 26.1 constantly

        Recursively trash XXX?  [yes, no, all, quit, help]

Previously there is only yes or no (which I replace with y or n). Now I
have to type all of these things. It's madness. So I set
dired-recursive-deletes to always. But that question pops up still.

To make it worse, I already have delete-by-moving-to-trash so all of
these questions are useless and slows me down. Why change for the worse?

Leo





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-06-11  5:09 bug#31782: 26.1; dired-recursive-deletes broken Leo Liu
@ 2018-06-11 14:33 ` Noam Postavsky
  2018-06-11 17:23   ` Eli Zaretskii
  0 siblings, 1 reply; 15+ messages in thread
From: Noam Postavsky @ 2018-06-11 14:33 UTC (permalink / raw)
  To: Leo Liu; +Cc: 31782

On 11 June 2018 at 01:09, Leo Liu <sdl.web@gmail.com> wrote:
>
> Sigh!
>
> I am annoyed to answer this question in 26.1 constantly
>
>         Recursively trash XXX?  [yes, no, all, quit, help]
>
> Previously there is only yes or no (which I replace with y or n). Now I
> have to type all of these things.

I think this is solved in the master branch. See Bug#30073.





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-06-11 14:33 ` Noam Postavsky
@ 2018-06-11 17:23   ` Eli Zaretskii
  2018-06-12 21:55     ` Noam Postavsky
  0 siblings, 1 reply; 15+ messages in thread
From: Eli Zaretskii @ 2018-06-11 17:23 UTC (permalink / raw)
  To: Noam Postavsky; +Cc: 31782, sdl.web

> From: Noam Postavsky <npostavs@gmail.com>
> Date: Mon, 11 Jun 2018 10:33:50 -0400
> Cc: 31782@debbugs.gnu.org
> 
> > I am annoyed to answer this question in 26.1 constantly
> >
> >         Recursively trash XXX?  [yes, no, all, quit, help]
> >
> > Previously there is only yes or no (which I replace with y or n). Now I
> > have to type all of these things.
> 
> I think this is solved in the master branch. See Bug#30073.

Should we backport that to the emacs-26 branch?





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-06-11 17:23   ` Eli Zaretskii
@ 2018-06-12 21:55     ` Noam Postavsky
  2018-06-13  2:32       ` Eli Zaretskii
  0 siblings, 1 reply; 15+ messages in thread
From: Noam Postavsky @ 2018-06-12 21:55 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 31782, sdl.web

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Noam Postavsky <npostavs@gmail.com>
>> Date: Mon, 11 Jun 2018 10:33:50 -0400
>> Cc: 31782@debbugs.gnu.org
>> 
>> > I am annoyed to answer this question in 26.1 constantly
>> >
>> >         Recursively trash XXX?  [yes, no, all, quit, help]
>> >
>> > Previously there is only yes or no (which I replace with y or n). Now I
>> > have to type all of these things.
>> 
>> I think this is solved in the master branch. See Bug#30073.
>
> Should we backport that to the emacs-26 branch?

Probably yes.  I have the impression that yes-or-no-p is sort of a
counterexample to what Leo mentioned in Bug#31772; that is, many (most?)
people are not very happy with it, but it's so easy to just do (fset
'yes-or-no-p #'y-or-n-p) so nobody bothers to complain about it.  But
it's a "customization" that breaks down in cases like this one.






^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-06-12 21:55     ` Noam Postavsky
@ 2018-06-13  2:32       ` Eli Zaretskii
  2018-06-14  4:15         ` Leo Liu
  0 siblings, 1 reply; 15+ messages in thread
From: Eli Zaretskii @ 2018-06-13  2:32 UTC (permalink / raw)
  To: Noam Postavsky; +Cc: 31782, sdl.web

> From: Noam Postavsky <npostavs@gmail.com>
> Cc: 31782@debbugs.gnu.org,  sdl.web@gmail.com
> Date: Tue, 12 Jun 2018 17:55:21 -0400
> 
> >> >         Recursively trash XXX?  [yes, no, all, quit, help]
> >> >
> >> > Previously there is only yes or no (which I replace with y or n). Now I
> >> > have to type all of these things.
> >> 
> >> I think this is solved in the master branch. See Bug#30073.
> >
> > Should we backport that to the emacs-26 branch?
> 
> Probably yes.

Then let's do that.





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-06-13  2:32       ` Eli Zaretskii
@ 2018-06-14  4:15         ` Leo Liu
  2018-06-14 13:05           ` Noam Postavsky
  0 siblings, 1 reply; 15+ messages in thread
From: Leo Liu @ 2018-06-14  4:15 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 31782, Noam Postavsky

On 2018-06-13 05:32 +0300, Eli Zaretskii wrote:
>> Probably yes.
>
> Then let's do that.

The verbosity of the question is one problem. I think the piece is a bit
over-engineered. (setq dired-recursive-deletes 'aways) still get
questioned is another problem.

It is worth a fix anyhow.

Leo





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-06-14  4:15         ` Leo Liu
@ 2018-06-14 13:05           ` Noam Postavsky
  2018-06-14 13:26             ` Leo Liu
  0 siblings, 1 reply; 15+ messages in thread
From: Noam Postavsky @ 2018-06-14 13:05 UTC (permalink / raw)
  To: Leo Liu; +Cc: 31782

Leo Liu <sdl.web@gmail.com> writes:

> (setq dired-recursive-deletes 'aways) still get
> questioned is another problem.

Oh, I missed that part.  I'm not able to reproduce with emacs-26.  I
tried

    mkdir -p a/b/c
    touch a/b/c/foo
    mkdir -p d/e/f

then 'emacs -Q --eval (setq dired-recursive-deletes (quote always))' and
then mark the 'a' and 'd' directories in dired, and hit D
(dired-do-delete).  I get the yes/no question about deleting 'a' and
'd', but no further questions about recursive deletions of any other
directories.







^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-06-14 13:05           ` Noam Postavsky
@ 2018-06-14 13:26             ` Leo Liu
  2018-06-15 11:24               ` Noam Postavsky
  0 siblings, 1 reply; 15+ messages in thread
From: Leo Liu @ 2018-06-14 13:26 UTC (permalink / raw)
  To: Noam Postavsky; +Cc: 31782

On 2018-06-14 09:05 -0400, Noam Postavsky wrote:
>> (setq dired-recursive-deletes 'aways) still get

I got an unfortunate typo here.

>> questioned is another problem.
>
> Oh, I missed that part.  I'm not able to reproduce with emacs-26.  I
> tried
>
>     mkdir -p a/b/c
>     touch a/b/c/foo
>     mkdir -p d/e/f

My bad. Just realised I had a typo in my init. So that is not dired's
fault.

Leo





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-06-14 13:26             ` Leo Liu
@ 2018-06-15 11:24               ` Noam Postavsky
  2018-07-31  1:39                 ` Noam Postavsky
  0 siblings, 1 reply; 15+ messages in thread
From: Noam Postavsky @ 2018-06-15 11:24 UTC (permalink / raw)
  To: Leo Liu; +Cc: 31782, Juri Linkov

Leo Liu <sdl.web@gmail.com> writes:

> On 2018-06-14 09:05 -0400, Noam Postavsky wrote:
>>> (setq dired-recursive-deletes 'aways) still get
>
> I got an unfortunate typo here.

Oh, hah, I missed that too.

So, looking at the Bug#30073 fix, the new (currently being introduced in
Emacs 27) read-answer function looks pretty similar to
read-multiple-choice.  Perhaps some sharing is in order?

Another thing is that the defcustom default value trick doesn't work as
intended (as far as I understand the intention, at least).

    ;; 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."

For a user with .emacs consisting of

    (fset 'yes-or-no-p 'y-or-n-p)

<f1> v read-answer-short RET gives:

    read-answer-short is a variable defined in ‘map-ynp.el’.
    Its value is nil
    Original value was t

I think we'd want some `auto' setting which would tell read-answer to
look at the yes-or-no-p function value at run time.





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-06-15 11:24               ` Noam Postavsky
@ 2018-07-31  1:39                 ` Noam Postavsky
  2018-07-31 16:00                   ` Eli Zaretskii
  0 siblings, 1 reply; 15+ messages in thread
From: Noam Postavsky @ 2018-07-31  1:39 UTC (permalink / raw)
  To: Leo Liu; +Cc: 31782, Juri Linkov

[-- Attachment #1: Type: text/plain, Size: 585 bytes --]

tags 31782 + patch
quit

Noam Postavsky <npostavs@gmail.com> writes:

> So, looking at the Bug#30073 fix, the new (currently being introduced in
> Emacs 27) read-answer function looks pretty similar to
> read-multiple-choice.  Perhaps some sharing is in order?

There are differences in both the interface and implementation which
make it difficult to merge these, even though the functionality has some
overlap.  Maybe something could be done later, but for now we'll have to
settle for taking it as is (modulo the fix for the standard value
problem).  Here is the backported patch:


[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 14481 bytes --]

From 0cb77a6c47799a556f224176e5e122b276224328 Mon Sep 17 00:00:00 2001
From: Juri Linkov <juri@linkov.net>
Date: Sun, 21 Jan 2018 23:45:43 +0200
Subject: [PATCH] New function read-answer (bug#30073)

* lisp/emacs-lisp/map-ynp.el (read-answer-short): New defcustom.
(read-answer): New function.
* etc/NEWS: Announce it.

* lisp/dired.el (dired-delete-file): Use read-answer.
(dired--yes-no-all-quit-help): Remove function.
(dired-delete-help): Remove defconst.

* lisp/subr.el (assoc-delete-all): New function.

(backported from master, "New function read-answer (bug#30073)" and
"Respect non-saved value of `read-short-answer' (Bug#31782)")
---
 etc/NEWS                   |   3 ++
 lisp/dired.el              |  41 +++------------
 lisp/emacs-lisp/map-ynp.el | 128 +++++++++++++++++++++++++++++++++++++++++++++
 lisp/subr.el               |  15 ++++++
 test/lisp/dired-tests.el   |  22 ++++----
 5 files changed, 165 insertions(+), 44 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index a27d1b89ec..331d5767f7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -110,6 +110,9 @@ be removed prior using the changed 'shadow-*' commands.
 \f
 * Lisp Changes in Emacs 26.2
 
+** The new function 'read-answer' accepts either long or short answers
+depending on the new customizable variable 'read-answer-short'.
+
 \f
 * Changes in Emacs 26.2 on Non-Free Operating Systems
 
diff --git a/lisp/dired.el b/lisp/dired.el
index c421e51ffd..2520ed2a10 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2995,37 +2995,6 @@ 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--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))
-
 ;; 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.
@@ -3055,11 +3024,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 directories with no more questions")
+                             ("quit" ?q "exit")))
                      ('"all" (setq recursive 'always dired-recursive-deletes recursive))
                      ('"yes" (if (eq recursive 'top) (setq recursive 'always)))
                      ('"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))))
 
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index 2a7eddedad..a1489c66ed 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -256,4 +256,132 @@ map-y-or-n-p
     ;; Return the number of actions that were taken.
     actions))
 
+\f
+;; read-answer is a general-purpose question-asker that supports
+;; either long or short answers.
+
+;; For backward compatibility check if short y/n answers are preferred.
+(defcustom read-answer-short 'auto
+  "Control whether `read-answer' accepts short answers.
+If t, accept short (single key-press) answers to the question.
+If nil, require long answers.  If `auto', accept short answers if
+the function cell of `yes-or-no-p' is set to `y-or-on-p'."
+  :type '(choice (const :tag "Accept short answers" t)
+                 (const :tag "Require long answer" nil)
+                 (const :tag "Guess preference" auto))
+  :version "26.2"
+  :group 'minibuffer)
+
+(defconst read-answer-map--memoize (make-hash-table :weakness 'key :test 'equal))
+
+(defun read-answer (question answers)
+  "Read an answer either as a complete word or its character abbreviation.
+Ask user a question and accept an answer from the list of possible answers.
+
+QUESTION should end in a space; this function adds a list of answers to it.
+
+ANSWERS is an alist with elements in the following format:
+  (LONG-ANSWER SHORT-ANSWER HELP-MESSAGE)
+where
+  LONG-ANSWER is a complete answer,
+  SHORT-ANSWER is an abbreviated one-character 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\")
+    (\"help\" ?h \"show help\")
+    (\"quit\" ?q \"exit\"))
+
+When `read-answer-short' is non-nil, accept short answers.
+
+Return a long answer even in case of accepting short ones.
+
+When `use-dialog-box' is t, pop up a dialog window to get user input."
+  (let* ((short (if (eq read-answer-short 'auto)
+                    (eq (symbol-function 'yes-or-no-p) 'y-or-n-p)
+                  read-answer-short))
+         (answers-with-help
+          (if (assoc "help" answers)
+              answers
+            (append answers '(("help" ?? "show this help message")))))
+         (answers-without-help
+          (assoc-delete-all "help" (copy-alist answers-with-help)))
+         (prompt
+          (format "%s(%s) " question
+                  (mapconcat (lambda (a)
+                               (if short
+                                   (format "%c" (nth 1 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
+            (or (gethash answers read-answer-map--memoize)
+                (puthash answers
+                         (let ((map (make-sparse-keymap)))
+                           (set-keymap-parent map minibuffer-local-map)
+                           (dolist (a answers-with-help)
+                             (define-key map (vector (nth 1 a))
+                               (lambda ()
+                                 (interactive)
+                                 (delete-minibuffer-contents)
+                                 (insert (nth 0 a))
+                                 (exit-minibuffer))))
+                           (define-key map [remap self-insert-command]
+                             (lambda ()
+                               (interactive)
+                               (delete-minibuffer-contents)
+                               (beep)
+                               (message message)
+                               (sleep-for 2)))
+                           map)
+                         read-answer-map--memoize))))
+         answer)
+    (while (not (assoc (setq answer (downcase
+                                     (cond
+                                      ((and (display-popup-menus-p)
+                                            last-input-event ; not during startup
+                                            (listp last-nonmenu-event)
+                                            use-dialog-box)
+                                       (x-popup-dialog
+                                        t
+                                        (cons question
+                                              (mapcar (lambda (a)
+                                                        (cons (capitalize (nth 0 a))
+                                                              (nth 0 a)))
+                                                      answers-with-help))))
+                                      (short
+                                       (read-from-minibuffer
+                                        prompt nil short-answer-map nil
+                                        'yes-or-no-p-history))
+                                      (t
+                                       (read-from-minibuffer
+                                        prompt nil nil nil
+                                        'yes-or-no-p-history)))))
+                       answers-without-help))
+      (if (string= answer "help")
+          (with-help-window "*Help*"
+            (with-current-buffer "*Help*"
+              (insert "Type:\n"
+                      (mapconcat
+                       (lambda (a)
+                         (format "`%s'%s to %s"
+                                 (if short (string (nth 1 a)) (nth 0 a))
+                                 (if short (format " (%s)" (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/subr.el b/lisp/subr.el
index f8ac70edef..7582b6cdb8 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -705,6 +705,21 @@ member-ignore-case
     (setq list (cdr list)))
   list)
 
+(defun assoc-delete-all (key alist)
+  "Delete from ALIST all elements whose car is `equal' to KEY.
+Return the modified alist.
+Elements of ALIST that are not conses are ignored."
+  (while (and (consp (car alist))
+	      (equal (car (car alist)) key))
+    (setq alist (cdr alist)))
+  (let ((tail alist) tail-cdr)
+    (while (setq tail-cdr (cdr tail))
+      (if (and (consp (car tail-cdr))
+	       (equal (car (car tail-cdr)) key))
+	  (setcdr tail (cdr tail-cdr))
+	(setq tail tail-cdr))))
+  alist)
+
 (defun assq-delete-all (key alist)
   "Delete from ALIST all elements whose car is `eq' to KEY.
 Return the modified alist.
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index c0242137b3..bb0e1bc388 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-advice)))
+     (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 (= 5 (length (dired-get-marked-files)))) ; Just the empty dirs deleted.
-     (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))
+     (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-advice)))
+     (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 (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted.
-     (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))))
+     (advice-remove 'read-answer 'dired-test-bug27940-advice))))
 
 
 (provide 'dired-tests)
-- 
2.11.0


[-- Attachment #3: Type: text/plain, Size: 712 bytes --]


I guess assoc-delete-all should be announced in NEWS too?  Although it
looks like it could be replaced with cl-delete instead.

> Another thing is that the defcustom default value trick doesn't work as
> intended (as far as I understand the intention, at least).
>
>     ;; 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."

> I think we'd want some `auto' setting which would tell read-answer to
> look at the yes-or-no-p function value at run time.

Here's a patch for that against master (I already included this into the
backported patch above).


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: patch --]
[-- Type: text/x-diff, Size: 2068 bytes --]

From 1059db2520f1aa8d26d2cdb253c57421f647df2e Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Wed, 4 Jul 2018 22:51:45 -0400
Subject: [PATCH 1/2] Respect non-saved value of `read-short-answer'
 (Bug#31782)

* lisp/emacs-lisp/map-ynp.el (read-answer-short): Add an `auto'
setting.
(read-answer): Check the function cell of `yes-or-no-p' when
`read-answer-short' is `auto' rather than calling
`custom-reevaluate-setting' which would reset the option to its saved
value.
---
 lisp/emacs-lisp/map-ynp.el | 16 +++++++++++-----
 1 file changed, 11 insertions(+), 5 deletions(-)

diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index 61c04ff7b3..c029c7e1b5 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -257,9 +257,14 @@ map-y-or-n-p
 ;; either long or short answers.
 
 ;; 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
+(defcustom read-answer-short 'auto
+  "Control whether `read-answer' accepts short answers.
+If t, accept short (single key-press) answers to the question.
+If nil, require long answers.  If `auto', accept short answers if
+the function cell of `yes-or-no-p' is set to `y-or-on-p'."
+  :type '(choice (const :tag "Accept short answers" t)
+                 (const :tag "Require long answer" nil)
+                 (const :tag "Guess preference" auto))
   :version "27.1"
   :group 'minibuffer)
 
@@ -290,8 +295,9 @@ read-answer
 Return a long answer even in case of accepting short ones.
 
 When `use-dialog-box' is t, pop up a dialog window to get user input."
-  (custom-reevaluate-setting 'read-answer-short)
-  (let* ((short read-answer-short)
+  (let* ((short (if (eq read-answer-short 'auto)
+                    (eq (symbol-function 'yes-or-no-p) 'y-or-n-p)
+                  read-answer-short))
          (answers-with-help
           (if (assoc "help" answers)
               answers
-- 
2.11.0


[-- Attachment #5: Type: text/plain, Size: 135 bytes --]


And once backported, we should remove the announcement from 27.1 NEWS,
since the new function it will already be introduced in 26.2:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: patch --]
[-- Type: text/x-diff, Size: 883 bytes --]

From c791639c259abe6e514a4e3ffd62c904cff636e2 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs@gmail.com>
Date: Mon, 30 Jul 2018 21:02:07 -0400
Subject: [PATCH 2/2] ; etc/NEWS: Remove read-answer, it was backported to v26

---
 etc/NEWS | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 5ca1b428de..2825bb9f59 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -913,10 +913,6 @@ higher-level functions.
 some years back.  It now respects 'imagemagick-types-inhibit' as a way
 to disable that.
 
-+++
-** The new function 'read-answer' accepts either long or short answers
-depending on the new customizable variable 'read-answer-short'.
-
 ** The function 'load' now behaves correctly when loading modules.
 Specifically, it puts the module name into 'load-history', prints
 loading messages if requested, and protects against recursive loads.
-- 
2.11.0


^ permalink raw reply related	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-07-31  1:39                 ` Noam Postavsky
@ 2018-07-31 16:00                   ` Eli Zaretskii
  2018-08-01  4:35                     ` Richard Stallman
  2018-08-04 16:02                     ` Noam Postavsky
  0 siblings, 2 replies; 15+ messages in thread
From: Eli Zaretskii @ 2018-07-31 16:00 UTC (permalink / raw)
  To: Noam Postavsky; +Cc: 31782, sdl.web, juri

> From: Noam Postavsky <npostavs@gmail.com>
> Date: Mon, 30 Jul 2018 21:39:12 -0400
> Cc: 31782@debbugs.gnu.org, Juri Linkov <juri@linkov.net>
> 
> There are differences in both the interface and implementation which
> make it difficult to merge these, even though the functionality has some
> overlap.  Maybe something could be done later, but for now we'll have to
> settle for taking it as is (modulo the fix for the standard value
> problem).  Here is the backported patch:

LGTM, thanks.

> +;; For backward compatibility check if short y/n answers are preferred.
> +(defcustom read-answer-short 'auto
> +  "Control whether `read-answer' accepts short answers.

This is unnecessarily vague.  How about

  If non-nil, `read-answer' accepts single-character answers.

with all the rest intact?

> I guess assoc-delete-all should be announced in NEWS too?

Yes, please.

> Although it looks like it could be replaced with cl-delete instead.

Such a small and simple function doesn't justify loading cl-seq, IMO.
And we already have a similar function in subr.el.

> -(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
> +(defcustom read-answer-short 'auto
> +  "Control whether `read-answer' accepts short answers.
> +If t, accept short (single key-press) answers to the question.
> +If nil, require long answers.  If `auto', accept short answers if
> +the function cell of `yes-or-no-p' is set to `y-or-on-p'."
> +  :type '(choice (const :tag "Accept short answers" t)
> +                 (const :tag "Require long answer" nil)
> +                 (const :tag "Guess preference" auto))
>    :version "27.1"

The :version tag should change, right?

> And once backported, we should remove the announcement from 27.1 NEWS,
> since the new function it will already be introduced in 26.2:

Right.

Thanks.





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-07-31 16:00                   ` Eli Zaretskii
@ 2018-08-01  4:35                     ` Richard Stallman
  2018-08-01  6:04                       ` Eli Zaretskii
  2018-08-01 13:00                       ` Basil L. Contovounesios
  2018-08-04 16:02                     ` Noam Postavsky
  1 sibling, 2 replies; 15+ messages in thread
From: Richard Stallman @ 2018-08-01  4:35 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: sdl.web, 31782, npostavs, juri

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > LGTM, thanks.

Every time I see "LGTM", it comes into my mind that LG stands for
"little green". and the M stands for "man".

If only I could figure out what the T stands for.

-- 
Dr Richard Stallman
President, Free Software Foundation (https://gnu.org, https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)







^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-08-01  4:35                     ` Richard Stallman
@ 2018-08-01  6:04                       ` Eli Zaretskii
  2018-08-01 13:00                       ` Basil L. Contovounesios
  1 sibling, 0 replies; 15+ messages in thread
From: Eli Zaretskii @ 2018-08-01  6:04 UTC (permalink / raw)
  To: rms; +Cc: sdl.web, 31782, npostavs, juri

> From: Richard Stallman <rms@gnu.org>
> Cc: npostavs@gmail.com, 31782@debbugs.gnu.org, sdl.web@gmail.com,
> 	juri@linkov.net
> Date: Wed, 01 Aug 2018 00:35:57 -0400
> 
>   > LGTM, thanks.
> 
> Every time I see "LGTM", it comes into my mind that LG stands for
> "little green". and the M stands for "man".
> 
> If only I could figure out what the T stands for.

It stands for "to".





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-08-01  4:35                     ` Richard Stallman
  2018-08-01  6:04                       ` Eli Zaretskii
@ 2018-08-01 13:00                       ` Basil L. Contovounesios
  1 sibling, 0 replies; 15+ messages in thread
From: Basil L. Contovounesios @ 2018-08-01 13:00 UTC (permalink / raw)
  To: Richard Stallman; +Cc: npostavs, sdl.web, 31782, juri

Richard Stallman <rms@gnu.org> writes:

> [[[ To any NSA and FBI agents reading my email: please consider    ]]]
> [[[ whether defending the US Constitution against all enemies,     ]]]
> [[[ foreign or domestic, requires you to follow Snowden's example. ]]]
>
>   > LGTM, thanks.
>
> Every time I see "LGTM", it comes into my mind that LG stands for
> "little green". and the M stands for "man".
>
> If only I could figure out what the T stands for.

"Terrestrial"?

-- 
Basil





^ permalink raw reply	[flat|nested] 15+ messages in thread

* bug#31782: 26.1; dired-recursive-deletes broken
  2018-07-31 16:00                   ` Eli Zaretskii
  2018-08-01  4:35                     ` Richard Stallman
@ 2018-08-04 16:02                     ` Noam Postavsky
  1 sibling, 0 replies; 15+ messages in thread
From: Noam Postavsky @ 2018-08-04 16:02 UTC (permalink / raw)
  To: Eli Zaretskii; +Cc: 31782, sdl.web, juri

tags 31782 fixed
close 31782 26.2
quit

Eli Zaretskii <eliz@gnu.org> writes:

>> +;; For backward compatibility check if short y/n answers are preferred.
>> +(defcustom read-answer-short 'auto
>> +  "Control whether `read-answer' accepts short answers.
>
> This is unnecessarily vague.  How about
>
>   If non-nil, `read-answer' accepts single-character answers.
>
> with all the rest intact?

Okay, I'm always a bit unsure how to summarize these multi-way choice
options.

>> I guess assoc-delete-all should be announced in NEWS too?
>
> Yes, please.

>> +(defcustom read-answer-short 'auto
>> +  "Control whether `read-answer' accepts short answers.
>> +If t, accept short (single key-press) answers to the question.
>> +If nil, require long answers.  If `auto', accept short answers if
>> +the function cell of `yes-or-no-p' is set to `y-or-on-p'."
>> +  :type '(choice (const :tag "Accept short answers" t)
>> +                 (const :tag "Require long answer" nil)
>> +                 (const :tag "Guess preference" auto))
>>    :version "27.1"
>
> The :version tag should change, right?

Oh, I got confused with the multiple branches.  Should be fixed now.

>> And once backported, we should remove the announcement from 27.1 NEWS,
>> since the new function it will already be introduced in 26.2:
>
> Right.

All done; [1: cc233365a9] in emacs-26, [2: 95050a5841], [3: 84ecc48d1f],
and [4: 111916596f] in master.

[1: cc233365a9]: 2018-08-04 11:37:39 -0400
  New function read-answer (Bug#31782)
  https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=cc233365a925dcf9fa7270630819f2e6e75280da

[2: 95050a5841]: 2018-08-04 11:55:40 -0400
  Respect non-saved value of `read-short-answer' (Bug#31782)
  https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=95050a5841c01bbcb6e8a82838881eee7879b7b9

[3: 84ecc48d1f]: 2018-08-04 11:55:40 -0400
  ; etc/NEWS: Remove read-answer, it was backported to v26
  https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=84ecc48d1f9a98626977151aca332cfd4d7361b9

[4: 111916596f]: 2018-08-04 12:00:43 -0400
  ; (read-answer-short): Fix :version setting for backport
  https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=111916596fc8518cffcd0c32cf0f99e638f6ec24





^ permalink raw reply	[flat|nested] 15+ messages in thread

end of thread, other threads:[~2018-08-04 16:02 UTC | newest]

Thread overview: 15+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-06-11  5:09 bug#31782: 26.1; dired-recursive-deletes broken Leo Liu
2018-06-11 14:33 ` Noam Postavsky
2018-06-11 17:23   ` Eli Zaretskii
2018-06-12 21:55     ` Noam Postavsky
2018-06-13  2:32       ` Eli Zaretskii
2018-06-14  4:15         ` Leo Liu
2018-06-14 13:05           ` Noam Postavsky
2018-06-14 13:26             ` Leo Liu
2018-06-15 11:24               ` Noam Postavsky
2018-07-31  1:39                 ` Noam Postavsky
2018-07-31 16:00                   ` Eli Zaretskii
2018-08-01  4:35                     ` Richard Stallman
2018-08-01  6:04                       ` Eli Zaretskii
2018-08-01 13:00                       ` Basil L. Contovounesios
2018-08-04 16:02                     ` Noam Postavsky

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).