* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters @ 2019-05-04 18:01 Kévin Le Gouguec 2019-05-05 8:44 ` martin rudalics 2019-06-09 11:08 ` bug#35564: [PATCH v2] Tweak dired " Kévin Le Gouguec 0 siblings, 2 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-05-04 18:01 UTC (permalink / raw) To: 35564 [-- Attachment #1: Type: text/plain, Size: 2418 bytes --] Hello, The function dired-do-shell-command checks the user's command for any star or question mark not surrounded by whitespace or backquotes, asking whether they are deliberate, since the character will then be sent as-is to the shell, instead of being replaced with the marked file(s). A silly example: - Open a Dired buffer - M-! echo "Foobar." > foo RET - g - with point on foo: - ! sed 's/\./?/' RET The way the question is phrased bothers me: > Confirm--do you mean to use `?' as a wildcard? The first time I met this prompt was when I included a quoted '?' in my command as in the example above, so I definitely did *not* mean to use '?' as a shell wildcard. Even now, knowing what the question really means, it still trips my brain that I must answer "yes" (as in, "yes, I know Dired will not substitute the marked files") when I mean "no" (as in, "no, I don't mean to use '?' as a wildcard, what is this even ab- oh wait no right I meant yes! Yes! 🤦"). I can think of a few ways to solve this: 1. Rephrase the question to be more general, specifically without calling the characters "wildcards"; for example: > Confirm--do you mean to send `?' to the shell without substitution? 2. Parse the command to find out whether the shell will actually use these characters as wildcards. - not sure how portable this would be across different shells - AFAICT the aim of this prompt is simply to warn the user that Dired will not expand these characters; whether the shell will process them as wildcards is irrelevant 3. Add an option to skip this question (more of a workaround than a solution). Favoring option #1, I tried to find alternative questions, but none of the ones I came up with sounded satisfying (most of them included some form of double-negation, which is not the kind of puzzle I want to solve when I'm about to run a hastily-put-together Bash oneliner). I played around with the idea of actually *showing* the "unsubstituted" characters to the user in order to be able to say something like… > Confirm--the highlighted characters will not be substituted. > Proceed? … and ended up with the attached patch, which I am not entirely satisfied with (for one, it replaces `y-or-n-p' with `yes-or-no-p' merely because the former seems to strip my prompt's text attributes somehow[1]). [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Make-dired-do-shell-command-highlight-unsubstituted-.patch --] [-- Type: text/x-diff, Size: 5556 bytes --] From f1d6df845909fd8a6fb0500984fd305d6cf6d6fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Sat, 4 May 2019 18:45:43 +0200 Subject: [PATCH] Make dired-do-shell-command highlight unsubstituted characters Stop calling them "wildcards", since they may be quoted, backslash-escaped, etc. NB: y-or-n-p has been changed to yes-or-no-p since the former makes the highlighting disappear, for some reason. * lisp/dired-aux.el (dired--isolated-char-p): (dired--highlight-nosubst-char): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el: Test new functions. --- lisp/dired-aux.el | 49 +++++++++++++++++++++++++++++++++--- test/lisp/dired-aux-tests.el | 27 ++++++++++++++++++++ 2 files changed, 72 insertions(+), 4 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index b81c0d1a4f..2b302e608b 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,49 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((n (length command)) + (whitespace '(?\s ?\t))) + (or (= n 1) + (and (= pos 0) + (memq (elt command 1) whitespace)) + (and (= pos (1- n)) + (memq (elt command (1- pos)) whitespace)) + (and + (> pos 0) + (< pos (1- n)) + (let ((prev (elt command (1- pos))) + (next (elt command (1+ pos)))) + (or (and (memq prev whitespace) + (memq next whitespace)) + (and (= prev ?`) + (= next ?`)))))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted. Proceed?")) + (format-message "%s\n%s " highlighted-command prompt))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -757,11 +800,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (yes-or-no-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (yes-or-no-p (dired--no-subst-prompt 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 ccd3192792..77a4232aac 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,33 @@ with-dired-bug28834-test (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Attachment #3: Type: text/plain, Size: 6502 bytes --] WDYT? Assuming that Dired calling unsubstituted characters "wildcards" is indeed a problem, - can someone come up with a better phrasing? - is the highlighting, as implemented in this patch, helpful? - does anybody know why `y-or-n-p' prompts lose their face property? Thank you for your time. Kévin [1] Compare: (let ((prompt "foobar ")) (add-face-text-property 3 6 'warning nil prompt) (yes-or-no-p prompt)) With: (let ((prompt "foobar ")) (add-face-text-property 3 6 'warning nil prompt) (y-or-n-p prompt)) In GNU Emacs 27.0.50 (build 2, i686-pc-linux-gnu, GTK+ Version 3.22.11) of 2019-05-02 built on nc10-laptop Repository revision: 17a722982cca4e8e643c7a9102903e820e784cc6 Repository branch: master Windowing system distributor 'The X.Org Foundation', version 11.0.11902000 System Description: BunsenLabs GNU/Linux 9.8 (Helium) Recent messages: Mark saved where search started Mark set Mark saved where search started Mark set Making completion list... Quit [3 times] Mark set Quit [2 times] Type "q" in help window to restore its previous buffer, C-M-v to scroll help. Quit Quit Configured using: 'configure --with-xwidgets' Configured features: XPM JPEG TIFF GIF PNG RSVG IMAGEMAGICK SOUND GPM DBUS GSETTINGS GLIB NOTIFY INOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS GTK3 X11 XDBE XIM THREADS XWIDGETS JSON PDUMPER LCMS2 GMP Important settings: value of $LANG: en_US.UTF-8 locale-coding-system: utf-8-unix Major mode: Emacs-Lisp Minor modes in effect: global-magit-file-mode: t magit-file-mode: t magit-auto-revert-mode: t auto-revert-mode: t global-git-commit-mode: t async-bytecomp-package-mode: t shell-dirtrack-mode: t show-paren-mode: t minibuffer-depth-indicate-mode: t icomplete-mode: t global-page-break-lines-mode: t page-break-lines-mode: t electric-pair-mode: t diff-hl-flydiff-mode: t global-diff-hl-mode: t diff-hl-mode: t delete-selection-mode: t tooltip-mode: t global-eldoc-mode: t eldoc-mode: t electric-indent-mode: t mouse-wheel-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t column-number-mode: t line-number-mode: t transient-mark-mode: t Load-path shadows: None found. Features: (shadow sort emacsbug sendmail nndoc gnus-dup mm-archive url-cache debbugs-gnu debbugs soap-client url-http url-auth url-gw url url-proxy url-privacy url-expand url-methods url-history url-cookie url-domsuf url-util warnings rng-xsd rng-dt rng-util xsd-regexp xml tabify man mail-extr ffap pulse diff-hl-dired magit-patch flyspell ispell dired-aux dired-x magit-extras hi-lock cc-mode cc-fonts cc-guess cc-menus cc-cmds cc-styles cc-align cc-engine cc-vars cc-defs cus-edit whitespace find-dired xref magit-submodule magit-obsolete magit-blame magit-stash magit-reflog magit-bisect magit-push magit-pull magit-fetch magit-clone magit-remote magit-commit magit-sequence magit-notes magit-worktree magit-tag magit-merge magit-branch magit-reset magit-files magit-refs magit-status magit magit-repos magit-apply magit-wip magit-log which-func imenu magit-diff smerge-mode magit-core magit-autorevert autorevert filenotify magit-margin magit-transient magit-process magit-mode transient git-commit magit-git magit-section log-edit pcvs-util add-log with-editor async-bytecomp async server face-remap eieio-opt speedbar sb-image ezimage dframe magit-utils crm dash shell pcomplete ert pp gnus-async qp gnus-ml nndraft nnmh nnfolder utf-7 epa-file gnutls network-stream nsm gnus-agent gnus-srvr gnus-score score-mode nnvirtual gnus-msg gnus-art mm-uu mml2015 mm-view mml-smime smime dig mailcap nntp gnus-cache gnus-sum gnus-group gnus-undo gnus-start gnus-cloud nnimap nnmail mail-source utf7 netrc nnoo parse-time gnus-spec gnus-int gnus-range message rmc puny dired dired-loaddefs format-spec rfc822 mml mml-sec epa derived epg mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader gnus-win gnus nnheader gnus-util rmail rmail-loaddefs rfc2047 rfc2045 ietf-drums text-property-search time-date mail-utils mm-util mail-prsvr wid-edit markdown-mode rx color noutline outline vc-mtn vc-hg jka-compr cl-print debug backtrace find-func thingatpt help-fns radix-tree executable misearch multi-isearch vc-git vc-bzr vc-src vc-sccs vc-svn vc-cvs vc-rcs project delight advice eighters-theme quail cl-extra help-mode rg rg-ibuffer rg-result wgrep-rg wgrep s rg-history rg-header rg-compat ibuf-ext ibuffer ibuffer-loaddefs grep compile comint ansi-color ring edmacro kmacro disp-table paren mb-depth icomplete page-break-lines elec-pair diff-hl-flydiff diff diff-hl vc-dir ewoc vc vc-dispatcher diff-mode easy-mmode delsel cus-start cus-load mule-util tex-site info package easymenu epg-config url-handlers url-parse auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs password-cache json subr-x map url-vars seq byte-opt gv bytecomp byte-compile cconv cl-loaddefs cl-lib tooltip eldoc electric uniquify ediff-hook vc-hooks lisp-float-type mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe tabulated-list replace newcomment text-mode elisp-mode lisp-mode prog-mode register page menu-bar rfn-eshadow isearch timer select scroll-bar mouse jit-lock font-lock syntax facemenu font-core term/tty-colors frame cl-generic cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese composite charscript charprop case-table epa-hook jka-cmpr-hook help simple abbrev obarray minibuffer cl-preloaded nadvice loaddefs button faces cus-face macroexp files text-properties overlay sha1 md5 base64 format env code-pages mule custom widget hashtable-print-readable backquote threads dbusbind inotify lcms2 dynamic-setting system-font-setting font-render-setting xwidget-internal move-toolbar gtk x-toolkit x multi-tty make-network-process emacs) Memory information: ((conses 8 708714 111581) (symbols 24 31862 1) (strings 16 136515 44484) (string-bytes 1 4039230) (vectors 8 60958) (vector-slots 4 1347636 61628) (floats 8 3359 1168) (intervals 28 69005 689) (buffers 564 56)) ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-04 18:01 bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters Kévin Le Gouguec @ 2019-05-05 8:44 ` martin rudalics 2019-05-06 19:40 ` Kévin Le Gouguec 2019-06-09 11:08 ` bug#35564: [PATCH v2] Tweak dired " Kévin Le Gouguec 1 sibling, 1 reply; 76+ messages in thread From: martin rudalics @ 2019-05-05 8:44 UTC (permalink / raw) To: Kévin Le Gouguec, 35564 > … and ended up with the attached patch, which I am not entirely > satisfied with (for one, it replaces `y-or-n-p' with `yes-or-no-p' > merely because the former seems to strip my prompt's text attributes > somehow[1]). [...] > [1] Compare: > > (let ((prompt "foobar ")) > (add-face-text-property 3 6 'warning nil prompt) > (yes-or-no-p prompt)) > > With: > > (let ((prompt "foobar ")) > (add-face-text-property 3 6 'warning nil prompt) > (y-or-n-p prompt)) 'y-or-n-p' propertizes the prompt rigidly as (read-key (propertize (if (memq answer scroll-actions) prompt (concat "Please answer y or n. " prompt)) 'face 'minibuffer-prompt))))) while 'yes-or-no-p' carefully applies 'minibuffer-prompt-properties' to any text properties provided with PROMPT. martin ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-05 8:44 ` martin rudalics @ 2019-05-06 19:40 ` Kévin Le Gouguec 2019-05-07 8:15 ` martin rudalics 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-05-06 19:40 UTC (permalink / raw) To: martin rudalics; +Cc: 35564 [-- Attachment #1: Type: text/plain, Size: 2917 bytes --] martin rudalics <rudalics@gmx.at> writes: >> [1] Compare: >> >> (let ((prompt "foobar ")) >> (add-face-text-property 3 6 'warning nil prompt) >> (yes-or-no-p prompt)) >> >> With: >> >> (let ((prompt "foobar ")) >> (add-face-text-property 3 6 'warning nil prompt) >> (y-or-n-p prompt)) > > 'y-or-n-p' propertizes the prompt rigidly as > > (read-key (propertize (if (memq answer scroll-actions) > prompt > (concat "Please answer y or n. " > prompt)) > 'face 'minibuffer-prompt))))) > > while 'yes-or-no-p' carefully applies 'minibuffer-prompt-properties' > to any text properties provided with PROMPT. Well, that's interesting. I dug into yes-or-no-p until I came across `read_minibuf()'; is this the code you are referring to? if (PT > BEG) { Fput_text_property (make_fixnum (BEG), make_fixnum (PT), Qfront_sticky, Qt, Qnil); Fput_text_property (make_fixnum (BEG), make_fixnum (PT), Qrear_nonsticky, Qt, Qnil); Fput_text_property (make_fixnum (BEG), make_fixnum (PT), Qfield, Qt, Qnil); if (CONSP (Vminibuffer_prompt_properties)) { /* We want to apply all properties from `minibuffer-prompt-properties' to the region normally, but if the `face' property is present, add that property to the end of the face properties to avoid overwriting faces. */ Lisp_Object list = Vminibuffer_prompt_properties; while (CONSP (list)) { Lisp_Object key = XCAR (list); list = XCDR (list); if (CONSP (list)) { Lisp_Object val = XCAR (list); list = XCDR (list); if (EQ (key, Qface)) Fadd_face_text_property (make_fixnum (BEG), make_fixnum (PT), val, Qt, Qnil); else Fput_text_property (make_fixnum (BEG), make_fixnum (PT), key, val, Qnil); } } } } If one were to fix the issue of y-or-n-p hardcoding the face property, what would be the best way to go? 1. Make a C DEFUN out of this snippet, and have it called by `read_minibuf()' and `y-or-n-p'. 2. Re-implement this snippet as an Elisp defun, and have it called by `read_minibuf()' and `y-or-n-p'. 3. (Re-implement this snippet within `y-or-n-p'.) (FWIW, the attached patch seems to work as a workaround, but I assume solutions 1 or 2 would be better, by virtue of reusing code) [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Make-y-or-no-p-keep-the-supplied-prompt-s-face.patch --] [-- Type: text/x-patch, Size: 1735 bytes --] From 9ea712779d725a23fe8f4acd7b934b0a64a1f1ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Mon, 6 May 2019 21:26:37 +0200 Subject: [PATCH] Make y-or-no-p keep the supplied prompt's face * lisp/subr.el (y-or-n-p): append the minibuffer-prompt face instead of overwriting the prompt's face property. --- lisp/subr.el | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index f68f9dd419..8d224ff5bb 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2647,11 +2647,15 @@ y-or-n-p (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. " - prompt)) - 'face 'minibuffer-prompt))))) + (read-key + (let ((prompt-maybe-please + (if (memq answer scroll-actions) + prompt + (concat "Please answer y or n. " prompt)))) + (add-face-text-property + 0 (1- (length prompt-maybe-please)) + 'minibuffer-prompt t prompt-maybe-please) + prompt-maybe-please))))) (setq answer (lookup-key query-replace-map (vector key) t)) (cond ((memq answer '(skip act)) nil) -- 2.21.0 [-- Attachment #3: Type: text/plain, Size: 37 bytes --] Thanks for your help! Kévin ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-06 19:40 ` Kévin Le Gouguec @ 2019-05-07 8:15 ` martin rudalics 2019-05-07 13:19 ` Drew Adams 0 siblings, 1 reply; 76+ messages in thread From: martin rudalics @ 2019-05-07 8:15 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564 > I dug into yes-or-no-p until I came across `read_minibuf()'; is this the > code you are referring to? It is. > If one were to fix the issue of y-or-n-p hardcoding the face property, > what would be the best way to go? > > 1. Make a C DEFUN out of this snippet, and have it called by > `read_minibuf()' and `y-or-n-p'. > > 2. Re-implement this snippet as an Elisp defun, and have it called by > `read_minibuf()' and `y-or-n-p'. > > 3. (Re-implement this snippet within `y-or-n-p'.) > > (FWIW, the attached patch seems to work as a workaround, but I assume > solutions 1 or 2 would be better, by virtue of reusing code) By design, 'yes-or-no-p' and 'y-or-n-p' are kept apart to avoid that people use the latter for more "crucial decisions". Part of this distinction is that 'y-or-n-p' is asked in the echo area, so applying 'minibuffer-prompt-properties' would be conceptually inappropriate. Obviously, applying 'minibuffer-prompt' is just as inappropriate (that face is part of 'minibuffer-prompt-properties') but that's a decision that has been made long ago. So although I'd vote for a solution like the one you propose in your patch, any decision in this area is subtle and should be approved by others first. Also because we'd then have to decide what to do with other clients of the 'minibuffer-prompt' face like 'read-char-choice' or the ones in isearch.el. martin ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-07 8:15 ` martin rudalics @ 2019-05-07 13:19 ` Drew Adams 2019-05-08 20:42 ` Kévin Le Gouguec 0 siblings, 1 reply; 76+ messages in thread From: Drew Adams @ 2019-05-07 13:19 UTC (permalink / raw) To: martin rudalics, Kévin Le Gouguec; +Cc: 35564 > By design, 'yes-or-no-p' and 'y-or-n-p' are kept apart to avoid that > people use the latter for more "crucial decisions". Part of this > distinction is that 'y-or-n-p' is asked in the echo area, so applying > 'minibuffer-prompt-properties' would be conceptually inappropriate. > Obviously, applying 'minibuffer-prompt' is just as inappropriate (that > face is part of 'minibuffer-prompt-properties') but that's a decision > that has been made long ago. > > So although I'd vote for a solution like the one you propose in your > patch, any decision in this area is subtle and should be approved by > others first. Also because we'd then have to decide what to do with > other clients of the 'minibuffer-prompt' face like 'read-char-choice' > or the ones in isearch.el. I don't see any good reason why face `minibuffer-prompt' should be used, especially by default (users can do whatever they like) for situations where there is no active minibuffer, i.e., for prompting situations generally. It should instead serve as a useful clue that the minibuffer is being used. (Just one opinion.) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-07 13:19 ` Drew Adams @ 2019-05-08 20:42 ` Kévin Le Gouguec 2019-05-08 22:39 ` Drew Adams 2019-05-09 8:13 ` martin rudalics 0 siblings, 2 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-05-08 20:42 UTC (permalink / raw) To: Drew Adams, martin rudalics; +Cc: 35564 Drew Adams <drew.adams@oracle.com> writes: > I don't see any good reason why face `minibuffer-prompt' > should be used, especially by default (users can do > whatever they like) for situations where there is no > active minibuffer, i.e., for prompting situations > generally. It should instead serve as a useful clue > that the minibuffer is being used. (Just one opinion.) I'd hazard a guess[1] that this was done to make y-or-n-p and yes-or-no-p similar from a UI point of view: they both prompt the user for a binary answer, therefore the prompt might as well look the same in both situations. From what I can tell the use of 'minibuffer-prompt' in minibuffer-less situations has enough precedents (the "other clients" Martin mentions) that the "minibuffer-" prefix might be considered a historical accident by now… (Perhaps those clients could be migrated to a new face, e.g. 'message-prompt', which would inherit 'minibuffer-prompt' by default?) martin rudalics <rudalics@gmx.at> writes: > So although I'd vote for a solution like the one you propose in your > patch, any decision in this area is subtle and should be approved by > others first. Also because we'd then have to decide what to do with > other clients of the 'minibuffer-prompt' face like 'read-char-choice' > or the ones in isearch.el. Fair enough. Should I raise the issue on emacs-devel, or create a new bug report? Just to make sure I am not omitting something, is this how you would sum up the issue? - In the context of bug#35564, I would like to add text properties to the y-or-n-p prompt (although I'm open to other, simpler solutions e.g. simply changing Dired's message). - While this can be patched within y-or-n-p and we can call it a day, the minibuffer-prompt-face-adding code could be factored out of 'read_minibuf'. - This raises two questions: 1. Do we actually want to use the 'minibuffer-prompt' face in this context, since the minibuffer is not involved? 2. What do we do with other clients of 'minibuffer-prompt', which use the same (propertize prompt 'face 'minibuffer-prompt) idiom? Thank you both for your thoughts on this. [1] AFAICT, the commit that added this face (927be33, back when y-or-n-p was still a C function) does not say why this was thought to be a good idea. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-08 20:42 ` Kévin Le Gouguec @ 2019-05-08 22:39 ` Drew Adams 2019-05-09 8:13 ` martin rudalics 1 sibling, 0 replies; 76+ messages in thread From: Drew Adams @ 2019-05-08 22:39 UTC (permalink / raw) To: Kévin Le Gouguec, martin rudalics; +Cc: 35564 > Drew Adams <drew.adams@oracle.com> writes: > > > I don't see any good reason why face `minibuffer-prompt' > > should be used, especially by default (users can do > > whatever they like) for situations where there is no > > active minibuffer, i.e., for prompting situations > > generally. It should instead serve as a useful clue > > that the minibuffer is being used. (Just one opinion.) > > I'd hazard a guess[1] that this was done to make y-or-n-p and > yes-or-no-p similar from a UI point of view: they both prompt the user > for a binary answer, therefore the prompt might as well look the same in > both situations. > > From what I can tell the use of 'minibuffer-prompt' in minibuffer-less > situations has enough precedents (the "other clients" Martin mentions) > that the "minibuffer-" prefix might be considered a historical accident > by now… Not an accident. The "precedents" are themselves bugs, IMO. The minibuffer is the minibuffer. It's important that users be aware when it is active. That may not matter much for `yes-or-no-p', as it insists on "yes" or "no". But it is important for the minibuffer in general. The minibuffer is an editing buffer; you can do lots of things in it and with it. > (Perhaps those clients could be migrated to a new face, > e.g. 'message-prompt', which would inherit 'minibuffer-prompt' by > default?) That would be fine by me. Or no face. Is it really important that the prompt be distinguished by a face? (To be clear, I have no objection to our using faces for prompts.) > - In the context of bug#35564, I would like to add text properties to > the y-or-n-p prompt (although I'm open to other, simpler solutions > e.g. simply changing Dired's message). I wouldn't mention bug #35564. And that bug should not, itself, also deal with prompt faces. It should be only about `dired-do-shell-command' warning about wildcard characters. Any question (for this command or in general) about prompt faces is independent of this bug report about the `dired-do-shell-command' treatment of wildcards. (Just one opinion.) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-08 20:42 ` Kévin Le Gouguec 2019-05-08 22:39 ` Drew Adams @ 2019-05-09 8:13 ` martin rudalics 2019-05-09 14:17 ` Drew Adams 1 sibling, 1 reply; 76+ messages in thread From: martin rudalics @ 2019-05-09 8:13 UTC (permalink / raw) To: Kévin Le Gouguec, Drew Adams; +Cc: 35564 > (Perhaps those clients could be migrated to a new face, > e.g. 'message-prompt', which would inherit 'minibuffer-prompt' by > default?) Simply 'prompt' would be more intuitive since most messages do not show prompts. But I'm afraid we'll have to stick to what we have now. > Fair enough. Should I raise the issue on emacs-devel, or create a new > bug report? Just to make sure I am not omitting something, is this how > you would sum up the issue? > > - In the context of bug#35564, I would like to add text properties to > the y-or-n-p prompt (although I'm open to other, simpler solutions > e.g. simply changing Dired's message). > > - While this can be patched within y-or-n-p and we can call it a day, > the minibuffer-prompt-face-adding code could be factored out of > 'read_minibuf'. > > - This raises two questions: > > 1. Do we actually want to use the 'minibuffer-prompt' face in this > context, since the minibuffer is not involved? > > 2. What do we do with other clients of 'minibuffer-prompt', which > use the same (propertize prompt 'face 'minibuffer-prompt) idiom? That would sum it up (but since I don't use Dired I can't comment on that). Note that this isssue also touches one Drew raised elsewhere - whether 'tooltip-show' should retain face properties of the original text or show text uniformly with the 'tooltip' face. Maybe we should introduce an option like 'prompts-retain-text-properites' so users have the choice. > [1] AFAICT, the commit that added this face (927be33, back when y-or-n-p > was still a C function) does not say why this was thought to be a > good idea. It's probably part of a concept to have prompts appear uniformly and integrate them into the framework of themes. Note that Emacs usually cannot control the appearance of dialog boxes or system tooltips. martin ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-09 8:13 ` martin rudalics @ 2019-05-09 14:17 ` Drew Adams 2019-05-09 17:51 ` martin rudalics 0 siblings, 1 reply; 76+ messages in thread From: Drew Adams @ 2019-05-09 14:17 UTC (permalink / raw) To: martin rudalics, Kévin Le Gouguec; +Cc: 35564 > > (Perhaps those clients could be migrated to a new face, > > e.g. 'message-prompt', which would inherit 'minibuffer-prompt' by > > default?) > > Simply 'prompt' would be more intuitive since most messages do not show > prompts. Sounds OK to me. > But I'm afraid we'll have to stick to what we have now. Why? Not sure what you mean. > Note that this isssue also touches one Drew raised elsewhere - whether > 'tooltip-show' should retain face properties of the original text or > show text uniformly with the 'tooltip' face. Maybe we should > introduce an option like 'prompts-retain-text-properites' so users > have the choice. I would prefer that the two be separated. Tooltip text is quite different from prompts in use cases and behavior. Wrt tooltips, I also don't see why we need an option, or even a defvar. Tooltips should just accept and respect propertized strings. When you use `x-show-tip' there is no such problem - you can apply properties as usual. It is only `help-echo' tooltips that do not respect properties (AFAIK). Another, simpler possibility, for dealing with face `tooltip': It is not possible to simply _bind_ a face for the duration (or lex scope) of a function. But if we use a face variable for this, e.g. `tooltip-face', then it should be simple to do so. IOW, work around the limitation that you cannot bind a face by binding a face variable and using that for `help-echo'. That should make it simple for any code to control the appearance of the tooltip text. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-09 14:17 ` Drew Adams @ 2019-05-09 17:51 ` martin rudalics 2019-05-09 20:04 ` Drew Adams 0 siblings, 1 reply; 76+ messages in thread From: martin rudalics @ 2019-05-09 17:51 UTC (permalink / raw) To: Drew Adams, Kévin Le Gouguec; +Cc: 35564 >> But I'm afraid we'll have to stick to what we have now. > > Why? Not sure what you mean. I mean that it won't be easy to convince others that we need a new face for propertizing prompts. > I would prefer that the two be separated. Tooltip text > is quite different from prompts in use cases and behavior. They are similar in the following aspect: Both prompts and tooltips are often displayed using toolkit functions. GTK tooltips are by default not propertized because the system doesn't accept any face properties for them. If Emacs used balloon tooltips on Windows, propertizing them would not be possible either. And both 'y-or-n-p' and 'yes-or-no-p', when implemented via dialog popups, don't adopt our text properties either. The question is now whether an application should accept the uniform appearance of such objects as prescribed by the toolkit used and as such obey the toolkit's look-and-feel or insist to use its own implementations. Emacs leaves that choice to its users. Which means that users are told things like "if you want this mode to behave as intended, you have to customize variables like 'use-dialog-box' or 'x-gtk-use-system-tooltips'". Nothing bad with that, but some users might be uncertain whether they should agree. In particular when such an option affects all sorts of tooltips or prompts. martin ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters 2019-05-09 17:51 ` martin rudalics @ 2019-05-09 20:04 ` Drew Adams 0 siblings, 0 replies; 76+ messages in thread From: Drew Adams @ 2019-05-09 20:04 UTC (permalink / raw) To: martin rudalics, Kévin Le Gouguec; +Cc: 35564 > >> But I'm afraid we'll have to stick to what we have now. > > > > Why? Not sure what you mean. > > I mean that it won't be easy to convince others that we need a new > face for propertizing prompts. Why assume that? Who needs to be convinced? If we can't have a new face for this then I'd like to see non-minibuffer prompting have no face at all, by default. > > I would prefer that the two be separated. Tooltip text > > is quite different from prompts in use cases and behavior. > > They are similar in the following aspect: Both prompts and tooltips > are often displayed using toolkit functions. That sounds like an implementation thing, not a user-level thing. And as I said, `x-show-tooltip' has no problem with showing propertized text. > GTK tooltips are by > default not propertized because the system doesn't accept any face > properties for them. If Emacs used balloon tooltips on Windows, > propertizing them would not be possible either. And both 'y-or-n-p' > and 'yes-or-no-p', when implemented via dialog popups, don't adopt our > text properties either. Oh, so `x-show-tooltip' only supports properties on some platforms (e.g. MS Windows)? If so, that's unfortunate. Yes, I don't expect window-dialogs to respect propertized text. Again, unfortunate - but livable. > The question is now whether an application should accept the uniform > appearance of such objects as prescribed by the toolkit used and as > such obey the toolkit's look-and-feel or insist to use its own > implementations. Emacs leaves that choice to its users. Which means > that users are told things like "if you want this mode to behave as > intended, you have to customize variables like 'use-dialog-box' or > 'x-gtk-use-system-tooltips'". Nothing bad with that, but some users > might be uncertain whether they should agree. In particular when such > an option affects all sorts of tooltips or prompts. Got it; thx. I would like to see Emacs allow, when possible, Emacsy things as much as possible. But I can understand that there can be some tradeoffs. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v2] Tweak dired warning about "wildcard" characters 2019-05-04 18:01 bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters Kévin Le Gouguec 2019-05-05 8:44 ` martin rudalics @ 2019-06-09 11:08 ` Kévin Le Gouguec 2019-06-12 12:23 ` Noam Postavsky 2019-06-26 6:16 ` bug#35564: [PATCH v3] " Kévin Le Gouguec 1 sibling, 2 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-06-09 11:08 UTC (permalink / raw) To: 35564; +Cc: Stefan Monnier [-- Attachment #1: Type: text/plain, Size: 866 bytes --] Hello, Here is my second attempt at solving this issue. To recap: dired-do-shell-command warns the user about non-isolated '*' and '?' characters since the function will not substitute them. It refers to these characters as "wildcards", which can be incorrect: they may be quoted or backslash-escaped, in which case the shell will not interpret them as wildcards. My main motivation to change this warning is that it trips my brain to have to answer "yes" ("yes, I want to use wildcards") when no wildcards are involved. I could not come up with a simple, self-sufficient rephrasing for the warning, so I decided to display the command itself as part of the warning prompt, highlighting the non-isolated characters. The first patch adjusts y-or-n-p so that it preserves the prompt's text properties. The second patch changes dired-do-shell-command's prompt. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Preserve-text-properties-in-y-or-n-p-prompts.patch --] [-- Type: text/x-diff, Size: 2096 bytes --] From 1719809f75183dcc743f2bdf697c919ae859b82f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:03:59 +0200 Subject: [PATCH 1/2] Preserve text properties in y-or-n-p prompts * lisp/subr.el (read--propertize-prompt): New function to append the prompt face to a string. (y-or-n-p): Use it instead of discarding potential text properties. --- lisp/subr.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index fd60ec87cc..1fcadc291c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2334,6 +2334,9 @@ memory-limit \f ;;;; Input and display facilities. +(defun read--propertize-prompt (prompt) + (add-face-text-property 0 (length prompt) 'minibuffer-prompt t prompt)) + (defconst read-key-empty-map (make-sparse-keymap)) (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. @@ -2671,14 +2674,14 @@ y-or-n-p (let* ((scroll-actions '(recenter scroll-up scroll-down scroll-other-window scroll-other-window-down)) (key - (let ((cursor-in-echo-area t)) + (let ((cursor-in-echo-area t) + (prompt (if (memq answer scroll-actions) + prompt + (concat "Please answer y or n. " prompt)))) (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. " - prompt)) - 'face 'minibuffer-prompt))))) + (read--propertize-prompt prompt) + (read-key prompt)))) (setq answer (lookup-key query-replace-map (vector key) t)) (cond ((memq answer '(skip act)) nil) -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-diff, Size: 5681 bytes --] From 69b8dfc60f8aca1a6f5358af6fdf60ce3c910cfc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:19:44 +0200 Subject: [PATCH 2/2] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired--isolated-char-p) (dired--highlight-nosubst-char, dired--no-subst-prompt): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p) (dired-test-highlight-metachar): Test the new functions. --- lisp/dired-aux.el | 49 +++++++++++++++++++++++++++++++++--- test/lisp/dired-aux-tests.el | 27 ++++++++++++++++++++ 2 files changed, 72 insertions(+), 4 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 51749acb21..dfb793324f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,49 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((n (length command)) + (whitespace '(?\s ?\t))) + (or (= n 1) + (and (= pos 0) + (memq (elt command 1) whitespace)) + (and (= pos (1- n)) + (memq (elt command (1- pos)) whitespace)) + (and + (> pos 0) + (< pos (1- n)) + (let ((prev (elt command (1- pos))) + (next (elt command (1+ pos)))) + (or (and (memq prev whitespace) + (memq next whitespace)) + (and (= prev ?`) + (= next ?`)))))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted:")) + (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -759,11 +802,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt 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 ccd3192792..77a4232aac 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,33 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Attachment #4: Type: text/plain, Size: 21 bytes --] Sample screenshot: [-- Attachment #5: dired-warning-highlight.png --] [-- Type: image/png, Size: 5823 bytes --] [-- Attachment #6: Type: text/plain, Size: 965 bytes --] I am not sure these patches should be applied as-is. Some things I wonder about: 1. About read--propertize-prompt… 1. Should the function return a copy of its argument instead of propertizing it directly? 2. Is it properly named? Does it fit in subr.el? I placed it there because I figured other users of read-char in subr.el could use it, e.g. read-char-choice. 2. dired-aux.el already contains some logic to detect isolated characters; I could not think of a way to re-use it, so I added my own functions to find *non*-isolated characters. I added unit tests for these new functions; still, there may be some redundancy there. WDYT? PS1: I am still absolutely open to simply rephrasing the prompt… I just cannot come up with good alternatives. PS2: CC'ing Stefan to follow up on the discussion on emacs-devel. <https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00339.html> ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v2] Tweak dired warning about "wildcard" characters 2019-06-09 11:08 ` bug#35564: [PATCH v2] Tweak dired " Kévin Le Gouguec @ 2019-06-12 12:23 ` Noam Postavsky 2019-06-12 14:29 ` Stefan Monnier 2019-06-13 6:19 ` Kévin Le Gouguec 2019-06-26 6:16 ` bug#35564: [PATCH v3] " Kévin Le Gouguec 1 sibling, 2 replies; 76+ messages in thread From: Noam Postavsky @ 2019-06-12 12:23 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, Stefan Monnier Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > +(defun dired--isolated-char-p (command pos) > + "Assert whether the character at POS is isolated within COMMAND. > +A character is isolated if: > +- it is surrounded by whitespace, the start of the command, or > + the end of the command, > +- it is surrounded by `\\=`' characters." > + (let ((n (length command)) > + (whitespace '(?\s ?\t))) > + (or (= n 1) > + (and (= pos 0) > + (memq (elt command 1) whitespace)) > + (and (= pos (1- n)) > + (memq (elt command (1- pos)) whitespace)) > + (and > + (> pos 0) > + (< pos (1- n)) > + (let ((prev (elt command (1- pos))) > + (next (elt command (1+ pos)))) > + (or (and (memq prev whitespace) > + (memq next whitespace)) > + (and (= prev ?`) > + (= next ?`)))))))) I think this might be better expressed in regexp: (and (string-match (rx-to-string '(seq (or bos (in blank ?`)) (group (eval (string (aref command pos)))) (or eos (in blank ?`)))) command (max 0 (1- pos))) (= pos (match-beginning 1))) Although this gives different results for things like: (dired--isolated-char-p "?`foo`" 0) Do we care about that? (if yes, then that's a missing test case) > +(defun dired--highlight-nosubst-char (command char) > + "Highlight occurences of CHAR that are not isolated in COMMAND. > +These occurences will not be substituted; they will be sent as-is > +to the shell, which may interpret them as wildcards." > + (save-match-data > + (let ((highlighted (substring-no-properties command)) > + (pos 0)) > + (while (string-match (regexp-quote char) command pos) > + (let ((start (match-beginning 0)) > + (end (match-end 0))) > + (unless (dired--isolated-char-p command start) > + (add-face-text-property start end 'warning nil highlighted)) > + (setq pos end))) > + highlighted))) And perhaps the regexp above (if it's correct) can be integrated into this search? (maybe not though, since negation isn't straightforward in regexps) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v2] Tweak dired warning about "wildcard" characters 2019-06-12 12:23 ` Noam Postavsky @ 2019-06-12 14:29 ` Stefan Monnier 2019-06-13 6:19 ` Kévin Le Gouguec 1 sibling, 0 replies; 76+ messages in thread From: Stefan Monnier @ 2019-06-12 14:29 UTC (permalink / raw) To: Noam Postavsky; +Cc: 35564, Kévin Le Gouguec > (rx-to-string '(seq (or bos (in blank ?`)) > (group (eval (string (aref command pos)))) > (or eos (in blank ?`)))) Can't we use `(... ,.. ..) instead of `eval`? Stefan ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v2] Tweak dired warning about "wildcard" characters 2019-06-12 12:23 ` Noam Postavsky 2019-06-12 14:29 ` Stefan Monnier @ 2019-06-13 6:19 ` Kévin Le Gouguec 2019-06-13 7:58 ` Stefan Monnier 2019-06-13 16:53 ` npostavs 1 sibling, 2 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-06-13 6:19 UTC (permalink / raw) To: Noam Postavsky; +Cc: 35564, Stefan Monnier Noam Postavsky <npostavs@gmail.com> writes: > I think this might be better expressed in regexp: I guess it is; I just tend to get superstitious about messing with match data. > Although this gives different results for things like: > > (dired--isolated-char-p "?`foo`" 0) > > Do we care about that? (if yes, then that's a missing test case) I think we do care; if I look at what the existing code says, (dired--star-or-qmark-p "?`foo`" "?") ;; => nil Off the top of my head, this is the best I can come up with to satisfy this edge case: (defun dired--isolated-char-p (command pos) "Assert whether the character at POS is isolated within COMMAND. A character is isolated if: - it is surrounded by whitespace, the start of the command, or the end of the command, - it is surrounded by `\\=`' characters." (let ((start (max 0 (1- pos))) (char (string (aref command pos)))) (and (or (string-match (rx-to-string '(seq (or bos blank) (group char) (or eos blank))) command start) (string-match (rx-to-string '(seq ?` (group char) ?`)) command start)) (= pos (match-beginning 1))))) > And perhaps the regexp above (if it's correct) can be integrated into > this search? (maybe not though, since negation isn't straightforward in > regexps) I will look into that. Stefan Monnier <monnier@iro.umontreal.ca> writes: > Can't we use `(... ,.. ..) instead of `eval`? > > > Stefan That works too from what I tested, although it's not necessary anymore with the new version above. Thank you both for the review! I will come back with an updated patch (with the new test case) Some Time Later™. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v2] Tweak dired warning about "wildcard" characters 2019-06-13 6:19 ` Kévin Le Gouguec @ 2019-06-13 7:58 ` Stefan Monnier 2019-06-13 16:53 ` npostavs 1 sibling, 0 replies; 76+ messages in thread From: Stefan Monnier @ 2019-06-13 7:58 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, Noam Postavsky > I guess it is; I just tend to get superstitious about messing with match > data. Instead, you should get superstitious about using the match data too far from the corresponding match. Stefan ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v2] Tweak dired warning about "wildcard" characters 2019-06-13 6:19 ` Kévin Le Gouguec 2019-06-13 7:58 ` Stefan Monnier @ 2019-06-13 16:53 ` npostavs 2019-06-18 8:52 ` Kévin Le Gouguec 1 sibling, 1 reply; 76+ messages in thread From: npostavs @ 2019-06-13 16:53 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, Noam Postavsky, Stefan Monnier > > I think we do care; if I look at what the existing code says, > > (dired--star-or-qmark-p "?`foo`" "?") > ;; => nil > (let ((start (max 0 (1- pos))) > (char (string (aref command pos)))) > (rx-to-string '(seq (or bos blank) > (group char) `char' in this context translates to the "." regexp (i.e., any character). Yeah it's a bit weird. I have a patch in mind to remove the need for eval or rx-to-string. I'll send in a few days (to a new bug, it's getting off-topic here). Meanwhile, I suggest: (let ((start (max 0 (1- pos))) (char (aref command pos))) (and (string-match (rx-to-string `(or (seq (or bos blank) (group-n 1 ,char) (or eos blank)) (seq ?` (group-n 1 ,char) ?`))) command start) (= pos (match-beginning 1)))) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v2] Tweak dired warning about "wildcard" characters 2019-06-13 16:53 ` npostavs @ 2019-06-18 8:52 ` Kévin Le Gouguec 2019-06-19 0:12 ` Noam Postavsky 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-06-18 8:52 UTC (permalink / raw) To: npostavs; +Cc: 35564, Stefan Monnier npostavs@gmail.com writes: > (rx-to-string `(or (seq (or bos blank) > (group-n 1 ,char) > (or eos blank)) > (seq ?` (group-n 1 ,char) ?`))) Ah! Thanks for teaching me about \(?NUM: ... \), I did not know this Elisp extension. This makes the whole thing much more readable. For a minute I thought that maybe this patch should also add (require 'rx) somewhere in dired-aux.el, but AFAICT this is not necessary since rx-to-string is autoloaded… Do I understand correctly? Thanks again for the review, and for your efforts with bug#36237. (And thank you Stefan for your advice on being superstitious about the right things :) ) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v2] Tweak dired warning about "wildcard" characters 2019-06-18 8:52 ` Kévin Le Gouguec @ 2019-06-19 0:12 ` Noam Postavsky 0 siblings, 0 replies; 76+ messages in thread From: Noam Postavsky @ 2019-06-19 0:12 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, Stefan Monnier Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > For a minute I thought that maybe this patch should also add (require > 'rx) somewhere in dired-aux.el, but AFAICT this is not necessary since > rx-to-string is autoloaded… Do I understand correctly? Yes, that's correct. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-09 11:08 ` bug#35564: [PATCH v2] Tweak dired " Kévin Le Gouguec 2019-06-12 12:23 ` Noam Postavsky @ 2019-06-26 6:16 ` Kévin Le Gouguec 2019-06-26 13:27 ` Drew Adams ` (3 more replies) 1 sibling, 4 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-06-26 6:16 UTC (permalink / raw) To: 35564; +Cc: Stefan Monnier, Noam Postavsky [-- Attachment #1: Type: text/plain, Size: 39 bytes --] And here is the third set of patches. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Preserve-text-properties-in-y-or-n-p-prompts.patch --] [-- Type: text/x-patch, Size: 2096 bytes --] From d2892b05f08348bbc3eea770a92f7cf735a88cb3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:03:59 +0200 Subject: [PATCH 1/2] Preserve text properties in y-or-n-p prompts * lisp/subr.el (read--propertize-prompt): New function to append the prompt face to a string. (y-or-n-p): Use it instead of discarding potential text properties. --- lisp/subr.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index baff1e909a..67c4f1da3a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2334,6 +2334,9 @@ memory-limit \f ;;;; Input and display facilities. +(defun read--propertize-prompt (prompt) + (add-face-text-property 0 (length prompt) 'minibuffer-prompt t prompt)) + (defconst read-key-empty-map (make-sparse-keymap)) (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. @@ -2671,14 +2674,14 @@ y-or-n-p (let* ((scroll-actions '(recenter scroll-up scroll-down scroll-other-window scroll-other-window-down)) (key - (let ((cursor-in-echo-area t)) + (let ((cursor-in-echo-area t) + (prompt (if (memq answer scroll-actions) + prompt + (concat "Please answer y or n. " prompt)))) (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. " - prompt)) - 'face 'minibuffer-prompt))))) + (read--propertize-prompt prompt) + (read-key prompt)))) (setq answer (lookup-key query-replace-map (vector key) t)) (cond ((memq answer '(skip act)) nil) -- 2.21.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-patch, Size: 5548 bytes --] From bf49a90f9bf5c03e159dd2377da079e195258ea0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:19:44 +0200 Subject: [PATCH 2/2] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired--isolated-char-p) (dired--highlight-nosubst-char, dired--no-subst-prompt): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p) (dired-test-highlight-metachar): Test the new functions. --- lisp/dired-aux.el | 42 ++++++++++++++++++++++++++++++++---- test/lisp/dired-aux-tests.el | 28 ++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 4 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 5e4ec4d1ec..079e4f102f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,42 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((start (max 0 (1- pos))) + (char (string (aref command pos)))) + (and (string-match + (rx (or (seq (or bos blank) + (group-n 1 (literal char)) + (or eos blank)) + (seq ?` (group-n 1 (literal char)) ?`))) + command start) + (= pos (match-beginning 1))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted:")) + (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -759,11 +795,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt 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 ccd3192792..80b6393931 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,34 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo `bar`?" 9)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.21.0 [-- Attachment #4: Type: text/plain, Size: 1014 bytes --] The first patch is unchanged (it adjusts y-or-n-p so that the prompt's text properties are preserved), the second patch uses the new (literal …) feature from rx and adds a test case for dired--isolated-char-p[1]. Quoting my previous email: > Some things I wonder about: > > 1. About read--propertize-prompt… > > 1. Should the function return a copy of its argument instead of > propertizing it directly? > > 2. Is it properly named? Does it fit in subr.el? I placed it there > because I figured other users of read-char in subr.el could use > it, e.g. read-char-choice. > > 2. dired-aux.el already contains some logic to detect isolated > characters; I could not think of a way to re-use it, so I added my > own functions to find *non*-isolated characters. I added unit tests > for these new functions; still, there may be some redundancy there. Thank you for your time. [1] (should-not (dired--isolated-char-p "foo `bar`?" 9)) ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-26 6:16 ` bug#35564: [PATCH v3] " Kévin Le Gouguec @ 2019-06-26 13:27 ` Drew Adams 2019-06-27 5:58 ` Kévin Le Gouguec 2019-06-26 14:33 ` Stefan Monnier ` (2 subsequent siblings) 3 siblings, 1 reply; 76+ messages in thread From: Drew Adams @ 2019-06-26 13:27 UTC (permalink / raw) To: Kévin Le Gouguec, 35564; +Cc: Stefan Monnier, Noam Postavsky Please do not hard-code any particular face. Ever. (add-face-text-property 0 (length prompt) 'minibuffer-prompt t prompt)) ^^^^^^^^^^^^^^^^^^ Yes, I know that the code this patch would replace already does that. But it shouldn't. Nothing is gained by imposing such things on users and making it hard for them to control such behavior as they wish. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-26 13:27 ` Drew Adams @ 2019-06-27 5:58 ` Kévin Le Gouguec 0 siblings, 0 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-06-27 5:58 UTC (permalink / raw) To: Drew Adams; +Cc: 35564, Stefan Monnier, Noam Postavsky Drew Adams <drew.adams@oracle.com> writes: > Please do not hard-code any particular face. Ever. > > (add-face-text-property 0 (length prompt) > 'minibuffer-prompt t prompt)) > ^^^^^^^^^^^^^^^^^^ > > Yes, I know that the code this patch would replace > already does that. But it shouldn't. > > Nothing is gained by imposing such things on users > and making it hard for them to control such behavior > as they wish. While I am not entirely satisfied with the resolution of the previous discussion on emacs-devel[1] (mostly because this thread arguably lacks a resolution[2]), I'd like to cross this bug (i.e. Dired's brain-tripping warning) off my list before tackling the more general issue of read-* functions abusing the minibuffer-prompt face. [1] https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00340.html [2] https://lists.gnu.org/archive/html/emacs-devel/2019-05/msg00344.html ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-26 6:16 ` bug#35564: [PATCH v3] " Kévin Le Gouguec 2019-06-26 13:27 ` Drew Adams @ 2019-06-26 14:33 ` Stefan Monnier 2019-06-27 6:15 ` Kévin Le Gouguec 2019-06-27 23:31 ` Noam Postavsky 2019-07-03 19:47 ` bug#35564: [PATCH v4] " Kévin Le Gouguec 3 siblings, 1 reply; 76+ messages in thread From: Stefan Monnier @ 2019-06-26 14:33 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, Noam Postavsky I wouldn't bother with the read--propertize-prompt auxiliary function, but ... LGTM (including the use of a hardcoded face ;-) Stefan Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > And here is the third set of patches. > > > > > The first patch is unchanged (it adjusts y-or-n-p so that the prompt's > text properties are preserved), the second patch uses the new > (literal …) feature from rx and adds a test case for > dired--isolated-char-p[1]. > > Quoting my previous email: > >> Some things I wonder about: >> >> 1. About read--propertize-prompt… >> >> 1. Should the function return a copy of its argument instead of >> propertizing it directly? >> >> 2. Is it properly named? Does it fit in subr.el? I placed it there >> because I figured other users of read-char in subr.el could use >> it, e.g. read-char-choice. >> >> 2. dired-aux.el already contains some logic to detect isolated >> characters; I could not think of a way to re-use it, so I added my >> own functions to find *non*-isolated characters. I added unit tests >> for these new functions; still, there may be some redundancy there. > > Thank you for your time. > > > [1] (should-not (dired--isolated-char-p "foo `bar`?" 9)) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-26 14:33 ` Stefan Monnier @ 2019-06-27 6:15 ` Kévin Le Gouguec 0 siblings, 0 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-06-27 6:15 UTC (permalink / raw) To: Stefan Monnier; +Cc: 35564, Noam Postavsky Stefan Monnier <monnier@iro.umontreal.ca> writes: > I wouldn't bother with the read--propertize-prompt auxiliary > function, but ... LGTM Fair enough. I figured having a function would reduce the inertia of changing other prompts which are propertized rigidly, and make it easier to (maybe, someday) change the face that these prompts use in one go. Though it's probably better to wait for a few prompts to be adapted, deduce some pattern in the way they are propertized, and then introduce a new function to do the job. I'll submit a revised patch without the auxiliary function. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-26 6:16 ` bug#35564: [PATCH v3] " Kévin Le Gouguec 2019-06-26 13:27 ` Drew Adams 2019-06-26 14:33 ` Stefan Monnier @ 2019-06-27 23:31 ` Noam Postavsky 2019-06-28 6:15 ` Kévin Le Gouguec 2019-07-03 19:47 ` bug#35564: [PATCH v4] " Kévin Le Gouguec 3 siblings, 1 reply; 76+ messages in thread From: Noam Postavsky @ 2019-06-27 23:31 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, Stefan Monnier [-- Attachment #1: Type: text/plain, Size: 515 bytes --] Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: >> 2. dired-aux.el already contains some logic to detect isolated >> characters Yes, this was kind of bugging me, so here's a patch to reuse that logic (it applies on top of yours). While doing this I noticed that we earlier missed that `*` is not considered isolated, unlike `?`. Assuming no problems, I'll just push your two patches followed by mine (I considered squashing, but probably that makes things harder to follow in this case). [-- Attachment #2: patch --] [-- Type: text/plain, Size: 10740 bytes --] From 52af7efc5e0c673b24e09991db275112212f3fbf Mon Sep 17 00:00:00 2001 From: Noam Postavsky <npostavs@gmail.com> Date: Thu, 27 Jun 2019 19:15:56 -0400 Subject: [PATCH 3/3] Dedup dired-aux isolated char searching * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--no-subst-prompt): Operate on a list of positions rather than searching again for isolated chars. (dired--isolated-char-p): Remove. (dired--need-confirm-positions): New function. (dired-do-shell-command): Use it. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p): Remove. (dired-test-highlight-metachar): Adjust to new functions. Make sure that `*` isn't considered isolated. --- lisp/dired-aux.el | 108 +++++++++++++++++++------------------------ test/lisp/dired-aux-tests.el | 31 ++++++------- 2 files changed, 62 insertions(+), 77 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 079e4f102f..e716b2b42c 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,60 +60,55 @@ (defun dired-isolated-string-re (string) of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) - -(defun dired--isolated-char-p (command pos) - "Assert whether the character at POS is isolated within COMMAND. -A character is isolated if: -- it is surrounded by whitespace, the start of the command, or - the end of the command, -- it is surrounded by `\\=`' characters." - (let ((start (max 0 (1- pos))) - (char (string (aref command pos)))) - (and (string-match - (rx (or (seq (or bos blank) - (group-n 1 (literal char)) - (or eos blank)) - (seq ?` (group-n 1 (literal char)) ?`))) - command start) - (= pos (match-beginning 1))))) - -(defun dired--highlight-nosubst-char (command char) - "Highlight occurences of CHAR that are not isolated in COMMAND. -These occurences will not be substituted; they will be sent as-is -to the shell, which may interpret them as wildcards." - (save-match-data - (let ((highlighted (substring-no-properties command)) - (pos 0)) - (while (string-match (regexp-quote char) command pos) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (unless (dired--isolated-char-p command start) - (add-face-text-property start end 'warning nil highlighted)) - (setq pos end))) - highlighted))) - -(defun dired--no-subst-prompt (command char) - (let ((highlighted-command (dired--highlight-nosubst-char command char)) - (prompt "Confirm--the highlighted characters will not be substituted:")) - (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--no-subst-prompt (command char-positions) + (let ((highlighted (substring-no-properties command))) + (dolist (pos char-positions) + (add-face-text-property pos (1+ pos) 'warning nil highlighted)) + (format-message "\ +Confirm--the highlighted characters will not be substituted:\n%s +Proceed?" highlighted))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -779,26 +774,19 @@ (defun dired-do-shell-command (command &optional arg file-list) (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (dired--no-subst-prompt command "*"))) - ((need-confirm-p command "?") - (y-or-n-p (dired--no-subst-prompt command "?"))) - (t)))) + (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))) + ((setq confirmations (dired--need-confirm-positions command "?")) + (y-or-n-p (dired--no-subst-prompt command confirmations))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -809,7 +797,7 @@ (defun dired-do-shell-command (command &optional arg file-list) nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 80b6393931..3f4bfffaf6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,34 +114,31 @@ (ert-deftest dired-test-bug30624 () (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) -(ert-deftest dired-test-isolated-char-p () - (should (dired--isolated-char-p "?" 0)) - (should (dired--isolated-char-p "? " 0)) - (should (dired--isolated-char-p " ?" 1)) - (should (dired--isolated-char-p " ? " 1)) - (should (dired--isolated-char-p "foo bar ? baz" 8)) - (should (dired--isolated-char-p "foo -i`?`" 7)) - (should-not (dired--isolated-char-p "foo `bar`?" 9)) - (should-not (dired--isolated-char-p "foo 'bar?'" 8)) - (should-not (dired--isolated-char-p "foo bar?baz" 7)) - (should-not (dired--isolated-char-p "foo bar?" 7))) - (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") - (result (dired--highlight-nosubst-char command "?"))) + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "?"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) (should (equal 'warning (get-text-property 15 'face result))) (should-not (text-property-not-all 16 28 'face nil result)) (should (equal 'warning (get-text-property 29 'face result))) (should-not (text-property-not-all 30 39 'face nil result))) - (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") - (result (dired--highlight-nosubst-char command "*"))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "*"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) (should (equal 'warning (get-text-property 11 'face result))) (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 24 'face result))) - (should-not (text-property-not-all 25 29 'face nil result)))) + (should (equal 'warning (get-text-property 25 'face result))) + (should-not (text-property-not-all 26 32 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.11.0 ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-27 23:31 ` Noam Postavsky @ 2019-06-28 6:15 ` Kévin Le Gouguec 2019-06-28 15:35 ` Drew Adams 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-06-28 6:15 UTC (permalink / raw) To: Noam Postavsky; +Cc: 35564, Stefan Monnier [-- Attachment #1: Type: text/plain, Size: 483 bytes --] Noam Postavsky <npostavs@gmail.com> writes: > Yes, this was kind of bugging me, so here's a patch to reuse that logic > (it applies on top of yours). While doing this I noticed that we > earlier missed that `*` is not considered isolated, unlike `?`. Thank you very much! > Assuming no problems, I'll just push your two patches followed by mine Fine by me, although it just occurs to me that I forgot to mention the bug number in my commit messages. Here are updated patches: [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Preserve-text-properties-in-y-or-n-p-prompts.patch --] [-- Type: text/x-patch, Size: 2109 bytes --] From f34a6271f86e2f6045fc8e37c157676e046f85a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:03:59 +0200 Subject: [PATCH 1/2] Preserve text properties in y-or-n-p prompts * lisp/subr.el (read--propertize-prompt): New function to append the prompt face to a string. (y-or-n-p): Use it instead of discarding potential text properties. (Bug#35564) --- lisp/subr.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index baff1e909a..67c4f1da3a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2334,6 +2334,9 @@ memory-limit \f ;;;; Input and display facilities. +(defun read--propertize-prompt (prompt) + (add-face-text-property 0 (length prompt) 'minibuffer-prompt t prompt)) + (defconst read-key-empty-map (make-sparse-keymap)) (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. @@ -2671,14 +2674,14 @@ y-or-n-p (let* ((scroll-actions '(recenter scroll-up scroll-down scroll-other-window scroll-other-window-down)) (key - (let ((cursor-in-echo-area t)) + (let ((cursor-in-echo-area t) + (prompt (if (memq answer scroll-actions) + prompt + (concat "Please answer y or n. " prompt)))) (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. " - prompt)) - 'face 'minibuffer-prompt))))) + (read--propertize-prompt prompt) + (read-key prompt)))) (setq answer (lookup-key query-replace-map (vector key) t)) (cond ((memq answer '(skip act)) nil) -- 2.21.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-patch, Size: 5561 bytes --] From a70bbeae31315a3c1b8baf979e27be3dbc4f7eac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:19:44 +0200 Subject: [PATCH 2/2] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired--isolated-char-p) (dired--highlight-nosubst-char, dired--no-subst-prompt): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p) (dired-test-highlight-metachar): Test the new functions. (Bug#35564) --- lisp/dired-aux.el | 42 ++++++++++++++++++++++++++++++++---- test/lisp/dired-aux-tests.el | 28 ++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 4 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 5e4ec4d1ec..079e4f102f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,42 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((start (max 0 (1- pos))) + (char (string (aref command pos)))) + (and (string-match + (rx (or (seq (or bos blank) + (group-n 1 (literal char)) + (or eos blank)) + (seq ?` (group-n 1 (literal char)) ?`))) + command start) + (= pos (match-beginning 1))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted:")) + (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -759,11 +795,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt 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 ccd3192792..80b6393931 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,34 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo `bar`?" 9)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.21.0 [-- Attachment #4: Type: text/plain, Size: 805 bytes --] > +(defun dired--no-subst-prompt (command char-positions) > […] > + ((setq confirmations (dired--need-confirm-positions command "*")) > + (y-or-n-p (dired--no-subst-prompt confirmations command))) > + ((setq confirmations (dired--need-confirm-positions command "?")) > + (y-or-n-p (dired--no-subst-prompt command confirmations))) Mmmm, am I missing something, or have the arguments to dired--no-subst-prompt been reversed in the "*" case? I.e. shoudn't > + (y-or-n-p (dired--no-subst-prompt confirmations command))) rather be > + (y-or-n-p (dired--no-subst-prompt command confirmations))) ? As things stand, "! grep 'foo.*'" in Dired fails, saying: let: Wrong type argument: stringp, (9) ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-28 6:15 ` Kévin Le Gouguec @ 2019-06-28 15:35 ` Drew Adams 2019-06-28 17:58 ` Kévin Le Gouguec 0 siblings, 1 reply; 76+ messages in thread From: Drew Adams @ 2019-06-28 15:35 UTC (permalink / raw) To: Kévin Le Gouguec, Noam Postavsky; +Cc: 35564, Stefan Monnier (Apologies if I missed something - I took only a quick look at the patches and the bug report.) The old question "Confirm--do you mean to use `*' as a wildcard? " Seemed clear enough, I thought. But I see now from the bug report that it could be confusing. But the new question (and actually it's not even a question - it should be, no?) seems even less clear to me: "Confirm--the highlighted characters will not be substituted:" (And too long - "highlighted chars won't be substituted" says the same thing as "the highlighted...".) Maybe something like this? "Should highlighted chars be substituted? " or "Substitute highlighted occurrences of `*'? " But see next - 1. It's not clear to me what someone will understand by "substituted" here. What would (otherwise) be substituted for what, where, and for what purpose? What substitution are we talking about, and how would a user be expected to know what we mean, here? 2. Are there multiple different "characterS" involved, or is the confirmation about only _one_ character, in (possibly) multiple locations - occurrences of one char? 3. Is it the case that the new prompt does not, itself, show the character? Do you have to look elsewhere to see which char or chars(?) are meant by the prompt? Shouldn't the prompt itself show the char? I think more thought might need to be put into this, by those who understand what the code actually does, ways in which the resulting behavior could be confusing, and just what it is we're asking the user to confirm. (I'm not one who really understands all of this. I'm just saying that my guess is that things are still not so clear after the patching.) A final comment, which I'm not sure is relevant: We should not, in any case, _rely_ on any highlighting to get across meaning (semantics). Highlighting should always be an extra - a nice-to-have. Some users will not see the highlighting - it cannot be the only thing that gets the intended meaning across. (Again, I'm not saying that we _are_ relying on highlighting this way. I just want to be sure we're not. We don't want to unnecessarily introduce an accessibility problem.) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-28 15:35 ` Drew Adams @ 2019-06-28 17:58 ` Kévin Le Gouguec 2019-06-28 18:43 ` Drew Adams 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-06-28 17:58 UTC (permalink / raw) To: Drew Adams; +Cc: 35564, Noam Postavsky, Stefan Monnier Drew Adams <drew.adams@oracle.com> writes: > But the new question (and actually it's not even a > question - it should be, no?) seems even less clear > to me: A question would probably make the interaction more fluid, I agree. As fun as messing with text properties has been, I would still very much favour a simpler solution in the form of a better question (where "better" mostly means "does not talk about wildcards"). As I mentioned, the only reason I came up with these highlighting shenanigans is because I could not come up with a better phrasing. Point taken about the new phrasing possibly being less clear; I was aiming for some sort of "is the following statement correct? yes/no" interaction. > (And too long - "highlighted chars won't be substituted" > says the same thing as "the highlighted...".) (Silly question: is it kosher to use contractions such as "won't" in user-facing text? Or were you pointing out the superfluous "the" and/or suggesting "chars" rather than "characters"?) > "Should highlighted chars be substituted? " > > or > > "Substitute highlighted occurrences of `*'? " Mmm; currently this prompt is raised when the code detects that the characters will *not* be substituted; answering "yes" makes Dired go on with the command, answering "no" aborts. If we phrased the question like you suggest, we should probably change the code to actually perform the substitutions should the user answer "yes". > 1. It's not clear to me what someone will understand > by "substituted" here. What would (otherwise) be > substituted for what, where, and for what purpose? > What substitution are we talking about, and how > would a user be expected to know what we mean, here? Right. Not sure how to make things clearer without quoting dired-do-shell-command's documentation, which would make the prompt quite verbose. > 2. Are there multiple different "characterS" involved, > or is the confirmation about only _one_ character, > in (possibly) multiple locations - occurrences of > one char? One character in (possibly) multiple locations. > 3. Is it the case that the new prompt does not, itself, > show the character? Do you have to look elsewhere > to see which char or chars(?) are meant by the > prompt? Shouldn't the prompt itself show the char? It does; the prompt shows the full command, and applies the warning face to the character(s). > A final comment, which I'm not sure is relevant: > > We should not, in any case, _rely_ on any > highlighting to get across meaning (semantics). > Highlighting should always be an extra - a > nice-to-have. Some users will not see the > highlighting - it cannot be the only thing that > gets the intended meaning across. > > (Again, I'm not saying that we _are_ relying on > highlighting this way. I just want to be sure > we're not. We don't want to unnecessarily > introduce an accessibility problem.) With the current patches, we absolutely totally completely _would_ rely on highlighting to get across semantics. Thank you for spelling it out as an accessibility problem; that kind of confirms my nagging feeling that the highlighting method has an unfavorable benefit/cost ratio (IOW, it's cute, but it might make things worse for some users). So to conclude, these are the paths forward that I see: (0. Drop the issue and grit my teeth when the warning shows up.) 1. find a simple rephrasing, 2. keep trying to make a more elaborate prompt, only using some other tricks to point out the characters. Example of path 1: > Confirm--do you mean to send `*' verbatim to the shell? (I don't like this one because it sounds like "do you want us to quote `*' to make sure the shell does not expand it?") Example of path 2: > Confirm--do you mean to send these characters as-is to the shell? > sed -e 's/foo?/foo!/' -e 's/bar?/bar!' > ^ ^ (I.e. using '^' to denote the non-isolated characters; not sure how clear it is that "these" refers to "the caracters underlined by a '^'") ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-28 17:58 ` Kévin Le Gouguec @ 2019-06-28 18:43 ` Drew Adams 2019-06-29 13:48 ` Noam Postavsky 2019-06-29 14:13 ` Eli Zaretskii 0 siblings, 2 replies; 76+ messages in thread From: Drew Adams @ 2019-06-28 18:43 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, Noam Postavsky, Stefan Monnier > > (And too long - "highlighted chars won't be substituted" > > says the same thing as "the highlighted...".) > > (Silly question: is it kosher to use contractions such as "won't" in > user-facing text? Or were you pointing out the superfluous "the" and/or > suggesting "chars" rather than "characters"?) Yes, and yes, and yes. Well, for the first "yes": I can't vouch for what's kosher. But yes. > > "Should highlighted chars be substituted? " > > > > or > > > > "Substitute highlighted occurrences of `*'? " > > Mmm; currently this prompt is raised when the code detects that the > characters will *not* be substituted; answering "yes" makes Dired go on > with the command, answering "no" aborts. Yes, I assumed, in saying that, that the sense of the code would need to be reversed if the question was put that way. The question should be in a form that's easiest for users to understand and not misunderstand, if that's feasible in terms of code. > If we phrased the question like you suggest, we should probably change > the code to actually perform the substitutions should the user answer > "yes". Yes, that's what I meant. But that wording was just a casual suggestion, to get the point across. Someone (e.g. you) might well come up with something better. > > 1. It's not clear to me what someone will understand > > by "substituted" here. What would (otherwise) be > > substituted for what, where, and for what purpose? > > What substitution are we talking about, and how > > would a user be expected to know what we mean, here? > > Right. Not sure how to make things clearer without quoting > dired-do-shell-command's documentation, which would make the prompt > quite verbose. Maybe someone else has a suggestion. It's worth working on, I think. > > 2. Are there multiple different "characterS" involved, > > or is the confirmation about only _one_ character, > > in (possibly) multiple locations - occurrences of > > one char? > > One character in (possibly) multiple locations. That's what I thought. Then don't say chars (plural). > > 3. Is it the case that the new prompt does not, itself, > > show the character? Do you have to look elsewhere > > to see which char or chars(?) are meant by the > > prompt? Shouldn't the prompt itself show the char? > > It does; the prompt shows the full command, and applies the warning face > to the character(s). Good. > > A final comment, which I'm not sure is relevant: > > > > We should not, in any case, _rely_ on any > > highlighting to get across meaning (semantics). > > Highlighting should always be an extra - a > > nice-to-have. Some users will not see the > > highlighting - it cannot be the only thing that > > gets the intended meaning across. > > > > (Again, I'm not saying that we _are_ relying on > > highlighting this way. I just want to be sure > > we're not. We don't want to unnecessarily > > introduce an accessibility problem.) > > With the current patches, we absolutely totally completely _would_ rely > on highlighting to get across semantics. Thank you for spelling it out > as an accessibility problem; that kind of confirms my nagging feeling > that the highlighting method has an unfavorable benefit/cost ratio (IOW, > it's cute, but it might make things worse for some users). There is likely another way to make those occurrences stand out (in addition to, not instead of, highlighting). But I'm no expert on that. Maybe Eli has a suggestion. Emacs doesn't jump through zillions of hoops to try maximize accessibility. But it's good to keep it in mind and, at least when other things are equal, to DTRT in this regard. > So to conclude, these are the paths forward that I see: > > (0. Drop the issue and grit my teeth when the warning shows up.) > > 1. find a simple rephrasing, > > 2. keep trying to make a more elaborate prompt, only using some other > tricks to point out the characters. > > Example of path 1: > > > Confirm--do you mean to send `*' verbatim to the shell? You can drop "Confirm--". You could even drop "do you mean to". If a reply is required to the question (e.g. it's `y-or-n-p') then users cannot avoid it or miss it. > (I don't like this one because it sounds like "do you want us to quote > `*' to make sure the shell does not expand it?") > > Example of path 2: > > > Confirm--do you mean to send these characters as-is to the shell? > > sed -e 's/foo?/foo!/' -e 's/bar?/bar!' > > ^ ^ > > (I.e. using '^' to denote the non-isolated characters; not sure how > clear it is that "these" refers to "the caracters underlined by a '^'") Much better, IMO. Again: drop "Confirm--do you mean to", and use "these occurrences of `?'", not "these characters". There is only one char, in perhaps multiple locations. And I do think the char (`?' or whatever) should be mentioned explicitly in the question, not just have its occurrences indicated in the command to be sent. (Thanks for working on this.) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-28 18:43 ` Drew Adams @ 2019-06-29 13:48 ` Noam Postavsky 2019-06-29 14:30 ` Drew Adams 2019-06-29 14:13 ` Eli Zaretskii 1 sibling, 1 reply; 76+ messages in thread From: Noam Postavsky @ 2019-06-29 13:48 UTC (permalink / raw) To: Drew Adams; +Cc: 35564, Stefan Monnier, Kévin Le Gouguec [-- Attachment #1: Type: text/plain, Size: 3122 bytes --] Drew Adams <drew.adams@oracle.com> writes: >> > A final comment, which I'm not sure is relevant: >> > >> > We should not, in any case, _rely_ on any >> > highlighting to get across meaning (semantics). >> > Highlighting should always be an extra - a >> > nice-to-have. Some users will not see the >> > highlighting - it cannot be the only thing that >> > gets the intended meaning across. >> With the current patches, we absolutely totally completely _would_ rely >> on highlighting to get across semantics. Thank you for spelling it out >> as an accessibility problem; that kind of confirms my nagging feeling >> that the highlighting method has an unfavorable benefit/cost ratio (IOW, >> it's cute, but it might make things worse for some users). > There is likely another way to make those occurrences > stand out (in addition to, not instead of, highlighting). > But I'm no expert on that. Maybe Eli has a suggestion. > > Emacs doesn't jump through zillions of hoops to try > maximize accessibility. But it's good to keep it in > mind and, at least when other things are equal, to DTRT > in this regard. Yes, we should definitely be careful not to make accessibility worse; thank you for bringing this up Drew. >> 1. find a simple rephrasing, >> >> > Confirm--do you mean to send `*' verbatim to the shell? >> (I don't like this one because it sounds like "do you want us to quote >> `*' to make sure the shell does not expand it?") >> 2. keep trying to make a more elaborate prompt, only using some other >> tricks to point out the characters. >> >> > Confirm--do you mean to send these characters as-is to the shell? >> > sed -e 's/foo?/foo!/' -e 's/bar?/bar!' >> > ^ ^ >> >> (I.e. using '^' to denote the non-isolated characters; not sure how >> clear it is that "these" refers to "the caracters underlined by a '^'") I don't know about the '^' trick, if the minibuffer window is narrow enough to cause line wrapping the result won't be very readable. And I doubt a screen reader would handle this kind of thing any better than highlighting (someone please correct me if I'm wrong about that). I like the use of "as-is to shell": short and clear. > Again: drop "Confirm--do you mean to", and use > "these occurrences of `?'", not "these > characters". There is only one char, in perhaps > multiple locations. > > And I do think the char (`?' or whatever) should > be mentioned explicitly in the question, not just > have its occurrences indicated in the command to > be sent. Agreed on both these points. Updated patch is below, it produces prompts like these (still using highlighting): echo foo* Send 1 occurence of ‘*’ as-is to shell? (y or n) echo foo* bar* * Send 2 occurences of ‘*’ as-is to shell? (y or n) The last case (where there are both as-is and substituted "*") isn't so great without highlighting (you have to count the "*"s and work out if something unexpected is happening), but I think it's at least not worse than the current situation. [-- Attachment #2: patch --] [-- Type: text/plain, Size: 11070 bytes --] From e339ad7d83025764645ed9101769467139390432 Mon Sep 17 00:00:00 2001 From: Noam Postavsky <npostavs@gmail.com> Date: Thu, 27 Jun 2019 19:15:56 -0400 Subject: [PATCH 3/3] Dedup dired-aux isolated char searching (Bug#35564) * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--no-subst-prompt): Operate on a list of positions rather than searching again for isolated chars. Shorten prompt, and include the character being asked about in the question (to make it clearer, and in case the user can't see the fontification for whatever reason, e.g., screen reader). (dired--isolated-char-p): Remove. (dired--need-confirm-positions): New function. (dired-do-shell-command): Use it. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p): Remove. (dired-test-highlight-metachar): Adjust to new functions. Make sure that `*` isn't considered isolated. --- lisp/dired-aux.el | 113 ++++++++++++++++++++----------------------- test/lisp/dired-aux-tests.el | 31 ++++++------ 2 files changed, 67 insertions(+), 77 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 079e4f102f..47e1d38223 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,60 +60,60 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) - -(defun dired--isolated-char-p (command pos) - "Assert whether the character at POS is isolated within COMMAND. -A character is isolated if: -- it is surrounded by whitespace, the start of the command, or - the end of the command, -- it is surrounded by `\\=`' characters." - (let ((start (max 0 (1- pos))) - (char (string (aref command pos)))) - (and (string-match - (rx (or (seq (or bos blank) - (group-n 1 (literal char)) - (or eos blank)) - (seq ?` (group-n 1 (literal char)) ?`))) - command start) - (= pos (match-beginning 1))))) - -(defun dired--highlight-nosubst-char (command char) - "Highlight occurences of CHAR that are not isolated in COMMAND. -These occurences will not be substituted; they will be sent as-is -to the shell, which may interpret them as wildcards." - (save-match-data - (let ((highlighted (substring-no-properties command)) - (pos 0)) - (while (string-match (regexp-quote char) command pos) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (unless (dired--isolated-char-p command start) - (add-face-text-property start end 'warning nil highlighted)) - (setq pos end))) - highlighted))) - -(defun dired--no-subst-prompt (command char) - (let ((highlighted-command (dired--highlight-nosubst-char command char)) - (prompt "Confirm--the highlighted characters will not be substituted:")) - (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--no-subst-prompt (char-positions command) + (cl-callf substring-no-properties command) + (dolist (pos char-positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (concat command "\n" + (format-message + (ngettext "Send %d occurence of `%s' as-is to shell?" + "Send %d occurences of `%s' as-is to shell?" + (length char-positions)) + (length char-positions) + (propertize (string (aref command (car char-positions))) + 'face 'warning)))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -779,26 +779,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (dired--no-subst-prompt command "*"))) - ((need-confirm-p command "?") - (y-or-n-p (dired--no-subst-prompt command "?"))) - (t)))) + (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))) + ((setq confirmations (dired--need-confirm-positions command "?")) + (y-or-n-p (dired--no-subst-prompt confirmations command))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -809,7 +802,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 80b6393931..3f4bfffaf6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,34 +114,31 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) -(ert-deftest dired-test-isolated-char-p () - (should (dired--isolated-char-p "?" 0)) - (should (dired--isolated-char-p "? " 0)) - (should (dired--isolated-char-p " ?" 1)) - (should (dired--isolated-char-p " ? " 1)) - (should (dired--isolated-char-p "foo bar ? baz" 8)) - (should (dired--isolated-char-p "foo -i`?`" 7)) - (should-not (dired--isolated-char-p "foo `bar`?" 9)) - (should-not (dired--isolated-char-p "foo 'bar?'" 8)) - (should-not (dired--isolated-char-p "foo bar?baz" 7)) - (should-not (dired--isolated-char-p "foo bar?" 7))) - (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") - (result (dired--highlight-nosubst-char command "?"))) + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "?"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) (should (equal 'warning (get-text-property 15 'face result))) (should-not (text-property-not-all 16 28 'face nil result)) (should (equal 'warning (get-text-property 29 'face result))) (should-not (text-property-not-all 30 39 'face nil result))) - (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") - (result (dired--highlight-nosubst-char command "*"))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "*"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) (should (equal 'warning (get-text-property 11 'face result))) (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 24 'face result))) - (should-not (text-property-not-all 25 29 'face nil result)))) + (should (equal 'warning (get-text-property 25 'face result))) + (should-not (text-property-not-all 26 32 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.11.0 ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-29 13:48 ` Noam Postavsky @ 2019-06-29 14:30 ` Drew Adams 0 siblings, 0 replies; 76+ messages in thread From: Drew Adams @ 2019-06-29 14:30 UTC (permalink / raw) To: Noam Postavsky; +Cc: 35564, Stefan Monnier, Kévin Le Gouguec > >> > Confirm--do you mean to send these characters as-is to the shell? > >> > sed -e 's/foo?/foo!/' -e 's/bar?/bar!' > >> > ^ ^ > > I don't know about the '^' trick, if the minibuffer window is narrow > enough to cause line wrapping the result won't be very readable. And I > doubt a screen reader would handle this kind of thing any better than > highlighting (someone please correct me if I'm wrong about that). Another possibility I almost mentioned is to use, by default, a face that uses `:box' or `:overline', or some such properties to make the char occurrences stand out without relying on color. That might at least help with some who have difficulty distinguishing color, but it's not an ideal solution either. I don't think we should try to jump through too many hoops about this. The main thing, I think, is to put the char itself in the sentence preceding the quoted command text. The use of `^' is not too bad, I think, even given the problems you mention. If the char occurrences that are problematic are not obvious then a user can cancel the command and check `*Messages*' for the full feedback. > Agreed on both these points. Updated patch is below, it produces > prompts like these (still using highlighting): > > echo foo* > Send 1 occurence of ‘*’ as-is to shell? (y or n) > > echo foo* bar* * > Send 2 occurences of ‘*’ as-is to shell? (y or n) Good. But "occurrences", not "occurences". > The last case (where there are both as-is and substituted "*") isn't so > great without highlighting (you have to count the "*"s and work out if > something unexpected is happening), but I think it's at least not worse > than the current situation. I vote for also adding the ^ indications underneath. If you think that is too often too problematic then maybe do something like one of these: 1. Give users a way to opt out or to remove that on demand. 2. Automatically remove it, based on window width, whether there are multiple lines, or whatever. But this should be controllable by a user (e.g. an option). Agreed about use of screenreaders. Users should be able to turn off the ^ indicators. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v3] Tweak dired warning about "wildcard" characters 2019-06-28 18:43 ` Drew Adams 2019-06-29 13:48 ` Noam Postavsky @ 2019-06-29 14:13 ` Eli Zaretskii 1 sibling, 0 replies; 76+ messages in thread From: Eli Zaretskii @ 2019-06-29 14:13 UTC (permalink / raw) To: Drew Adams; +Cc: kevin.legouguec, 35564, npostavs, monnier > Date: Fri, 28 Jun 2019 11:43:55 -0700 (PDT) > From: Drew Adams <drew.adams@oracle.com> > Cc: 35564@debbugs.gnu.org, Noam Postavsky <npostavs@gmail.com>, > Stefan Monnier <monnier@iro.umontreal.ca> > > > > We should not, in any case, _rely_ on any > > > highlighting to get across meaning (semantics). > > > Highlighting should always be an extra - a > > > nice-to-have. Some users will not see the > > > highlighting - it cannot be the only thing that > > > gets the intended meaning across. > > > > > > (Again, I'm not saying that we _are_ relying on > > > highlighting this way. I just want to be sure > > > we're not. We don't want to unnecessarily > > > introduce an accessibility problem.) > > > > With the current patches, we absolutely totally completely _would_ rely > > on highlighting to get across semantics. Thank you for spelling it out > > as an accessibility problem; that kind of confirms my nagging feeling > > that the highlighting method has an unfavorable benefit/cost ratio (IOW, > > it's cute, but it might make things worse for some users). > > There is likely another way to make those occurrences > stand out (in addition to, not instead of, highlighting). > But I'm no expert on that. Maybe Eli has a suggestion. We could both highlight and underline the relevant text. We already do that in other cases. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-06-26 6:16 ` bug#35564: [PATCH v3] " Kévin Le Gouguec ` (2 preceding siblings ...) 2019-06-27 23:31 ` Noam Postavsky @ 2019-07-03 19:47 ` Kévin Le Gouguec 2019-07-12 15:10 ` Kévin Le Gouguec 2019-10-10 18:45 ` bug#35564: [PATCH v5] " Kévin Le Gouguec 3 siblings, 2 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-07-03 19:47 UTC (permalink / raw) To: 35564; +Cc: Stefan Monnier, Noam Postavsky [-- Attachment #1: Type: text/plain, Size: 691 bytes --] This series of patches consists in - the same 2 patches as v3 - Noam's refactoring - some amendments ("occurrence", order of arguments in tests) - a proof-of-concept for marking the occurrences with '^' Here is a list of improvements that I plan on tackling Soonish™ 1. refrain from adding markers if the minibuffer is not wide enough, 2. use (:inherit '(warning underline)) instead of warning, so that - if the warning face has some underlining, it is used, - otherwise the underline face makes sure that we don't rely only on colors. Thank you all for your your reviews and your patience. Sorry I can't manage to take more time to work on this. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Preserve-text-properties-in-y-or-n-p-prompts.patch --] [-- Type: text/x-patch, Size: 2109 bytes --] From 1f1e6c974a56e834ee09446bac3ab41e6cd6f9af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:03:59 +0200 Subject: [PATCH 1/5] Preserve text properties in y-or-n-p prompts * lisp/subr.el (read--propertize-prompt): New function to append the prompt face to a string. (y-or-n-p): Use it instead of discarding potential text properties. (Bug#35564) --- lisp/subr.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 4a1649f601..c59f13b24c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2338,6 +2338,9 @@ memory-limit \f ;;;; Input and display facilities. +(defun read--propertize-prompt (prompt) + (add-face-text-property 0 (length prompt) 'minibuffer-prompt t prompt)) + (defconst read-key-empty-map (make-sparse-keymap)) (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. @@ -2675,14 +2678,14 @@ y-or-n-p (let* ((scroll-actions '(recenter scroll-up scroll-down scroll-other-window scroll-other-window-down)) (key - (let ((cursor-in-echo-area t)) + (let ((cursor-in-echo-area t) + (prompt (if (memq answer scroll-actions) + prompt + (concat "Please answer y or n. " prompt)))) (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. " - prompt)) - 'face 'minibuffer-prompt))))) + (read--propertize-prompt prompt) + (read-key prompt)))) (setq answer (lookup-key query-replace-map (vector key) t)) (cond ((memq answer '(skip act)) nil) -- 2.22.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-patch, Size: 5561 bytes --] From 2fbda185484b45a9fa70518c064ad55b884387c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:19:44 +0200 Subject: [PATCH 2/5] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired--isolated-char-p) (dired--highlight-nosubst-char, dired--no-subst-prompt): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p) (dired-test-highlight-metachar): Test the new functions. (Bug#35564) --- lisp/dired-aux.el | 42 ++++++++++++++++++++++++++++++++---- test/lisp/dired-aux-tests.el | 28 ++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 4 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 5e4ec4d1ec..079e4f102f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,42 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((start (max 0 (1- pos))) + (char (string (aref command pos)))) + (and (string-match + (rx (or (seq (or bos blank) + (group-n 1 (literal char)) + (or eos blank)) + (seq ?` (group-n 1 (literal char)) ?`))) + command start) + (= pos (match-beginning 1))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted:")) + (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -759,11 +795,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt 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 ccd3192792..80b6393931 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,34 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo `bar`?" 9)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.22.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0003-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch --] [-- Type: text/x-patch, Size: 11060 bytes --] From 0ecd865a837665b6d7549f1a18eff3b46988a7dd Mon Sep 17 00:00:00 2001 From: Noam Postavsky <npostavs@gmail.com> Date: Thu, 27 Jun 2019 19:15:56 -0400 Subject: [PATCH 3/5] Dedup dired-aux isolated char searching (Bug#35564) * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--no-subst-prompt): Operate on a list of positions rather than searching again for isolated chars. Shorten prompt, and include the character being asked about in the question (to make it clearer, and in case the user can't see the fontification for whatever reason, e.g., screen reader). (dired--isolated-char-p): Remove. (dired--need-confirm-positions): New function. (dired-do-shell-command): Use it. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p): Remove. (dired-test-highlight-metachar): Adjust to new functions. Make sure that `*` isn't considered isolated. --- lisp/dired-aux.el | 113 ++++++++++++++++------------------- test/lisp/dired-aux-tests.el | 31 +++++----- 2 files changed, 67 insertions(+), 77 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 079e4f102f..47e1d38223 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,60 +60,60 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) - -(defun dired--isolated-char-p (command pos) - "Assert whether the character at POS is isolated within COMMAND. -A character is isolated if: -- it is surrounded by whitespace, the start of the command, or - the end of the command, -- it is surrounded by `\\=`' characters." - (let ((start (max 0 (1- pos))) - (char (string (aref command pos)))) - (and (string-match - (rx (or (seq (or bos blank) - (group-n 1 (literal char)) - (or eos blank)) - (seq ?` (group-n 1 (literal char)) ?`))) - command start) - (= pos (match-beginning 1))))) - -(defun dired--highlight-nosubst-char (command char) - "Highlight occurences of CHAR that are not isolated in COMMAND. -These occurences will not be substituted; they will be sent as-is -to the shell, which may interpret them as wildcards." - (save-match-data - (let ((highlighted (substring-no-properties command)) - (pos 0)) - (while (string-match (regexp-quote char) command pos) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (unless (dired--isolated-char-p command start) - (add-face-text-property start end 'warning nil highlighted)) - (setq pos end))) - highlighted))) - -(defun dired--no-subst-prompt (command char) - (let ((highlighted-command (dired--highlight-nosubst-char command char)) - (prompt "Confirm--the highlighted characters will not be substituted:")) - (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--no-subst-prompt (char-positions command) + (cl-callf substring-no-properties command) + (dolist (pos char-positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (concat command "\n" + (format-message + (ngettext "Send %d occurence of `%s' as-is to shell?" + "Send %d occurences of `%s' as-is to shell?" + (length char-positions)) + (length char-positions) + (propertize (string (aref command (car char-positions))) + 'face 'warning)))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -779,26 +779,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (dired--no-subst-prompt command "*"))) - ((need-confirm-p command "?") - (y-or-n-p (dired--no-subst-prompt command "?"))) - (t)))) + (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))) + ((setq confirmations (dired--need-confirm-positions command "?")) + (y-or-n-p (dired--no-subst-prompt confirmations command))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -809,7 +802,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 80b6393931..3f4bfffaf6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,34 +114,31 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) -(ert-deftest dired-test-isolated-char-p () - (should (dired--isolated-char-p "?" 0)) - (should (dired--isolated-char-p "? " 0)) - (should (dired--isolated-char-p " ?" 1)) - (should (dired--isolated-char-p " ? " 1)) - (should (dired--isolated-char-p "foo bar ? baz" 8)) - (should (dired--isolated-char-p "foo -i`?`" 7)) - (should-not (dired--isolated-char-p "foo `bar`?" 9)) - (should-not (dired--isolated-char-p "foo 'bar?'" 8)) - (should-not (dired--isolated-char-p "foo bar?baz" 7)) - (should-not (dired--isolated-char-p "foo bar?" 7))) - (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") - (result (dired--highlight-nosubst-char command "?"))) + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "?"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) (should (equal 'warning (get-text-property 15 'face result))) (should-not (text-property-not-all 16 28 'face nil result)) (should (equal 'warning (get-text-property 29 'face result))) (should-not (text-property-not-all 30 39 'face nil result))) - (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") - (result (dired--highlight-nosubst-char command "*"))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "*"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) (should (equal 'warning (get-text-property 11 'face result))) (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 24 'face result))) - (should-not (text-property-not-all 25 29 'face nil result)))) + (should (equal 'warning (get-text-property 25 'face result))) + (should-not (text-property-not-all 26 32 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.22.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0004-fixup-Dedup-dired-aux-isolated-char-searching-Bug-35.patch --] [-- Type: text/x-patch, Size: 2459 bytes --] From 8944a2c77e04012593450edd391a0e4ac0be090d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 3 Jul 2019 21:29:38 +0200 Subject: [PATCH 4/5] fixup! Dedup dired-aux isolated char searching (Bug#35564) --- lisp/dired-aux.el | 4 ++-- test/lisp/dired-aux-tests.el | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 47e1d38223..7ea1191c49 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -108,8 +108,8 @@ dired--no-subst-prompt (add-face-text-property pos (1+ pos) 'warning nil command)) (concat command "\n" (format-message - (ngettext "Send %d occurence of `%s' as-is to shell?" - "Send %d occurences of `%s' as-is to shell?" + (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))) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 3f4bfffaf6..ff18edddb6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -118,8 +118,8 @@ dired-test-highlight-metachar "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") (prompt (dired--no-subst-prompt - command - (dired--need-confirm-positions command "?"))) + (dired--need-confirm-positions command "?") + command)) (result (and (string-match (regexp-quote command) prompt) (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) @@ -130,8 +130,8 @@ dired-test-highlight-metachar ;; Note that `?` is considered isolated, but `*` is not. (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") (prompt (dired--no-subst-prompt - command - (dired--need-confirm-positions command "*"))) + (dired--need-confirm-positions command "*") + command)) (result (and (string-match (regexp-quote command) prompt) (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) -- 2.22.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0005-Add-markers-below-non-isolated-chars-in-dired-prompt.patch --] [-- Type: text/x-patch, Size: 4118 bytes --] From 7f28faa497419aeda4fed6ec413b7d6060f2c203 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 3 Jul 2019 21:17:57 +0200 Subject: [PATCH 5/5] Add '^' markers below non-isolated chars in dired prompt * lisp/dired-aux.el (dired--mark-positions): New function. (dired--no-subst-prompt): Use it. * test/lisp/dired-aux-tests.el (dired-test-highlight-metachar): Add assertion for '^' marker positions. (Bug#35564) --- lisp/dired-aux.el | 25 +++++++++++++++++-------- test/lisp/dired-aux-tests.el | 8 ++++++-- 2 files changed, 23 insertions(+), 10 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 7ea1191c49..cc11f2674f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -102,18 +102,27 @@ dired--need-confirm-positions (setq start (match-end 0))) confirm-positions)) +(defun dired--mark-positions (positions) + (let* ((positions (sort positions '<)) + (markers (make-string (1+ (car (last positions))) ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + (defun dired--no-subst-prompt (char-positions command) (cl-callf substring-no-properties command) (dolist (pos char-positions) (add-face-text-property pos (1+ pos) 'warning nil command)) - (concat command "\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)))) + (let ((markers (dired--mark-positions char-positions))) + (concat command "\n" + markers "\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))))) ;;;###autoload (defun dired-diff (file &optional switches) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index ff18edddb6..fbadfcbf12 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -117,6 +117,7 @@ dired-test-bug30624 (ert-deftest 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 (dired--need-confirm-positions command "?") command)) @@ -126,9 +127,11 @@ dired-test-highlight-metachar (should (equal 'warning (get-text-property 15 'face result))) (should-not (text-property-not-all 16 28 'face nil result)) (should (equal 'warning (get-text-property 29 'face result))) - (should-not (text-property-not-all 30 39 'face nil result))) + (should-not (text-property-not-all 30 39 'face nil result)) + (should (string-match (regexp-quote markers) prompt (1+ (length command))))) ;; 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 (dired--need-confirm-positions command "*") command)) @@ -138,7 +141,8 @@ dired-test-highlight-metachar (should (equal 'warning (get-text-property 11 'face result))) (should-not (text-property-not-all 12 23 'face nil result)) (should (equal 'warning (get-text-property 25 'face result))) - (should-not (text-property-not-all 26 32 'face nil result)))) + (should-not (text-property-not-all 26 32 'face nil result)) + (should (string-match (regexp-quote markers) prompt (1+ (length command)))))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.22.0 ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-03 19:47 ` bug#35564: [PATCH v4] " Kévin Le Gouguec @ 2019-07-12 15:10 ` Kévin Le Gouguec 2019-07-27 11:20 ` Eli Zaretskii 2019-10-10 18:45 ` bug#35564: [PATCH v5] " Kévin Le Gouguec 1 sibling, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-07-12 15:10 UTC (permalink / raw) To: 35564; +Cc: Stefan Monnier, Noam Postavsky [-- Attachment #1: Type: text/plain, Size: 536 bytes --] Hello, I have now added '^' markers below the highlighted command, on condition that the echo area is wide enough not to wrap lines. Do we want to add some customizability (highlight face, whether or not to display '^' markers), or is this good enough for now? The patch series now includes: - two patches to make y-or-n-p preserve text properties and implement an initial version of highlighting, - Noam's refactoring patch, plus fixups, - one patch to add '^' markers, - one last patch to make tests less tedious to maintain. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Preserve-text-properties-in-y-or-n-p-prompts.patch --] [-- Type: text/x-diff, Size: 2109 bytes --] From fbd41865515e13e35874e98a8847e1a67a9b956c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:03:59 +0200 Subject: [PATCH 1/6] Preserve text properties in y-or-n-p prompts * lisp/subr.el (read--propertize-prompt): New function to append the prompt face to a string. (y-or-n-p): Use it instead of discarding potential text properties. (Bug#35564) --- lisp/subr.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 4a1649f601..c59f13b24c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2338,6 +2338,9 @@ memory-limit \f ;;;; Input and display facilities. +(defun read--propertize-prompt (prompt) + (add-face-text-property 0 (length prompt) 'minibuffer-prompt t prompt)) + (defconst read-key-empty-map (make-sparse-keymap)) (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. @@ -2675,14 +2678,14 @@ y-or-n-p (let* ((scroll-actions '(recenter scroll-up scroll-down scroll-other-window scroll-other-window-down)) (key - (let ((cursor-in-echo-area t)) + (let ((cursor-in-echo-area t) + (prompt (if (memq answer scroll-actions) + prompt + (concat "Please answer y or n. " prompt)))) (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. " - prompt)) - 'face 'minibuffer-prompt))))) + (read--propertize-prompt prompt) + (read-key prompt)))) (setq answer (lookup-key query-replace-map (vector key) t)) (cond ((memq answer '(skip act)) nil) -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-diff, Size: 5561 bytes --] From 802f14e186de7a8cf540b8d8c04155da1d983731 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:19:44 +0200 Subject: [PATCH 2/6] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired--isolated-char-p) (dired--highlight-nosubst-char, dired--no-subst-prompt): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p) (dired-test-highlight-metachar): Test the new functions. (Bug#35564) --- lisp/dired-aux.el | 42 ++++++++++++++++++++++++++++++++---- test/lisp/dired-aux-tests.el | 28 ++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 4 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index d83e57d58d..d184598b92 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,42 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((start (max 0 (1- pos))) + (char (string (aref command pos)))) + (and (string-match + (rx (or (seq (or bos blank) + (group-n 1 (literal char)) + (or eos blank)) + (seq ?` (group-n 1 (literal char)) ?`))) + command start) + (= pos (match-beginning 1))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted:")) + (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -761,11 +797,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt 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 ccd3192792..80b6393931 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,34 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo `bar`?" 9)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0003-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch --] [-- Type: text/x-diff, Size: 11060 bytes --] From e2d8c836bfa221205d7c72f8fc983258d24d02ce Mon Sep 17 00:00:00 2001 From: Noam Postavsky <npostavs@gmail.com> Date: Thu, 27 Jun 2019 19:15:56 -0400 Subject: [PATCH 3/6] Dedup dired-aux isolated char searching (Bug#35564) * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--no-subst-prompt): Operate on a list of positions rather than searching again for isolated chars. Shorten prompt, and include the character being asked about in the question (to make it clearer, and in case the user can't see the fontification for whatever reason, e.g., screen reader). (dired--isolated-char-p): Remove. (dired--need-confirm-positions): New function. (dired-do-shell-command): Use it. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p): Remove. (dired-test-highlight-metachar): Adjust to new functions. Make sure that `*` isn't considered isolated. --- lisp/dired-aux.el | 113 ++++++++++++++++------------------- test/lisp/dired-aux-tests.el | 31 +++++----- 2 files changed, 67 insertions(+), 77 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index d184598b92..32a4988498 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,60 +60,60 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) - -(defun dired--isolated-char-p (command pos) - "Assert whether the character at POS is isolated within COMMAND. -A character is isolated if: -- it is surrounded by whitespace, the start of the command, or - the end of the command, -- it is surrounded by `\\=`' characters." - (let ((start (max 0 (1- pos))) - (char (string (aref command pos)))) - (and (string-match - (rx (or (seq (or bos blank) - (group-n 1 (literal char)) - (or eos blank)) - (seq ?` (group-n 1 (literal char)) ?`))) - command start) - (= pos (match-beginning 1))))) - -(defun dired--highlight-nosubst-char (command char) - "Highlight occurences of CHAR that are not isolated in COMMAND. -These occurences will not be substituted; they will be sent as-is -to the shell, which may interpret them as wildcards." - (save-match-data - (let ((highlighted (substring-no-properties command)) - (pos 0)) - (while (string-match (regexp-quote char) command pos) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (unless (dired--isolated-char-p command start) - (add-face-text-property start end 'warning nil highlighted)) - (setq pos end))) - highlighted))) - -(defun dired--no-subst-prompt (command char) - (let ((highlighted-command (dired--highlight-nosubst-char command char)) - (prompt "Confirm--the highlighted characters will not be substituted:")) - (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--no-subst-prompt (char-positions command) + (cl-callf substring-no-properties command) + (dolist (pos char-positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (concat command "\n" + (format-message + (ngettext "Send %d occurence of `%s' as-is to shell?" + "Send %d occurences of `%s' as-is to shell?" + (length char-positions)) + (length char-positions) + (propertize (string (aref command (car char-positions))) + 'face 'warning)))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -781,26 +781,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (dired--no-subst-prompt command "*"))) - ((need-confirm-p command "?") - (y-or-n-p (dired--no-subst-prompt command "?"))) - (t)))) + (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))) + ((setq confirmations (dired--need-confirm-positions command "?")) + (y-or-n-p (dired--no-subst-prompt confirmations command))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -811,7 +804,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 80b6393931..3f4bfffaf6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,34 +114,31 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) -(ert-deftest dired-test-isolated-char-p () - (should (dired--isolated-char-p "?" 0)) - (should (dired--isolated-char-p "? " 0)) - (should (dired--isolated-char-p " ?" 1)) - (should (dired--isolated-char-p " ? " 1)) - (should (dired--isolated-char-p "foo bar ? baz" 8)) - (should (dired--isolated-char-p "foo -i`?`" 7)) - (should-not (dired--isolated-char-p "foo `bar`?" 9)) - (should-not (dired--isolated-char-p "foo 'bar?'" 8)) - (should-not (dired--isolated-char-p "foo bar?baz" 7)) - (should-not (dired--isolated-char-p "foo bar?" 7))) - (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") - (result (dired--highlight-nosubst-char command "?"))) + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "?"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) (should (equal 'warning (get-text-property 15 'face result))) (should-not (text-property-not-all 16 28 'face nil result)) (should (equal 'warning (get-text-property 29 'face result))) (should-not (text-property-not-all 30 39 'face nil result))) - (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") - (result (dired--highlight-nosubst-char command "*"))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "*"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) (should (equal 'warning (get-text-property 11 'face result))) (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 24 'face result))) - (should-not (text-property-not-all 25 29 'face nil result)))) + (should (equal 'warning (get-text-property 25 'face result))) + (should-not (text-property-not-all 26 32 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0004-fixup-Dedup-dired-aux-isolated-char-searching-Bug-35.patch --] [-- Type: text/x-diff, Size: 2459 bytes --] From 2b93d2984cfa6ad9a33376a198707ebeb9d851b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 3 Jul 2019 21:29:38 +0200 Subject: [PATCH 4/6] fixup! Dedup dired-aux isolated char searching (Bug#35564) --- lisp/dired-aux.el | 4 ++-- test/lisp/dired-aux-tests.el | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 32a4988498..75c3a8952a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -108,8 +108,8 @@ dired--no-subst-prompt (add-face-text-property pos (1+ pos) 'warning nil command)) (concat command "\n" (format-message - (ngettext "Send %d occurence of `%s' as-is to shell?" - "Send %d occurences of `%s' as-is to shell?" + (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))) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 3f4bfffaf6..ff18edddb6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -118,8 +118,8 @@ dired-test-highlight-metachar "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") (prompt (dired--no-subst-prompt - command - (dired--need-confirm-positions command "?"))) + (dired--need-confirm-positions command "?") + command)) (result (and (string-match (regexp-quote command) prompt) (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) @@ -130,8 +130,8 @@ dired-test-highlight-metachar ;; Note that `?` is considered isolated, but `*` is not. (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") (prompt (dired--no-subst-prompt - command - (dired--need-confirm-positions command "*"))) + (dired--need-confirm-positions command "*") + command)) (result (and (string-match (regexp-quote command) prompt) (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0005-Add-markers-below-non-isolated-chars-in-dired-prompt.patch --] [-- Type: text/x-diff, Size: 7844 bytes --] From 5f4b3ed76a0b89f7a3dc2120cd2f29a3e64037bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 3 Jul 2019 21:17:57 +0200 Subject: [PATCH 5/6] Add '^' markers below non-isolated chars in dired prompt * lisp/dired-aux.el (dired--mark-positions): New function. (dired--no-subst-prompt): Use it to show chars without overly relying on highlighting. (dired-do-shell-command): When the echo area is wide enough to display the command without wrapping it, add the markers. * test/lisp/dired-aux-tests.el (dired-test-highlight-metachar): Add assertion for '^' marker positions. (Bug#35564) --- lisp/dired-aux.el | 43 +++++++++++++++++++++-------- test/lisp/dired-aux-tests.el | 53 ++++++++++++++++++++++++------------ 2 files changed, 68 insertions(+), 28 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 75c3a8952a..262ce64938 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -102,18 +102,35 @@ dired--need-confirm-positions (setq start (match-end 0))) confirm-positions)) -(defun dired--no-subst-prompt (char-positions command) +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--no-subst-prompt (char-positions command add-markers) (cl-callf substring-no-properties command) (dolist (pos char-positions) (add-face-text-property pos (1+ pos) 'warning nil command)) - (concat command "\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)))) + ;; `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))))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -784,15 +801,19 @@ 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))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) ((setq confirmations (dired--need-confirm-positions command "?")) - (y-or-n-p (dired--no-subst-prompt confirmations command))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) (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 ff18edddb6..58b3def2f5 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -115,30 +115,49 @@ dired-test-bug30624 (kill-buffer buf))))) (ert-deftest dired-test-highlight-metachar () - "Check that non-isolated meta-characters are highlighted" + "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 (dired--need-confirm-positions command "?") - command)) - (result (and (string-match (regexp-quote command) prompt) - (match-string 0 prompt)))) - (should-not (text-property-not-all 1 14 'face nil result)) - (should (equal 'warning (get-text-property 15 'face result))) - (should-not (text-property-not-all 16 28 'face nil result)) - (should (equal 'warning (get-text-property 29 'face result))) - (should-not (text-property-not-all 30 39 'face nil result))) + 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))) + (should-not (text-property-not-all 1 14 'face nil highlit-command)) + (should (equal 'warning (get-text-property 15 'face highlit-command))) + (should-not (text-property-not-all 16 28 'face nil highlit-command)) + (should (equal 'warning (get-text-property 29 'face highlit-command))) + (should-not (text-property-not-all 30 39 'face nil highlit-command))) ;; 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 (dired--need-confirm-positions command "*") - command)) - (result (and (string-match (regexp-quote command) prompt) - (match-string 0 prompt)))) - (should-not (text-property-not-all 1 10 'face nil result)) - (should (equal 'warning (get-text-property 11 'face result))) - (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 25 'face result))) - (should-not (text-property-not-all 26 32 'face nil result)))) + 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))) + (should-not (text-property-not-all 1 10 'face nil highlit-command)) + (should (equal 'warning (get-text-property 11 'face highlit-command))) + (should-not (text-property-not-all 12 23 'face nil highlit-command)) + (should (equal 'warning (get-text-property 25 'face highlit-command))) + (should-not (text-property-not-all 26 32 'face nil highlit-command)) + (let* ((command "sed 's/\\?/!/'") + (prompt (dired--no-subst-prompt + (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)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0006-Simplify-highlighting-assertions.patch --] [-- Type: text/x-diff, Size: 3416 bytes --] From 086937da30b912e8c0f44e3c7e8e2f5545b4f687 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 12 Jul 2019 16:10:54 +0200 Subject: [PATCH 6/6] Simplify highlighting assertions * test/lisp/dired-aux-tests.el (dired-test--check-highlighting): New function. (dired-test-highlight-metachar): Use it. (Bug#35564) --- test/lisp/dired-aux-tests.el | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 58b3def2f5..ba10c54332 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,15 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted." (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") @@ -127,11 +136,7 @@ dired-test-highlight-metachar (should (= (length lines) 4)) (should (string-match (regexp-quote command) highlit-command)) (should (string-match (regexp-quote markers) (nth 2 lines))) - (should-not (text-property-not-all 1 14 'face nil highlit-command)) - (should (equal 'warning (get-text-property 15 'face highlit-command))) - (should-not (text-property-not-all 16 28 'face nil highlit-command)) - (should (equal 'warning (get-text-property 29 'face highlit-command))) - (should-not (text-property-not-all 30 39 'face nil highlit-command))) + (dired-test--check-highlighting highlit-command '(15 29))) ;; Note that `?` is considered isolated, but `*` is not. (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") (markers " ^ ^") @@ -144,11 +149,7 @@ dired-test-highlight-metachar (should (= (length lines) 4)) (should (string-match (regexp-quote command) highlit-command)) (should (string-match (regexp-quote markers) (nth 2 lines))) - (should-not (text-property-not-all 1 10 'face nil highlit-command)) - (should (equal 'warning (get-text-property 11 'face highlit-command))) - (should-not (text-property-not-all 12 23 'face nil highlit-command)) - (should (equal 'warning (get-text-property 25 'face highlit-command))) - (should-not (text-property-not-all 26 32 'face nil highlit-command)) + (dired-test--check-highlighting highlit-command '(11 25))) (let* ((command "sed 's/\\?/!/'") (prompt (dired--no-subst-prompt (dired--need-confirm-positions command "?") @@ -157,7 +158,8 @@ dired-test-highlight-metachar (lines (split-string prompt "\n")) (highlit-command (nth 1 lines))) (should (= (length lines) 3)) - (should (string-match (regexp-quote command) highlit-command)))) + (should (string-match (regexp-quote command) highlit-command)) + (dired-test--check-highlighting highlit-command '(8)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Attachment #8: Type: text/plain, Size: 764 bytes --] Again, thank you for your patience and your reviews. PS: the prompt now looks like this ('?' characters are highlighted with the warning face): With markers: > Confirm: > sed 's/\?/!/' > ^ > Send 1 occurrence of ‘?’ as-is to shell? Without markers: > Confirm: > sed 's/\?/!/' > Send 1 occurrence of ‘?’ as-is to shell? I added the "Confirm:" line because - y-or-n-p adds "Please answer y or n. " before the prompt when the user fails to answer correctly, so the markers would not line up if the command remained on the first line, - y-or-n-p adds " (y or n)" after the prompt; I find it more legible to have the question next to this suffix, so I did not want to move the question to the first line. ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-12 15:10 ` Kévin Le Gouguec @ 2019-07-27 11:20 ` Eli Zaretskii 2019-07-27 17:26 ` Kévin Le Gouguec 2019-07-27 22:03 ` Basil L. Contovounesios 0 siblings, 2 replies; 76+ messages in thread From: Eli Zaretskii @ 2019-07-27 11:20 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, monnier, npostavs > From: Kévin Le Gouguec <kevin.legouguec@gmail.com> > Cc: Eli Zaretskii <eliz@gnu.org>, Stefan Monnier > <monnier@iro.umontreal.ca>, Drew Adams <drew.adams@oracle.com>, Noam > Postavsky <npostavs@gmail.com> > Date: Fri, 12 Jul 2019 17:10:26 +0200 > > I have now added '^' markers below the highlighted command, on condition > that the echo area is wide enough not to wrap lines. > > Do we want to add some customizability (highlight face, whether or not > to display '^' markers), or is this good enough for now? > > > The patch series now includes: > > - two patches to make y-or-n-p preserve text properties and implement an > initial version of highlighting, > - Noam's refactoring patch, plus fixups, > - one patch to add '^' markers, > - one last patch to make tests less tedious to maintain. Any more comments, anyone? Is there anything in these changes that would warrant a NEWS entry? Thanks. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-27 11:20 ` Eli Zaretskii @ 2019-07-27 17:26 ` Kévin Le Gouguec 2019-07-27 22:22 ` Michael Heerdegen 2019-07-27 22:03 ` Basil L. Contovounesios 1 sibling, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-07-27 17:26 UTC (permalink / raw) To: Eli Zaretskii; +Cc: michael_heerdegen, 35564, monnier, npostavs Eli Zaretskii <eliz@gnu.org> writes: >> From: Kévin Le Gouguec <kevin.legouguec@gmail.com> >> Cc: Eli Zaretskii <eliz@gnu.org>, Stefan Monnier >> <monnier@iro.umontreal.ca>, Drew Adams <drew.adams@oracle.com>, Noam >> Postavsky <npostavs@gmail.com> >> Date: Fri, 12 Jul 2019 17:10:26 +0200 >> >> I have now added '^' markers below the highlighted command, on condition >> that the echo area is wide enough not to wrap lines. >> >> Do we want to add some customizability (highlight face, whether or not >> to display '^' markers), or is this good enough for now? >> >> >> The patch series now includes: >> >> - two patches to make y-or-n-p preserve text properties and implement an >> initial version of highlighting, >> - Noam's refactoring patch, plus fixups, >> - one patch to add '^' markers, >> - one last patch to make tests less tedious to maintain. > > Any more comments, anyone? Michael had some comments over at bug#28969, but no objections AFAICT. Michael, did you get the chance to try the patch out? > Is there anything in these changes that would warrant a NEWS entry? The changes are only cosmetic: the user interaction has not changed (tell Dired to run a command, press 'y' to confirm). The prompt is simply more verbose now. There are no new variables for the user to customize either, if I am not mistaken. NB: I squashed all those patches in [2], to make it easier to try the new prompt out. The squashed patch's commit message summarizes every change, and mentions both bugs; I don't know if it makes more sense to commit the series or the squashed patch to the repository. [1] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28969#22 [2] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28969#19 ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-27 17:26 ` Kévin Le Gouguec @ 2019-07-27 22:22 ` Michael Heerdegen 2019-07-29 3:29 ` Michael Heerdegen 0 siblings, 1 reply; 76+ messages in thread From: Michael Heerdegen @ 2019-07-27 22:22 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, monnier, npostavs Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > Michael, did you get the chance to try the patch out? I skimmed through the changes and have installed it, but I didn't yet try it. Will do ASAP, hopefully tonight. Michael. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-27 22:22 ` Michael Heerdegen @ 2019-07-29 3:29 ` Michael Heerdegen 2019-07-29 18:11 ` Juri Linkov 2019-07-29 19:01 ` Kévin Le Gouguec 0 siblings, 2 replies; 76+ messages in thread From: Michael Heerdegen @ 2019-07-29 3:29 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, monnier, npostavs Michael Heerdegen <michael_heerdegen@web.de> writes: > I skimmed through the changes and have installed it, but I didn't yet > try it. Will do ASAP, hopefully tonight. Ok, I did. It worked well without problems, and nicely indicates the questionable character(s). I dunno if the double emphasizing in the y-n-prompt (coloring + additional underlining with "^") is a bit too much. A bit related: Maybe the second line could be combined with the first line so that one line is saved. I mean, the prompt is four lines high with this change, quite a lot. Dunno what others think about it. Anyway, I like it. Thanks, Michael. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-29 3:29 ` Michael Heerdegen @ 2019-07-29 18:11 ` Juri Linkov 2019-07-29 19:01 ` Kévin Le Gouguec 1 sibling, 0 replies; 76+ messages in thread From: Juri Linkov @ 2019-07-29 18:11 UTC (permalink / raw) To: Michael Heerdegen; +Cc: Kévin Le Gouguec, 35564, npostavs, monnier > I dunno if the double emphasizing in the y-n-prompt (coloring + > additional underlining with "^") is a bit too much. A bit related: Maybe additional underlining should be used only when the current display doesn't support colors. > Maybe the second line could be combined with the first line so that one > line is saved. I mean, the prompt is four lines high with this change, > quite a lot. Dunno what others think about it. Then with using colors the prompt could fit into one line (when the display supports colors). ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-29 3:29 ` Michael Heerdegen 2019-07-29 18:11 ` Juri Linkov @ 2019-07-29 19:01 ` Kévin Le Gouguec 2019-08-02 5:26 ` Michael Heerdegen 1 sibling, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-07-29 19:01 UTC (permalink / raw) To: Michael Heerdegen; +Cc: 35564, monnier, npostavs [-- Attachment #1: Type: text/plain, Size: 1907 bytes --] Michael Heerdegen <michael_heerdegen@web.de> writes: > I dunno if the double emphasizing in the y-n-prompt (coloring + > additional underlining with "^") is a bit too much. The patch series started out with just the coloring, which we figured might have accessibility issues on its own (we can't assume that the user can distinguish colors); we added the '^' markers to alleviate this; then… > A bit related: > Maybe the second line could be combined with the first line so that one > line is saved. (Assuming the first line you mention is "Confirm" and the second line is the command, which would make the '^' markers the third line; apologies if I misunderstood) … I realized that when the user fails to answer 'y' or 'n', y-or-n-p prepends "Please answer y or n." to the prompt, i.e. this… sed 's/?/!/' ^ … becomes this: Please answer y or n. sed 's/?/!/' ^ AFAICT, this means that we need a newline *before* the command (unless we add an optional RETRY-PROMPT argument to y-or-n-p or something). (I added comments to try to explain this in dired--no-subst-prompt; tell me if they need more work.) > I mean, the prompt is four lines high with this change, > quite a lot. Dunno what others think about it. It is fairly more heavyweight than before. And the irony is, I am still not 100% satisfied with it; I worry that the user will take "Send 1 occurrence of `*' as-is to shell?" to mean "Escape 1 occurrence of `*' so that the shell leaves it as-is?". Tell me if the shed is about to crumble under the weight of paint, but if we are fine with so many lines, could we perhaps rephrase… > Confirm > sed 's/?/!/' > ^ > Send 1 occurrence of `?' as-is to shell? … to: > Warning: the shell may interpret 1 occurrence of `?' as wildcard: > sed 's/?/!/' > ^ > Proceed anyway? [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Tweak-dired-do-shell-command-warning-some-more.patch --] [-- Type: text/x-patch, Size: 1798 bytes --] From 97d5ec40ccbb3a2d366aaa05b45e29690ee5288a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Mon, 29 Jul 2019 20:48:53 +0200 Subject: [PATCH] Tweak dired-do-shell-command warning some more * lisp/dired-aux.el (dired--no-subst-prompt): Clarify what we are concerned about. (bug#28969, bug#35564) --- lisp/dired-aux.el | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 3887d75356..35052785ba 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -120,17 +120,18 @@ dired--no-subst-prompt ;; text will shove the command to the right, and the '^' markers ;; will become misaligned. (apply #'concat - `("Confirm:\n" + `(,(format-message + (ngettext + "Warning: the shell may interpret %d occurrence of `%s' as wildcard:\n" + "Warning: the shell may interpret %d occurrences of `%s' as wildcards:\n" + (length char-positions)) + (length char-positions) + (propertize (string (aref command (car char-positions))) + 'face 'warning)) ,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))))) + "Proceed anyway?"))) ;;;###autoload (defun dired-diff (file &optional switches) -- 2.22.0 [-- Attachment #3: Type: text/plain, Size: 315 bytes --] (Can be applied on top of the patch series or the squashed patch; if the latter, the commit message can be discarded. Tests unchanged, since they only look at the command and the markers.) If everybody likes the prompt well enough without this umpteenth tweak, it's fine by me. Thank you all for your patience. ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-29 19:01 ` Kévin Le Gouguec @ 2019-08-02 5:26 ` Michael Heerdegen 2019-08-08 10:40 ` Kévin Le Gouguec 0 siblings, 1 reply; 76+ messages in thread From: Michael Heerdegen @ 2019-08-02 5:26 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, monnier, npostavs Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > > I dunno if the double emphasizing in the y-n-prompt (coloring + > > additional underlining with "^") is a bit too much. > > The patch series started out with just the coloring, which we figured > might have accessibility issues on its own (we can't assume that the > user can distinguish colors); we added the '^' markers to alleviate > this; then… Yeah, as mentioned, when coloring is possible, I would also just leave out the ^ underlining. > (Assuming the first line you mention is "Confirm" and the second line is > the command, which would make the '^' markers the third line; apologies > if I misunderstood) Yes, I suggested to combine Confirm... with the command in the first line. > … I realized that when the user fails to answer 'y' or 'n', y-or-n-p > prepends "Please answer y or n." to the prompt, i.e. this… > > sed 's/?/!/' > ^ > > … becomes this: > > Please answer y or n. sed 's/?/!/' > ^ > > AFAICT, this means that we need a newline *before* the command (unless > we add an optional RETRY-PROMPT argument to y-or-n-p or something). > > (I added comments to try to explain this in dired--no-subst-prompt; tell > me if they need more work.) Looks fine. > And the irony is, I am still not 100% satisfied with it; I worry that > the user will take "Send 1 occurrence of `*' as-is to shell?" to mean > "Escape 1 occurrence of `*' so that the shell leaves it as-is?". > > Tell me if the shed is about to crumble under the weight of paint, No, a valid concern, and it's good that you noticed. > but if we are fine with so many lines, could we perhaps rephrase… > > > Confirm > > sed 's/?/!/' > > ^ > > Send 1 occurrence of `?' as-is to shell? > > … to: > > > Warning: the shell may interpret 1 occurrence of `?' as wildcard: > > sed 's/?/!/' > > ^ > > Proceed anyway? I'm not happy with that either. Look at it: there are quotes around the critical part, so the user might become crazy trying to find out why Emacs thinks the shell might interpret that as a wildcard. The highlighting even more makes it look like there is something wrong with the command. Even "proceed anyway" as you chose makes it sound like this is an exception/ something wrong although it is totally legitimate. Maybe just telling what dired did not do would be better? Like "N occurrences of X will not be replaced with the file/file list - proceed? Because, there are two things we mix up: (1) dired does not substitute with files, though the user might have wanted that, and (2) the char is send to the shell and is a wildcard there, so the result might also not be what the user intended. Do we want to warn about (1) or (2)? Both seems to be too much for one line of text. If we don't find a good wording maybe use something like `read-multiple-choice' or some other mechanism where the user is allowed to hit a help key (?, and that key should also be visible in the prompt). We can leave an explanation that doesn't have to fit into one line in the help text. I only mention `read-multiple-choice' because it provides all of that out of the box, of course there are alternative ways. Michael. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-08-02 5:26 ` Michael Heerdegen @ 2019-08-08 10:40 ` Kévin Le Gouguec 2019-08-08 21:06 ` Juri Linkov 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-08-08 10:40 UTC (permalink / raw) To: Michael Heerdegen; +Cc: npostavs, 35564, monnier, Juri Linkov First, apologies for taking so long to respond - I was AFK last week. I might not be very reactive these coming weeks either. Michael Heerdegen <michael_heerdegen@web.de> writes: > Yeah, as mentioned, when coloring is possible, I would also just leave > out the ^ underlining. OK. What exactly do we mean by "coloring is possible"? 1. "Does the warning face have a distinct foreground or background from the prompt face?" 2. "Are the colors distinguishable enough?" (e.g. what shr-color-visible tries to guess IIUC) 3. Something else? What bothers me is that even if we can assert #2, nothing guarantees that these colors will be distinguishable *to the user* (who may e.g. have some form of color blindness). It would therefore be nice if this user could force Emacs to use ^ markers; I guess that would involve a new variable. I stayed away from this path because I wasn't convinced that we needed a full-blown customization option for a supposedly rare branch in dired-do-shell-command, and that we could live with the redundant coloring plus underlining. I'd be happy to make the prompt more succinct, as soon as I'm sure I understand what we mean by "coloring is possible"! >> > Warning: the shell may interpret 1 occurrence of `?' as wildcard: >> > sed 's/?/!/' >> > ^ >> > Proceed anyway? > > I'm not happy with that either. Look at it: there are quotes around the > critical part, so the user might become crazy trying to find out why > Emacs thinks the shell might interpret that as a wildcard. Right. Becoming crazy because Emacs sees phantom wildcards is the reason why I started this bug report; I hoped that by saying "*may* interpret", the user would understand that Emacs is basically saying "this looks like a common footgun; I don't speak shell though so you tell me". > Maybe just telling what dired did not do would be better? Like > "N occurrences of X will not be replaced with the file/file list - > proceed? That would be the most correct description of the situation. I didn't go that way because the user might not be aware of this feature; I failed to come up with a short prompt that would 1. explain the substitution feature and 2. explain why Dired will not activate it here. > Because, there are two things we mix up: (1) dired does not substitute > with files, though the user might have wanted that, and (2) the char is > send to the shell and is a wildcard there, so the result might also not > be what the user intended. Do we want to warn about (1) or (2)? Both > seems to be too much for one line of text. Very much agreed. > If we don't find a good wording maybe use something like > `read-multiple-choice' or some other mechanism where the user is allowed > to hit a help key (?, and that key should also be visible in the > prompt). We can leave an explanation that doesn't have to fit into one > line in the help text. I only mention `read-multiple-choice' because it > provides all of that out of the box, of course there are alternative > ways. That sounds like a good compromise. I'll see what I can come up with. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-08-08 10:40 ` Kévin Le Gouguec @ 2019-08-08 21:06 ` Juri Linkov 2019-08-09 12:43 ` Kévin Le Gouguec 0 siblings, 1 reply; 76+ messages in thread From: Juri Linkov @ 2019-08-08 21:06 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: Michael Heerdegen, 35564, monnier, npostavs > First, apologies for taking so long to respond - I was AFK last week. I > might not be very reactive these coming weeks either. I use the substitution feature in dired-do-shell-command quite rarely, but today I needed to use it, and it strikes as partly unusable and confusing. There are several problems: 1. Answering "no" cancels the command. Instead of this, it should proceed without substitution. There is a special key `C-g' to cancel the command. 2. The current question is too ambiguous: Confirm--do you mean to use ‘?’ as a wildcard? (y or n) A wildcard can mean both dired substitution and shell substitution. A better question should use the same terms as documented in the docstring of `dired-do-shell-command', i.e. "marked files", "file list". So a better question would be: Confirm--do you mean to substitute ‘?’ with marked files? (y or n) Or something similar that makes clear that substitution applies to dired files, not files matched by shell. 3. I still can't be sure if after asking these question, dired still does the right thing. I'd prefer to have an option to show the final command before running it, exactly like `C-u M-x rgrep' does with its `confirm' argument. Yes, its command line is quite long, but this is not a problem: wrapped minibuffer content is less problematic than multi-line prompts. > What bothers me is that even if we can assert #2, nothing guarantees > that these colors will be distinguishable *to the user* (who may > e.g. have some form of color blindness). It would therefore be nice if > this user could force Emacs to use ^ markers; I guess that would involve > a new variable. As was already discussed in this thread, using (:inherit '(warning underline)) will solve this problem and improve accessibility. So there will be no need in multi-line prompt when using underline face attribute. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-08-08 21:06 ` Juri Linkov @ 2019-08-09 12:43 ` Kévin Le Gouguec 2019-08-09 18:03 ` Juri Linkov 2019-08-15 20:56 ` Juri Linkov 0 siblings, 2 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-08-09 12:43 UTC (permalink / raw) To: Juri Linkov; +Cc: Michael Heerdegen, 35564, monnier, npostavs Juri Linkov <juri@linkov.net> writes: > I use the substitution feature in dired-do-shell-command quite rarely, > but today I needed to use it, and it strikes as partly unusable > and confusing. Welcome to the club :) > 2. The current question is too ambiguous: > > Confirm--do you mean to use ‘?’ as a wildcard? (y or n) > > A wildcard can mean both dired substitution and shell substitution. > A better question should use the same terms as documented in the > docstring of `dired-do-shell-command', i.e. "marked files", "file list". > So a better question would be: > > Confirm--do you mean to substitute ‘?’ with marked files? (y or n) > > Or something similar that makes clear that substitution applies > to dired files, not files matched by shell. Mmm, I think that the current prompt *does* use the same terms as documented in the docstring: it simply mistakenly assumes that if '?' and '*' are not "isolated", the shell will unconditionally process them as wildcards. It is a heuristic that fails to consider that '?' and '*' may be quoted or escaped. So with this prompt, "yes" means "yes, I want the shell to (possibly) substitute these characters", while "no" means "By Jove, what a silly mistake I was about to make! Thank you ever so much for catching it Dired old chap! Let me add some backquotes around this '?' so that you can be sure I mean for you to substitute it for the marked files." IIUC, your suggested prompt does not match what dired-do-shell-command actually does: the function only ever substitutes '?' if it is "isolated", i.e. surrounded with whitespace or backquotes. Cf. the docstring: > ‘*’ and ‘?’ when not surrounded by whitespace nor ‘`’ have no special > significance for ‘dired-do-shell-command’, and are passed through > normally to the shell, but you must confirm first. (Drew suggested that we may want to change *the code* to behave as your prompt suggests[1], I sketched a possible way to let the user select which occurrences to substitute[2], but did not act on it as AFAICT this use-case is already handled by adding backquotes around '?') >> What bothers me is that even if we can assert #2, nothing guarantees >> that these colors will be distinguishable *to the user* (who may >> e.g. have some form of color blindness). It would therefore be nice if >> this user could force Emacs to use ^ markers; I guess that would involve >> a new variable. > > As was already discussed in this thread, using (:inherit '(warning underline)) > will solve this problem and improve accessibility. So there will be > no need in multi-line prompt when using underline face attribute. Mmm. I went to a TTY to check how (:inherit '(underline)) looks. Since (display-supports-face-attributes-p '(:underline t)) is nil there, the "underline" face is defined as (:weight bold), which merely makes the foreground color brighter. So (:inherit '(warning underline)) amounts to just (:inherit '(warning)). Perhaps (display-supports-face-attributes-p '(:underline t)) can be used to decide whether we need to add ^ markers. [1] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35564#89 [2] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28969#19 ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-08-09 12:43 ` Kévin Le Gouguec @ 2019-08-09 18:03 ` Juri Linkov 2019-08-15 20:56 ` Juri Linkov 1 sibling, 0 replies; 76+ messages in thread From: Juri Linkov @ 2019-08-09 18:03 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: Michael Heerdegen, 35564, monnier, npostavs >> 2. The current question is too ambiguous: >> >> Confirm--do you mean to use ‘?’ as a wildcard? (y or n) >> >> A wildcard can mean both dired substitution and shell substitution. >> A better question should use the same terms as documented in the >> docstring of `dired-do-shell-command', i.e. "marked files", "file list". >> So a better question would be: >> >> Confirm--do you mean to substitute ‘?’ with marked files? (y or n) >> >> Or something similar that makes clear that substitution applies >> to dired files, not files matched by shell. > > Mmm, I think that the current prompt *does* use the same terms as > documented in the docstring: it simply mistakenly assumes that if '?' > and '*' are not "isolated", the shell will unconditionally process them > as wildcards. It is a heuristic that fails to consider that '?' and '*' > may be quoted or escaped. Do you mean this case: despite that the docstring of `dired-do-shell-command' mentions "a shell wildcard", typing on a file: ! cat '*' and confirming with `y': Confirm--do you mean to use ‘*’ as a wildcard? (y or n) y still doesn't use * as "a shell wildcard". Then I agree. >> As was already discussed in this thread, using (:inherit '(warning underline)) >> will solve this problem and improve accessibility. So there will be >> no need in multi-line prompt when using underline face attribute. > > Mmm. I went to a TTY to check how (:inherit '(underline)) looks. Since > (display-supports-face-attributes-p '(:underline t)) is nil there, the > "underline" face is defined as (:weight bold), which merely makes the > foreground color brighter. So (:inherit '(warning underline)) amounts > to just (:inherit '(warning)). > > Perhaps (display-supports-face-attributes-p '(:underline t)) can be used > to decide whether we need to add ^ markers. You can check all possible face attributes to find the one available on tty: underline, weight: bold, inverse-video, ... ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-08-09 12:43 ` Kévin Le Gouguec 2019-08-09 18:03 ` Juri Linkov @ 2019-08-15 20:56 ` Juri Linkov 2019-08-19 4:55 ` Kévin Le Gouguec 1 sibling, 1 reply; 76+ messages in thread From: Juri Linkov @ 2019-08-15 20:56 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: Michael Heerdegen, 35564, monnier, npostavs > IIUC, your suggested prompt does not match what dired-do-shell-command > actually does: the function only ever substitutes '?' if it is > "isolated", i.e. surrounded with whitespace or backquotes. Cf. the > docstring: > >> ‘*’ and ‘?’ when not surrounded by whitespace nor ‘`’ have no special >> significance for ‘dired-do-shell-command’, and are passed through >> normally to the shell, but you must confirm first. I collected a short summary that shows one case is still missing (‘!’ means Dired prompt called on the marked file, and ‘$’ is the corresponding shell command): 1. ? ! cat ? $ cat marked ! cat ./? Confirm--do you mean to use ‘?’ as a wildcard? (y or n) y $ cat ./? marked ! cat ?"" Confirm--do you mean to use ‘?’ as a wildcard? (y or n) y $ cat ? marked ! cat '?' Confirm--do you mean to use ‘?’ as a wildcard? (y or n) y $ cat '?' marked cat: '?': No such file or directory ! cat ./`?` $ cat ./marked 2. * ! cat * $ cat marked ! cat ./* Confirm--do you mean to use ‘*’ as a wildcard? (y or n) y $ cat ./* marked ! cat *"" Confirm--do you mean to use ‘*’ as a wildcard? (y or n) y $ cat * marked ! cat '*' Confirm--do you mean to use ‘*’ as a wildcard? (y or n) y $ cat '*' marked cat: '*': No such file or directory Now the missing case - how to do the same that ‘cat ./`?`’ does, i.e. how to substitute ‘*’ by marked files in such Dired prompt: ! cat ./`*` Confirm--do you mean to use ‘*’ as a wildcard? (y or n) y $ cat ./`*` marked /bin/bash: marked: command not found cat: ./: Is a directory Why can't it run this shell command: $ cat ./marked ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-08-15 20:56 ` Juri Linkov @ 2019-08-19 4:55 ` Kévin Le Gouguec 0 siblings, 0 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-08-19 4:55 UTC (permalink / raw) To: Juri Linkov; +Cc: Michael Heerdegen, 35564, monnier, npostavs Juri Linkov <juri@linkov.net> writes: > Now the missing case - how to do the same that ‘cat ./`?`’ does, > i.e. how to substitute ‘*’ by marked files in such Dired prompt: > > ! cat ./`*` > Confirm--do you mean to use ‘*’ as a wildcard? (y or n) y > $ cat ./`*` marked > /bin/bash: marked: command not found > cat: ./: Is a directory > > Why can't it run this shell command: > > $ cat ./marked AFAICT, because dired--star-or-qmark-p does not handle `*`: > Isolated means that MATCH is surrounded by spaces or at the beginning/end > of STRING followed/prefixed with an space. A match to ‘`?`’, > isolated or not, is also valid. I've skimmed the docstrings and comments for dired--star-or-qmark-p, dired-shell-stuff-it and dired-do-shell-command, but I could not find a rationale for not handling that case. git log -G'`\*`' hasn't finished yet but so far it hasn't told me anything either. If this is something we want[1], we can add it independently of this bug report. If no-one has committed it (or created a new bug report for it) by the time I get back to coding, I might throw in a patch for that in the series; chances are it might simplify the code somewhat, since ? and * will then be handled similarly. Thanks for the survey Juri! [1] I see no reason not to support it, since otherwise the shell translates `*` into the command first-file-according-to-locale other-files… which doesn't strike me as very useful behaviour. Substituting `*` for the file list, like we substitute `?` for each file, could make sense, e.g. for ! some-command "`*`" where some-command wants a space-separated file list as a single argument (though I can't come up with an actual command off the top of my head). ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-27 11:20 ` Eli Zaretskii 2019-07-27 17:26 ` Kévin Le Gouguec @ 2019-07-27 22:03 ` Basil L. Contovounesios 2019-07-27 23:32 ` Kévin Le Gouguec 1 sibling, 1 reply; 76+ messages in thread From: Basil L. Contovounesios @ 2019-07-27 22:03 UTC (permalink / raw) To: Eli Zaretskii; +Cc: Kévin Le Gouguec, 35564, npostavs, monnier Eli Zaretskii <eliz@gnu.org> writes: > Any more comments, anyone? Just a couple of very minor questions from me: Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > -(defun dired--no-subst-prompt (char-positions command) > +(defun dired--mark-positions (positions) > + (let ((markers (make-string > + (1+ (apply #'max positions)) Is POSITIONS guaranteed to be non-nil? (The max function takes at least one argument.) > Subject: [PATCH 6/6] Simplify highlighting assertions > > * test/lisp/dired-aux-tests.el (dired-test--check-highlighting): > New function. > (dired-test-highlight-metachar): Use it. Will this simplification hinder debugging of test failures? I don't have an opinion on the proposed change, it's just something to consider. > Again, thank you for your patience and your reviews. Thank you for working on this, -- Basil ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-27 22:03 ` Basil L. Contovounesios @ 2019-07-27 23:32 ` Kévin Le Gouguec 2019-07-27 23:41 ` Basil L. Contovounesios 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-07-27 23:32 UTC (permalink / raw) To: Basil L. Contovounesios; +Cc: 35564, monnier, npostavs [-- Attachment #1: Type: text/plain, Size: 1790 bytes --] "Basil L. Contovounesios" <contovob@tcd.ie> writes: >> -(defun dired--no-subst-prompt (char-positions command) >> +(defun dired--mark-positions (positions) >> + (let ((markers (make-string >> + (1+ (apply #'max positions)) > > Is POSITIONS guaranteed to be non-nil? (The max function takes at least > one argument.) AFAICT dired--mark-positions is only called by dired--no-subst-prompt, which is only used when there is at least one ambiguous character to highlight. So as things stand now, POSITIONS will always be non-nil. Nothing prevents someone from attempting to re-use the function with a potentially-nil argument though. I don't know what makes more sense here: adding an assertion? Handling the nil case explicitly for robustness? >> Subject: [PATCH 6/6] Simplify highlighting assertions >> >> * test/lisp/dired-aux-tests.el (dired-test--check-highlighting): >> New function. >> (dired-test-highlight-metachar): Use it. > > Will this simplification hinder debugging of test failures? I don't > have an opinion on the proposed change, it's just something to consider. Mmm. Since the assertion that fails is now nested in a more generic function, the report shown in the ERT-Results buffer might be somewhat less informative; one has to bring up the backtrace to understand the context. I could try my hand at an ERT explainer for these assertions. Or we could just drop the 6th patch… I do find the tests easier to read and write with it though. PS: Looking at this made me realize that patch #5 was borked (missed a parenthesis in dired-test-highlight-metachar, so the tests just plain wouldn't run). Here is the patch series with patches #5 and #6 fixed. The squashed patch[1] remains the same. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Preserve-text-properties-in-y-or-n-p-prompts.patch --] [-- Type: text/x-diff, Size: 2109 bytes --] From f8f22404a6e0a46cd27149491df781d8c2c4cea8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:03:59 +0200 Subject: [PATCH 1/6] Preserve text properties in y-or-n-p prompts * lisp/subr.el (read--propertize-prompt): New function to append the prompt face to a string. (y-or-n-p): Use it instead of discarding potential text properties. (Bug#35564) --- lisp/subr.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index eea4e045dd..0766530239 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2343,6 +2343,9 @@ memory-limit \f ;;;; Input and display facilities. +(defun read--propertize-prompt (prompt) + (add-face-text-property 0 (length prompt) 'minibuffer-prompt t prompt)) + (defconst read-key-empty-map (make-sparse-keymap)) (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. @@ -2680,14 +2683,14 @@ y-or-n-p (let* ((scroll-actions '(recenter scroll-up scroll-down scroll-other-window scroll-other-window-down)) (key - (let ((cursor-in-echo-area t)) + (let ((cursor-in-echo-area t) + (prompt (if (memq answer scroll-actions) + prompt + (concat "Please answer y or n. " prompt)))) (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. " - prompt)) - 'face 'minibuffer-prompt))))) + (read--propertize-prompt prompt) + (read-key prompt)))) (setq answer (lookup-key query-replace-map (vector key) t)) (cond ((memq answer '(skip act)) nil) -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-diff, Size: 5561 bytes --] From 047a2d355cbd167d93a1bbd25de64e2fb16fd815 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:19:44 +0200 Subject: [PATCH 2/6] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired--isolated-char-p) (dired--highlight-nosubst-char, dired--no-subst-prompt): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p) (dired-test-highlight-metachar): Test the new functions. (Bug#35564) --- lisp/dired-aux.el | 42 ++++++++++++++++++++++++++++++++---- test/lisp/dired-aux-tests.el | 28 ++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 4 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 30a941c7bb..1e1ebf7552 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,42 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((start (max 0 (1- pos))) + (char (string (aref command pos)))) + (and (string-match + (rx (or (seq (or bos blank) + (group-n 1 (literal char)) + (or eos blank)) + (seq ?` (group-n 1 (literal char)) ?`))) + command start) + (= pos (match-beginning 1))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted:")) + (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -761,11 +797,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt 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 ccd3192792..80b6393931 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,34 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo `bar`?" 9)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0003-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch --] [-- Type: text/x-diff, Size: 11060 bytes --] From 83497dc721d098ba089589ec2a5987a3b986c807 Mon Sep 17 00:00:00 2001 From: Noam Postavsky <npostavs@gmail.com> Date: Thu, 27 Jun 2019 19:15:56 -0400 Subject: [PATCH 3/6] Dedup dired-aux isolated char searching (Bug#35564) * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--no-subst-prompt): Operate on a list of positions rather than searching again for isolated chars. Shorten prompt, and include the character being asked about in the question (to make it clearer, and in case the user can't see the fontification for whatever reason, e.g., screen reader). (dired--isolated-char-p): Remove. (dired--need-confirm-positions): New function. (dired-do-shell-command): Use it. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p): Remove. (dired-test-highlight-metachar): Adjust to new functions. Make sure that `*` isn't considered isolated. --- lisp/dired-aux.el | 113 ++++++++++++++++------------------- test/lisp/dired-aux-tests.el | 31 +++++----- 2 files changed, 67 insertions(+), 77 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 1e1ebf7552..ca5b8cf801 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,60 +60,60 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) - -(defun dired--isolated-char-p (command pos) - "Assert whether the character at POS is isolated within COMMAND. -A character is isolated if: -- it is surrounded by whitespace, the start of the command, or - the end of the command, -- it is surrounded by `\\=`' characters." - (let ((start (max 0 (1- pos))) - (char (string (aref command pos)))) - (and (string-match - (rx (or (seq (or bos blank) - (group-n 1 (literal char)) - (or eos blank)) - (seq ?` (group-n 1 (literal char)) ?`))) - command start) - (= pos (match-beginning 1))))) - -(defun dired--highlight-nosubst-char (command char) - "Highlight occurences of CHAR that are not isolated in COMMAND. -These occurences will not be substituted; they will be sent as-is -to the shell, which may interpret them as wildcards." - (save-match-data - (let ((highlighted (substring-no-properties command)) - (pos 0)) - (while (string-match (regexp-quote char) command pos) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (unless (dired--isolated-char-p command start) - (add-face-text-property start end 'warning nil highlighted)) - (setq pos end))) - highlighted))) - -(defun dired--no-subst-prompt (command char) - (let ((highlighted-command (dired--highlight-nosubst-char command char)) - (prompt "Confirm--the highlighted characters will not be substituted:")) - (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--no-subst-prompt (char-positions command) + (cl-callf substring-no-properties command) + (dolist (pos char-positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (concat command "\n" + (format-message + (ngettext "Send %d occurence of `%s' as-is to shell?" + "Send %d occurences of `%s' as-is to shell?" + (length char-positions)) + (length char-positions) + (propertize (string (aref command (car char-positions))) + 'face 'warning)))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -781,26 +781,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (dired--no-subst-prompt command "*"))) - ((need-confirm-p command "?") - (y-or-n-p (dired--no-subst-prompt command "?"))) - (t)))) + (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))) + ((setq confirmations (dired--need-confirm-positions command "?")) + (y-or-n-p (dired--no-subst-prompt confirmations command))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -811,7 +804,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 80b6393931..3f4bfffaf6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,34 +114,31 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) -(ert-deftest dired-test-isolated-char-p () - (should (dired--isolated-char-p "?" 0)) - (should (dired--isolated-char-p "? " 0)) - (should (dired--isolated-char-p " ?" 1)) - (should (dired--isolated-char-p " ? " 1)) - (should (dired--isolated-char-p "foo bar ? baz" 8)) - (should (dired--isolated-char-p "foo -i`?`" 7)) - (should-not (dired--isolated-char-p "foo `bar`?" 9)) - (should-not (dired--isolated-char-p "foo 'bar?'" 8)) - (should-not (dired--isolated-char-p "foo bar?baz" 7)) - (should-not (dired--isolated-char-p "foo bar?" 7))) - (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") - (result (dired--highlight-nosubst-char command "?"))) + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "?"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) (should (equal 'warning (get-text-property 15 'face result))) (should-not (text-property-not-all 16 28 'face nil result)) (should (equal 'warning (get-text-property 29 'face result))) (should-not (text-property-not-all 30 39 'face nil result))) - (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") - (result (dired--highlight-nosubst-char command "*"))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (prompt (dired--no-subst-prompt + command + (dired--need-confirm-positions command "*"))) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) (should (equal 'warning (get-text-property 11 'face result))) (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 24 'face result))) - (should-not (text-property-not-all 25 29 'face nil result)))) + (should (equal 'warning (get-text-property 25 'face result))) + (should-not (text-property-not-all 26 32 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0004-fixup-Dedup-dired-aux-isolated-char-searching-Bug-35.patch --] [-- Type: text/x-diff, Size: 2459 bytes --] From 612e77f1cd0163c383a20b4401bfcf5e299b0aa6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 3 Jul 2019 21:29:38 +0200 Subject: [PATCH 4/6] fixup! Dedup dired-aux isolated char searching (Bug#35564) --- lisp/dired-aux.el | 4 ++-- test/lisp/dired-aux-tests.el | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index ca5b8cf801..b15a9426dc 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -108,8 +108,8 @@ dired--no-subst-prompt (add-face-text-property pos (1+ pos) 'warning nil command)) (concat command "\n" (format-message - (ngettext "Send %d occurence of `%s' as-is to shell?" - "Send %d occurences of `%s' as-is to shell?" + (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))) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 3f4bfffaf6..ff18edddb6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -118,8 +118,8 @@ dired-test-highlight-metachar "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") (prompt (dired--no-subst-prompt - command - (dired--need-confirm-positions command "?"))) + (dired--need-confirm-positions command "?") + command)) (result (and (string-match (regexp-quote command) prompt) (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) @@ -130,8 +130,8 @@ dired-test-highlight-metachar ;; Note that `?` is considered isolated, but `*` is not. (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") (prompt (dired--no-subst-prompt - command - (dired--need-confirm-positions command "*"))) + (dired--need-confirm-positions command "*") + command)) (result (and (string-match (regexp-quote command) prompt) (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0005-Add-markers-below-non-isolated-chars-in-dired-prompt.patch --] [-- Type: text/x-diff, Size: 7845 bytes --] From 9ba62e66fcdbba8305821acf690f263e9ccf10a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 3 Jul 2019 21:17:57 +0200 Subject: [PATCH 5/6] Add '^' markers below non-isolated chars in dired prompt * lisp/dired-aux.el (dired--mark-positions): New function. (dired--no-subst-prompt): Use it to show chars without overly relying on highlighting. (dired-do-shell-command): When the echo area is wide enough to display the command without wrapping it, add the markers. * test/lisp/dired-aux-tests.el (dired-test-highlight-metachar): Add assertion for '^' marker positions. (Bug#35564) --- lisp/dired-aux.el | 43 +++++++++++++++++++++-------- test/lisp/dired-aux-tests.el | 53 ++++++++++++++++++++++++------------ 2 files changed, 68 insertions(+), 28 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index b15a9426dc..3887d75356 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -102,18 +102,35 @@ dired--need-confirm-positions (setq start (match-end 0))) confirm-positions)) -(defun dired--no-subst-prompt (char-positions command) +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--no-subst-prompt (char-positions command add-markers) (cl-callf substring-no-properties command) (dolist (pos char-positions) (add-face-text-property pos (1+ pos) 'warning nil command)) - (concat command "\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)))) + ;; `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))))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -784,15 +801,19 @@ 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))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) ((setq confirmations (dired--need-confirm-positions command "?")) - (y-or-n-p (dired--no-subst-prompt confirmations command))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) (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 ff18edddb6..174c27052e 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -115,30 +115,49 @@ dired-test-bug30624 (kill-buffer buf))))) (ert-deftest dired-test-highlight-metachar () - "Check that non-isolated meta-characters are highlighted" + "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 (dired--need-confirm-positions command "?") - command)) - (result (and (string-match (regexp-quote command) prompt) - (match-string 0 prompt)))) - (should-not (text-property-not-all 1 14 'face nil result)) - (should (equal 'warning (get-text-property 15 'face result))) - (should-not (text-property-not-all 16 28 'face nil result)) - (should (equal 'warning (get-text-property 29 'face result))) - (should-not (text-property-not-all 30 39 'face nil result))) + 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))) + (should-not (text-property-not-all 1 14 'face nil highlit-command)) + (should (equal 'warning (get-text-property 15 'face highlit-command))) + (should-not (text-property-not-all 16 28 'face nil highlit-command)) + (should (equal 'warning (get-text-property 29 'face highlit-command))) + (should-not (text-property-not-all 30 39 'face nil highlit-command))) ;; 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 (dired--need-confirm-positions command "*") - command)) - (result (and (string-match (regexp-quote command) prompt) - (match-string 0 prompt)))) - (should-not (text-property-not-all 1 10 'face nil result)) - (should (equal 'warning (get-text-property 11 'face result))) - (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 25 'face result))) - (should-not (text-property-not-all 26 32 'face nil result)))) + 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))) + (should-not (text-property-not-all 1 10 'face nil highlit-command)) + (should (equal 'warning (get-text-property 11 'face highlit-command))) + (should-not (text-property-not-all 12 23 'face nil highlit-command)) + (should (equal 'warning (get-text-property 25 'face highlit-command))) + (should-not (text-property-not-all 26 32 'face nil highlit-command))) + (let* ((command "sed 's/\\?/!/'") + (prompt (dired--no-subst-prompt + (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)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0006-Simplify-highlighting-assertions.patch --] [-- Type: text/x-diff, Size: 3417 bytes --] From c5729141cda2131a4c72f268bfacf36b6ebca47c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 12 Jul 2019 16:10:54 +0200 Subject: [PATCH 6/6] Simplify highlighting assertions * test/lisp/dired-aux-tests.el (dired-test--check-highlighting): New function. (dired-test-highlight-metachar): Use it. (Bug#35564) --- test/lisp/dired-aux-tests.el | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 174c27052e..ba10c54332 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,15 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted." (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") @@ -127,11 +136,7 @@ dired-test-highlight-metachar (should (= (length lines) 4)) (should (string-match (regexp-quote command) highlit-command)) (should (string-match (regexp-quote markers) (nth 2 lines))) - (should-not (text-property-not-all 1 14 'face nil highlit-command)) - (should (equal 'warning (get-text-property 15 'face highlit-command))) - (should-not (text-property-not-all 16 28 'face nil highlit-command)) - (should (equal 'warning (get-text-property 29 'face highlit-command))) - (should-not (text-property-not-all 30 39 'face nil highlit-command))) + (dired-test--check-highlighting highlit-command '(15 29))) ;; Note that `?` is considered isolated, but `*` is not. (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") (markers " ^ ^") @@ -144,11 +149,7 @@ dired-test-highlight-metachar (should (= (length lines) 4)) (should (string-match (regexp-quote command) highlit-command)) (should (string-match (regexp-quote markers) (nth 2 lines))) - (should-not (text-property-not-all 1 10 'face nil highlit-command)) - (should (equal 'warning (get-text-property 11 'face highlit-command))) - (should-not (text-property-not-all 12 23 'face nil highlit-command)) - (should (equal 'warning (get-text-property 25 'face highlit-command))) - (should-not (text-property-not-all 26 32 'face nil highlit-command))) + (dired-test--check-highlighting highlit-command '(11 25))) (let* ((command "sed 's/\\?/!/'") (prompt (dired--no-subst-prompt (dired--need-confirm-positions command "?") @@ -157,7 +158,8 @@ dired-test-highlight-metachar (lines (split-string prompt "\n")) (highlit-command (nth 1 lines))) (should (= (length lines) 3)) - (should (string-match (regexp-quote command) highlit-command)))) + (should (string-match (regexp-quote command) highlit-command)) + (dired-test--check-highlighting highlit-command '(8)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.20.1 [-- Attachment #8: Type: text/plain, Size: 89 bytes --] Thank you for your review. [1] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=28969#19 ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v4] Tweak dired warning about "wildcard" characters 2019-07-27 23:32 ` Kévin Le Gouguec @ 2019-07-27 23:41 ` Basil L. Contovounesios 0 siblings, 0 replies; 76+ messages in thread From: Basil L. Contovounesios @ 2019-07-27 23:41 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, monnier, npostavs Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > "Basil L. Contovounesios" <contovob@tcd.ie> writes: > >>> -(defun dired--no-subst-prompt (char-positions command) >>> +(defun dired--mark-positions (positions) >>> + (let ((markers (make-string >>> + (1+ (apply #'max positions)) >> >> Is POSITIONS guaranteed to be non-nil? (The max function takes at least >> one argument.) > > AFAICT dired--mark-positions is only called by dired--no-subst-prompt, > which is only used when there is at least one ambiguous character to > highlight. > > So as things stand now, POSITIONS will always be non-nil. Nothing > prevents someone from attempting to re-use the function with a > potentially-nil argument though. > > I don't know what makes more sense here: adding an assertion? Handling > the nil case explicitly for robustness? I think it's fine the way it is, though a docstring/comment never hurts. I was just checking. >>> Subject: [PATCH 6/6] Simplify highlighting assertions >>> >>> * test/lisp/dired-aux-tests.el (dired-test--check-highlighting): >>> New function. >>> (dired-test-highlight-metachar): Use it. >> >> Will this simplification hinder debugging of test failures? I don't >> have an opinion on the proposed change, it's just something to consider. > > Mmm. Since the assertion that fails is now nested in a more generic > function, the report shown in the ERT-Results buffer might be somewhat > less informative; one has to bring up the backtrace to understand the > context. > > I could try my hand at an ERT explainer for these assertions. Or we > could just drop the 6th patch… I do find the tests easier to read and > write with it though. That's good enough for me, -- Basil ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-07-03 19:47 ` bug#35564: [PATCH v4] " Kévin Le Gouguec 2019-07-12 15:10 ` Kévin Le Gouguec @ 2019-10-10 18:45 ` Kévin Le Gouguec 2019-10-22 15:10 ` Kévin Le Gouguec 2019-12-18 7:11 ` Kévin Le Gouguec 1 sibling, 2 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-10-10 18:45 UTC (permalink / raw) To: 35564; +Cc: Michael Heerdegen, Noam Postavsky, Juri Linkov, Stefan Monnier, 28969 [-- Attachment #1: Type: text/plain, Size: 1013 bytes --] Finally got around to try out rmc.el. A brief recap of the issue: dired-do-shell-command looks out for any non-isolated metacharacters[1], and prompts the user when it finds some. The problem is that the prompt is downright misleading under some circumstances. E.g. after marking some files in a Dired buffer: ! sed 's/?/!/g' RET => Confirm--do you mean to use `?' as a wildcard? The answer a user must input to proceed is "yes", despite '?' not being a wildcard in this situation; the answer some users may give intuitively is "no" (or, in my case, "whaaa?"). This patch series initially tried to shove the command in the prompt, highlight the non-isolated characters, and re-phrase the prompt to be more accurate (i.e. not talk about wildcards). It went through a several iterations for a few reasons[2]; most recently Michael suggested using read-multiple-choice [bug#35564#136]; I looked at how nsm.el uses it, saw that is was good, and got distracted for two months. Here is the new series: [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-patch, Size: 5561 bytes --] From 0c0b1570623a69141ebd31b8e3dffdeef5273c7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:19:44 +0200 Subject: [PATCH 1/5] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired--isolated-char-p) (dired--highlight-nosubst-char, dired--no-subst-prompt): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p) (dired-test-highlight-metachar): Test the new functions. (Bug#35564) --- lisp/dired-aux.el | 42 ++++++++++++++++++++++++++++++++---- test/lisp/dired-aux-tests.el | 28 ++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 4 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index bfc37c5cde..409f028e2b 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,42 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((start (max 0 (1- pos))) + (char (string (aref command pos)))) + (and (string-match + (rx (or (seq (or bos blank) + (group-n 1 (literal char)) + (or eos blank)) + (seq ?` (group-n 1 (literal char)) ?`))) + command start) + (= pos (match-beginning 1))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted:")) + (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -761,11 +797,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt 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 ccd3192792..80b6393931 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,34 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo `bar`?" 9)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.23.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch --] [-- Type: text/x-patch, Size: 11062 bytes --] From b80d55bf5307cf95ae0804cc1dfe66b40b012ba6 Mon Sep 17 00:00:00 2001 From: Noam Postavsky <npostavs@gmail.com> Date: Thu, 27 Jun 2019 19:15:56 -0400 Subject: [PATCH 2/5] Dedup dired-aux isolated char searching (Bug#35564) * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--no-subst-prompt): Operate on a list of positions rather than searching again for isolated chars. Shorten prompt, and include the character being asked about in the question (to make it clearer, and in case the user can't see the fontification for whatever reason, e.g., screen reader). (dired--isolated-char-p): Remove. (dired--need-confirm-positions): New function. (dired-do-shell-command): Use it. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p): Remove. (dired-test-highlight-metachar): Adjust to new functions. Make sure that `*` isn't considered isolated. --- lisp/dired-aux.el | 113 ++++++++++++++++------------------- test/lisp/dired-aux-tests.el | 31 +++++----- 2 files changed, 67 insertions(+), 77 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 409f028e2b..c13cbcf2e3 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,60 +60,60 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) - -(defun dired--isolated-char-p (command pos) - "Assert whether the character at POS is isolated within COMMAND. -A character is isolated if: -- it is surrounded by whitespace, the start of the command, or - the end of the command, -- it is surrounded by `\\=`' characters." - (let ((start (max 0 (1- pos))) - (char (string (aref command pos)))) - (and (string-match - (rx (or (seq (or bos blank) - (group-n 1 (literal char)) - (or eos blank)) - (seq ?` (group-n 1 (literal char)) ?`))) - command start) - (= pos (match-beginning 1))))) - -(defun dired--highlight-nosubst-char (command char) - "Highlight occurences of CHAR that are not isolated in COMMAND. -These occurences will not be substituted; they will be sent as-is -to the shell, which may interpret them as wildcards." - (save-match-data - (let ((highlighted (substring-no-properties command)) - (pos 0)) - (while (string-match (regexp-quote char) command pos) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (unless (dired--isolated-char-p command start) - (add-face-text-property start end 'warning nil highlighted)) - (setq pos end))) - highlighted))) - -(defun dired--no-subst-prompt (command char) - (let ((highlighted-command (dired--highlight-nosubst-char command char)) - (prompt "Confirm--the highlighted characters will not be substituted:")) - (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--no-subst-prompt (char-positions command) + (cl-callf substring-no-properties command) + (dolist (pos char-positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (concat command "\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)))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -781,26 +781,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (dired--no-subst-prompt command "*"))) - ((need-confirm-p command "?") - (y-or-n-p (dired--no-subst-prompt command "?"))) - (t)))) + (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))) + ((setq confirmations (dired--need-confirm-positions command "?")) + (y-or-n-p (dired--no-subst-prompt confirmations command))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -811,7 +804,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 80b6393931..ff18edddb6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,34 +114,31 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) -(ert-deftest dired-test-isolated-char-p () - (should (dired--isolated-char-p "?" 0)) - (should (dired--isolated-char-p "? " 0)) - (should (dired--isolated-char-p " ?" 1)) - (should (dired--isolated-char-p " ? " 1)) - (should (dired--isolated-char-p "foo bar ? baz" 8)) - (should (dired--isolated-char-p "foo -i`?`" 7)) - (should-not (dired--isolated-char-p "foo `bar`?" 9)) - (should-not (dired--isolated-char-p "foo 'bar?'" 8)) - (should-not (dired--isolated-char-p "foo bar?baz" 7)) - (should-not (dired--isolated-char-p "foo bar?" 7))) - (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") - (result (dired--highlight-nosubst-char command "?"))) + (prompt (dired--no-subst-prompt + (dired--need-confirm-positions command "?") + command)) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) (should (equal 'warning (get-text-property 15 'face result))) (should-not (text-property-not-all 16 28 'face nil result)) (should (equal 'warning (get-text-property 29 'face result))) (should-not (text-property-not-all 30 39 'face nil result))) - (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") - (result (dired--highlight-nosubst-char command "*"))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (prompt (dired--no-subst-prompt + (dired--need-confirm-positions command "*") + command)) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) (should (equal 'warning (get-text-property 11 'face result))) (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 24 'face result))) - (should-not (text-property-not-all 25 29 'face nil result)))) + (should (equal 'warning (get-text-property 25 'face result))) + (should-not (text-property-not-all 26 32 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.23.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0003-Add-markers-below-non-isolated-chars-in-dired-prompt.patch --] [-- Type: text/x-patch, Size: 7845 bytes --] From cd41c96d0631275d1fc24367663cf891a17cad47 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 3 Jul 2019 21:17:57 +0200 Subject: [PATCH 3/5] Add '^' markers below non-isolated chars in dired prompt * lisp/dired-aux.el (dired--mark-positions): New function. (dired--no-subst-prompt): Use it to show chars without overly relying on highlighting. (dired-do-shell-command): When the echo area is wide enough to display the command without wrapping it, add the markers. * test/lisp/dired-aux-tests.el (dired-test-highlight-metachar): Add assertion for '^' marker positions. (Bug#35564) --- lisp/dired-aux.el | 43 +++++++++++++++++++++-------- test/lisp/dired-aux-tests.el | 53 ++++++++++++++++++++++++------------ 2 files changed, 68 insertions(+), 28 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index c13cbcf2e3..01c1b92595 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -102,18 +102,35 @@ dired--need-confirm-positions (setq start (match-end 0))) confirm-positions)) -(defun dired--no-subst-prompt (char-positions command) +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--no-subst-prompt (char-positions command add-markers) (cl-callf substring-no-properties command) (dolist (pos char-positions) (add-face-text-property pos (1+ pos) 'warning nil command)) - (concat command "\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)))) + ;; `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))))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -784,15 +801,19 @@ 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))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) ((setq confirmations (dired--need-confirm-positions command "?")) - (y-or-n-p (dired--no-subst-prompt confirmations command))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) (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 ff18edddb6..174c27052e 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -115,30 +115,49 @@ dired-test-bug30624 (kill-buffer buf))))) (ert-deftest dired-test-highlight-metachar () - "Check that non-isolated meta-characters are highlighted" + "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 (dired--need-confirm-positions command "?") - command)) - (result (and (string-match (regexp-quote command) prompt) - (match-string 0 prompt)))) - (should-not (text-property-not-all 1 14 'face nil result)) - (should (equal 'warning (get-text-property 15 'face result))) - (should-not (text-property-not-all 16 28 'face nil result)) - (should (equal 'warning (get-text-property 29 'face result))) - (should-not (text-property-not-all 30 39 'face nil result))) + 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))) + (should-not (text-property-not-all 1 14 'face nil highlit-command)) + (should (equal 'warning (get-text-property 15 'face highlit-command))) + (should-not (text-property-not-all 16 28 'face nil highlit-command)) + (should (equal 'warning (get-text-property 29 'face highlit-command))) + (should-not (text-property-not-all 30 39 'face nil highlit-command))) ;; 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 (dired--need-confirm-positions command "*") - command)) - (result (and (string-match (regexp-quote command) prompt) - (match-string 0 prompt)))) - (should-not (text-property-not-all 1 10 'face nil result)) - (should (equal 'warning (get-text-property 11 'face result))) - (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 25 'face result))) - (should-not (text-property-not-all 26 32 'face nil result)))) + 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))) + (should-not (text-property-not-all 1 10 'face nil highlit-command)) + (should (equal 'warning (get-text-property 11 'face highlit-command))) + (should-not (text-property-not-all 12 23 'face nil highlit-command)) + (should (equal 'warning (get-text-property 25 'face highlit-command))) + (should-not (text-property-not-all 26 32 'face nil highlit-command))) + (let* ((command "sed 's/\\?/!/'") + (prompt (dired--no-subst-prompt + (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)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.23.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0004-Simplify-highlighting-assertions.patch --] [-- Type: text/x-patch, Size: 3417 bytes --] From 7a884e189fa18cd903c6c684090860cf8ebb7f7f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 12 Jul 2019 16:10:54 +0200 Subject: [PATCH 4/5] Simplify highlighting assertions * test/lisp/dired-aux-tests.el (dired-test--check-highlighting): New function. (dired-test-highlight-metachar): Use it. (Bug#35564) --- test/lisp/dired-aux-tests.el | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 174c27052e..ba10c54332 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,15 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted." (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") @@ -127,11 +136,7 @@ dired-test-highlight-metachar (should (= (length lines) 4)) (should (string-match (regexp-quote command) highlit-command)) (should (string-match (regexp-quote markers) (nth 2 lines))) - (should-not (text-property-not-all 1 14 'face nil highlit-command)) - (should (equal 'warning (get-text-property 15 'face highlit-command))) - (should-not (text-property-not-all 16 28 'face nil highlit-command)) - (should (equal 'warning (get-text-property 29 'face highlit-command))) - (should-not (text-property-not-all 30 39 'face nil highlit-command))) + (dired-test--check-highlighting highlit-command '(15 29))) ;; Note that `?` is considered isolated, but `*` is not. (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") (markers " ^ ^") @@ -144,11 +149,7 @@ dired-test-highlight-metachar (should (= (length lines) 4)) (should (string-match (regexp-quote command) highlit-command)) (should (string-match (regexp-quote markers) (nth 2 lines))) - (should-not (text-property-not-all 1 10 'face nil highlit-command)) - (should (equal 'warning (get-text-property 11 'face highlit-command))) - (should-not (text-property-not-all 12 23 'face nil highlit-command)) - (should (equal 'warning (get-text-property 25 'face highlit-command))) - (should-not (text-property-not-all 26 32 'face nil highlit-command))) + (dired-test--check-highlighting highlit-command '(11 25))) (let* ((command "sed 's/\\?/!/'") (prompt (dired--no-subst-prompt (dired--need-confirm-positions command "?") @@ -157,7 +158,8 @@ dired-test-highlight-metachar (lines (split-string prompt "\n")) (highlit-command (nth 1 lines))) (should (= (length lines) 3)) - (should (string-match (regexp-quote command) highlit-command)))) + (should (string-match (regexp-quote command) highlit-command)) + (dired-test--check-highlighting highlit-command '(8)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.23.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #6: 0005-Hide-detailed-explanations-in-a-togglable-help-buffe.patch --] [-- Type: text/x-patch, Size: 9704 bytes --] From 9fa3a93492c6c4d6553cff163d0203253bdb2eb6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> 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-multiple-choice, (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 | 102 ++++++++++++++++++++++++++--------- test/lisp/dired-aux-tests.el | 39 +++++++------- 2 files changed, 95 insertions(+), 46 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 01c1b92595..6b33f4ebfb 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -110,27 +110,83 @@ 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 +" + "`" + (string (aref command (car char-positions))) + (dired--highlight-no-subst-chars char-positions command mark-positions))))) + +(defun dired--no-subst-ask (char nb-occur details) + (let ((hilit-char (propertize (string char) 'face 'warning))) + (car + (read-multiple-choice + (format-message + (ngettext + "Warning: %d occurrence of `%s' will not be substituted. Proceed?" + "Warning: %d occurrences of `%s' will not be substituted. Proceed?" + nb-occur) + nb-occur hilit-char) + `((?y "yes" "Send shell command without substituting.") + (?n "no" "Abort.") + (?d "toggle details" ,(format-message + "Show/hide occurrences of `%s'" hilit-char)) + ,@(when details + '((?m "toggle markers" "Show/hide `^' markers")))))))) + +(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) + (dired--no-subst-explain help-buf char-positions command nil) + (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)) + (?d + (if details + (progn + (quit-window nil details) + (setq details nil)) + (setq details (display-buffer help-buf)))) + (?m + (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) @@ -801,19 +857,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..e1d9eefbea 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-multiple-choice) '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.23.0 [-- Attachment #7: Type: text/plain, Size: 439 bytes --] Highlights: - removed the patch for y-or-n-p, since we don't need it anymore, - (squashed Noam's patch with my fixups,) - the last patch contains the new stuff: - the default prompt is now as concise as the old one, - pressing 'd' toggles a help buffer which highlights occurrences using the warning face, - when the help buffer is enabled, pressing 'm' toggles the '^' markers. Squashed patch for convenience: [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #8: 0001-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-patch, Size: 12387 bytes --] From 8a51df696ef4d1b794ea75d94b1137f1e1ff536f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Thu, 10 Oct 2019 20:20:41 +0200 Subject: [PATCH] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and offer to highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--need-confirm-positions, dired--mark-positions) (dired--highlight-no-subst-chars, dired--no-subst-explain) (dired--no-subst-ask, dired--no-subst-confirm): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-bug27496): Adapt to new prompt. (dired-test--check-highlighting): New test helper. (dired-test-highlight-metachar): New tests. Co-authored-by: Noam Postavsky <npostavs@gmail.com> (bug#28969, bug#35564) --- lisp/dired-aux.el | 152 +++++++++++++++++++++++++++++------ test/lisp/dired-aux-tests.el | 45 ++++++++++- 2 files changed, 170 insertions(+), 27 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index bfc37c5cde..6b33f4ebfb 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,24 +60,133 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--highlight-no-subst-chars (positions command mark) + (cl-callf substring-no-properties command) + (dolist (pos positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (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 +" + "`" + (string (aref command (car char-positions))) + (dired--highlight-no-subst-chars char-positions command mark-positions))))) + +(defun dired--no-subst-ask (char nb-occur details) + (let ((hilit-char (propertize (string char) 'face 'warning))) + (car + (read-multiple-choice + (format-message + (ngettext + "Warning: %d occurrence of `%s' will not be substituted. Proceed?" + "Warning: %d occurrences of `%s' will not be substituted. Proceed?" + nb-occur) + nb-occur hilit-char) + `((?y "yes" "Send shell command without substituting.") + (?n "no" "Abort.") + (?d "toggle details" ,(format-message + "Show/hide occurrences of `%s'" hilit-char)) + ,@(when details + '((?m "toggle markers" "Show/hide `^' markers")))))))) + +(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) + (dired--no-subst-explain help-buf char-positions command nil) + (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)) + (?d + (if details + (progn + (quit-window nil details) + (setq details nil)) + (setq details (display-buffer help-buf)))) + (?m + (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) @@ -745,28 +854,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) - ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) - (t)))) + (ok (cond + ((not (or on-each no-subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((setq confirmations (dired--need-confirm-positions command "*")) + (dired--no-subst-confirm confirmations command)) + ((setq confirmations (dired--need-confirm-positions command "?")) + (dired--no-subst-confirm confirmations command)) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -777,7 +877,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index ccd3192792..e1d9eefbea 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-multiple-choice) 'error)) (dired temporary-file-directory) (dired-goto-file foo) ;; `dired-do-shell-command' returns nil on success. @@ -114,6 +114,49 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + +(ert-deftest 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 " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + t)) + (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 " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "*") + command + t)) + (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/\\?/!/'") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + nil)) + (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.23.0 [-- Attachment #9: Type: text/plain, Size: 1091 bytes --] To try the changes out, it's enough to reload dired-aux.el, mark a few files in Dired, type e.g. ! sed 's/?/!/g' RET … and play with the new prompt. Let me know if this UI looks OK, and how the implementation may be improved. Thank you for your patience. Not addressed in this patch series: - letting the user iterate over non-isolated occurrences and selectively substitute them, - allowing '*' to be substituted when surrounded by backquotes, just like '?'. I do find these features valuable (or at least worthy of discussion), however the current bug reports were motivated merely by an inaccurate warning; I'd like to close this first before considering further changes. [1] '?' when not surrounded by whitespace or backquotes, '*' when not surrounded by whitespace. [2] Trying to find the right balance between concision and accurate explanation, considering that some users may not know about the file-substitution feature; also trying to make the highlighting "accessible", i.e. not just relying on colored faces. ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-10 18:45 ` bug#35564: [PATCH v5] " Kévin Le Gouguec @ 2019-10-22 15:10 ` Kévin Le Gouguec 2019-10-22 16:58 ` Michael Heerdegen 2019-10-22 20:43 ` Juri Linkov 2019-12-18 7:11 ` Kévin Le Gouguec 1 sibling, 2 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-10-22 15:10 UTC (permalink / raw) To: 35564; +Cc: Michael Heerdegen, Noam Postavsky, Juri Linkov, Stefan Monnier [-- Attachment #1: Type: text/plain, Size: 827 bytes --] Casual and nonchalant bump. I realize that everyone has their plate full right now (Emacs has tabs! Face extension beyond EOL is customizable! What a time to be alive!), so I am not expecting this to get any immediate attention. In case it helps though, here is a comparison when running e.g. sed 's/?/!/': Old prompt: > Confirm--do you mean to use ‘?’ as a wildcard? (y or n) New prompt based on read-multiple-choice: > Warning: 1 occurrence of ‘?’ will not be substituted. Proceed? > ([Y]es, [N]o, toggle [D]etails, [?]): Hitting 'd' pops a buffer showing more information[1]. The commands then become: > ([Y]es, [N]o, toggle [D]etails, toggle [M]arkers, [?]) Hitting 'm' shows/hides '^' markers below the occurrences; 'd' quits the details window. Screenshots in GUI session: [-- Attachment #2: gui-basic.png --] [-- Type: image/png, Size: 151116 bytes --] [-- Attachment #3: gui-details.png --] [-- Type: image/png, Size: 122107 bytes --] [-- Attachment #4: gui-markers.png --] [-- Type: image/png, Size: 121981 bytes --] [-- Attachment #5: Type: text/plain, Size: 22 bytes --] Screenshots in TTY: [-- Attachment #6: tty-basic.png --] [-- Type: image/png, Size: 12101 bytes --] [-- Attachment #7: tty-details.png --] [-- Type: image/png, Size: 11785 bytes --] [-- Attachment #8: tty-markers.png --] [-- Type: image/png, Size: 11779 bytes --] [-- Attachment #9: Type: text/plain, Size: 907 bytes --] The patch(es) can be found in my previous message[2] (along with some context and rationale). Let me know if there is anything I can do to help with the review. Thank you for your time. [1] Contents of the details buffer: > 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 ‘`’, Dired will > run the command once for each file, substituting ‘?’ for each > file name. > > Your command contains occurrences of ‘?’ that will not be > substituted, and will be passed through normally to the shell. > > sed 's/?/!/' '?' is highlighted with the warning face. [2] https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35564#157 ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-22 15:10 ` Kévin Le Gouguec @ 2019-10-22 16:58 ` Michael Heerdegen 2019-10-22 21:32 ` Kévin Le Gouguec 2019-10-22 20:43 ` Juri Linkov 1 sibling, 1 reply; 76+ messages in thread From: Michael Heerdegen @ 2019-10-22 16:58 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: 35564, Noam Postavsky, Juri Linkov, Stefan Monnier Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > Casual and nonchalant bump. > > I realize that everyone has their plate full right now (Emacs has tabs! > Face extension beyond EOL is customizable! What a time to be alive!) Yeah, indeed. Looking at your patch is at my list - will have a look soon. Thanks for your summary, that is very kind and useful. Without having had a look yet - your last version addresses everything brought up so far and can be considered final, right? Thanks, Michael. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-22 16:58 ` Michael Heerdegen @ 2019-10-22 21:32 ` Kévin Le Gouguec 2019-11-10 20:29 ` Juri Linkov 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-10-22 21:32 UTC (permalink / raw) To: Michael Heerdegen; +Cc: 35564, Noam Postavsky, Juri Linkov, Stefan Monnier Michael Heerdegen <michael_heerdegen@web.de> writes: > Without having had a look yet - your last version addresses everything > brought up so far and can be considered final, right? I think so. Going over for bug#28969 and bug#35564, here are the discussion points I could identify: - y-or-n-p propertizing its prompt rigidly: out of scope, since we use read-multiple-choice now. - The prompt getting too long: it's now much shorter than the four(!)-line version I came up with in v4; it concisely spells out the issue (some characters will not be substituted) and invites the user to ask for more details if needed. - Asking the user whether they'd like to actually substitute these characters: out of scope; not sure it's necessary, since the new "details" buffer explains how to work around this for '?' (using backquotes). (Though no such workaround exists for '*'. Allowing '*' to be isolated with backquotes just like '?' would be a natural thing to do IMO, but that's unrelated to fixing this confusing prompt.) - Ensuring accessibility: users who cannot distinguish the 'warning' face are now invited to add optional '^' markers. - Preventing '`' being linked to the backquote macro in the docstring for dired-do-shell-command: still no idea how to fix that, but that can be investigated independently. Here are some remaining issues I can think of: - The code that toggles the '^' markers does not check that the command is not wrapped/truncated (i.e. that the window is wide enough). - The details window might not be tall enough, in which case maybe I should add [f]orward-/[b]ackward-page actions like nsm.el does. - In dired--no-subst-confirm, I did my best to make the window-popping dance as graceful as possible (unwind-protect so that the details buffer is killed even after C-g, save-window-excursion to restore the window configuration…), but maybe it falls apart in cases I haven't considered. - UI bikeshedding: maybe drop the leading "Warning:", add the underline face to the mix… - Code quality: some of the small functions I wrote exist for no other reason than I found the resulting code to be easier to follow; they could probably be inlined if others do not share my preferences. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-22 21:32 ` Kévin Le Gouguec @ 2019-11-10 20:29 ` Juri Linkov 2019-11-14 7:02 ` Kévin Le Gouguec 0 siblings, 1 reply; 76+ messages in thread From: Juri Linkov @ 2019-11-10 20:29 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier > Going over for bug#28969 and bug#35564, here are the > discussion points I could identify: It seems all these points are resolved now: > - y-or-n-p propertizing its prompt rigidly: out of scope, since we use > read-multiple-choice now. y-or-n-p doesn't propertize its prompt rigidly now, but indeed this is out of scope when using read-char-from-minibuffer. > - The prompt getting too long: it's now much shorter than the > four(!)-line version I came up with in v4; it concisely spells out the > issue (some characters will not be substituted) and invites the user > to ask for more details if needed. Please use a shorter prompt like 1 occurrence of ‘?’ will not be substituted. Proceed? (y, n or ?) > - Asking the user whether they'd like to actually substitute these > characters: out of scope; not sure it's necessary, since the new > "details" buffer explains how to work around this for '?' (using > backquotes). Displaying the new "Dired help" buffer on demand is a good idea. > - Ensuring accessibility: users who cannot distinguish the 'warning' > face are now invited to add optional '^' markers. In the new "Dired help" buffer where there is enough space to add the command line with '^' markers. > - Preventing '`' being linked to the backquote macro in the docstring > for dired-do-shell-command: still no idea how to fix that, but that > can be investigated independently. Maybe use double quotes "`" as an exception. > Here are some remaining issues I can think of: > > - The code that toggles the '^' markers does not check that the command > is not wrapped/truncated (i.e. that the window is wide enough). Everything should be explained in the new "Dired help" buffer including the command line with '^' markers. > - The details window might not be tall enough, in which case maybe I > should add [f]orward-/[b]ackward-page actions like nsm.el does. Yesterday I added new keybindings C-v/M-v for scrolling the original window from the minibuffer. > - In dired--no-subst-confirm, I did my best to make the window-popping > dance as graceful as possible (unwind-protect so that the details > buffer is killed even after C-g, save-window-excursion to restore the > window configuration…), but maybe it falls apart in cases I haven't > considered. Maybe some of the standard display-window functions can handle this, but this is a minor question. > - UI bikeshedding: maybe drop the leading "Warning:" Right, this makes the prompt shorter. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-11-10 20:29 ` Juri Linkov @ 2019-11-14 7:02 ` Kévin Le Gouguec 2019-11-16 20:23 ` Juri Linkov 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-11-14 7:02 UTC (permalink / raw) To: Juri Linkov; +Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier Thanks for your input Juri. I see that your work on read-char-from-minibuffer has been pushed to master; I'll start working on a v6 using that function instead of read-multiple-choice ASAP. Juri Linkov <juri@linkov.net> writes: > Please use a shorter prompt like > > 1 occurrence of ‘?’ will not be substituted. Proceed? (y, n or ?) Will do. > In the new "Dired help" buffer where there is enough space to add > the command line with '^' markers. Note that the current implementation is quite naive: it falls apart if the command is wider than the help window. E.g.: some-command "first?argument" "sec⤸ ⤹ond?argument" "final-argument" ^ ⤸ ⤹ ^ (⤸ and ⤹ represent fringe indicators for wrapped lines.) I don't know how important it is to handle this situation, since read-char-from-minibuffer allows C-x o'ing to the help buffer and toggling truncated lines. >> - Preventing '`' being linked to the backquote macro in the docstring >> for dired-do-shell-command: still no idea how to fix that, but that >> can be investigated independently. > > Maybe use double quotes "`" as an exception. Maybe. The docstring single-quotes every other character it mentions though (?, *, &, ;), so that would look sort of inconsistent. Note that this problem also impacts other docstrings[1]. >> - The details window might not be tall enough, in which case maybe I >> should add [f]orward-/[b]ackward-page actions like nsm.el does. > > Yesterday I added new keybindings C-v/M-v for scrolling the original > window from the minibuffer. Nice! (Out of curiosity, would it make sense to also bind C-x < and C-x >?) >> - UI bikeshedding: maybe drop the leading "Warning:" > > Right, this makes the prompt shorter. Will do then. Again, thank you for your time. [1] subr.el:372:like `%', `\\=`' and `\\='', use (error \"%s\" MESSAGE). subr.el:388:like `%', `\\=`' and `\\='', use (error \"%s\" MESSAGE). emulation/viper-util.el:1173:symbols like `\\=`', `\\='', `:', `\"', `)', and `{' are excluded. leim/quail/cyrillic.el:1362:`]', `\\', `\\=`' and `[' keys respectively, Caps Lock does not affect them." leim/quail/hebrew.el:116: `\\=`' is used to switch levels instead of Alt-Gr. leim/quail/hebrew.el:606: `\\=`' is used to switch levels instead of Alt-Gr. leim/quail/thai.el:50: `ฃ' and `ฅ' are assigned to `\\=`' and `~' respectively, Note also that there are places where this works as intended: emacs-lisp/backquote.el:253: "See `\\=`' (also `pcase') for the usage of `,'.") emacs-lisp/backquote.el:257: "See `\\=`' for the usage of `,@'.") ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-11-14 7:02 ` Kévin Le Gouguec @ 2019-11-16 20:23 ` Juri Linkov 0 siblings, 0 replies; 76+ messages in thread From: Juri Linkov @ 2019-11-16 20:23 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier >> In the new "Dired help" buffer where there is enough space to add >> the command line with '^' markers. > > Note that the current implementation is quite naive: it falls apart if > the command is wider than the help window. E.g.: > > some-command "first?argument" "sec⤸ > ⤹ond?argument" "final-argument" > ^ ⤸ > ⤹ ^ > > (⤸ and ⤹ represent fringe indicators for wrapped lines.) > > I don't know how important it is to handle this situation, since > read-char-from-minibuffer allows C-x o'ing to the help buffer and > toggling truncated lines. Or truncated lines could be enabled by default in the "Dired help" buffer by using (setq truncate-lines nil) >>> - The details window might not be tall enough, in which case maybe I >>> should add [f]orward-/[b]ackward-page actions like nsm.el does. >> >> Yesterday I added new keybindings C-v/M-v for scrolling the original >> window from the minibuffer. > > Nice! > (Out of curiosity, would it make sense to also bind C-x < and C-x >?) Wouldn't ‘C-x <’ and ‘C-x >’ be more needed to scroll the minibuffer horizontally? I tried to toggle truncated lines in the minibuffer, and then ‘C-x <’ and ‘C-x >’ scroll the minibuffer horizontally. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-22 15:10 ` Kévin Le Gouguec 2019-10-22 16:58 ` Michael Heerdegen @ 2019-10-22 20:43 ` Juri Linkov 2019-10-22 21:11 ` Kévin Le Gouguec 1 sibling, 1 reply; 76+ messages in thread From: Juri Linkov @ 2019-10-22 20:43 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier > I realize that everyone has their plate full right now (Emacs has tabs! > Face extension beyond EOL is customizable! What a time to be alive!), > so I am not expecting this to get any immediate attention. Sorry for leaving your new mail unanswered for so long (although I marked your mail with the "read-later" tag :) > New prompt based on read-multiple-choice: > >> Warning: 1 occurrence of ‘?’ will not be substituted. Proceed? >> ([Y]es, [N]o, toggle [D]etails, [?]): > > Hitting 'd' pops a buffer showing more information[1]. The commands > then become: > >> ([Y]es, [N]o, toggle [D]etails, toggle [M]arkers, [?]) > > Hitting 'm' shows/hides '^' markers below the occurrences; 'd' quits the > details window. Finally we have the best solution where the prompt is concise and fits into one line, still allowing to show more information on demand, thanks for that. Some minor details that I still don't understand: 1. Why there is the verbose option “toggle [D]etails” while just “[?]” should be enough. For example, like in query-replace typing ‘?’ displays the Help window, just typing ‘?’ here could display the Dired Help. 2. Would it be possible to customize the prompt to accept short answers “y, n” instead of long answers “Yes, No”? When ‘read-answer-short’ is ‘auto’ by default, the behaviour of ‘read-answer’ depends on whether `yes-or-no-p' is set to `y-or-n-p'. In this case ‘read-answer’ accepts short single-key answers. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-22 20:43 ` Juri Linkov @ 2019-10-22 21:11 ` Kévin Le Gouguec 2019-10-27 21:40 ` Juri Linkov 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-10-22 21:11 UTC (permalink / raw) To: Juri Linkov; +Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier Juri Linkov <juri@linkov.net> writes: > 1. Why there is the verbose option “toggle [D]etails” > while just “[?]” should be enough. For example, like > in query-replace typing ‘?’ displays the Help window, > just typing ‘?’ here could display the Dired Help. '?' is an automatic option added by read-multiple-choice. It pops-up an autogenerated buffer repeating the prompt and showing longer descriptions for each option. I would have liked '?' to show what I ended up putting in the "details" buffer; ideally read-multiple-choice would have an optional HELP-MESSAGE argument that could be squeezed between the prompt and the key description when showing the help buffer. Since that's not how things work, I went for the additional option ('d'). > 2. Would it be possible to customize the prompt to accept > short answers “y, n” instead of long answers “Yes, No”? > When ‘read-answer-short’ is ‘auto’ by default, > the behaviour of ‘read-answer’ depends on whether > `yes-or-no-p' is set to `y-or-n-p'. In this case > ‘read-answer’ accepts short single-key answers. I didn't know about read-answer, that was an interesting discovery. read-multiple-choice only accepts single-key answers, you cannot answer with long options if I'm not mistaken. You cannot choose what the prompt looks like either; you simply provide a list of (KEY NAME [DESCRIPTION]) tuples; NAMEs will be shown in the prompt, DESCRIPTIONs will be shown in the auto-generated help buffer. (Let me know if that does not answer your question; I might have misunderstood.) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-22 21:11 ` Kévin Le Gouguec @ 2019-10-27 21:40 ` Juri Linkov 2019-10-30 21:59 ` Juri Linkov 0 siblings, 1 reply; 76+ messages in thread From: Juri Linkov @ 2019-10-27 21:40 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier >> 1. Why there is the verbose option “toggle [D]etails” >> while just “[?]” should be enough. For example, like >> in query-replace typing ‘?’ displays the Help window, >> just typing ‘?’ here could display the Dired Help. > > '?' is an automatic option added by read-multiple-choice. It pops-up an > autogenerated buffer repeating the prompt and showing longer > descriptions for each option. > > I would have liked '?' to show what I ended up putting in the "details" > buffer; ideally read-multiple-choice would have an optional HELP-MESSAGE > argument that could be squeezed between the prompt and the key > description when showing the help buffer. '?' would be more preferable since this is the standard way to ask for additional information in Dired, for example, on error it shows: Dired error--type ? for details where '?' shows the details. dired-do-shell-command should do the same in its prompt. read-multiple-choice could be changed to not add its own help option when a '?' is provided in its 'choices' arg. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-27 21:40 ` Juri Linkov @ 2019-10-30 21:59 ` Juri Linkov 2019-11-04 6:36 ` Kévin Le Gouguec 0 siblings, 1 reply; 76+ messages in thread From: Juri Linkov @ 2019-10-30 21:59 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier >>> 1. Why there is the verbose option “toggle [D]etails” >>> while just “[?]” should be enough. For example, like >>> in query-replace typing ‘?’ displays the Help window, >>> just typing ‘?’ here could display the Dired Help. >> >> '?' is an automatic option added by read-multiple-choice. It pops-up an >> autogenerated buffer repeating the prompt and showing longer >> descriptions for each option. >> >> I would have liked '?' to show what I ended up putting in the "details" >> buffer; ideally read-multiple-choice would have an optional HELP-MESSAGE >> argument that could be squeezed between the prompt and the key >> description when showing the help buffer. > > '?' would be more preferable since this is the standard way to ask > for additional information in Dired, for example, on error it shows: > > Dired error--type ? for details > > where '?' shows the details. dired-do-shell-command should do the same > in its prompt. read-multiple-choice could be changed to not add > its own help option when a '?' is provided in its 'choices' arg. I meant using the same logic as in 'read-answer': (if (assoc "help" answers) answers (append answers '(("help" ?? "show this help message")))) i.e. if '?' is provided in the function argument then use it, otherwise use the default value. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-30 21:59 ` Juri Linkov @ 2019-11-04 6:36 ` Kévin Le Gouguec 2019-11-05 22:22 ` Juri Linkov 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-11-04 6:36 UTC (permalink / raw) To: Juri Linkov; +Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier Juri Linkov <juri@linkov.net> writes: >> '?' would be more preferable since this is the standard way to ask >> for additional information in Dired, for example, on error it shows: >> >> Dired error--type ? for details >> >> where '?' shows the details. dired-do-shell-command should do the same >> in its prompt. read-multiple-choice could be changed to not add >> its own help option when a '?' is provided in its 'choices' arg. > > I meant using the same logic as in 'read-answer': > > (if (assoc "help" answers) > answers > (append answers '(("help" ?? "show this help message")))) > > i.e. if '?' is provided in the function argument then use it, > otherwise use the default value. I'd like to keep read-multiple-choice's built-in help action available though, I find it quite ergonomic. Plus, the fact that it is bound to ? and C-h makes it consistent with help-for-help, another command whose purpose is to describe prompt bindings in more details. Here are the ways forward I can see: 1. keep 'd' for "details" (a la nsm.el), 2. use 'h' for "help": more intuitive for "what the ftok is going on" reactions, though perhaps confusing when shown alongside '?', 3. teach read-multiple-choice to let go of '?', and… 3.1. that's it; give up on the bindings-explaining help buffer, 3.2. move the code generating this buffer to an external function, which callers could re-use to fill in their own help buffer, 4. add a third, optional argument to read-multiple-choice (e.g. help-text) that would be added to the help buffer (e.g. squeezed between the prompt and the bindings). Ranked according to my preference: 1. (keeping "help" mnemonics (?, C-h) for "what can I do" actions, and "details/description/debug" mnemonics for "give more context" actions) 4. (reduces the number of actions for this specific prompt) 3.2. (same, only more involved) 3.1. (sad to give up on the bindings description) 2. (see rationale for 1; plus 'h' and '?' doing different things might be confusing) Tell me if there are other solutions I missed, or if you find any of these satisfying! Thank you for your time, and for the review. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-11-04 6:36 ` Kévin Le Gouguec @ 2019-11-05 22:22 ` Juri Linkov 2019-11-07 22:17 ` Juri Linkov 0 siblings, 1 reply; 76+ messages in thread From: Juri Linkov @ 2019-11-05 22:22 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier > I'd like to keep read-multiple-choice's built-in help action available > though, I find it quite ergonomic. Plus, the fact that it is bound to ? > and C-h makes it consistent with help-for-help, another command whose > purpose is to describe prompt bindings in more details. > > Here are the ways forward I can see: > > 1. keep 'd' for "details" (a la nsm.el), > > 2. use 'h' for "help": more intuitive for "what the ftok is going on" > reactions, though perhaps confusing when shown alongside '?', Indeed, providing several help keys is confusing. It should be less confusing to provide only '?' and to teach read-multiple-choice to use our help text where we could describe each supported key (y/n/etc.) and their effect explicitly. > 3. teach read-multiple-choice to let go of '?', and… > > 3.1. that's it; give up on the bindings-explaining help buffer, > > 3.2. move the code generating this buffer to an external function, > which callers could re-use to fill in their own help buffer, It seems this read-multiple-choice needs to be rewritten anyway to use the minibuffer instead of read-event. So the ability to override '?' could be added at the same time as well. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-11-05 22:22 ` Juri Linkov @ 2019-11-07 22:17 ` Juri Linkov 2019-11-10 20:18 ` Juri Linkov 0 siblings, 1 reply; 76+ messages in thread From: Juri Linkov @ 2019-11-07 22:17 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier > It seems this read-multiple-choice needs to be rewritten anyway > to use the minibuffer instead of read-event. So the ability > to override '?' could be added at the same time as well. A patch in bug#38076 replaces read-char-choice with read-char-from-minibuffer, and in one place in the patch it uses read-char-from-minibuffer in files--ask-user-about-large-file simply as (read-char-from-minibuffer (concat prompt " (y)es or (n)o or (l)iterally ") '(?y ?Y ?n ?N ?l ?L)) Maybe it would be much simpler to use something like (read-char-from-minibuffer (concat "1 occurrence of ‘?’ will not be substituted. Proceed? (y)es or (n)o or (h)elp ") '(?y ?Y ?n ?N ?h ?H)) ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-11-07 22:17 ` Juri Linkov @ 2019-11-10 20:18 ` Juri Linkov 0 siblings, 0 replies; 76+ messages in thread From: Juri Linkov @ 2019-11-10 20:18 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier > A patch in bug#38076 replaces read-char-choice with > read-char-from-minibuffer, and in one place in the patch > it uses read-char-from-minibuffer in files--ask-user-about-large-file > simply as > > (read-char-from-minibuffer > (concat prompt " (y)es or (n)o or (l)iterally ") > '(?y ?Y ?n ?N ?l ?L)) > > Maybe it would be much simpler to use something like > > (read-char-from-minibuffer > (concat "1 occurrence of ‘?’ will not be substituted. Proceed? (y)es or (n)o or (h)elp ") > '(?y ?Y ?n ?N ?h ?H)) A better example is ask-user-about-supersession-threat in userlock.el that using read-char-from-minibuffer displays such prompt: file changed on disk; really edit the buffer? (y, n, r or C-h) Please use a similarly short prompt: 1 occurrence of ‘?’ will not be substituted. Proceed? (y, n or ?) where '?' will show the Dired help window. This will simplify the user interface to make it less confusing (no more choice for two separate help texts). ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-10-10 18:45 ` bug#35564: [PATCH v5] " Kévin Le Gouguec 2019-10-22 15:10 ` Kévin Le Gouguec @ 2019-12-18 7:11 ` Kévin Le Gouguec 2019-12-19 22:01 ` Juri Linkov 1 sibling, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-12-18 7:11 UTC (permalink / raw) To: 35564; +Cc: Michael Heerdegen, Noam Postavsky, Juri Linkov, Stefan Monnier [-- Attachment #1: Type: text/plain, Size: 966 bytes --] Hello, Here is a new revision of this patch series, which aims to rephrase dired-do-shell-command's warning about occurrences of '?' and '*' that will not be substituted for filenames, with the following goals in mind: 1. cease to call these characters "wildcards" since they may be quoted or escaped, 2. cater to users who do not know about the substitution feature, 3. keep the default prompt as concise as the current one. The first revisions[1][2][3][4] focused on goals 1 and 2, to the detriment of 3. The last revision[5] hid the verbosity behind an optional explanatory buffer, using read-multiple-choice. Since this function already generates a help buffer bound to '?', I bound the explanatory buffer to 'd' for "details", a la nsm-query-user. Juri suggested[6] that read-char-from-minibuffer might fit the bill better. Since I feel kind of torn between these options, I'm putting them both forward. First, the scaffolding patches (same as v5): [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-patch, Size: 5561 bytes --] From 179fd2765e53c838d89a80ff3f680dccd4414293 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 7 Jun 2019 17:19:44 +0200 Subject: [PATCH 1/5] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired--isolated-char-p) (dired--highlight-nosubst-char, dired--no-subst-prompt): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p) (dired-test-highlight-metachar): Test the new functions. (Bug#35564) --- lisp/dired-aux.el | 42 ++++++++++++++++++++++++++++++++---- test/lisp/dired-aux-tests.el | 28 ++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 4 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index fb1ad6266d..1c2a9d1555 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -79,6 +79,42 @@ dired--star-or-qmark-p (funcall (if keep #'string-match-p #'string-match) x string)) regexps))) +(defun dired--isolated-char-p (command pos) + "Assert whether the character at POS is isolated within COMMAND. +A character is isolated if: +- it is surrounded by whitespace, the start of the command, or + the end of the command, +- it is surrounded by `\\=`' characters." + (let ((start (max 0 (1- pos))) + (char (string (aref command pos)))) + (and (string-match + (rx (or (seq (or bos blank) + (group-n 1 (literal char)) + (or eos blank)) + (seq ?` (group-n 1 (literal char)) ?`))) + command start) + (= pos (match-beginning 1))))) + +(defun dired--highlight-nosubst-char (command char) + "Highlight occurences of CHAR that are not isolated in COMMAND. +These occurences will not be substituted; they will be sent as-is +to the shell, which may interpret them as wildcards." + (save-match-data + (let ((highlighted (substring-no-properties command)) + (pos 0)) + (while (string-match (regexp-quote char) command pos) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (unless (dired--isolated-char-p command start) + (add-face-text-property start end 'warning nil highlighted)) + (setq pos end))) + highlighted))) + +(defun dired--no-subst-prompt (command char) + (let ((highlighted-command (dired--highlight-nosubst-char command char)) + (prompt "Confirm--the highlighted characters will not be substituted:")) + (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + ;;;###autoload (defun dired-diff (file &optional switches) "Compare file at point with FILE using `diff'. @@ -773,11 +809,9 @@ dired-do-shell-command (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt command "*"))) ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) + (y-or-n-p (dired--no-subst-prompt 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 ccd3192792..80b6393931 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,34 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(ert-deftest dired-test-isolated-char-p () + (should (dired--isolated-char-p "?" 0)) + (should (dired--isolated-char-p "? " 0)) + (should (dired--isolated-char-p " ?" 1)) + (should (dired--isolated-char-p " ? " 1)) + (should (dired--isolated-char-p "foo bar ? baz" 8)) + (should (dired--isolated-char-p "foo -i`?`" 7)) + (should-not (dired--isolated-char-p "foo `bar`?" 9)) + (should-not (dired--isolated-char-p "foo 'bar?'" 8)) + (should-not (dired--isolated-char-p "foo bar?baz" 7)) + (should-not (dired--isolated-char-p "foo bar?" 7))) + +(ert-deftest dired-test-highlight-metachar () + "Check that non-isolated meta-characters are highlighted" + (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") + (result (dired--highlight-nosubst-char command "?"))) + (should-not (text-property-not-all 1 14 'face nil result)) + (should (equal 'warning (get-text-property 15 'face result))) + (should-not (text-property-not-all 16 28 'face nil result)) + (should (equal 'warning (get-text-property 29 'face result))) + (should-not (text-property-not-all 30 39 'face nil result))) + (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") + (result (dired--highlight-nosubst-char command "*"))) + (should-not (text-property-not-all 1 10 'face nil result)) + (should (equal 'warning (get-text-property 11 'face result))) + (should-not (text-property-not-all 12 23 'face nil result)) + (should (equal 'warning (get-text-property 24 'face result))) + (should-not (text-property-not-all 25 29 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.24.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch --] [-- Type: text/x-patch, Size: 11062 bytes --] From 064ec112fae60b9914b635965c5ab54b151da3b8 Mon Sep 17 00:00:00 2001 From: Noam Postavsky <npostavs@gmail.com> Date: Thu, 27 Jun 2019 19:15:56 -0400 Subject: [PATCH 2/5] Dedup dired-aux isolated char searching (Bug#35564) * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--no-subst-prompt): Operate on a list of positions rather than searching again for isolated chars. Shorten prompt, and include the character being asked about in the question (to make it clearer, and in case the user can't see the fontification for whatever reason, e.g., screen reader). (dired--isolated-char-p): Remove. (dired--need-confirm-positions): New function. (dired-do-shell-command): Use it. * test/lisp/dired-aux-tests.el (dired-test-isolated-char-p): Remove. (dired-test-highlight-metachar): Adjust to new functions. Make sure that `*` isn't considered isolated. --- lisp/dired-aux.el | 113 ++++++++++++++++------------------- test/lisp/dired-aux-tests.el | 31 +++++----- 2 files changed, 67 insertions(+), 77 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 1c2a9d1555..6766c620f6 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,60 +60,60 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) - -(defun dired--isolated-char-p (command pos) - "Assert whether the character at POS is isolated within COMMAND. -A character is isolated if: -- it is surrounded by whitespace, the start of the command, or - the end of the command, -- it is surrounded by `\\=`' characters." - (let ((start (max 0 (1- pos))) - (char (string (aref command pos)))) - (and (string-match - (rx (or (seq (or bos blank) - (group-n 1 (literal char)) - (or eos blank)) - (seq ?` (group-n 1 (literal char)) ?`))) - command start) - (= pos (match-beginning 1))))) - -(defun dired--highlight-nosubst-char (command char) - "Highlight occurences of CHAR that are not isolated in COMMAND. -These occurences will not be substituted; they will be sent as-is -to the shell, which may interpret them as wildcards." - (save-match-data - (let ((highlighted (substring-no-properties command)) - (pos 0)) - (while (string-match (regexp-quote char) command pos) - (let ((start (match-beginning 0)) - (end (match-end 0))) - (unless (dired--isolated-char-p command start) - (add-face-text-property start end 'warning nil highlighted)) - (setq pos end))) - highlighted))) - -(defun dired--no-subst-prompt (command char) - (let ((highlighted-command (dired--highlight-nosubst-char command char)) - (prompt "Confirm--the highlighted characters will not be substituted:")) - (format-message "%s\n%s\nProceed?" prompt highlighted-command))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--no-subst-prompt (char-positions command) + (cl-callf substring-no-properties command) + (dolist (pos char-positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (concat command "\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)))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -793,26 +793,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (dired--no-subst-prompt command "*"))) - ((need-confirm-p command "?") - (y-or-n-p (dired--no-subst-prompt command "?"))) - (t)))) + (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))) + ((setq confirmations (dired--need-confirm-positions command "?")) + (y-or-n-p (dired--no-subst-prompt confirmations command))) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -823,7 +816,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 80b6393931..ff18edddb6 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,34 +114,31 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) -(ert-deftest dired-test-isolated-char-p () - (should (dired--isolated-char-p "?" 0)) - (should (dired--isolated-char-p "? " 0)) - (should (dired--isolated-char-p " ?" 1)) - (should (dired--isolated-char-p " ? " 1)) - (should (dired--isolated-char-p "foo bar ? baz" 8)) - (should (dired--isolated-char-p "foo -i`?`" 7)) - (should-not (dired--isolated-char-p "foo `bar`?" 9)) - (should-not (dired--isolated-char-p "foo 'bar?'" 8)) - (should-not (dired--isolated-char-p "foo bar?baz" 7)) - (should-not (dired--isolated-char-p "foo bar?" 7))) - (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted" (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") - (result (dired--highlight-nosubst-char command "?"))) + (prompt (dired--no-subst-prompt + (dired--need-confirm-positions command "?") + command)) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 14 'face nil result)) (should (equal 'warning (get-text-property 15 'face result))) (should-not (text-property-not-all 16 28 'face nil result)) (should (equal 'warning (get-text-property 29 'face result))) (should-not (text-property-not-all 30 39 'face nil result))) - (let* ((command "sed -e 's/o*/a/' -e 's/o*/a/'") - (result (dired--highlight-nosubst-char command "*"))) + ;; Note that `?` is considered isolated, but `*` is not. + (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") + (prompt (dired--no-subst-prompt + (dired--need-confirm-positions command "*") + command)) + (result (and (string-match (regexp-quote command) prompt) + (match-string 0 prompt)))) (should-not (text-property-not-all 1 10 'face nil result)) (should (equal 'warning (get-text-property 11 'face result))) (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 24 'face result))) - (should-not (text-property-not-all 25 29 'face nil result)))) + (should (equal 'warning (get-text-property 25 'face result))) + (should-not (text-property-not-all 26 32 'face nil result)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.24.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #4: 0003-Add-markers-below-non-isolated-chars-in-dired-prompt.patch --] [-- Type: text/x-patch, Size: 7845 bytes --] From 2475254565c798725d724ee89e5d699342b6c818 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 3 Jul 2019 21:17:57 +0200 Subject: [PATCH 3/5] Add '^' markers below non-isolated chars in dired prompt * lisp/dired-aux.el (dired--mark-positions): New function. (dired--no-subst-prompt): Use it to show chars without overly relying on highlighting. (dired-do-shell-command): When the echo area is wide enough to display the command without wrapping it, add the markers. * test/lisp/dired-aux-tests.el (dired-test-highlight-metachar): Add assertion for '^' marker positions. (Bug#35564) --- lisp/dired-aux.el | 43 +++++++++++++++++++++-------- test/lisp/dired-aux-tests.el | 53 ++++++++++++++++++++++++------------ 2 files changed, 68 insertions(+), 28 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 6766c620f6..038e1dbbed 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -102,18 +102,35 @@ dired--need-confirm-positions (setq start (match-end 0))) confirm-positions)) -(defun dired--no-subst-prompt (char-positions command) +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--no-subst-prompt (char-positions command add-markers) (cl-callf substring-no-properties command) (dolist (pos char-positions) (add-face-text-property pos (1+ pos) 'warning nil command)) - (concat command "\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)))) + ;; `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))))) ;;;###autoload (defun dired-diff (file &optional switches) @@ -796,15 +813,19 @@ 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))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) ((setq confirmations (dired--need-confirm-positions command "?")) - (y-or-n-p (dired--no-subst-prompt confirmations command))) + (y-or-n-p (dired--no-subst-prompt confirmations command + short-enough))) (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 ff18edddb6..174c27052e 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -115,30 +115,49 @@ dired-test-bug30624 (kill-buffer buf))))) (ert-deftest dired-test-highlight-metachar () - "Check that non-isolated meta-characters are highlighted" + "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 (dired--need-confirm-positions command "?") - command)) - (result (and (string-match (regexp-quote command) prompt) - (match-string 0 prompt)))) - (should-not (text-property-not-all 1 14 'face nil result)) - (should (equal 'warning (get-text-property 15 'face result))) - (should-not (text-property-not-all 16 28 'face nil result)) - (should (equal 'warning (get-text-property 29 'face result))) - (should-not (text-property-not-all 30 39 'face nil result))) + 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))) + (should-not (text-property-not-all 1 14 'face nil highlit-command)) + (should (equal 'warning (get-text-property 15 'face highlit-command))) + (should-not (text-property-not-all 16 28 'face nil highlit-command)) + (should (equal 'warning (get-text-property 29 'face highlit-command))) + (should-not (text-property-not-all 30 39 'face nil highlit-command))) ;; 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 (dired--need-confirm-positions command "*") - command)) - (result (and (string-match (regexp-quote command) prompt) - (match-string 0 prompt)))) - (should-not (text-property-not-all 1 10 'face nil result)) - (should (equal 'warning (get-text-property 11 'face result))) - (should-not (text-property-not-all 12 23 'face nil result)) - (should (equal 'warning (get-text-property 25 'face result))) - (should-not (text-property-not-all 26 32 'face nil result)))) + 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))) + (should-not (text-property-not-all 1 10 'face nil highlit-command)) + (should (equal 'warning (get-text-property 11 'face highlit-command))) + (should-not (text-property-not-all 12 23 'face nil highlit-command)) + (should (equal 'warning (get-text-property 25 'face highlit-command))) + (should-not (text-property-not-all 26 32 'face nil highlit-command))) + (let* ((command "sed 's/\\?/!/'") + (prompt (dired--no-subst-prompt + (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)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.24.0 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #5: 0004-Simplify-highlighting-assertions.patch --] [-- Type: text/x-patch, Size: 3417 bytes --] From 853ac332fffab69523e02a6ca4957e63d9cf3544 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Fri, 12 Jul 2019 16:10:54 +0200 Subject: [PATCH 4/5] Simplify highlighting assertions * test/lisp/dired-aux-tests.el (dired-test--check-highlighting): New function. (dired-test-highlight-metachar): Use it. (Bug#35564) --- test/lisp/dired-aux-tests.el | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 174c27052e..ba10c54332 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -114,6 +114,15 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + (ert-deftest dired-test-highlight-metachar () "Check that non-isolated meta-characters are highlighted." (let* ((command "sed -r -e 's/oo?/a/' -e 's/oo?/a/' ? `?`") @@ -127,11 +136,7 @@ dired-test-highlight-metachar (should (= (length lines) 4)) (should (string-match (regexp-quote command) highlit-command)) (should (string-match (regexp-quote markers) (nth 2 lines))) - (should-not (text-property-not-all 1 14 'face nil highlit-command)) - (should (equal 'warning (get-text-property 15 'face highlit-command))) - (should-not (text-property-not-all 16 28 'face nil highlit-command)) - (should (equal 'warning (get-text-property 29 'face highlit-command))) - (should-not (text-property-not-all 30 39 'face nil highlit-command))) + (dired-test--check-highlighting highlit-command '(15 29))) ;; Note that `?` is considered isolated, but `*` is not. (let* ((command "sed -e 's/o*/a/' -e 's/o`*` /a/'") (markers " ^ ^") @@ -144,11 +149,7 @@ dired-test-highlight-metachar (should (= (length lines) 4)) (should (string-match (regexp-quote command) highlit-command)) (should (string-match (regexp-quote markers) (nth 2 lines))) - (should-not (text-property-not-all 1 10 'face nil highlit-command)) - (should (equal 'warning (get-text-property 11 'face highlit-command))) - (should-not (text-property-not-all 12 23 'face nil highlit-command)) - (should (equal 'warning (get-text-property 25 'face highlit-command))) - (should-not (text-property-not-all 26 32 'face nil highlit-command))) + (dired-test--check-highlighting highlit-command '(11 25))) (let* ((command "sed 's/\\?/!/'") (prompt (dired--no-subst-prompt (dired--need-confirm-positions command "?") @@ -157,7 +158,8 @@ dired-test-highlight-metachar (lines (split-string prompt "\n")) (highlit-command (nth 1 lines))) (should (= (length lines) 3)) - (should (string-match (regexp-quote command) highlit-command)))) + (should (string-match (regexp-quote command) highlit-command)) + (dired-test--check-highlighting highlit-command '(8)))) (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here -- 2.24.0 [-- Attachment #6: Type: text/plain, Size: 71 bytes --] Then, the patch adding read-multiple-choice (mostly the same as v5): [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #7: 0005-Hide-detailed-explanations-in-a-togglable-help-buffe-rmc.patch --] [-- Type: text/x-patch, Size: 9723 bytes --] From 9851fc4f223e4d2a8880aa479f10b75c75100e29 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> 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-multiple-choice, (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 | 103 ++++++++++++++++++++++++++--------- test/lisp/dired-aux-tests.el | 39 ++++++------- 2 files changed, 96 insertions(+), 46 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 038e1dbbed..564c6931b5 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -110,27 +110,84 @@ 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 +" + "`" + (string (aref command (car char-positions))) + (dired--highlight-no-subst-chars char-positions command mark-positions))))) + +(defun dired--no-subst-ask (char nb-occur details) + (let ((hilit-char (propertize (string char) 'face 'warning))) + (car + (read-multiple-choice + (format-message + (ngettext + "%d occurrence of `%s' will not be substituted. Proceed?" + "%d occurrences of `%s' will not be substituted. Proceed?" + nb-occur) + nb-occur hilit-char) + `((?y "yes" "Send shell command without substituting.") + (?n "no" "Abort.") + (?d "toggle details" ,(format-message + "Show/hide occurrences of `%s'." hilit-char)) + ,@(when details + '((?m "toggle markers" "Show/hide `^' markers.")))))))) + +(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)) + (?d + (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)))) + (?m + (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 +870,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..e1d9eefbea 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-multiple-choice) '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 [-- Attachment #8: Type: text/plain, Size: 50 bytes --] Or, the patch adding read-char-from-minibuffer: [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #9: 0005-Hide-detailed-explanations-in-a-togglable-help-buffe-rcfm.patch --] [-- Type: text/x-patch, Size: 9620 bytes --] From fabee1c28f5a8fbfc41c2646478b8224f63fbfe8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> 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 [-- Attachment #10: Type: text/plain, Size: 20 bytes --] Squashed patches: [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #11: 0001-Tweak-dired-warning-about-wildcard-characters-rmc-squashed.patch --] [-- Type: text/x-patch, Size: 12407 bytes --] From e0024d156a7668a3829d451a7cc3b382860662ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 18 Dec 2019 07:54:02 +0100 Subject: [PATCH] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and offer to highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--need-confirm-positions, dired--mark-positions) (dired--highlight-no-subst-chars, dired--no-subst-explain) (dired--no-subst-ask, dired--no-subst-confirm): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-bug27496): Adapt to new prompt. (dired-test--check-highlighting): New test helper. (dired-test-highlight-metachar): New tests. Co-authored-by: Noam Postavsky <npostavs@gmail.com> (bug#28969, bug#35564) --- lisp/dired-aux.el | 153 +++++++++++++++++++++++++++++------ test/lisp/dired-aux-tests.el | 45 ++++++++++- 2 files changed, 171 insertions(+), 27 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index fb1ad6266d..564c6931b5 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,24 +60,134 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--highlight-no-subst-chars (positions command mark) + (cl-callf substring-no-properties command) + (dolist (pos positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (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 +" + "`" + (string (aref command (car char-positions))) + (dired--highlight-no-subst-chars char-positions command mark-positions))))) + +(defun dired--no-subst-ask (char nb-occur details) + (let ((hilit-char (propertize (string char) 'face 'warning))) + (car + (read-multiple-choice + (format-message + (ngettext + "%d occurrence of `%s' will not be substituted. Proceed?" + "%d occurrences of `%s' will not be substituted. Proceed?" + nb-occur) + nb-occur hilit-char) + `((?y "yes" "Send shell command without substituting.") + (?n "no" "Abort.") + (?d "toggle details" ,(format-message + "Show/hide occurrences of `%s'." hilit-char)) + ,@(when details + '((?m "toggle markers" "Show/hide `^' markers.")))))))) + +(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)) + (?d + (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)))) + (?m + (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) @@ -757,28 +867,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) - ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) - (t)))) + (ok (cond + ((not (or on-each no-subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((setq confirmations (dired--need-confirm-positions command "*")) + (dired--no-subst-confirm confirmations command)) + ((setq confirmations (dired--need-confirm-positions command "?")) + (dired--no-subst-confirm confirmations command)) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -789,7 +890,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index ccd3192792..e1d9eefbea 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-multiple-choice) 'error)) (dired temporary-file-directory) (dired-goto-file foo) ;; `dired-do-shell-command' returns nil on success. @@ -114,6 +114,49 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + +(ert-deftest 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 " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + t)) + (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 " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "*") + command + t)) + (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/\\?/!/'") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + nil)) + (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 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #12: 0001-Tweak-dired-warning-about-wildcard-characters-rcfm-squashed.patch --] [-- Type: text/x-patch, Size: 12298 bytes --] From 2b6d4fda6bbe2cae2d77d099f65c77bdb5ebc161 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 18 Dec 2019 07:54:01 +0100 Subject: [PATCH] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and offer to highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--need-confirm-positions, dired--mark-positions) (dired--highlight-no-subst-chars, dired--no-subst-explain) (dired--no-subst-ask, dired--no-subst-confirm): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-bug27496): Adapt to new prompt. (dired-test--check-highlighting): New test helper. (dired-test-highlight-metachar): New tests. Co-authored-by: Noam Postavsky <npostavs@gmail.com> (bug#28969, bug#35564) --- lisp/dired-aux.el | 151 +++++++++++++++++++++++++++++------ test/lisp/dired-aux-tests.el | 45 ++++++++++- 2 files changed, 169 insertions(+), 27 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index fb1ad6266d..20b056e9f1 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,24 +60,132 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--highlight-no-subst-chars (positions command mark) + (cl-callf substring-no-properties command) + (dolist (pos positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (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) @@ -757,28 +865,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) - ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) - (t)))) + (ok (cond + ((not (or on-each no-subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((setq confirmations (dired--need-confirm-positions command "*")) + (dired--no-subst-confirm confirmations command)) + ((setq confirmations (dired--need-confirm-positions command "?")) + (dired--no-subst-confirm confirmations command)) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -789,7 +888,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index ccd3192792..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. @@ -114,6 +114,49 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + +(ert-deftest 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 " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + t)) + (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 " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "*") + command + t)) + (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/\\?/!/'") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + nil)) + (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 [-- Attachment #13: Type: text/plain, Size: 115 bytes --] For reference, here is the diff between both the read-multiple-choice and the read-char-from-minibuffer options: [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #14: rmc-vs-rcfm.patch --] [-- Type: text/x-patch, Size: 3056 bytes --] diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 564c6931b5..20b056e9f1 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -134,27 +134,25 @@ dired--no-subst-explain 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))))) + (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))) - (car - (read-multiple-choice - (format-message - (ngettext - "%d occurrence of `%s' will not be substituted. Proceed?" - "%d occurrences of `%s' will not be substituted. Proceed?" - nb-occur) - nb-occur hilit-char) - `((?y "yes" "Send shell command without substituting.") - (?n "no" "Abort.") - (?d "toggle details" ,(format-message - "Show/hide occurrences of `%s'." hilit-char)) - ,@(when details - '((?m "toggle markers" "Show/hide `^' markers.")))))))) + (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*")) @@ -174,7 +172,7 @@ dired--no-subst-confirm (?n (setq done t proceed nil)) - (?d + (?? (if details (progn (quit-window nil details) @@ -182,7 +180,7 @@ dired--no-subst-confirm (dired--no-subst-explain help-buf char-positions command markers) (setq details (display-buffer help-buf)))) - (?m + (?^ (setq markers (not markers)) (dired--no-subst-explain help-buf char-positions command markers))))) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index e1d9eefbea..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 'read-multiple-choice) '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. [-- Attachment #15: Type: text/plain, Size: 263 bytes --] Once applied, the patches can be tried out by - opening a Dired buffer, - hitting '!', - inputting e.g. "sed 's/?/!/'". WDYT? Thank you for your time. [1] bug#35564#5 [2] bug#35564#38 [3] bug#35564#62 [4] bug#35564#101 [5] bug#35564#157 [6] bug#35564#187 ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-12-18 7:11 ` Kévin Le Gouguec @ 2019-12-19 22:01 ` Juri Linkov 2019-12-20 8:53 ` Eli Zaretskii 2019-12-20 20:43 ` Kévin Le Gouguec 0 siblings, 2 replies; 76+ messages in thread From: Juri Linkov @ 2019-12-19 22:01 UTC (permalink / raw) To: Kévin Le Gouguec Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier > Once applied, the patches can be tried out by > > - opening a Dired buffer, > - hitting '!', > - inputting e.g. "sed 's/?/!/'". > > WDYT? Thanks. I tried out your patch with read-char-from-minibuffer and it works smoothly without any problem. Please ask Eli for a permission to push it before starting the pretest. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-12-19 22:01 ` Juri Linkov @ 2019-12-20 8:53 ` Eli Zaretskii 2019-12-20 20:34 ` Kévin Le Gouguec 2019-12-20 20:43 ` Kévin Le Gouguec 1 sibling, 1 reply; 76+ messages in thread From: Eli Zaretskii @ 2019-12-20 8:53 UTC (permalink / raw) To: Juri Linkov; +Cc: michael_heerdegen, 35564, npostavs, monnier, kevin.legouguec > From: Juri Linkov <juri@linkov.net> > Cc: 35564@debbugs.gnu.org, Michael Heerdegen <michael_heerdegen@web.de>, > Noam Postavsky <npostavs@gmail.com>, Stefan Monnier > <monnier@iro.umontreal.ca>, Eli Zaretskii <eliz@gnu.org>, Drew Adams > <drew.adams@oracle.com> > Date: Fri, 20 Dec 2019 00:01:03 +0200 > > > Once applied, the patches can be tried out by > > > > - opening a Dired buffer, > > - hitting '!', > > - inputting e.g. "sed 's/?/!/'". > > > > WDYT? > > Thanks. I tried out your patch with read-char-from-minibuffer > and it works smoothly without any problem. Please ask Eli > for a permission to push it before starting the pretest. I'll let other participants of this long discussion to chime in, but in general I'd like to postpone this till after the emacs-27 branch is cut (hopefully, very soon), as this constitutes a significant behavior change, AFAIU. Thanks. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-12-20 8:53 ` Eli Zaretskii @ 2019-12-20 20:34 ` Kévin Le Gouguec 2019-12-21 7:08 ` Eli Zaretskii 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-12-20 20:34 UTC (permalink / raw) To: Eli Zaretskii; +Cc: michael_heerdegen, 35564, npostavs, Juri Linkov, monnier Eli Zaretskii <eliz@gnu.org> writes: > I'll let other participants of this long discussion to chime in, but > in general I'd like to postpone this till after the emacs-27 branch is > cut (hopefully, very soon), as this constitutes a significant behavior > change, AFAIU. I won't insist too much for this to land on Emacs 27, since a) the "bug" it fixes is fairly minor, b) I know everyone's plate is quite full, and c) I mostly use the master branch anyway, so it's not like I'll have to wait to benefit. For the record though, I'll point out a few reasons why I think it should be "safe" to include this in the upcoming release: - the changes are fairly limited in scope: they only affect dired-do-shell-command; - in the simplest case, the UI change is minor: it turns this message: > Confirm--do you mean to use ‘?’ as a wildcard? (y or n) into this one: > 1 occurrence of ‘?’ will not be substituted. Proceed? (y, n, ?) ? (or, with read-multiple-choice:) > 1 occurrence of ‘?’ will not be substituted. Proceed? (_y_es, _n_o, toggle _d_etails, _?_): - the "riskiest" refactoring changes have been handled by Noam[1] and are partially covered by unit tests. Most of the lengthy discussion was about finding the right balance between message correctness and verbosity; hopefully the eventual behavior change is not that significant. > Thanks. Thank you for your time. [1] https://debbugs.gnu.org/cgi/bugreport.cgi?att=2;filename=0002-Dedup-dired-aux-isolated-char-searching-Bug-35564.patch;bug=35564;msg=202 ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-12-20 20:34 ` Kévin Le Gouguec @ 2019-12-21 7:08 ` Eli Zaretskii 2019-12-22 16:02 ` Kévin Le Gouguec 0 siblings, 1 reply; 76+ messages in thread From: Eli Zaretskii @ 2019-12-21 7:08 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: michael_heerdegen, 35564, npostavs, juri, monnier > From: Kévin Le Gouguec <kevin.legouguec@gmail.com> > Cc: Juri Linkov <juri@linkov.net>, 35564@debbugs.gnu.org, > michael_heerdegen@web.de, npostavs@gmail.com, monnier@iro.umontreal.ca, > drew.adams@oracle.com > Date: Fri, 20 Dec 2019 21:34:07 +0100 > > - in the simplest case, the UI change is minor: it turns this message: > > > Confirm--do you mean to use ‘?’ as a wildcard? (y or n) > > into this one: > > > 1 occurrence of ‘?’ will not be substituted. Proceed? (y, n, ?) ? > > (or, with read-multiple-choice:) > > > 1 occurrence of ‘?’ will not be substituted. Proceed? (_y_es, _n_o, toggle _d_etails, _?_): Is this the best wording you've been able to arrive at? It sounds slightly confusing to me (but then I don't use this facility too much). The confusing part is that it talks about "substitution", and the user might not be aware that there is any substitution going on. Thanks. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-12-21 7:08 ` Eli Zaretskii @ 2019-12-22 16:02 ` Kévin Le Gouguec 0 siblings, 0 replies; 76+ messages in thread From: Kévin Le Gouguec @ 2019-12-22 16:02 UTC (permalink / raw) To: Eli Zaretskii; +Cc: michael_heerdegen, 35564, npostavs, juri, monnier Eli Zaretskii <eliz@gnu.org> writes: >> From: Kévin Le Gouguec <kevin.legouguec@gmail.com> >> Cc: Juri Linkov <juri@linkov.net>, 35564@debbugs.gnu.org, >> michael_heerdegen@web.de, npostavs@gmail.com, monnier@iro.umontreal.ca, >> drew.adams@oracle.com >> Date: Fri, 20 Dec 2019 21:34:07 +0100 >> >> - in the simplest case, the UI change is minor: it turns this message: >> >> > Confirm--do you mean to use ‘?’ as a wildcard? (y or n) >> >> into this one: >> >> > 1 occurrence of ‘?’ will not be substituted. Proceed? (y, n, ?) ? >> >> (or, with read-multiple-choice:) >> >> > 1 occurrence of ‘?’ will not be substituted. Proceed? (_y_es, _n_o, toggle _d_etails, _?_): > > Is this the best wording you've been able to arrive at? It sounds > slightly confusing to me (but then I don't use this facility too > much). The confusing part is that it talks about "substitution", and > the user might not be aware that there is any substitution going on. Indeed, that's why the prompt now supports an additional action to pop a help buffer explaining what the deal is[1]. Fundamentally, this prompt *is* about the substitution feature. Dired detects non-isolated occurrences of '*' and '?', and requests confirmation before proceeding without substituting them. With this in mind, explicitly mentioning "substitution" doesn't sound too outlandish… ( Or, we could assume that the current message is correct (i.e. it's the wildcards we want to warn about) but the condition that triggers it is wrong, i.e. Dired should be smarter and only warn when the characters are unquoted and unescaped. That sounds complex to implement though. As Drew noted[2], another way to handle this would be asking users whether they want to substitute the non-isolated characters. That still implies talking about "substitution" though. Also, users can already mark occurrences of '?' for substitution using backquotes, as explained in the new help buffer. ) To wrap up, I'd say that the current message makes me go: "Huh? No, I don't want to use these characters as wildcards." *hits "n", command is aborted* *confusion: extreme & growing* I'm hoping that the new message will have users go: "Huh? Why would Dired substitute these characters?" *hits "?", skims, hits "y", moves on* *confusion: mild & receding* Thank you for your patience, and for reviewing this. [1] > 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 ‘`’, Dired will > run the command once for each file, substituting ‘?’ for each > file name. > > Your command contains occurrences of ‘?’ that will not be > substituted, and will be passed through normally to the shell. > > sed 's/?/!/' > > (Press ^ to add markers below these occurrences.) [2] bug#35564#83 ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-12-19 22:01 ` Juri Linkov 2019-12-20 8:53 ` Eli Zaretskii @ 2019-12-20 20:43 ` Kévin Le Gouguec 2019-12-21 7:08 ` Eli Zaretskii 1 sibling, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2019-12-20 20:43 UTC (permalink / raw) To: Juri Linkov; +Cc: Michael Heerdegen, 35564, Noam Postavsky, Stefan Monnier Juri Linkov <juri@linkov.net> writes: > Thanks. I tried out your patch with read-char-from-minibuffer > and it works smoothly without any problem. Please ask Eli > for a permission to push it before starting the pretest. Glad to hear it! Like Eli, I'd like to collect some feedback, e.g. from Michael who submitted bug#28969 and suggested read-multiple-choice. Some additional remarks: - I do not have push access AFAIK, so feel free to install whenever you think there is consensus on whether to wait for emacs-27 to fork off. - I guess there is also the question of whether to push the five patches or the squashed one (all have valid commit messages, unless I messed up). ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-12-20 20:43 ` Kévin Le Gouguec @ 2019-12-21 7:08 ` Eli Zaretskii 2020-09-20 11:42 ` Lars Ingebrigtsen 0 siblings, 1 reply; 76+ messages in thread From: Eli Zaretskii @ 2019-12-21 7:08 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: michael_heerdegen, 35564, npostavs, juri, monnier > From: Kévin Le Gouguec <kevin.legouguec@gmail.com> > Cc: 35564@debbugs.gnu.org, Michael Heerdegen <michael_heerdegen@web.de>, > Noam Postavsky <npostavs@gmail.com>, Stefan Monnier > <monnier@iro.umontreal.ca>, Eli Zaretskii <eliz@gnu.org>, Drew Adams > <drew.adams@oracle.com> > Date: Fri, 20 Dec 2019 21:43:59 +0100 > > - I guess there is also the question of whether to push the five patches > or the squashed one (all have valid commit messages, unless I messed > up). The latter, please. ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2019-12-21 7:08 ` Eli Zaretskii @ 2020-09-20 11:42 ` Lars Ingebrigtsen 2020-09-20 12:04 ` Kévin Le Gouguec 0 siblings, 1 reply; 76+ messages in thread From: Lars Ingebrigtsen @ 2020-09-20 11:42 UTC (permalink / raw) To: Eli Zaretskii Cc: michael_heerdegen, 35564, npostavs, juri, monnier, Kévin Le Gouguec Eli Zaretskii <eliz@gnu.org> writes: >> - I guess there is also the question of whether to push the five patches >> or the squashed one (all have valid commit messages, unless I messed >> up). > > The latter, please. Kévin, skimming this thread, there seemed to be a general consensus that your patch series should be applied. Could you work up a single squashed patch to apply? There's so many patches with different variations that it's difficult to tell which ones should be applied. -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2020-09-20 11:42 ` Lars Ingebrigtsen @ 2020-09-20 12:04 ` Kévin Le Gouguec 2020-09-20 12:18 ` Lars Ingebrigtsen 0 siblings, 1 reply; 76+ messages in thread From: Kévin Le Gouguec @ 2020-09-20 12:04 UTC (permalink / raw) To: Lars Ingebrigtsen; +Cc: michael_heerdegen, 35564, npostavs, juri, monnier [-- Attachment #1: Type: text/plain, Size: 604 bytes --] Lars Ingebrigtsen <larsi@gnus.org> writes: > Kévin, skimming this thread, there seemed to be a general consensus that > your patch series should be applied. Could you work up a single > squashed patch to apply? There's so many patches with different > variations that it's difficult to tell which ones should be applied. Thanks for following up on this! I was planning to do so after the release of 27.1, but somehow never found the time. Here is the squashed patch using read-char-from-minibuffer (which unless I messed something up should be the same as the one from December[1]). [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Tweak-dired-warning-about-wildcard-characters.patch --] [-- Type: text/x-diff, Size: 12298 bytes --] From 135465cb28a8cfc2059754b7ab2c188864eb891d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <kevin.legouguec@gmail.com> Date: Wed, 18 Dec 2019 07:54:01 +0100 Subject: [PATCH] Tweak dired warning about "wildcard" characters Non-isolated '?' and '*' characters may be quoted, or backslash-escaped; we do not know for a fact that the shell will interpret them as wildcards. Rephrase the prompt and offer to highlight the characters so that the user sees exactly what we are talking about. * lisp/dired-aux.el (dired-isolated-string-re): Use explicitly numbered groups. (dired--star-or-qmark-p): Add START parameter. Make sure to return the first isolated match. (dired--need-confirm-positions, dired--mark-positions) (dired--highlight-no-subst-chars, dired--no-subst-explain) (dired--no-subst-ask, dired--no-subst-confirm): New functions. (dired-do-shell-command): Use them. * test/lisp/dired-aux-tests.el (dired-test-bug27496): Adapt to new prompt. (dired-test--check-highlighting): New test helper. (dired-test-highlight-metachar): New tests. Co-authored-by: Noam Postavsky <npostavs@gmail.com> (bug#28969, bug#35564) --- lisp/dired-aux.el | 151 +++++++++++++++++++++++++++++------ test/lisp/dired-aux-tests.el | 45 ++++++++++- 2 files changed, 169 insertions(+), 27 deletions(-) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index cf2926ad37..df25a6418f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -60,24 +60,132 @@ dired-isolated-string-re of a string followed/prefixed with an space. The regexp capture the preceding blank, STRING and the following blank as the groups 1, 2 and 3 respectively." - (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string)) + (format "\\(?1:\\`\\|[ \t]\\)\\(?2:%s\\)\\(?3:[ \t]\\|\\'\\)" string)) -(defun dired--star-or-qmark-p (string match &optional keep) +(defun dired--star-or-qmark-p (string match &optional keep start) "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'. MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter means STRING contains either \"?\" or `\\=`?\\=`' or \"*\". If optional arg KEEP is non-nil, then preserve the match data. Otherwise, this function changes it and saves MATCH as the second match group. +START is the position to start matching from. Isolated means that MATCH is surrounded by spaces or at the beginning/end of STRING followed/prefixed with an space. A match to `\\=`?\\=`', isolated or not, is also valid." - (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]"))))) + (let ((regexp (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))) (when (or (null match) (equal match "?")) - (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps))) - (cl-some (lambda (x) - (funcall (if keep #'string-match-p #'string-match) x string)) - regexps))) + (cl-callf concat regexp "\\|\\(?1:\\)\\(?2:`\\?`\\)\\(?3:\\)")) + (funcall (if keep #'string-match-p #'string-match) regexp string start))) + +(defun dired--need-confirm-positions (command string) + "Search for non-isolated matches of STRING in COMMAND. +Return a list of positions that match STRING, but would not be +considered \"isolated\" by `dired--star-or-qmark-p'." + (cl-assert (= (length string) 1)) + (let ((start 0) + (isolated-char-positions nil) + (confirm-positions nil) + (regexp (regexp-quote string))) + ;; Collect all ? and * surrounded by spaces and `?`. + (while (dired--star-or-qmark-p command string nil start) + (push (cons (match-beginning 2) (match-end 2)) + isolated-char-positions) + (setq start (match-end 2))) + ;; Now collect any remaining ? and *. + (setq start 0) + (while (string-match regexp command start) + (unless (cl-member (match-beginning 0) isolated-char-positions + :test (lambda (pos match) + (<= (car match) pos (cdr match)))) + (push (match-beginning 0) confirm-positions)) + (setq start (match-end 0))) + confirm-positions)) + +(defun dired--mark-positions (positions) + (let ((markers (make-string + (1+ (apply #'max positions)) + ?\s))) + (dolist (pos positions) + (setf (aref markers pos) ?^)) + markers)) + +(defun dired--highlight-no-subst-chars (positions command mark) + (cl-callf substring-no-properties command) + (dolist (pos positions) + (add-face-text-property pos (1+ pos) 'warning nil command)) + (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) @@ -772,28 +880,19 @@ dired-do-shell-command (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) - (cl-flet ((need-confirm-p - (cmd str) - (let ((res cmd) - (regexp (regexp-quote str))) - ;; Drop all ? and * surrounded by spaces and `?`. - (while (and (string-match regexp res) - (dired--star-or-qmark-p res str)) - (setq res (replace-match "" t t res 2))) - (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) + (confirmations nil) ;; 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")) - ((need-confirm-p command "*") - (y-or-n-p (format-message - "Confirm--do you mean to use `*' as a wildcard? "))) - ((need-confirm-p command "?") - (y-or-n-p (format-message - "Confirm--do you mean to use `?' as a wildcard? "))) - (t)))) + (ok (cond + ((not (or on-each no-subst)) + (error "You can not combine `*' and `?' substitution marks")) + ((setq confirmations (dired--need-confirm-positions command "*")) + (dired--no-subst-confirm confirmations command)) + ((setq confirmations (dired--need-confirm-positions command "?")) + (dired--no-subst-confirm confirmations command)) + (t)))) (cond ((not ok) (message "Command canceled")) (t (if on-each @@ -804,7 +903,7 @@ dired-do-shell-command nil file-list) ;; execute the shell command (dired-run-shell-command - (dired-shell-stuff-it command file-list nil arg)))))))) + (dired-shell-stuff-it command file-list nil arg))))))) ;; Might use {,} for bash or csh: (defvar dired-mark-prefix "" diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 1fe155718d..54ec5d673c 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. @@ -114,6 +114,49 @@ dired-test-bug30624 (mapc #'delete-file `(,file1 ,file2)) (kill-buffer buf))))) +(defun dired-test--check-highlighting (command positions) + (let ((start 1)) + (dolist (pos positions) + (should-not (text-property-not-all start (1- pos) 'face nil command)) + (should (equal 'warning (get-text-property pos 'face command))) + (setq start (1+ pos))) + (should-not (text-property-not-all + start (length command) 'face nil command)))) + +(ert-deftest 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 " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + t)) + (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 " ^ ^") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "*") + command + t)) + (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/\\?/!/'") + (result (dired--highlight-no-subst-chars + (dired--need-confirm-positions command "?") + command + nil)) + (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.20.1 [-- Attachment #3: Type: text/plain, Size: 155 bytes --] [1] <https://debbugs.gnu.org/cgi/bugreport.cgi?filename=0001-Tweak-dired-warning-about-wildcard-characters-rcfm-squashed.patch;att=11;msg=202;bug=35564> ^ permalink raw reply related [flat|nested] 76+ messages in thread
* bug#35564: [PATCH v5] Tweak dired warning about "wildcard" characters 2020-09-20 12:04 ` Kévin Le Gouguec @ 2020-09-20 12:18 ` Lars Ingebrigtsen 0 siblings, 0 replies; 76+ messages in thread From: Lars Ingebrigtsen @ 2020-09-20 12:18 UTC (permalink / raw) To: Kévin Le Gouguec; +Cc: michael_heerdegen, 35564, npostavs, juri, monnier Kévin Le Gouguec <kevin.legouguec@gmail.com> writes: > Here is the squashed patch using read-char-from-minibuffer (which unless > I messed something up should be the same as the one from December[1]). Thanks for the speedy squash. :-) I've now applied it to Emacs 28 after some extremely light testing. -- (domestic pets only, the antidote for overdose, milk.) bloggy blog: http://lars.ingebrigtsen.no ^ permalink raw reply [flat|nested] 76+ messages in thread
end of thread, other threads:[~2020-09-20 12:18 UTC | newest] Thread overview: 76+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2019-05-04 18:01 bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters Kévin Le Gouguec 2019-05-05 8:44 ` martin rudalics 2019-05-06 19:40 ` Kévin Le Gouguec 2019-05-07 8:15 ` martin rudalics 2019-05-07 13:19 ` Drew Adams 2019-05-08 20:42 ` Kévin Le Gouguec 2019-05-08 22:39 ` Drew Adams 2019-05-09 8:13 ` martin rudalics 2019-05-09 14:17 ` Drew Adams 2019-05-09 17:51 ` martin rudalics 2019-05-09 20:04 ` Drew Adams 2019-06-09 11:08 ` bug#35564: [PATCH v2] Tweak dired " Kévin Le Gouguec 2019-06-12 12:23 ` Noam Postavsky 2019-06-12 14:29 ` Stefan Monnier 2019-06-13 6:19 ` Kévin Le Gouguec 2019-06-13 7:58 ` Stefan Monnier 2019-06-13 16:53 ` npostavs 2019-06-18 8:52 ` Kévin Le Gouguec 2019-06-19 0:12 ` Noam Postavsky 2019-06-26 6:16 ` bug#35564: [PATCH v3] " Kévin Le Gouguec 2019-06-26 13:27 ` Drew Adams 2019-06-27 5:58 ` Kévin Le Gouguec 2019-06-26 14:33 ` Stefan Monnier 2019-06-27 6:15 ` Kévin Le Gouguec 2019-06-27 23:31 ` Noam Postavsky 2019-06-28 6:15 ` Kévin Le Gouguec 2019-06-28 15:35 ` Drew Adams 2019-06-28 17:58 ` Kévin Le Gouguec 2019-06-28 18:43 ` Drew Adams 2019-06-29 13:48 ` Noam Postavsky 2019-06-29 14:30 ` Drew Adams 2019-06-29 14:13 ` Eli Zaretskii 2019-07-03 19:47 ` bug#35564: [PATCH v4] " Kévin Le Gouguec 2019-07-12 15:10 ` Kévin Le Gouguec 2019-07-27 11:20 ` Eli Zaretskii 2019-07-27 17:26 ` Kévin Le Gouguec 2019-07-27 22:22 ` Michael Heerdegen 2019-07-29 3:29 ` Michael Heerdegen 2019-07-29 18:11 ` Juri Linkov 2019-07-29 19:01 ` Kévin Le Gouguec 2019-08-02 5:26 ` Michael Heerdegen 2019-08-08 10:40 ` Kévin Le Gouguec 2019-08-08 21:06 ` Juri Linkov 2019-08-09 12:43 ` Kévin Le Gouguec 2019-08-09 18:03 ` Juri Linkov 2019-08-15 20:56 ` Juri Linkov 2019-08-19 4:55 ` Kévin Le Gouguec 2019-07-27 22:03 ` Basil L. Contovounesios 2019-07-27 23:32 ` Kévin Le Gouguec 2019-07-27 23:41 ` Basil L. Contovounesios 2019-10-10 18:45 ` bug#35564: [PATCH v5] " Kévin Le Gouguec 2019-10-22 15:10 ` Kévin Le Gouguec 2019-10-22 16:58 ` Michael Heerdegen 2019-10-22 21:32 ` Kévin Le Gouguec 2019-11-10 20:29 ` Juri Linkov 2019-11-14 7:02 ` Kévin Le Gouguec 2019-11-16 20:23 ` Juri Linkov 2019-10-22 20:43 ` Juri Linkov 2019-10-22 21:11 ` Kévin Le Gouguec 2019-10-27 21:40 ` Juri Linkov 2019-10-30 21:59 ` Juri Linkov 2019-11-04 6:36 ` Kévin Le Gouguec 2019-11-05 22:22 ` Juri Linkov 2019-11-07 22:17 ` Juri Linkov 2019-11-10 20:18 ` Juri Linkov 2019-12-18 7:11 ` Kévin Le Gouguec 2019-12-19 22:01 ` Juri Linkov 2019-12-20 8:53 ` Eli Zaretskii 2019-12-20 20:34 ` Kévin Le Gouguec 2019-12-21 7:08 ` Eli Zaretskii 2019-12-22 16:02 ` Kévin Le Gouguec 2019-12-20 20:43 ` Kévin Le Gouguec 2019-12-21 7:08 ` Eli Zaretskii 2020-09-20 11:42 ` Lars Ingebrigtsen 2020-09-20 12:04 ` Kévin Le Gouguec 2020-09-20 12:18 ` Lars Ingebrigtsen
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).