[elpa] externals/relint 6425990 3/4: Check skip-syntax-{forward, backward} argument strings

[Mattias Engdegård]

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

    Check skip-syntax-{forward,backward} argument strings
    
    These are just strings of syntax codes, possibly negated by a leading ^,
    but it can apparently still be misunderstood.
---
 README.org | 19 ++++++++++--
 relint.el  | 97 +++++++++++++++++++++++++++++++++++++++++++++++---------------
 2 files changed, 91 insertions(+), 25 deletions(-)

diff --git a/README.org b/README.org
index 1f9599e..17b7903 100644
--- a/README.org
+++ b/README.org
@@ -2,8 +2,8 @@
 
 Relint (regular expression lint) scans elisp files for mistakes in
 regexps, including deprecated syntax and bad practice. It also checks
-the regexp-like arguments to ~skip-chars-forward~ and
-~skip-chars-backward~.
+the regexp-like arguments to ~skip-chars-forward~, ~skip-chars-backward~,
+~skip-syntax-forward~ and ~skip-syntax-backward~.
 
 * Usage
 
@@ -175,6 +175,21 @@ If you are just building a string containing a regexp for 
display
 purposes, consider using other delimiters than square brackets;
 displaying the regexp ~0-9~ as ~[0-9]~ is very misleading.
 
+- Invalid char 'X' in syntax string ::
+A string argument to ~skip-syntax-forward~ or ~skip-syntax-backward~
+contains a character that doesn't indicate a syntax class. Such a
+string is not a regexp or skip-set, but just a string of syntax codes,
+possibly with a leading ~^~ for negation.
+
+- Duplicated char 'X' in syntax string ::
+A string argument to ~skip-syntax-forward~ or ~skip-syntax-backward~
+contains a duplicated character, which is pointless and may indicate
+a mistake.
+
+- Empty syntax string ::
+A string argument to ~skip-syntax-forward~ or ~skip-syntax-backward~
+is empty, which makes no sense.
+
 * Suppressing diagnostics
 
 While relint has been designed to avoid false positives, there may
diff --git a/relint.el b/relint.el
index b26fbba..25c361f 100644
--- a/relint.el
+++ b/relint.el
@@ -199,30 +199,29 @@ list of list indices to follow to target)."
                file (nth 1 point-line-col) (nth 2 point-line-col) message))))
   (setq relint--error-count (1+ relint--error-count)))
 
+(defun relint--escape-string (str escape-printable)
+  (replace-regexp-in-string
+   (rx (any cntrl "\177-\377" ?\\ ?\"))
+   (lambda (s)
+     (let ((c (logand (string-to-char s) #xff)))
+       (or (cdr (assq c '((?\b . "\\b")
+                          (?\t . "\\t")
+                          (?\n . "\\n")
+                          (?\v . "\\v")
+                          (?\f . "\\f")
+                          (?\r . "\\r")
+                          (?\e . "\\e"))))
+           (if (memq c '(?\\ ?\"))
+               (if escape-printable (string ?\\ c) (string c))
+             (format "\\%03o" c)))))
+   str t t))
+
 (defun relint--quote-string (str)
-  (concat "\""
-          (replace-regexp-in-string
-           (rx (any cntrl "\177-\377" ?\\ ?\"))
-           (lambda (s)
-             (let ((c (logand (string-to-char s) #xff)))
-               (or (cdr (assq c
-                              '((?\" . "\\\"")
-                                (?\\ . "\\\\")
-                                (?\b . "\\b")
-                                (?\t . "\\t")
-                                (?\n . "\\n")
-                                (?\v . "\\v")
-                                (?\f . "\\f")
-                                (?\r . "\\r")
-                                (?\e . "\\e"))))
-                   (format "\\%03o" c))))
-           str t t)
-          "\""))
+  (concat "\"" (relint--escape-string str t) "\""))
 
 (defun relint--caret-string (string pos)
   (let ((quoted-pos
-         (- (length (relint--quote-string (substring string 0 pos)))
-            2)))                        ; Lop off quotes
+         (length (relint--escape-string (substring string 0 pos) t))))
     (concat (make-string quoted-pos ?.) "^")))
 
 (defun relint--check-string (string checker name file pos path)
@@ -247,11 +246,55 @@ list of list indices to follow to target)."
 (defun relint--check-re-string (re name file pos path)
   (relint--check-string re #'xr-lint name file pos path))
   
+(defun relint--check-syntax-string (syntax name file pos path)
+  (relint--check-string syntax #'relint--syntax-string-lint name file pos 
path))
+
+(defconst relint--syntax-codes
+  '((?-  . whitespace)
+    (?\s . whitespace)
+    (?.  . punctuation)
+    (?w  . word)
+    (?W  . word)       ; undocumented
+    (?_  . symbol)
+    (?\( . open-parenthesis)
+    (?\) . close-parenthesis)
+    (?'  . expression-prefix)
+    (?\" . string-quote)
+    (?$  . paired-delimiter)
+    (?\\ . escape)
+    (?/  . character-quote)
+    (?<  . comment-start)
+    (?>  . comment-end)
+    (?|  . string-delimiter)
+    (?!  . comment-delimiter)))
+
+(defun relint--syntax-string-lint (syntax)
+  "Check the syntax-skip string SYNTAX.  Return list of complaints."
+  (let ((errs nil)
+        (start (if (string-prefix-p "^" syntax) 1 0)))
+    (when (member syntax '("" "^"))
+      (push (cons start "Empty syntax string") errs))
+    (let ((seen nil))
+      (dolist (i (number-sequence start (1- (length syntax))))
+        (let* ((c (aref syntax i))
+               (sym (cdr (assq c relint--syntax-codes))))
+          (if sym
+              (if (memq sym seen)
+                  (push (cons i (relint--escape-string
+                                 (format "Duplicated syntax code `%c'" c)
+                                 nil))
+                        errs)
+                (push sym seen))
+            (push (cons i (relint--escape-string
+                           (format "Invalid char `%c' in syntax string" c)
+                           nil))
+                  errs)))))
+    (nreverse errs)))
+
 (defvar relint--variables nil
   "Alist of global variable definitions seen so far.
  The variable names map to unevaluated forms.")
 
-
 ;; List of variables that have been checked, so that we can avoid
 ;; checking direct uses of it.
 (defvar relint--checked-variables)
@@ -913,7 +956,7 @@ EXPANDED is a list of expanded functions, to prevent 
recursion."
                                   x (cons head expanded)))
                                (caddr fun))))))))))
 
-(defun relint--check-skip-set-provenance (skip-function form file pos path)
+(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 file pos path
@@ -1180,9 +1223,17 @@ return (NAME); on syntax error, return nil."
           (when str
             (relint--check-skip-set str (format "call to %s" (car form))
                                     file pos (cons 1 path))))
-        (relint--check-skip-set-provenance
+        (relint--check-non-regexp-provenance
          (car form) skip-arg file pos (cons 1 path))
         )
+       (`(,(or 'skip-syntax-forward 'skip-syntax-backward) ,arg . ,_)
+        (let ((str (relint--get-string arg file pos (cons 1 path))))
+          (when str
+            (relint--check-syntax-string str (format "call to %s" (car form))
+                                         file pos (cons 1 path))))
+        (relint--check-non-regexp-provenance
+         (car form) arg file pos (cons 1 path))
+        )
        (`(concat . ,args)
         (relint--check-concat-mixup args file pos path))
        (`(format ,template-arg . ,args)