[elpa] externals/relint caea432bb4 09/17: Better string range highlighting in output

[ELPA Syncer]

branch: externals/relint
commit caea432bb4a54b0ebb3dfd376d7ea54280524765
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Better string range highlighting in output
    
    Add `relint-batch-highlight` variable that controls the `relint-batch`
    output: caret (as before), terminal escape sequence (now default), or
    nothing.
    
    Add `relint-buffer-highlight` face for interactive use.
---
 README         | 29 ++++++++++++++++------
 relint-test.el | 37 +++++++++++++++++++++++++++-
 relint.el      | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++-------
 3 files changed, 126 insertions(+), 16 deletions(-)

diff --git a/README b/README
index 0c7bbc874d..b0a953ec84 100644
--- a/README
+++ b/README
@@ -64,15 +64,30 @@ skip-syntax-forward and skip-syntax-backward.
   it will be installed automatically.
 
 
-* Configuration
+* User options
 
-  No configuration is required.
+  - variable 'relint-xr-checks'
 
-  There is a single user option, 'relint-xr-checks'.
-  If set to 'all', it enables more thorough checks that detect more
-  errors and performance problems but may also produce more false
-  warnings. The default value is 'nil', limiting warnings to ones that
-  are likely to be accurate.
+      If set to 'all', it enables checks that detect more errors and
+      performance problems but may also produce more false warnings.
+      The default value is 'nil' which limits warnings to ones that
+      are likely to be accurate.
+
+  - variable 'relint-batch-highlight'
+
+      This variable controls the diagnostics output of 'relint-batch'.
+      If set to a string pair (BEGIN . END), these strings will be
+      used to highlight the part of a regexp that a message is talking
+      about. The default value makes that part appear in reverse video
+      in a (VT100-compatible) terminal.
+      The value 'caret' uses ASCII symbols to mark the interesting part
+      instead.
+      The value 'nil' disables highlighting entirely.
+
+  - face 'relint-buffer-highlight'
+
+      This is the face used to highlight text warned about for a
+      message appearing in the '*relint*' buffer.
 
 
 * What the diagnostics mean
