>From fabee1c28f5a8fbfc41c2646478b8224f63fbfe8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Wed, 2 Oct 2019 22:04:01 +0200 Subject: [PATCH 5/5] Hide detailed explanations in a togglable help buffer * test/lisp/dired-aux-tests.el (dired-test-bug27496): (dired-test-highlight-metachar): Adapt to new prompt. * lisp/dired-aux.el (dired--no-subst-prompt): Split into... (dired--highlight-no-subst-chars): add warning face and possibly '^' markers to command, (dired--no-subst-explain): fill in help buffer with detailed explanations, (dired--no-subst-ask): setup read-char-from-minibuffer, (dired--no-subst-confirm): loop until we know what to do. (dired-do-shell-command): Call new function 'dired--no-subst-confirm.' (bug#28969, bug#35564) --- lisp/dired-aux.el | 101 ++++++++++++++++++++++++++--------- test/lisp/dired-aux-tests.el | 39 +++++++------- 2 files changed, 94 insertions(+), 46 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 038e1dbbed..20b056e9f1 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -110,27 +110,82 @@ dired--mark-positions (setf (aref markers pos) ?^)) markers)) -(defun dired--no-subst-prompt (char-positions command add-markers) +(defun dired--highlight-no-subst-chars (positions command mark) (cl-callf substring-no-properties command) - (dolist (pos char-positions) + (dolist (pos positions) (add-face-text-property pos (1+ pos) 'warning nil command)) - ;; `y-or-n-p' adds some text to the beginning of the prompt when the - ;; user fails to answer 'y' or 'n'. The highlighted command thus - ;; cannot be put on the first line of the prompt, since the added - ;; text will shove the command to the right, and the '^' markers - ;; will become misaligned. - (apply #'concat - `("Confirm:\n" - ,command "\n" - ,@(when add-markers - (list (dired--mark-positions char-positions) "\n")) - ,(format-message - (ngettext "Send %d occurrence of `%s' as-is to shell?" - "Send %d occurrences of `%s' as-is to shell?" - (length char-positions)) - (length char-positions) - (propertize (string (aref command (car char-positions))) - 'face 'warning))))) + (if mark + (concat command "\n" (dired--mark-positions positions)) + command)) + +(defun dired--no-subst-explain (buf char-positions command mark-positions) + (with-current-buffer buf + (erase-buffer) + (insert + (format-message "\ +If your command contains occurrences of `*' surrounded by +whitespace, `dired-do-shell-command' substitutes them for the +entire file list to process. Otherwise, if your command contains +occurrences of `?' surrounded by whitespace or `%s', Dired will +run the command once for each file, substituting `?' for each +file name. + +Your command contains occurrences of `%s' that will not be +substituted, and will be passed through normally to the shell. + +%s + +(Press ^ to %s markers below these occurrences.) +" + "`" + (string (aref command (car char-positions))) + (dired--highlight-no-subst-chars char-positions command mark-positions) + (if mark-positions "remove" "add"))))) + +(defun dired--no-subst-ask (char nb-occur details) + (let ((hilit-char (propertize (string char) 'face 'warning)) + (choices `(?y ?n ?? ,@(when details '(?^))))) + (read-char-from-minibuffer + (format-message + (ngettext + "%d occurrence of `%s' will not be substituted. Proceed? (%s) " + "%d occurrences of `%s' will not be substituted. Proceed? (%s) " + nb-occur) + nb-occur hilit-char (mapconcat #'string choices ", ")) + choices))) + +(defun dired--no-subst-confirm (char-positions command) + (let ((help-buf (get-buffer-create "*Dired help*")) + (char (aref command (car char-positions))) + (nb-occur (length char-positions)) + (done nil) + (details nil) + (markers nil) + proceed) + (unwind-protect + (save-window-excursion + (while (not done) + (cl-case (dired--no-subst-ask char nb-occur details) + (?y + (setq done t + proceed t)) + (?n + (setq done t + proceed nil)) + (?? + (if details + (progn + (quit-window nil details) + (setq details nil)) + (dired--no-subst-explain + help-buf char-positions command markers) + (setq details (display-buffer help-buf)))) + (?^ + (setq markers (not markers)) + (dired--no-subst-explain + help-buf char-positions command markers))))) + (kill-buffer help-buf)) + proceed)) ;;;###autoload (defun dired-diff (file &optional switches) @@ -813,19 +868,15 @@ dired-do-shell-command (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) (confirmations nil) - (short-enough (< (length command) - (window-width (minibuffer-window)))) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((setq confirmations (dired--need-confirm-positions command "*")) - (y-or-n-p (dired--no-subst-prompt confirmations command - short-enough))) + (dired--no-subst-confirm confirmations command)) ((setq confirmations (dired--need-confirm-positions command "?")) - (y-or-n-p (dired--no-subst-prompt confirmations command - short-enough))) + (dired--no-subst-confirm confirmations command)) (t)))) (cond ((not ok) (message "Command canceled")) (t diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index ba10c54332..64a8a035da 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -28,7 +28,7 @@ dired-test-bug27496 (let* ((foo (make-temp-file "foo")) (files (list foo))) (unwind-protect - (cl-letf (((symbol-function 'y-or-n-p) 'error)) + (cl-letf (((symbol-function 'read-char-from-minibuffer) 'error)) (dired temporary-file-directory) (dired-goto-file foo) ;; `dired-do-shell-command' returns nil on success. @@ -127,39 +127,36 @@ dired-test-highlight-metachar "Check that non-isolated meta-characters are highlighted." (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") (markers " ^ ^") - (prompt (dired--no-subst-prompt + (result (dired--highlight-no-subst-chars (dired--need-confirm-positions command "?") command t)) - (lines (split-string prompt "\n")) - (highlit-command (nth 1 lines))) - (should (= (length lines) 4)) - (should (string-match (regexp-quote command) highlit-command)) - (should (string-match (regexp-quote markers) (nth 2 lines))) - (dired-test--check-highlighting highlit-command '(15 29))) + (lines (split-string result "\n"))) + (should (= (length lines) 2)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (should (string-match (regexp-quote markers) (nth 1 lines))) + (dired-test--check-highlighting (nth 0 lines) '(15 29))) ;; Note that `?` is considered isolated, but `*` is not. (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") (markers " ^ ^") - (prompt (dired--no-subst-prompt + (result (dired--highlight-no-subst-chars (dired--need-confirm-positions command "*") command t)) - (lines (split-string prompt "\n")) - (highlit-command (nth 1 lines))) - (should (= (length lines) 4)) - (should (string-match (regexp-quote command) highlit-command)) - (should (string-match (regexp-quote markers) (nth 2 lines))) - (dired-test--check-highlighting highlit-command '(11 25))) + (lines (split-string result "\n"))) + (should (= (length lines) 2)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (should (string-match (regexp-quote markers) (nth 1 lines))) + (dired-test--check-highlighting (nth 0 lines) '(11 25))) (let* ((command "sed 's/\\?/!/'") - (prompt (dired--no-subst-prompt + (result (dired--highlight-no-subst-chars (dired--need-confirm-positions command "?") command nil)) - (lines (split-string prompt "\n")) - (highlit-command (nth 1 lines))) - (should (= (length lines) 3)) - (should (string-match (regexp-quote command) highlit-command)) - (dired-test--check-highlighting highlit-command '(8)))) + (lines (split-string result "\n"))) + (should (= (length lines) 1)) + (should (string-match (regexp-quote command) (nth 0 lines))) + (dired-test--check-highlighting (nth 0 lines) '(8)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.24.0