Subject: bug#35564: 27.0.50; [PATCH] Tweak dired-do-shell-command warning about "wildcard" characters

From: Kévin Le Gouguec <[email-masked]>
Date: Sat, 04 May 2019 20:01:52 +0200

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]).

>From f1d6df845909fd8a6fb0500984fd305d6cf6d6fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= <[email-masked]>
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

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))