[elpa] externals/el-search 1a46fca 291/332: [el-search] Allow expressions as args of 'string'

[Stefan Monnier]

branch: externals/el-search
commit 1a46fca979c3493a4c413c205d7836ba439a03e1
Author: Michael Heerdegen <michael_heerdegen@web.de>
Commit: Michael Heerdegen <michael_heerdegen@web.de>

    [el-search] Allow expressions as args of 'string'
    
    Also tweak docstrings and bump version to 1.9.5.
    
    * packages/el-search/el-search.el (el-search--simple-regexp-like-p):
    New helper function.
    (el-search-regexp-like-p): Change to include expressions.  Improve
    docstring.
    (el-search--string-matcher): Make it handle expressions.  Minor
    tweaks.
    (string, symbol): Tweak docstrings.
---
 NEWS         |  6 +++++
 el-search.el | 82 +++++++++++++++++++++++++++++++++++++++---------------------
 2 files changed, 60 insertions(+), 28 deletions(-)

diff --git a/NEWS b/NEWS
index e158df9..3a57263 100644
--- a/NEWS
+++ b/NEWS
@@ -1,6 +1,12 @@
 Some of the user visible news were:
 
 
+Version: 1.9.5
+
+  'string' and derived pattern types now support expressions evaluting
+  to regexps as arguments.  This means you can use 'rx' to construct
+  regexps in 'string' patterns, for example.
+
 Version: 1.9.0
 
   This version adds some help commands available through the C-h help
diff --git a/el-search.el b/el-search.el
index c85197c..66f84e7 100644
--- a/el-search.el
+++ b/el-search.el
@@ -7,7 +7,7 @@
 ;; Created: 29 Jul 2015
 ;; Keywords: lisp
 ;; Compatibility: GNU Emacs 25
-;; Version: 1.9.4
+;; Version: 1.9.5
 ;; Package-Requires: ((emacs "25") (stream "2.2.4") (cl-print "1.0"))
 
 
@@ -2087,51 +2087,72 @@ Introduction to El-Search
 
 ;;;; Additional pattern type definitions
 
-(defun el-search-regexp-like-p (thing)
-  "Return non-nil when THING is regexp like.
+(defun el-search--simple-regexp-like-p (thing)
+  (or (atom thing)
+      (functionp thing)
+      (and (consp thing)
+           (proper-list-p thing)
+           (not (consp (car thing))))))
 
-In el-search, a regexp-like is either a normal regexp (i.e. a
-string), or a predicate accepting a string argument, or a list of
-the form
+(defun el-search-regexp-like-p (object)
+  "Return non-nil when OBJECT is regexp like.
 
-  \(bindings regexp\)
+In el-search, a regexp-like is either an expression evaluating to
+a normal regexp (e.g. a string or an `rx' form; it is evaluated
+once when a pattern is compiled) or a function accepting a string
+argument that can be used directly as a predicate for match
+testing, or a list of the form
 
-where REGEXP is the actual regexp to match and BINDINGS is a
-let-style list of variable bindings.
+  \(BINDINGS X\)
 
-Example: (((case-fold-search nil)) \"foo\") is a regexp like
-matching \"foo\", but not \"Foo\" even when `case-fold-search' is
-currently enabled."
-  (pcase thing
-    ((or (pred stringp) (pred functionp)) t)
+where BINDINGS is a let-style list of variable bindings and X one
+of the above.
+
+Example: (((case-fold-search nil)) (rx bos \"a\")) is a
+regexp-like matching any string starting with lower case \"a\"."
+  (pcase object
+    ((pred el-search--simple-regexp-like-p) t)
     (`(,(and (pred listp) bindings)
-       ,(pred stringp))
+       ,(pred el-search--simple-regexp-like-p))
      (cl-every
-      (lambda (binding) (pcase binding ((or (pred symbolp) `(,(pred symbolp)) 
`(,(pred symbolp) ,_)) t)))
+      (lambda (binding)
+        (pcase binding ((or (pred symbolp) `(,(pred symbolp)) `(,(pred 
symbolp) ,_)) t)))
       bindings))))
 
 (defun el-search--string-matcher (regexp-like)
   "Return a compiled match predicate for REGEXP-LIKE.
-That's a predicate returning non-nil when the
+This is a predicate returning non-nil when the
 `el-search-regexp-like-p' REGEXP-LIKE matches the (only)
 argument (that should be a string)."
-  (let ((match-bindings ()) regexp)
-    (pcase regexp-like
-      ((pred stringp) (setq regexp regexp-like))
-      (`(,binds ,real-regexp)
+  (let ((regexp) (match-bindings ()))
+    (pcase-exhaustive regexp-like
+      ((pred el-search--simple-regexp-like-p) (setq regexp regexp-like))
+      (`(,(and (pred listp) binds) ,real-regexp)
        (setq regexp real-regexp)
        (setq match-bindings binds)))
-    (if (functionp regexp-like)
-        (if (or (symbolp regexp-like) (byte-code-function-p regexp-like))
-            regexp-like
-          (byte-compile regexp-like))
+    (cl-flet ((wrap-let
+               (lambda (bindings body)
+                 (if (null bindings) body
+                   `(let ,bindings ,body)))))
       (byte-compile
        (let ((string (make-symbol "string")))
-         `(lambda (,string) (let ,match-bindings (string-match ,regexp 
,string))))))))
+         `(lambda (,string)
+            ,(wrap-let
+              match-bindings
+              (if (functionp regexp)
+                  `(funcall #',regexp ,string)
+                `(string-match
+                  ,(pcase (eval regexp t)
+                     ((and (pred stringp) s) s)
+                     (_ (error "Expression in regexp-like doesn't eval to a 
string: %S" regexp)))
+                  ,string)))))))))
 
 (el-search-defpattern string (&rest regexps)
   "Matches any string that is matched by all REGEXPS.
-Any of the REGEXPS is `el-search-regexp-like-p'."
+Any of the REGEXPS is `el-search-regexp-like-p'.
+
+If multiple REGEXPS are given, they don't need to match in order,
+so (string \"bar\" \"foo\") matches \"foobar\" for example."
   (declare (heuristic-matcher
             (lambda (&rest regexps)
               (let ((matchers (mapcar #'el-search--string-matcher regexps)))
@@ -2150,11 +2171,16 @@ Any of the REGEXPS is `el-search-regexp-like-p'."
   "Matches any symbol whose name is matched by all REGEXPS.
 Any of the REGEXPS is `el-search-regexp-like-p'.
 
+This pattern is equivalent to
+
+  `(and (pred symbolp)
+        (app symbol-name (string ,@regexps)))
+
 Example: to replace all symbols with names starting with \"foo-\"
 to start with \"bar-\" instead, you would use
 `el-search-query-replace' with a rule like this:
 
-  (and (symbol \"\\\\`foo-\\\\(.*\\\\)\") s) >
+  (and (symbol (rx bos \"foo-\" (group (+ nonl)))) s) >
   (intern (concat \"bar-\" (match-string 1 (symbol-name s))))"
   (declare (heuristic-matcher
             (lambda (&rest regexps)