X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/5a36d21f3743a54a4409a5ec5539eacff9ca9ebe..bace971d3cff75963ee52d0157c091caaba857ac:/packages/el-search/el-search.el

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 00b1b15c2..764d77eb9 100644
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -253,9 +253,48 @@ The default value is `exp'."
                                  (t                   (:background "DarkSlateGray1")))
   "Face for highlighting the other matches.")
 
+(defcustom el-search-smart-case-fold-search t
+  "Whether to use smart case folding in pattern matching.
+When an \"el-search\" pattern involves regexp matching (like for
+\"string\" or \"source\") and this option is non-nil,
+case-fold-search will be temporarily bound to t if the according
+regexp contains any upper case letter, and nil else.  This is
+done independently for every single matching operation.
+
+If nil, the value of `case-fold-search' is decisive."
+  :type 'boolean)
+
+(defcustom el-search-use-sloppy-strings nil
+  "Whether to allow the usage of \"sloppy strings\".
+When this option is turned on, for faster typing you are allowed
+to specify symbols instead of strings as arguments to an
+\"el-search\" pattern type that would otherwise accept only
+strings, and their names will be used as input (with other words,
+this spares you to type the string delimiters in many cases).
+
+For example,
+
+  \(source ^cl\)
+
+is then equivalent to
+
+  \(source \"^cl\"\)
+
+When this option is off, the first form would just signal an
+error."
+  :type 'boolean)
+
 
 ;;;; Helpers
 
+(defun el-search--smart-string-match-p (regexp string)
+  "`string-match-p' taking `el-search-smart-case-fold-search' into account."
+  (let ((case-fold-search (if el-search-smart-case-fold-search
+                              (not (let ((case-fold-search nil))
+                                     (string-match-p "[[:upper:]]" regexp)))
+                            case-fold-search)))
+    (string-match-p regexp string)))
+
 (defun el-search--print (expr)
   (let ((print-quoted t)
         (print-length nil)
@@ -308,9 +347,10 @@ The default value is `exp'."
   (or (scan-sexps (point) 1) (point-max)))
 
 (defun el-search--ensure-sexp-start ()
-  "Move point to the beginning of the next sexp if necessary.
-Don't move if already at beginning of a sexp.
-Point must not be inside a string or comment."
+  "Move point to the next sexp beginning position.
+Don't move if already at beginning of a sexp.  Point must not be
+inside a string or comment.  `read' the expression at that point
+and return it."
   (let ((not-done t) res)
     (while not-done
       (let ((stop-here nil)
@@ -369,6 +409,17 @@ of the definitions is limited to \"el-search\"."
   `(setf (alist-get ',name el-search--pcase-macros)
          (lambda ,args ,@body)))
 
+(defun el-search--macroexpand-1 (pattern)
+  "Expand \"el-search\" PATTERN.
+This is like `pcase--macroexpand', but expands only patterns
+defined with `el-search-defpattern' and performs only one
+expansion step.
+
+Return PATTERN if this pattern type was not defined with
+`el-search-defpattern'."
+  (if-let ((expander (alist-get (car-safe pattern) el-search--pcase-macros)))
+      (apply expander (cdr pattern))
+    pattern))
 
 (defmacro el-search--with-additional-pcase-macros (&rest body)
   `(cl-letf ,(mapcar (pcase-lambda (`(,symbol . ,fun))
@@ -561,20 +612,22 @@ matches the list (1 2 3 4 5 6 7 8 9) and binds `x' to (4 5 6)."
                           (,'\, ,(car more-patterns)))))))
        (t `(append ,pattern (append ,@more-patterns)))))))
 
+(defun el-search--stringish-p (thing)
+  (or (stringp thing) (and el-search-use-sloppy-strings (symbolp thing))))
+
 (el-search-defpattern string (&rest regexps)
   "Matches any string that is matched by all REGEXPS."
-  (el-search--check-pattern-args 'string regexps #'stringp)
-  (let ((string (make-symbol "string"))
-        (regexp (make-symbol "regexp")))
-    `(and (pred stringp)
-          (pred (lambda (,string)
-                  (cl-every
-                   (lambda (,regexp) (string-match-p ,regexp ,string))
-                   (list ,@regexps)))))))
+  (el-search--check-pattern-args 'string regexps #'el-search--stringish-p
+                                 "Argument not a string")
+  `(and (pred stringp)
+        ,@(mapcar (lambda (thing) `(pred (el-search--smart-string-match-p
+                                     ,(if (symbolp thing) (symbol-name thing) thing))))
+                  regexps)))
 
 (el-search-defpattern symbol (&rest regexps)
   "Matches any symbol whose name is matched by all REGEXPS."
-  (el-search--check-pattern-args 'symbol regexps #'stringp)
+  (el-search--check-pattern-args 'symbol regexps #'el-search--stringish-p
+                                 "Argument not a string")
   `(and (pred symbolp)
         (app symbol-name (string ,@regexps))))
 
@@ -614,7 +667,7 @@ of any kind matched by all PATTERNs are also matched.
 (defun el-search--match-symbol-file (regexp symbol)
   (when-let ((symbol-file (and (symbolp symbol)
                                (symbol-file symbol))))
-    (string-match-p
+    (el-search--smart-string-match-p
      (if (symbolp regexp) (concat "\\`" (symbol-name regexp) "\\'") regexp)
      (file-name-sans-extension (file-name-nondirectory symbol-file)))))
 
@@ -631,8 +684,9 @@ REGEXP can also be a symbol, in which case
   (concat \"^\" (symbol-name regexp) \"$\")
 
 is used as regular expression."
-  (el-search--check-pattern-args 'source (list regexp) #'stringp)
-  `(pred (el-search--match-symbol-file ,regexp)))
+  (el-search--check-pattern-args 'source (list regexp) #'el-search--stringish-p
+                                 "Argument not a string")
+  `(pred (el-search--match-symbol-file ,(if (symbolp regexp) (symbol-name regexp) regexp))))
 
 (defun el-search--match-key-sequence (keys expr)
   (when-let ((expr-keys (pcase expr
@@ -829,23 +883,25 @@ The following additional pattern types are currently defined:"
                                         (not (eq (symbol-value pattern) pattern))))
                            (error "Please don't forget the quote when searching for a symbol"))
                          (el-search--wrap-pattern pattern)))))
-  (setq this-command 'el-search-pattern) ;in case we come from isearch
-  (setq el-search-current-pattern pattern)
-  (let ((opoint (point)))
-    (when (and (eq this-command last-command) el-search-success)
-      (el-search--skip-expression nil t))
-    (setq el-search-success nil)
-    (when (condition-case nil
-              (el-search--search-pattern pattern)
-            (end-of-buffer (message "No match")
-                           (goto-char opoint)
-                           (el-search-hl-remove)
-                           (ding)
-                           nil))
-      (setq el-search-success t)
-      (el-search-hl-sexp)
-      (unless (eq this-command last-command)
-        (el-search-hl-other-matches pattern)))))
+  (if (not (called-interactively-p 'any))
+      (el-search--search-pattern pattern)
+    (setq this-command 'el-search-pattern) ;in case we come from isearch
+    (setq el-search-current-pattern pattern)
+    (let ((opoint (point)))
+      (when (and (eq this-command last-command) el-search-success)
+        (el-search--skip-expression nil t))
+      (setq el-search-success nil)
+      (when (condition-case nil
+                (el-search--search-pattern pattern)
+              (end-of-buffer (message "No match")
+                             (goto-char opoint)
+                             (el-search-hl-remove)
+                             (ding)
+                             nil))
+        (setq el-search-success t)
+        (el-search-hl-sexp)
+        (unless (eq this-command last-command)
+          (el-search-hl-other-matches pattern))))))
 
 (defvar el-search-search-and-replace-help-string
   "\