branch: externals/relint commit 64259904fccdfd8429de3f75a03435b10da10b11 Author: Mattias Engdegård <matti...@acm.org> Commit: Mattias Engdegård <matti...@acm.org>
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)