[elpa] externals/relint feba965 3/7: Add severity field to tuple returned from relint-buffer

[Mattias Engdegård]

branch: externals/relint
commit feba9658d98dc0fa6ba9d34b415f05f68c7805bb
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    Add severity field to tuple returned from relint-buffer
    
    It takes the conventional values 'warning' and 'error' (and perhaps
    'info' in the future). The "error:" part of the message is now gone.
---
 relint-test.el  | 15 +++++++------
 relint.el       | 65 ++++++++++++++++++++++++++++++++-------------------------
 test/1.expected |  3 ++-
 3 files changed, 47 insertions(+), 36 deletions(-)

diff --git a/relint-test.el b/relint-test.el
index fae38a9..1df5d66 100644
--- a/relint-test.el
+++ b/relint-test.el
@@ -133,13 +133,16 @@ and a path."
             (emacs-lisp-mode)
             (insert ";hello\n(looking-at \"broken**regexp\")\n")
             (insert "(looking-at (make-string 2 ?^))\n")
-            (insert "(looking-at (concat \"ab\" \"cdef\" \"[gg]\"))\n"))
+            (insert "(looking-at (concat \"ab\" \"cdef\" \"[gg]\"))\n")
+            (insert "(string-match \"[xy\" s)\n"))
           (should (equal
                    (relint-buffer buf)
-                   '(("In call to looking-at: Repetition of repetition" 20 28
-                      "broken**regexp" 7)
-                     ("In call to looking-at: Unescaped literal `^'" 50 nil
-                      "^^" 1)
+                   '(("In call to looking-at: Repetition of repetition"
+                      20 28 "broken**regexp" 7 warning)
+                     ("In call to looking-at: Unescaped literal `^'"
+                      50 nil "^^" 1 warning)
                      ("In call to looking-at: Duplicated `g' inside character 
alternative"
-                      82 105 "abcdef[gg]" 8)))))
+                      82 105 "abcdef[gg]" 8 warning)
+                     ("In call to string-match: Unterminated character 
alternative"
+                      125 nil "[xy" nil error)))))
       (kill-buffer buf))))
diff --git a/relint.el b/relint.el
index 1575b73..612bd73 100644
--- a/relint.el
+++ b/relint.el
@@ -230,7 +230,8 @@ or nil if no position could be determined."
       (relint--add-to-error-buffer (concat string "\n"))
     (message "%s" string)))
 
-(defun relint--output-report (file expr-pos error-pos message str str-idx)
+(defun relint--output-report (file expr-pos error-pos message str str-idx
+                              severity)
   (let* ((pos (or error-pos expr-pos))
          (line (line-number-at-pos pos t))
          (col (save-excursion
@@ -238,26 +239,32 @@ or nil if no position could be determined."
                 (1+ (current-column)))))
     (relint--output-message
      (concat
-      (format "%s:%d:%d: %s" file line col message)
+      (format "%s:%d:%d: " file line col)
+      (and (eq severity 'error) "error: ")
+      message
       (and str-idx (format " (pos %d)" str-idx))
-      (and str
-           (format "\n  %s\n   %s"
-                   (relint--quote-string str)
-                   (relint--caret-string str str-idx)))))))
+      (and str     (format "\n  %s" (relint--quote-string str)))
+      (and str-idx (format "\n   %s" (relint--caret-string str str-idx)))))))
   
 (defvar relint--report-function #'relint--output-report
   "Function accepting a found complaint, taking the arguments
-(FILE EXPR-POS ERROR-POS MESSAGE STRING STRING-IDX).")
+(FILE EXPR-POS ERROR-POS MESSAGE STRING STRING-IDX SEVERITY).")
 
-(defun relint--report (file start-pos path message &optional str str-idx)
+(defun relint--report (file start-pos path message str str-idx severity)
   (let* ((expr-pos (relint--pos-from-start-pos-path start-pos path))
          (error-pos (and str-idx (relint--string-pos expr-pos str-idx))))
     (if (relint--suppression expr-pos message)
         (setq relint--suppression-count (1+ relint--suppression-count))
       (funcall relint--report-function file expr-pos error-pos message
-               str str-idx)))
+               str str-idx severity)))
   (setq relint--error-count (1+ relint--error-count)))
 