diff --git a/relint-test.el b/relint-test.el
index d3470dc9c6..c8d5e71a59 100644
--- a/relint-test.el
+++ b/relint-test.el
@@ -98,7 +98,9 @@ and a path."
   (with-temp-buffer
     ;; The reference files (*.expected) are kept in the `grave' style,
     ;; to make the test independent of `text-quoting-style'.
-    (let ((text-quoting-style 'grave))
+    (let ((text-quoting-style 'grave)
+          (relint--force-batch-output t)
+          (relint-batch-highlight 'caret))
       (relint--buffer (find-file-noselect file t) (current-buffer) t))
     (buffer-string)))
 
@@ -210,4 +212,37 @@ and a path."
                      (and checks
                           `([,msg 13 17 18 "\\(:?xy\\)+" 2 3 warning])))))))
 
+(defun relint-test--batch (prog)
+  (with-temp-buffer
+    (let ((errbuf (current-buffer)))
+      (let ((progbuf (get-buffer-create "relint--test.el")))
+        (unwind-protect
+            (with-current-buffer progbuf
+              (insert prog)
+              (emacs-lisp-mode)
+              (let ((text-quoting-style 'grave)
+                    (relint--force-batch-output t))
+                (relint--buffer (current-buffer) errbuf t)))
+          (kill-buffer progbuf)))
+      (buffer-string))))
+
+(ert-deftest relint-batch-highlight ()
+  (let ((prog "(looking-at \"[pqrf-az]\")\n")
+        (msg (concat "relint--test.el:1:18-20: "
+                     "In call to looking-at: "
+                     "Reversed range `f-a' matches nothing (pos 4..6)\n")))
+    (let ((relint-batch-highlight nil))
+      (should (equal (relint-test--batch prog)
+                     (concat msg
+                             "  \"[pqrf-az]\"\n"))))
+    (let ((relint-batch-highlight 'caret))
+      (should (equal (relint-test--batch prog)
+                     (concat msg
+                             "  \"[pqrf-az]\"\n"
+                             "   ....^^^\n"))))
+    (let ((relint-batch-highlight '("{" . "}")))
+      (should (equal (relint-test--batch prog)
+                     (concat msg
+                             "  \"[pqr{f-a}z]\"\n"))))))
+
 (provide 'relint-test)
diff --git a/relint.el b/relint.el
index 69f7856185..31d9f15895 100644
--- a/relint.el
+++ b/relint.el
@@ -43,6 +43,39 @@ false positives, or `all', enabling all checks."
   :type '(choice (const :tag "Standard checks only" nil)
                  (const :tag "All checks" all)))
 
+;; FIXME: should this be a defcustom, defface, or both?
+(defface relint-buffer-highlight
+  '((t (:inherit highlight)))
+  "Face for highlight the string part warned about in the `*relint*' buffer."
+  :group 'relint)
+
+;; FIXME: default to underline or reverse?
+(defcustom relint-batch-highlight '("\e[7m" . "\e[m")
+  "How to emphasise part of a string warned about in batch output.
+The value is one of the following:
+
+  A pair of strings for turning on and off highlighting in
+  the terminal; these are typically escape sequences.
+
+  `caret', which adds an ASCII caret on the line under the string.
+
+  `nil', which disables highlighting.
+
+The default value produces reverse video in a VT100-compatible terminal.
+
+In interactive mode, relint uses the `relint-buffer-highlight' face instead."
+  :group 'relint
+  :type '(choice
+          (const :tag "Terminal reverse" ("\e[7m" . "\e[m"))
+          (const :tag "Terminal underline" ("\e[4m" . "\e[m"))
+          (cons :tag "Escape sequences"
+                (string :tag "Sequence for turning highlighting on" "\e[7m")
+                (string :tag "Sequence for turning highlighting off" "\e[m"))
+          (const :tag "ASCII caret" caret)
+          (const :tag "Highlighting disabled" nil)))
+
+(defvar relint--force-batch-output nil)  ; for testing only
+
 (defun relint--get-error-buffer ()
   "Buffer to which errors are printed, or nil if noninteractive."
   (and (not noninteractive)
@@ -229,7 +262,34 @@ in case it occupies more than one position in the buffer."
                    (end-col
                     (format "%d:%d-%d" beg-line beg-col end-col))
                    (t
-                    (format "%d:%d" beg-line beg-col)))))
+                    (format "%d:%d" beg-line beg-col))))
+         (quoted-str (and str (relint--quote-string str)))
+         (caret-str nil))
+
+    (when beg-idx
+      (let* ((bounds (relint--caret-bounds str beg-idx end-idx))
+             ;; Indices into quoted-str, which includes double quotes:
+             (beg-qs (+ (car bounds) 1))
+             (end-qs (+ (cdr bounds) 2)))  ; exclusive
+        (cond ((and error-buffer (not relint--force-batch-output))
+               ;; Output to buffer: apply highlight face to part of string.
+               (put-text-property
+                beg-qs end-qs 'font-lock-face 'relint-buffer-highlight
+                quoted-str))
+              ((eq relint-batch-highlight 'caret)
+               (let* ((col-from (car bounds))
+                      (col-to (cdr bounds)))
+                 (setq caret-str (concat
+                                  (make-string col-from ?.)
+                                  (make-string (- col-to col-from -1) ?^)))))
+              ((consp relint-batch-highlight)
+               (setq quoted-str
+                     (concat (substring quoted-str 0 beg-qs)
+                             (car relint-batch-highlight)
+                             (substring quoted-str beg-qs end-qs)
+                             (cdr relint-batch-highlight)
+                             (substring quoted-str end-qs)))))))
+
     (relint--output-message
      error-buffer
      (concat
@@ -240,9 +300,8 @@ in case it occupies more than one position in the buffer."
       (cond ((and beg-idx end-idx (< beg-idx end-idx))
              (format " (pos %d..%d)" beg-idx end-idx))
             (beg-idx (format " (pos %d)" beg-idx)))
-      (and str     (format "\n  %s" (relint--quote-string str)))
-      (and beg-idx (format "\n   %s" (relint--caret-string
-                                      str beg-idx end-idx)))))))
+      (and quoted-str (format "\n  %s" quoted-str))
+      (and caret-str  (format "\n   %s" caret-str))))))
   
 (defun relint--output-complaints (buffer file complaints error-buffer)
   (with-current-buffer buffer
@@ -329,7 +388,7 @@ in case it occupies more than one position in the buffer."
 (defun relint--quote-string (str)
   (concat "\"" (relint--escape-string str t) "\""))
 
-(defun relint--caret-string (string beg end)
+(defun relint--caret-bounds (string beg end)
   (let* ((beg-col
           (length (relint--escape-string (substring string 0 beg) t)))
          (end-col
@@ -338,8 +397,7 @@ in case it occupies more than one position in the buffer."
               (1- (length (relint--escape-string
                            (substring string 0 (1+ end)) t)))
             beg-col)))
-    (concat (make-string beg-col ?.)
-            (make-string (- end-col beg-col -1) ?^))))
+    (cons beg-col end-col)))
 
 (defun relint--expand-name (name)
   (pcase-exhaustive name
@@ -2794,7 +2852,9 @@ Call this function in batch mode with files and 
directories as
 command-line arguments.  Files are scanned; directories are
 searched recursively for *.el files to scan.
 When done, Emacs terminates with a nonzero status if anything worth
-complaining about was found, zero otherwise."
+complaining about was found, zero otherwise.
+
+The output appearance is controlled by the variable `relint-batch-highlight'."
   (unless noninteractive
     (error "`relint-batch' is only for use with -batch"))
   (let* ((err-supp