[elpa] externals/relint 83e677d 7/7: Increment version to 1.15
branch: externals/relint commit 83e677d07a79b6f2c0232f0b03c14dd5e1539b1d Author: Mattias Engdegård Commit: Mattias Engdegård Increment version to 1.15 Require xr 1.17. --- relint.el | 9 +++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/relint.el b/relint.el index 1149fee..a53e2c0 100644 --- a/relint.el +++ b/relint.el @@ -3,8 +3,8 @@ ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. ;; Author: Mattias Engdegård -;; Version: 1.14 -;; Package-Requires: ((xr "1.16") (emacs "26.1")) +;; Version: 1.15 +;; Package-Requires: ((xr "1.17") (emacs "26.1")) ;; URL: https://github.com/mattiase/relint ;; Keywords: lisp, regexps @@ -29,6 +29,11 @@ ;;; News: +;; Version 1.15: +;; - Improved position accuracy in various lists of regexps +;; - Check for mistake in rx `any' forms +;; - `relint-buffer' now also returns severity (warning, error) +;; - Relint can now also check the *scratch* buffer ;; Version 1.14: ;; - Added `relint-buffer' ;; - Report error position inside string literals when possible
[elpa] externals/xr 7842512 3/3: Increment version to 1.17
branch: externals/xr commit 7842512a73d2a6dab3f100921be2a0733f77149d Author: Mattias Engdegård Commit: Mattias Engdegård Increment version to 1.17 --- xr.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/xr.el b/xr.el index d5be9d8..772605e 100644 --- a/xr.el +++ b/xr.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. ;; Author: Mattias Engdegård -;; Version: 1.16 +;; Version: 1.17 ;; Package-Requires: ((emacs "26.1")) ;; URL: https://github.com/mattiase/xr ;; Keywords: lisp, regexps @@ -29,6 +29,8 @@ ;;; News: +;; Version 1.17: +;; - Performance improvements ;; Version 1.16: ;; - Translate [^\n] into nonl ;; - Better character class subset/superset analysis
[elpa] externals/relint 7dab4f2 4/7: Slight macro safety improvement
branch: externals/relint commit 7dab4f25800d3c016fc1a9d52ff59cfbad39905a Author: Mattias Engdegård Commit: Mattias Engdegård Slight macro safety improvement Use 'macroexpand-1' instead of 'macroexpand' to get better control over macro expansion. Some of the 'safe' macros are still potential loose cannons, since they may expand their arguments eagerly. --- relint.el | 8 +--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/relint.el b/relint.el index 612bd73..f231f28 100644 --- a/relint.el +++ b/relint.el @@ -711,11 +711,13 @@ not be evaluated safely." (delete-dups (copy-sequence arg ;; Safe macros that expand to pure code, and their auxiliary macros. + ;; FIXME: Some of these aren't actually safe at all, since they + ;; may expand their arguments eagerly, running arbitrary code! ((memq head '(when unless \` backquote-list* pcase pcase-let pcase-let* pcase--flip - cl-case cl-loop cl-flet cl-flet* cl-labels)) -(relint--eval (macroexpand form))) + cl-case cl-loop cl-block cl-flet cl-flet* cl-labels)) +(relint--eval (macroexpand-1 form))) ;; catch: as long as nobody throws, this naïve code is fine. ((eq head 'catch) @@ -1003,7 +1005,7 @@ evaluated are nil." (relint--eval-list (cadr form))) ((memq (car form) '(\` backquote-list*)) -(relint--eval-list (macroexpand form))) +(relint--eval-list (macroexpand-1 form))) ((assq (car form) relint--safe-alternatives) (relint--eval-list (cons (cdr (assq (car form) relint--safe-alternatives))
[elpa] externals/relint 8956b21 6/7: Check for mistakes in rx 'any' forms
branch: externals/relint commit 8956b21a5213efd10f6b80216ae74b45b370cc2d Author: Mattias Engdegård Commit: Mattias Engdegård Check for mistakes in rx 'any' forms These checks are similar to those done by xr in string regexps. --- README | 5 ++ relint.el| 153 +++ test/11.elisp| 15 ++ test/11.expected | 27 ++ 4 files changed, 200 insertions(+) diff --git a/README b/README index 25431d9..944e665 100644 --- a/README +++ b/README @@ -165,6 +165,11 @@ skip-syntax-backward. In general, A?, where A matches the empty string, can be simplified to just A. + - Suspect range '+-X' or 'X-+' + +A character range with '+' as one of its endpoints is more often an +incorrect attempt to include both '+' and '-' in the set. + - Unnecessarily escaped 'X' A character is backslash-escaped in a skip set despite not being diff --git a/relint.el b/relint.el index 47d9be2..1149fee 100644 --- a/relint.el +++ b/relint.el @@ -1306,6 +1306,153 @@ character alternative: `[' followed by a regexp-generating expression." (setq index (1+ index)) (setq args (cdr args) +(defun relint--pretty-range (from to) + (relint--escape-string + (if (eq from to) + (char-to-string from) + (format "%c-%c" from to)) + t)) + +(defun relint--intersecting-range (from to ranges) + "Return a range in RANGES intersecting [FROM,TO], or nil if none. +RANGES is a list of (X . Y) representing the interval [X,Y]." + (while (and ranges + (let ((range (car ranges))) +(not (and (<= from (cdr range)) + (<= (car range) to) +(setq ranges (cdr ranges))) + (car ranges)) + +(defun relint--check-rx (item file pos path) + "Check the `rx' expression ITEM." + (pcase item +(`(,(or ': 'seq 'sequence 'and 'or '| +'not 'intersection 'repeat '= '>= '** +'zero-or-more '0+ '* '*? +'one-or-more '1+ '+ '+? +'zero-or-one 'opt 'optional '\? ?\s '\?? ?? +'minimal-match 'maximal-match +'group 'submatch +'group-n 'submatch-n) + . ,args) + ;; Form with subforms: recurse. + (let ((i 1)) + (dolist (arg args) + (relint--check-rx arg file pos (cons i path)) + (setq i (1+ i) + +(`(,(or 'any 'in 'char 'not-char) . ,args) + ;; We don't bother checking for outright errors like "b-a", but + ;; look for mistakes that rx itself doesn't complain about. We + ;; assume a hand-written rx expression; machine-generated code + ;; can break these rules. + (let ((i 1) + (classes nil) + (ranges nil)) + (dolist (arg args) + (cond + ((characterp arg) + (let ((overlap (relint--intersecting-range arg arg ranges))) + (when overlap + (relint--warn +file pos (cons i path) +(if (eq (car overlap) (cdr overlap)) +(format-message "Duplicated character `%s'" +(relint--pretty-range arg arg)) + (format-message "Character `%s' included in range `%s'" + (relint--pretty-range arg arg) + (relint--pretty-range (car overlap) +(cdr overlap))) + (push (cons arg arg) ranges)) + + ((stringp arg) + (let ((j 0) + (len (length arg))) + (while (< j len) + (let ((from (aref arg j))) + (if (and (< (+ j 2) len) + (eq (aref arg (1+ j)) ?-)) + (let ((to (aref arg (+ j 2 + (cond +;; When people write "+-X" or "X-+" for some +;; X, they rarely mean a range. +((or (eq from ?+) + (eq to ?+)) + (relint--warn + file pos (cons i path) + (format-message "Suspect range `%s'" + (relint--pretty-range from to)) + arg j)) +((= to from) + (relint--warn + file pos (cons i path) + (format-message + "Single-character range `%s'" + (relint--escape-string (format "%c-%c" from to) t)) + arg j)) +((= to (1+ from)) + (relint--warn + file pos (cons i path) + (format-message "Two-character range `%s'" + (relint--pretty-range from to)) + arg j))) +
[elpa] externals/relint updated (c2d3f3b -> 83e677d)
mattiase pushed a change to branch externals/relint. from c2d3f3b Increment version to 1.14 new 67f4363 Don't erase the *relint* buffer from relint-buffer new fd43a5f Permit relint-current-buffer in *scratch* new feba965 Add severity field to tuple returned from relint-buffer new 7dab4f2 Slight macro safety improvement new bc7f295 Better position accuracy in various lists of regexps new 8956b21 Check for mistakes in rx 'any' forms new 83e677d Increment version to 1.15 Summary of changes: README | 5 + relint-test.el | 15 +- relint.el| 445 ++- test/1.expected | 81 +- test/10.elisp| 19 +++ test/10.expected | 30 test/11.elisp| 15 ++ test/11.expected | 27 test/3.expected | 16 +- test/9.expected | 6 +- 10 files changed, 501 insertions(+), 158 deletions(-) create mode 100644 test/10.elisp create mode 100644 test/10.expected create mode 100644 test/11.elisp create mode 100644 test/11.expected
[elpa] externals/xr 376fd03 2/3: Reduce consing in hot paths
branch: externals/xr
commit 376fd031242b8f43274e0fe7a650b4ba61b36115
Author: Mattias Engdegård
Commit: Mattias Engdegård
Reduce consing in hot paths
Use more destructive operations and avoiding match-string where
unnecessary.
---
xr.el | 24
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/xr.el b/xr.el
index af73c71..d5be9d8 100644
--- a/xr.el
+++ b/xr.el
@@ -109,7 +109,7 @@
(while (not (looking-at "]"))
(cond
;; character class
- ((looking-at (rx "[:" (group (*? anything)) ":]"))
+ ((looking-at (rx "[:" (group (* (not (any ":" ":]"))
(let ((sym (intern (match-string 1
(unless (memq sym
'(ascii alnum alpha blank cntrl digit graph
@@ -123,9 +123,9 @@
(push sym classes))
(goto-char (match-end 0
;; character range
- ((looking-at (rx (group (not (any "]"))) "-" (group (not (any "]")
-(let ((start (string-to-char (match-string 1)))
- (end (string-to-char (match-string 2
+ ((looking-at (rx (not (any "]")) "-" (not (any "]"
+(let ((start (char-after))
+ (end (char-after (+ (point) 2
(cond
((<= start end)
(push (vector start end (point)) intervals))
@@ -272,7 +272,7 @@
(when (memq ?- chars)
(setq chars (cons ?- (delq ?- chars
(let* ((set (cons 'any
-(append
+(nconc
(and ranges
(list (apply #'concat (nreverse ranges
(and chars
@@ -283,14 +283,14 @@
set
(defun xr--rev-join-seq (sequence)
- "Reverse a sequence, flatten any (seq ...) inside, and concatenate
-adjacent strings."
+ "Reverse SEQUENCE, flatten any (seq ...) inside, and concatenate
+adjacent strings. SEQUENCE is used destructively."
(let ((result nil))
(while sequence
(let ((elem (car sequence))
(rest (cdr sequence)))
(cond ((and (consp elem) (eq (car elem) 'seq))
- (setq sequence (append (reverse (cdr elem)) rest)))
+ (setq sequence (nconc (nreverse (cdr elem)) rest)))
((and (stringp elem) (stringp (car result)))
(setq result (cons (concat elem (car result)) (cdr result)))
(setq sequence rest))
@@ -572,7 +572,7 @@ UPPER may be nil, meaning infinity."
;; character alternative
((looking-at (rx "[" (opt (group "^"
(goto-char (match-end 0))
- (let ((negated (match-string 1)))
+ (let ((negated (match-beginning 1)))
(push (xr--parse-char-alt negated warnings) sequence)))
;; group
@@ -580,9 +580,9 @@ UPPER may be nil, meaning infinity."
(opt (opt (group (any "1-9")
(zero-or-more digit)))
(group ":")
- (let ((question (match-string 1))
+ (let ((question (match-beginning 1))
(number (match-string 2))
-(colon (match-string 3)))
+(colon (match-beginning 3)))
(when (and question (not colon))
(error "Invalid \\(? syntax"))
(goto-char (match-end 0))
@@ -1152,7 +1152,7 @@ A-SETS and B-SETS are arguments to `any'."
(if (or (equal alternatives '(nonl "\n"))
(equal alternatives '("\n" nonl)))
'anything
- (cons 'or (reverse alternatives)))
+ (cons 'or (nreverse alternatives)))
(car alternatives
(defun xr--parse (re-string warnings)
[elpa] externals/relint bc7f295 5/7: Better position accuracy in various lists of regexps
branch: externals/relint commit bc7f295932f5fe5fadc45184b7ee38e47b74e9f2 Author: Mattias Engdegård Commit: Mattias Engdegård Better position accuracy in various lists of regexps --- relint.el| 173 --- test/1.expected | 80 - test/10.elisp| 19 ++ test/10.expected | 30 ++ test/3.expected | 16 ++--- test/9.expected | 6 +- 6 files changed, 225 insertions(+), 99 deletions(-) diff --git a/relint.el b/relint.el index f231f28..47d9be2 100644 --- a/relint.el +++ b/relint.el @@ -146,7 +146,10 @@ and PATH is (3 0 1 2), then the returned position is right before G." (forward-sexp) (setq skip (1- skip) (setq p (cdr p - (relint--skip-whitespace)) + (relint--skip-whitespace) + (when (looking-at (rx ".")) +(forward-char) +(relint--skip-whitespace))) (defun relint--pos-from-start-pos-path (start-pos path) "Compute position from START-POS and PATH (reversed list of @@ -1014,11 +1017,64 @@ evaluated are nil." (t (relint--eval-or-nil form -(defun relint--get-list (form) - "Convert something to a list, or nil." - (let ((val (relint--eval-list form))) -(and (consp val) val))) - +(defun relint--eval-list-iter (fun form path) + "Evaluate FORM to a list and call FUN for each non-nil element +with (ELEM ELEM-PATH LITERAL) as arguments. ELEM-PATH is the best +approximation to a path to ELEM and has the same base position as +PATH; LITERAL is true if ELEM-PATH leads to a literal ELEM in the +source." + (pcase form +(`(quote ,arg) + (when (consp arg) + (let ((i 0) + (p (cons 1 path))) + (dolist (elem arg) + (when elem + (funcall fun elem (cons i p) t)) + (setq i (1+ i)) +(`(list . ,args) + (let ((i 1)) + (dolist (expr args) + (pcase expr + ((pred stringp) +(funcall fun expr (cons i path) t)) + (`(quote ,elem) +(when elem + (funcall fun elem (cons 1 (cons i path)) t))) + (_ (let ((elem (relint--eval-or-nil expr))) +(when elem + (funcall fun elem (cons i path) nil) + (setq i (1+ i) +(`(append . ,args) + (let ((i 1)) + (dolist (arg args) + (relint--eval-list-iter fun arg (cons i path)) + (setq i (1+ i) +(`(\` ,args) + (when (consp args) + (let ((i 0)) + (let ((p0 (cons 1 path))) + (dolist (arg args) + (let* ((expanded (relint--eval-or-nil (list '\` arg))) +(values (if (and (consp arg) + (eq (car arg) '\,@)) +expanded + (list expanded))) +(p (cons i p0))) + (dolist (elem values) + (when elem + (funcall fun elem p (equal arg expanded) + (setq i (1+ i))) +(`(eval-when-compile ,expr) + (relint--eval-list-iter fun expr (cons 1 path))) +(_ + ;; Fall back on `relint--eval-list', giving up on + ;; element-specific source position. + (let ((expr (relint--eval-list form))) + (when (consp expr) + (dolist (elem expr) + (funcall fun elem path nil))) + (defun relint--get-string (form) "Convert something to a string, or nil." (let ((val (relint--eval-or-nil form))) @@ -1031,72 +1087,93 @@ evaluated are nil." (defun relint--check-list (form name file pos path) "Check a list of regexps." - ;; Don't use dolist -- mustn't crash on improper lists. - (let ((l (relint--get-list form))) -(while (consp l) - (when (stringp (car l)) -(relint--check-re-string (car l) name file pos path)) - (setq l (cdr l) + (relint--eval-list-iter + (lambda (elem elem-path _literal) + (when (stringp elem) + (relint--check-re-string elem name file pos elem-path))) + form path)) (defun relint--check-list-any (form name file pos path) "Check a list of regexps or conses whose car is a regexp." - (dolist (elem (relint--get-list form)) -(cond - ((stringp elem) - (relint--check-re-string elem name file pos path)) - ((and (consp elem) - (stringp (car elem))) - (relint--check-re-string (car elem) name file pos path) + (relint--eval-list-iter + (lambda (elem elem-path literal) + (cond + ((stringp elem) + (relint--check-re-string elem name file pos elem-path)) + ((and (consp elem) +(stringp (car elem))) + (relint--check-re-string (car elem) name file pos +(if literal (cons 0 elem-path) elem-path) + form path)) (defun relint--check-alist-any (form name file pos path) "Check an alist whose cars or cdrs may be regexps." - (dolist (elem (relint--get-list form)) -(when
[elpa] externals/relint 67f4363 1/7: Don't erase the *relint* buffer from relint-buffer
branch: externals/relint commit 67f43634438f25eb4a1cf99b5859dbf89e535d37 Author: Mattias Engdegård Commit: Mattias Engdegård Don't erase the *relint* buffer from relint-buffer Since relint-buffer doesn't write to *relint*, that buffer should remain untouched. --- relint.el | 31 +++ 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/relint.el b/relint.el index 04002bc..b23e219 100644 --- a/relint.el +++ b/relint.el @@ -226,9 +226,9 @@ or nil if no position could be determined." matched))) (defun relint--output-message (string) - (if (and noninteractive (not relint--error-buffer)) - (message "%s" string) -(relint--add-to-error-buffer (concat string "\n" + (if relint--error-buffer + (relint--add-to-error-buffer (concat string "\n")) +(message "%s" string))) (defun relint--output-report (file expr-pos error-pos message str str-idx) (let* ((pos (or error-pos expr-pos)) @@ -1732,7 +1732,7 @@ directly." (setq index (1+ index))) (defun relint--show-errors () - (unless (or noninteractive relint--quiet) + (unless (or noninteractive relint--quiet (not relint--error-buffer)) (let ((pop-up-windows t)) (display-buffer relint--error-buffer) (sit-for 0 @@ -1800,10 +1800,9 @@ Return a list of (FORM . STARTING-POSITION)." (setq relint--quiet quiet) (setq relint--error-count 0) (setq relint--suppression-count 0) - (if noninteractive - (setq relint--error-buffer error-buffer) -(setq relint--error-buffer (or error-buffer (relint--get-error-buffer))) -(with-current-buffer relint--error-buffer + (setq relint--error-buffer error-buffer) + (when error-buffer +(with-current-buffer error-buffer (unless quiet (let ((inhibit-read-only t)) (insert (format "Relint results for %s\n" target)) @@ -1849,8 +1848,8 @@ Return a list of (FORM . STARTING-POSITION)." "Mode for relint output." (setq-local relint-last-target nil)) -(defun relint--scan-files (files target base-dir) - (relint--init target base-dir nil nil) +(defun relint--scan-files (files target base-dir error-buffer) + (relint--init target base-dir error-buffer nil) (dolist (file files) ;;(relint--output-message (format "Scanning %s" file)) (relint--scan-file file base-dir)) @@ -1862,8 +1861,7 @@ Return a list of (FORM . STARTING-POSITION)." (defun relint--scan-buffer (buffer error-buffer quiet) "Scan BUFFER for regexp errors. -Diagnostics to ERROR-BUFFER, or if nil to *relint*. -If QUIET, don't emit messages." +Diagnostics to ERROR-BUFFER. If QUIET, don't emit messages." (unless (eq (buffer-local-value 'major-mode buffer) 'emacs-lisp-mode) (error "Relint: can only scan elisp code (use emacs-lisp-mode)")) (relint--init buffer default-directory error-buffer quiet) @@ -1877,7 +1875,8 @@ If QUIET, don't emit messages." (defun relint-file (file) "Scan FILE, an elisp file, for regexp-related errors." (interactive "fRelint elisp file: ") - (relint--scan-files (list file) file (file-name-directory file))) + (relint--scan-files (list file) file (file-name-directory file) + (relint--get-error-buffer))) ;;;###autoload (defun relint-directory (dir) @@ -1886,14 +1885,14 @@ If QUIET, don't emit messages." (message "Finding .el files in %s..." dir) (let ((files (relint--tree-files dir))) (message "Scanning files...") -(relint--scan-files files dir dir))) +(relint--scan-files files dir dir (relint--get-error-buffer ;;;###autoload (defun relint-current-buffer () "Scan the current buffer for regexp errors. The buffer must be in emacs-lisp-mode." (interactive) - (relint--scan-buffer (current-buffer) nil nil)) + (relint--scan-buffer (current-buffer) (relint--get-error-buffer) nil)) ;;;###autoload (defun relint-buffer (buffer) @@ -1930,7 +1929,7 @@ complaining about was found, zero otherwise." (relint--tree-files arg) (list arg))) command-line-args-left) - nil default-directory) + nil default-directory nil) (setq command-line-args-left nil) (kill-emacs (if (> relint--error-count relint--suppression-count) 1 0)))
[elpa] externals/relint fd43a5f 2/7: Permit relint-current-buffer in *scratch*
branch: externals/relint commit fd43a5f0de6f22a2a126fcec3fd2632d11329638 Author: Mattias Engdegård Commit: Mattias Engdegård Permit relint-current-buffer in *scratch* Allow any buffer whose major mode is derived from emacs-lisp-mode; this includes lisp-interaction-mode. Suggested by Steve Purcell. --- relint.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/relint.el b/relint.el index b23e219..1575b73 100644 --- a/relint.el +++ b/relint.el @@ -1862,10 +1862,10 @@ Return a list of (FORM . STARTING-POSITION)." (defun relint--scan-buffer (buffer error-buffer quiet) "Scan BUFFER for regexp errors. Diagnostics to ERROR-BUFFER. If QUIET, don't emit messages." - (unless (eq (buffer-local-value 'major-mode buffer) 'emacs-lisp-mode) -(error "Relint: can only scan elisp code (use emacs-lisp-mode)")) - (relint--init buffer default-directory error-buffer quiet) (with-current-buffer buffer +(unless (derived-mode-p 'emacs-lisp-mode) + (error "Relint: can only scan elisp code (use emacs-lisp-mode)")) +(relint--init buffer default-directory error-buffer quiet) (save-excursion (relint--scan-current-buffer (buffer-name (relint--finish))
[elpa] externals/xr updated (dcf5240 -> 7842512)
mattiase pushed a change to branch externals/xr. from dcf5240 Increment version to 1.16 new 45108ee Expand strings to characters in subset computation new 376fd03 Reduce consing in hot paths new 7842512 Increment version to 1.17 Summary of changes: xr-test.el | 12 xr.el | 63 +++--- 2 files changed, 43 insertions(+), 32 deletions(-)
[elpa] externals/relint feba965 3/7: Add severity field to tuple returned from relint-buffer
branch: externals/relint
commit feba9658d98dc0fa6ba9d34b415f05f68c7805bb
Author: Mattias Engdegård
Commit: Mattias Engdegård
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 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 str str-idx)
+ (relint--report file start-pos path message str str-idx 'warning))
+
+(defun relint--err (file start-pos path message 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)
-
[elpa] externals/xr 45108ee 1/3: Expand strings to characters in subset computation
branch: externals/xr commit 45108ee88584bdad42db81d7d8c5b4923b586eb4 Author: Mattias Engdegård Commit: Mattias Engdegård Expand strings to characters in subset computation This is faster and performs less consing than using single-char strings. --- xr-test.el | 12 xr.el | 35 --- 2 files changed, 28 insertions(+), 19 deletions(-) diff --git a/xr-test.el b/xr-test.el index a0dae58..397d8f4 100644 --- a/xr-test.el +++ b/xr-test.el @@ -497,6 +497,18 @@ '((14 . "Branch matches subset of a previous branch" (should (equal (xr-lint "[^z-a]\\|[^0-9[:space:]]") '((8 . "Branch matches subset of a previous branch" + +(should (equal (xr-lint "\\(?:.\\|\n\\)\\|a") + '((12 . "Branch matches subset of a previous branch" +(should (equal (xr-lint "\\s-\\| ") + '((5 . "Branch matches subset of a previous branch" +(should (equal (xr-lint "\\S-\\|x") + '((5 . "Branch matches subset of a previous branch" +(should (equal (xr-lint "\\c.\\|a") + '((5 . "Branch matches subset of a previous branch" +(should (equal (xr-lint "\\Ca\\|ü") + '((5 . "Branch matches subset of a previous branch" + )) (ert-deftest xr-lint-subsumed-repetition () diff --git a/xr.el b/xr.el index ea8d7c9..af73c71 100644 --- a/xr.el +++ b/xr.el @@ -735,14 +735,15 @@ UPPER may be nil, meaning infinity." (defun xr--any-arg-to-items (arg) "Convert an `any' argument to a list of characters, ranges (as pairs), and classes (symbols)." - ;; We know (since we built it) that x is either a symbol or - ;; a string, and that the string does not mix ranges and chars. + ;; We know (since we built it) that x is either a symbol, string or char, + ;; and that the string does not mix ranges and chars. (cond ((symbolp arg) ;; unibyte and multibyte are aliases of ascii and nonascii in ;; practice; simplify. (list (cond ((eq arg 'unibyte) 'ascii) ((eq arg 'multibyte) 'nonascii) (t arg +((characterp arg) (list arg)) ((and (>= (length arg) 3) (eq (aref arg 1) ?-)) (xr--range-string-to-items arg)) @@ -977,9 +978,8 @@ A-SETS and B-SETS are arguments to `any'." 'unibyte 'upper 'word 'xdigit))) (and negated (xr--char-superset-of-char-set-p (list sym) nil sets))) -((pred stringp) - (and (= (length rx) 1) - (xr--char-superset-of-char-set-p sets negated (list rx)) +((pred characterp) + (xr--char-superset-of-char-set-p sets negated (list rx) (defun xr--single-non-newline-char-p (rx) "Whether RX only matches single characters none of which is newline." @@ -995,7 +995,7 @@ A-SETS and B-SETS are arguments to `any'." ascii alnum alpha blank cntrl digit graph lower multibyte nonascii print punct space unibyte upper word xdigit)) - (and (stringp rx) (= (length rx) 1)) + (characterp rx) (and (consp rx) (or (memq (car rx) '(any category syntax)) (and (eq (car rx) 'not) @@ -1020,24 +1020,21 @@ A-SETS and B-SETS are arguments to `any'." (and set (xr--char-superset-of-rx-p (cdr set) nil rx -(defun xr--string-to-chars (str) - (mapcar #'char-to-string (string-to-list str))) - (defun xr--expand-strings (rx) - "If RX is a string or a seq of strings, convert them to seqs of -single-character strings." + "Expand strings to characters or seqs of characters. +`seq' forms are expanded non-recursively." (cond ((consp rx) (if (eq (car rx) 'seq) (cons 'seq (mapcan (lambda (x) - (if (and (stringp x) - (> (length x) 1)) - (xr--string-to-chars x) + (if (stringp x) + (string-to-list x) (list x))) (cdr rx))) rx)) -((and (stringp rx) - (> (length rx) 1)) - (cons 'seq (xr--string-to-chars rx))) +((stringp rx) + (if (= (length rx) 1) + (string-to-char rx) + (cons 'seq (string-to-list rx (t rx))) (defun xr--superset-seq-p (a b) @@ -1125,8 +1122,8 @@ single-character strings." ((or `(category ,_) `(not (category ,_))) (or (equal a b) -(and (stringp b) - (string-match-p (rx-to-string a) b +(and (characterp b) + (string-match-p (rx-to-string a) (char-to-string b) (_ (equal a b))