+(defun relint--warn (file start-pos path message &optional str str-idx)
+  (relint--report file start-pos path message str str-idx 'warning))
+
+(defun relint--err (file start-pos path message &optional str str-idx)
+  (relint--report file start-pos path message str str-idx 'error))
+
 (defun relint--escape-string (str escape-printable)
   (replace-regexp-in-string
    (rx (any cntrl "\177-\377" ?\\ ?\"))
@@ -286,18 +293,16 @@ or nil if no position could be determined."
 (defun relint--check-string (string checker name file pos path)
   (let ((complaints
          (condition-case err
-             (mapcar (lambda (warning)
-                       (let ((ofs (car warning)))
-                         (list (format "In %s: %s" name (cdr warning))
-                               string ofs)))
-                     (funcall checker string))
-           (error (list (list
-                         (format "In %s: Error: %s: %s"
-                                 name  (cadr err)
-                                 (relint--quote-string string))
-                         nil nil))))))
+             (funcall checker string)
+           (error
+            (relint--err file pos path
+                         (format "In %s: %s" name (cadr err))
+                         string nil)
+            nil))))
     (dolist (c complaints)
-      (relint--report file pos path (nth 0 c) (nth 1 c) (nth 2 c)))))
+      (relint--warn file pos path
+                    (format "In %s: %s" name (cdr c))
+                    string (car c)))))
 
 (defun relint--check-skip-set (skip-set-string name file pos path)
   (relint--check-string skip-set-string #'xr-skip-set-lint name file pos path))
@@ -1152,7 +1157,7 @@ EXPANDED is a list of expanded functions, to prevent 
recursion."
 (defun relint--check-non-regexp-provenance (skip-function form file pos path)
   (let ((reg-gen (relint--regexp-generators form nil)))
     (when reg-gen
-      (relint--report
+      (relint--warn
        file pos path
        (format-message "`%s' cannot be used for arguments to `%s'"
                        (car reg-gen) skip-function)))))
@@ -1189,7 +1194,7 @@ parameter is regexp-generating."
                     (substring template start percent)))
           (let ((reg-gen (relint--regexp-generators (nth index args) nil)))
             (when reg-gen
-              (relint--report
+              (relint--warn
                file pos (cons (+ index 2) path)
                (format-message
                 "Value from `%s' cannot be spliced into `[...]'"
@@ -1214,7 +1219,7 @@ character alternative: `[' followed by a 
regexp-generating expression."
                                    arg))
           (let ((reg-gen (relint--regexp-generators (cadr args) nil)))
             (when reg-gen
-              (relint--report
+              (relint--warn
                file pos (cons (1+ index) path)
                (format-message
                 "Value from `%s' cannot be spliced into `[...]'"
@@ -1758,10 +1763,10 @@ Return a list of (FORM . STARTING-POSITION)."
              (goto-char pos)
              (forward-sexp 1))
             (t
-             (relint--report file (point) nil (prin1-to-string err))
+             (relint--err file (point) nil (prin1-to-string err))
              (setq keep-going nil))))
           (error
-           (relint--report file (point) nil (prin1-to-string err))
+           (relint--err file (point) nil (prin1-to-string err))
            (setq keep-going nil)))
         (when (consp form)
           (push (cons form pos) forms))))
@@ -1899,19 +1904,21 @@ The buffer must be in emacs-lisp-mode."
   "Scan BUFFER for regexp errors. Return list of diagnostics.
 Each element in the returned list has the form
 
-  (MESSAGE EXPR-POS ERROR-POS STRING STRING-IDX),
+  (MESSAGE EXPR-POS ERROR-POS STRING STRING-IDX SEVERITY),
 
 where MESSAGE is the message string, EXPR-POS the location of the
 flawed expression, ERROR-POS the exact position of the error or
 nil if unavailable, STRING is nil or a string to which the
-message pertains, and STRING-IDX is nil or an index into STRING.
+message pertains, STRING-IDX is nil or an index into STRING,
+and SEVERITY is `error' or `warning'.
 The intent is that ERROR-POS is the position in the buffer that
 corresponds to STRING at STRING-IDX, if such a location can be
 determined."
   (let* ((complaints nil)
          (relint--report-function
-          (lambda (_file expr-pos error-pos message str str-idx)
-            (push (list message expr-pos error-pos str str-idx) complaints))))
+          (lambda (_file expr-pos error-pos message str str-idx severity)
+            (push (list message expr-pos error-pos str str-idx severity)
+                  complaints))))
     (relint--scan-buffer buffer nil t)
     (nreverse complaints)))
 
diff --git a/test/1.expected b/test/1.expected
index 5cc17e0..9f84ffe 100644
--- a/test/1.expected
+++ b/test/1.expected
@@ -133,7 +133,8 @@
 1.elisp:65:25: In bad-custom-5: Unescaped literal `^' (pos 2)
   "^x^"
    ..^
-1.elisp:69:25: In bad-custom-6: Error: No character class `[:bah:]': 
"[[:bah:]]"
+1.elisp:69:25: error: In bad-custom-6: No character class `[:bah:]'
+  "[[:bah:]]"
 1.elisp:73:25: In bad-custom-7: Duplicated `a' inside character alternative 
(pos 2)
   "[aa]"
    ..^