[elpa] externals/relint 47490f3 08/15: Add relint-buffer for easier use of relint as a library

[Mattias Engdegård]

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

    Add relint-buffer for easier use of relint as a library
    
    Requested by Steve Purcell.
---
 README         | 30 ++++++++++++++++++------------
 relint-test.el | 13 +++++++++++++
 relint.el      | 49 +++++++++++++++++++++++++++++++++++--------------
 3 files changed, 66 insertions(+), 26 deletions(-)

diff --git a/README b/README
index d27bd8c..25431d9 100644
--- a/README
+++ b/README
@@ -8,27 +8,33 @@ skip-syntax-backward.
 
 * Usage
 
-  Check a single file:
+  - Check a single file:
 
-    M-x relint-file
+      M-x relint-file
 
-  Check all .el files in a directory tree:
+  - Check all .el files in a directory tree:
 
-    M-x relint-directory
+      M-x relint-directory
 
-  Check current buffer:
+  - Check current buffer:
 
-    M-x relint-current-buffer
+      M-x relint-current-buffer
 
-  From batch mode:
+  - From batch mode:
 
-    emacs -batch -l relint.el -f relint-batch FILES-AND-DIRS...
+      emacs -batch -l relint.el -f relint-batch FILES-AND-DIRS...
 
-  where directories are scanned recursively.
-  (Options for finding relint and xr need to be added after
-  -batch, either -f package-initialize or -L DIR.)
+    where directories are scanned recursively.
+    (Options for finding relint and xr need to be added after
+    -batch, either -f package-initialize or -L DIR.)
 
-  In the *relint* buffer, pressing "g" will re-run the same check.
+    In the *relint* buffer, pressing "g" will re-run the same check.
+
+  - From elisp code, use one of the above functions or
+
+      (relint-buffer BUFFER)
+
+    which returns a list of diagnostics.
 
 * Installation
 
diff --git a/relint-test.el b/relint-test.el
index 2c3d840..178fa7d 100644
--- a/relint-test.el
+++ b/relint-test.el
@@ -123,3 +123,16 @@ and a path."
             nil (rx ".elisp" eos)))
   (let ((base (string-remove-suffix ".elisp" f)))
     (eval `(relint-test--deftest ,base))))
+
+(ert-deftest relint-buffer ()
+  (let ((buf (get-buffer-create " *relint-test*")))
+    (unwind-protect
+        (progn
+          (with-current-buffer buf
+            (emacs-lisp-mode)
+            (insert ";hello\n(looking-at \"broken**regexp\")\n"))
+          (should (equal
+                   (relint-buffer buf)
+                   '(("In call to looking-at: Repetition of repetition" 28
+                      "broken**regexp" 7)))))
+      (kill-buffer buf))))
diff --git a/relint.el b/relint.el
index 093ea86..7e2fb15 100644
--- a/relint.el
+++ b/relint.el
@@ -232,28 +232,36 @@ list indices to follow to target)."
         (forward-line -1))
       matched)))
 
-(defun relint--output-error (string)
+(defun relint--output-message (string)
   (if (and noninteractive (not relint--error-buffer))
       (message "%s" string)
     (relint--add-to-error-buffer (concat string "\n"))))
 
-(defun relint--report (file toplevel-pos path message &optional str str-pos)
-  (let* ((base-pos (relint--pos-from-toplevel-pos-path toplevel-pos path))
-         (pos (if (eq (char-after base-pos) ?\")
-                  (relint--literal-string-pos base-pos str-pos)
-                base-pos))
-         (line-col (relint--line-col-from-pos pos))
+(defun relint--output-report (file pos message str str-pos)
+  (let* ((line-col (relint--line-col-from-pos pos))
          (line (car line-col))
          (col (cdr line-col)))
-    (if (relint--suppression pos message)
-        (setq relint--suppression-count (1+ relint--suppression-count))
-      (relint--output-error
+      (relint--output-message
        (concat
         (format "%s:%d:%d: %s" file line col message)
+        (and str-pos (format " (pos %d)" str-pos))
         (and str
              (format "\n  %s\n   %s"
                      (relint--quote-string str)
                      (relint--caret-string str str-pos)))))))
+  
+(defvar relint--report-function #'relint--output-report
+  "Function accepting a found complaint, taking the arguments
+(FILE POS MESSAGE STRING STRING-IDX).")
+
+(defun relint--report (file toplevel-pos path message &optional str str-pos)
+  (let* ((base-pos (relint--pos-from-toplevel-pos-path toplevel-pos path))
+         (pos (if (eq (char-after base-pos) ?\")
+                  (relint--literal-string-pos base-pos str-pos)
+                base-pos)))
+    (if (relint--suppression pos message)
+        (setq relint--suppression-count (1+ relint--suppression-count))
+      (funcall relint--report-function file pos message str str-pos)))
   (setq relint--error-count (1+ relint--error-count)))
 
 (defun relint--escape-string (str escape-printable)
@@ -286,8 +294,7 @@ list indices to follow to target)."
          (condition-case err
              (mapcar (lambda (warning)
                        (let ((ofs (car warning)))
-                         (list (format "In %s: %s (pos %d)"
-                                       name (cdr warning) ofs)
+                         (list (format "In %s: %s" name (cdr warning))
                                string ofs)))
                      (funcall checker string))
            (error (list (list
@@ -943,7 +950,7 @@ not be evaluated safely."
                             body)))
        
        (t
-        ;;(relint--output-error (format "eval rule missing: %S" form))
+        ;;(relint--output-message (format "eval rule missing: %S" form))
         (throw 'relint-eval 'no-value))))))
 
 (defun relint--eval-or-nil (form)
@@ -1851,7 +1858,7 @@ Return a list of (FORM . STARTING-POSITION)."
 (defun relint--scan-files (files target base-dir)
   (relint--init target base-dir nil nil)
   (dolist (file files)
-    ;;(relint--output-error (format "Scanning %s" file))
+    ;;(relint--output-message (format "Scanning %s" file))
     (relint--scan-file file base-dir))
   (relint--finish))
 
@@ -1894,6 +1901,20 @@ The buffer must be in emacs-lisp-mode."
   (interactive)
   (relint--scan-buffer (current-buffer) nil nil))
 
+;;;###autoload
+(defun relint-buffer (buffer)
+  "Scan BUFFER for regexp errors. Return list of diagnostics.
+Each element in the returned list is (MESSAGE POS STRING STRING-IDX),
+where MESSAGE is the message string, POS the buffer location,
+STRING is nil or a string to which the message pertains, and
+STRING-IDX is nil or an index into STRING."
+  (let* ((complaints nil)
+         (relint--report-function
+          (lambda (_file pos message str str-pos)
+            (push (list message pos str str-pos) complaints))))
+    (relint--scan-buffer buffer nil t)
+    (nreverse complaints)))
+
 (defun relint-batch ()
   "Scan elisp source files for regexp-related errors.
 Call this function in batch mode with files and directories as