: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"))
(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)
+
;;;; 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)
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
(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)
`(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))
(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))
`(and (pred stringp)
(pred (lambda (,string)
(cl-every
- (lambda (,regexp) (string-match-p ,regexp ,string))
- (list ,@regexps)))))))
+ (lambda (,regexp) (el-search--smart-string-match-p ,regexp ,string))
+ ',regexps))))))
(el-search-defpattern symbol (&rest regexps)
"Matches any symbol whose name is matched by all REGEXPS."
(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)))))
(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)))
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
(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
"\
(barf-if-buffer-read-only)
(el-search-search-and-replace-pattern from to mapping))
-(defun el-search--take-over-from-isearch ()
- (prog1 isearch-string (isearch-exit)))
+(defun el-search--take-over-from-isearch (&optional goto-left-end)
+ (let ((other-end (and goto-left-end isearch-other-end))
+ (input isearch-string))
+ (isearch-exit)
+ (when (and other-end (< other-end (point)))
+ (goto-char other-end))
+ input))
;;;###autoload
(defun el-search-search-from-isearch ()
;;;###autoload
(defun el-search-replace-from-isearch ()
(interactive)
- (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch))))
+ (let ((el-search--initial-mb-contents (concat "'" (el-search--take-over-from-isearch t))))
(call-interactively #'el-search-query-replace)))