[elpa] externals/relint 800f5cc 06/12: Scan function/macro doc strings for hints to regexp arguments

[Mattias Engdegård]

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

    Scan function/macro doc strings for hints to regexp arguments
    
    For example, "... the regexp ABCD ..." will assume that the argument
    'abcd' (if there is one) is a regexp.
---
 relint.el       | 89 ++++++++++++++++++++++++++++++++++-----------------------
 test/2.elisp    |  8 ++++++
 test/2.expected |  9 ++++++
 3 files changed, 70 insertions(+), 36 deletions(-)

diff --git a/relint.el b/relint.el
index f359486..02ea60d 100644
--- a/relint.el
+++ b/relint.el
@@ -1164,47 +1164,64 @@ character alternative: `[' followed by a 
regexp-generating expression."
       (setq index (1+ index))
       (setq args (cdr args)))))
 
+(defun relint--regexp-args-from-doc (doc-string)
+  "Extract regexp arguments (as a list of symbols) from DOC-STRING."
+  (let ((start 0)
+        (found nil))
+    (while (string-match (rx (any "rR")
+                             (or (seq  "egex" (opt "p"))
+                                 (seq "egular" (+ (any " \n\t")) "expression"))
+                             (+ (any " \n\t"))
+                             (group (+ (any "A-Z" ?-))))
+                         doc-string start)
+      (push (intern (downcase (match-string 1 doc-string))) found)
+      (setq start (match-end 0)))
+    found))
+
 (defun relint--check-form-recursively-1 (form file pos path)
   (pcase form
     (`(,(or 'defun 'defmacro 'defsubst)
        ,name ,args . ,body)
 
-     ;; Skip doc string.
-     (when (stringp (car body))
-       (setq body (cdr body)))
-     ;; Skip declarations.
-     (while (and (consp (car body))
-                 (memq (caar body) '(interactive declare)))
-       (setq body (cdr body)))
-     ;; Save the function or macro for possible use.
-     (push (list name args body)
-           (if (eq (car form) 'defmacro)
-               relint--macro-defs
-             relint--function-defs))
-
-     ;; If any argument looks like a regexp, remember it so that it can be
-     ;; checked in calls.
-     (when (consp args)
-       (let ((indices nil)
-             (index 0))
-         (while args
-           (let ((arg (car args)))
-             (when (symbolp arg)
-               (cond
-                ((eq arg '&optional))   ; Treat optional args as regular.
-                ((eq arg '&rest)
-                 (setq args nil))       ; Ignore &rest args.
-                (t
-                 (when (string-match-p (rx (or (or "regexp" "regex" "-re"
-                                                   "pattern")
-                                               (seq bos "re"))
-                                           eos)
-                                       (symbol-name arg))
-                   (push index indices))
-                 (setq index (1+ index)))))
-             (setq args (cdr args))))
-         (when indices
-           (push (cons name (reverse indices)) relint--regexp-functions)))))
+     (let ((doc-args nil))
+       ;; Skip doc string.
+       (when (stringp (car body))
+         (setq doc-args (relint--regexp-args-from-doc (car body)))
+         (setq body (cdr body)))
+       ;; Skip declarations.
+       (while (and (consp (car body))
+                   (memq (caar body) '(interactive declare)))
+         (setq body (cdr body)))
+       ;; Save the function or macro for possible use.
+       (push (list name args body)
+             (if (eq (car form) 'defmacro)
+                 relint--macro-defs
+               relint--function-defs))
+
+       ;; If any argument looks like a regexp, remember it so that it can be
+       ;; checked in calls.
+       (when (consp args)
+         (let ((indices nil)
+               (index 0))
+           (while args
+             (let ((arg (car args)))
+               (when (symbolp arg)
+                 (cond
+                  ((eq arg '&optional))   ; Treat optional args as regular.
+                  ((eq arg '&rest)
+                   (setq args nil))       ; Ignore &rest args.
+                  (t
+                   (when (or (memq arg doc-args)
+                             (string-match-p (rx (or (or "regexp" "regex" "-re"
+                                                         "pattern")
+                                                     (seq bos "re"))
+                                                 eos)
+                                             (symbol-name arg)))
+                     (push index indices))
+                   (setq index (1+ index)))))
+               (setq args (cdr args))))
+           (when indices
+             (push (cons name (reverse indices)) relint--regexp-functions))))))
     (`(defalias ,name-arg ,def-arg . ,_)
      (let ((name (relint--eval-or-nil name-arg))
            (def  (relint--eval-or-nil def-arg)))
diff --git a/test/2.elisp b/test/2.elisp
index 088b588..600103e 100644
--- a/test/2.elisp
+++ b/test/2.elisp
@@ -40,3 +40,11 @@
   (f2 "[AA]" "[BB]" "[CC]" "[DD]" "[EE]" "[FF]" "[GG]" "[HH]" "[II]" "[JJ]")
   (s2 "[AA]" "[BB]" "[CC]" "[DD]" "[EE]" "[FF]" "[GG]" "[HH]" "[II]" "[JJ]")
   (m2 "[AA]" "[BB]" "[CC]" "[DD]" "[EE]" "[FF]" "[GG]" "[HH]" "[II]" "[JJ]"))
+
+;; Test function doc string as means of detecting regexps.
+(defun f5 (a b c d e)
+  "Chew regular expression B, regexp C and regex D."
+  (list a b c d e))
+
+(defun f6 ()
+  (f5 "[aa]" "[bb]" "[cc]" "[dd]" "[ee]"))
diff --git a/test/2.expected b/test/2.expected
index 80a819a..984b5a0 100644
--- a/test/2.expected
+++ b/test/2.expected
@@ -118,3 +118,12 @@
 2.elisp:42:70: In call to m2: Duplicated `J' inside character alternative (pos 
2)
   "[JJ]"
    ..^
+2.elisp:50:14: In call to f5: Duplicated `b' inside character alternative (pos 
2)
+  "[bb]"
+   ..^
+2.elisp:50:21: In call to f5: Duplicated `c' inside character alternative (pos 
2)
+  "[cc]"
+   ..^
+2.elisp:50:28: In call to f5: Duplicated `d' inside character alternative (pos 
2)
+  "[dd]"
+   ..^