Merge commit 'f0b45f4a010d8e5680f66c9a22f433386d023466' from context-coloring

[gnu-emacs-elpa] / packages / el-search / el-search.el

diff --git a/packages/el-search/el-search.el b/packages/el-search/el-search.el
index 2f69f5f87c6c100df8bac663ed71c14d0ffa68bc..00b1b15c297fb715f16a05747d6d6264f1d06611 100644 (file)
--- a/packages/el-search/el-search.el
+++ b/packages/el-search/el-search.el
@@ -236,9 +236,13 @@
   :group 'lisp)
 
 (defcustom el-search-this-expression-identifier 'exp
-  "Name of the identifier referring to the current expression.
-The default value is `exp'.  You can use this name in the search
-prompt to refer to the value of the currently tested expression."
+  "Identifier referring to the current expression in pattern input.
+When entering a PATTERN in an interactive \"el-search\" command,
+the pattern actually used will be
+
+    `(and ,el-search-this-expression-identifier ,pattern)
+
+The default value is `exp'."
   :type 'symbol)
 
 (defface el-search-match '((((background dark)) (:background "#0000A0"))
@@ -269,35 +273,35 @@ prompt to refer to the value of the currently tested expression."
     map)
   "Map for reading input with `el-search-read-expression'.")
 
+(defun el-search--setup-minibuffer ()
+  (emacs-lisp-mode)
+  (use-local-map el-search-read-expression-map)
+  (setq font-lock-mode t)
+  (funcall font-lock-function 1)
+  (backward-sexp)
+  (indent-sexp)
+  (goto-char (point-max))
+  (when-let ((this-sexp (with-current-buffer (window-buffer (minibuffer-selected-window))
+                          (thing-at-point 'sexp))))
+    (let ((more-defaults (list (concat "'" this-sexp))))
+      (setq-local minibuffer-default-add-function
+                  (lambda () (if (listp minibuffer-default)
+                            (append minibuffer-default more-defaults)
+                          (cons minibuffer-default more-defaults)))))))
+
 ;; $$$$$FIXME: this should be in Emacs!  There is only a helper `read--expression'.
 (defun el-search-read-expression (prompt &optional initial-contents hist default read)
   "Read expression for `my-eval-expression'."
-  (minibuffer-with-setup-hook
-      (lambda ()
-        (emacs-lisp-mode)
-        (use-local-map el-search-read-expression-map)
-        (setq font-lock-mode t)
-        (funcall font-lock-function 1)
-        (backward-sexp)
-        (indent-sexp)
-        (goto-char (point-max)))
+  (minibuffer-with-setup-hook #'el-search--setup-minibuffer
     (read-from-minibuffer prompt initial-contents el-search-read-expression-map read
                           (or hist 'read-expression-history) default)))
 
 (defvar el-search--initial-mb-contents nil)
 
 (defun el-search--read-pattern (prompt &optional default read)
-  (let ((this-sexp (sexp-at-point)))
-    (minibuffer-with-setup-hook
-        (lambda ()
-          (when this-sexp
-            (let ((more-defaults (list (concat "'" (el-search--print this-sexp)))))
-              (setq-local minibuffer-default-add-function
-                          (lambda () (if (listp minibuffer-default)
-                                    (append minibuffer-default more-defaults)
-                                  (cons minibuffer-default more-defaults)))))))
-      (el-search-read-expression
-       prompt el-search--initial-mb-contents 'el-search-history default read))))
+  (let ((input (el-search-read-expression
+                prompt el-search--initial-mb-contents 'el-search-history default read)))
+    (if (or read (not (string= input ""))) input (car el-search-history))))
 
 (defun el-search--end-of-sexp ()
   ;;Point must be at sexp beginning
@@ -374,14 +378,15 @@ of the definitions is limited to \"el-search\"."
 
 (defun el-search--matcher (pattern &rest body)
   (eval ;use `eval' to allow for user defined pattern types at run time
-   `(el-search--with-additional-pcase-macros
-     (let ((byte-compile-debug t) ;make undefined pattern types raise an error
-           (warning-suppress-log-types '((bytecomp)))
-           (pcase--dontwarn-upats (cons '_ pcase--dontwarn-upats)))
-       (byte-compile (lambda (expression)
-                       (pcase expression
-                         (,pattern ,@(or body (list t)))
-                         (_        nil))))))))
+   (let ((expression (make-symbol "expression")))
+     `(el-search--with-additional-pcase-macros
+       (let ((byte-compile-debug t) ;make undefined pattern types raise an error
+             (warning-suppress-log-types '((bytecomp)))
+             (pcase--dontwarn-upats (cons '_ pcase--dontwarn-upats)))
+         (byte-compile (lambda (,expression)
+                         (pcase ,expression
+                           (,pattern ,@(or body (list t)))
+                           (_        nil)))))))))
 
 (defun el-search--match-p (matcher expression)
   (funcall matcher expression))
@@ -663,7 +668,9 @@ matches any of these expressions:
 
 (defun el-search--s (expr)
   (cond
-   ((symbolp expr) `(symbol ,(symbol-name expr)))
+   ((symbolp expr) `(or (symbol ,(symbol-name expr))
+                        (,'\` (,'quote    (,'\, (symbol ,(symbol-name expr)))))
+                        (,'\` (,'function (,'\, (symbol ,(symbol-name expr)))))))
    ((stringp expr) `(string ,expr))
    (t expr)))
 
@@ -677,8 +684,8 @@ with very brief input by using a specialized syntax.
 
 An LPAT can take the following forms:
 
-SYMBOL  Matches any symbol matched by SYMBOL's name interpreted as
-        a regexp
+SYMBOL  Matches any symbol S matched by SYMBOL's name interpreted
+        as a regexp.  Matches also 'S and #'S for any such S.
 STRING  Matches any string matched by STRING interpreted as a
         regexp
 _       Matches any list element