* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
@ 2021-09-23 16:59 ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-09-23 21:15 ` Lars Ingebrigtsen
0 siblings, 1 reply; 23+ messages in thread
From: ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-09-23 16:59 UTC (permalink / raw)
To: 50766
Emacs highlights parents by default, e.g. when point is after the closing
paren the opening parent is highlighted.
If I type capturing parens in the query replace regexp prompt then the
paren pairs are not highlighted:
Query replace regexp: \(something\)
They should be, so when typing a complex regexp with multiple capturing
parens then it's easier to see the pairs.
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-09-23 16:59 bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-09-23 21:15 ` Lars Ingebrigtsen
2021-09-24 8:27 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 23+ messages in thread
From: Lars Ingebrigtsen @ 2021-09-23 21:15 UTC (permalink / raw)
To: ndame; +Cc: 50766
ndame <laszlomail@protonmail.com> writes:
> Emacs highlights parents by default, e.g. when point is after the closing
> paren the opening parent is highlighted.
>
> If I type capturing parens in the query replace regexp prompt then the
> paren pairs are not highlighted:
>
> Query replace regexp: \(something\)
>
> They should be, so when typing a complex regexp with multiple capturing
> parens then it's easier to see the pairs.
Let's see... this basically ends up calling `read-regexp', which then
calls `read-from-minibuffer'.
The blinking is done from `blink-matching-open', which does a
`(forward-sexp -1)' to find the position.
So we'd have to set up some syntax stuff to get this right. Does
anybody know if we have something ready-made for regexps somewhere?
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-09-23 21:15 ` Lars Ingebrigtsen
@ 2021-09-24 8:27 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-09-25 0:54 ` Lars Ingebrigtsen
0 siblings, 1 reply; 23+ messages in thread
From: ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-09-24 8:27 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 50766
Looks like setting the syntax in the minibuffer fixes this:
(modify-syntax-entry ?\\ "\\" (syntax-table))
So the syntax of \ in the minibuffer should be changed temporarily to
escape-syntax during read-regexp.
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-09-24 8:27 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-09-25 0:54 ` Lars Ingebrigtsen
2021-09-27 13:16 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 23+ messages in thread
From: Lars Ingebrigtsen @ 2021-09-25 0:54 UTC (permalink / raw)
To: ndame; +Cc: 50766
ndame <laszlomail@protonmail.com> writes:
> Looks like setting the syntax in the minibuffer fixes this:
>
> (modify-syntax-entry ?\\ "\\" (syntax-table))
>
> So the syntax of \ in the minibuffer should be changed temporarily to
> escape-syntax during read-regexp.
But doesn't it already have escape syntax? That's why (...) blinks and
\(...\) doesn't blink, I'd have thought. (But I haven't tested it.)
The problem is, though, that we do want \ to escape some things (like
\[, which is the literal [ character), but the logic is the opposite
with ( and ).
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-09-25 0:54 ` Lars Ingebrigtsen
@ 2021-09-27 13:16 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-09-28 5:25 ` Lars Ingebrigtsen
0 siblings, 1 reply; 23+ messages in thread
From: ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-09-27 13:16 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 50766
>
> But doesn't it already have escape syntax? That's why (...) blinks and
> \(...\) doesn't blink, I'd have thought. (But I haven't tested it.)
Optimally, both should blink, but only for their fitting pairs.
So, \( does not match ), no blink, but it matches \), there should be a blink.
And vica versa for (.
> The problem is, though, that we do want \ to escape some things (like
> \[, which is the literal [ character), but the logic is the opposite
Even the literal character can have a matching \] part for which it should
blink, because it helps the user to see which literal \[ he closed.
So blinking should be able to handle escaped and non-escaped parens too and
pair them properly.
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-09-27 13:16 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-09-28 5:25 ` Lars Ingebrigtsen
2021-09-30 16:18 ` martin rudalics
0 siblings, 1 reply; 23+ messages in thread
From: Lars Ingebrigtsen @ 2021-09-28 5:25 UTC (permalink / raw)
To: ndame; +Cc: 50766
ndame <laszlomail@protonmail.com> writes:
> So blinking should be able to handle escaped and non-escaped parens too and
> pair them properly.
Indeed. I wondered whether we had code that did the right syntax
marking for regexps so that this would work, but I guess not?
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-09-28 5:25 ` Lars Ingebrigtsen
@ 2021-09-30 16:18 ` martin rudalics
2021-10-01 7:19 ` Lars Ingebrigtsen
0 siblings, 1 reply; 23+ messages in thread
From: martin rudalics @ 2021-09-30 16:18 UTC (permalink / raw)
To: Lars Ingebrigtsen, ndame; +Cc: 50766
> Indeed. I wondered whether we had code that did the right syntax
> marking for regexps so that this would work, but I guess not?
It's not entirely trivial: With "\(" you normally want to put the syntax
table property on the "\" but inside a character alternative you want to
put it on the "(". So you have to re-parse the minibuffer after each
editing change.
Which means we'd have to, at the beginning of 'show-paren--default',
- check whether this is a minibuffer where we want that feature enabled,
- enable 'parse-sexp-lookup-properties' for it,
- syntactically propertize parens, brackets, braces and backslashes
according to their positions within the regexp typed.
That's all. What it would get us are regexps with properly highlighted
parens and proper sexp navigation.
I have written such code for Elisp buffers and can convert and simplify
it to make it work for minibuffers. I suppose it would amount to about
100 lines to add to paren.el and would do it only if you are convinced
that it's worth the effort. It would not handle 'blink-matching-open'.
martin
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-09-30 16:18 ` martin rudalics
@ 2021-10-01 7:19 ` Lars Ingebrigtsen
2021-10-01 14:28 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-01 15:00 ` martin rudalics
0 siblings, 2 replies; 23+ messages in thread
From: Lars Ingebrigtsen @ 2021-10-01 7:19 UTC (permalink / raw)
To: martin rudalics; +Cc: ndame, 50766
martin rudalics <rudalics@gmx.at> writes:
> I have written such code for Elisp buffers and can convert and simplify
> it to make it work for minibuffers. I suppose it would amount to about
> 100 lines to add to paren.el and would do it only if you are convinced
> that it's worth the effort.
I think that it would help users a lot when constructing regexps, so it
would be very welcome.
> It would not handle 'blink-matching-open'.
Is there any way to make that work, too? Some people don't like
show-paren-mode, but use 'blink-matching-open' instead.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-10-01 7:19 ` Lars Ingebrigtsen
@ 2021-10-01 14:28 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-01 15:00 ` martin rudalics
2021-10-01 15:00 ` martin rudalics
1 sibling, 1 reply; 23+ messages in thread
From: ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2021-10-01 14:28 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: martin rudalics, 50766
>
> I think that it would help users a lot when constructing regexps, so it
> would be very welcome.
I wonder if it could be a generic feature which besides working in the
minibuffer for regexps would also work when typing escaped parens in
in strings, e.g. when using a string regexp in a program:
"stuff ( \\( ) "
Here it could indicate the mismatching parens.
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-10-01 7:19 ` Lars Ingebrigtsen
2021-10-01 14:28 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-10-01 15:00 ` martin rudalics
2021-10-02 9:01 ` Lars Ingebrigtsen
1 sibling, 1 reply; 23+ messages in thread
From: martin rudalics @ 2021-10-01 15:00 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: ndame, 50766
> I think that it would help users a lot when constructing regexps, so it
> would be very welcome.
OK. I'll try to cook up something useful.
>> It would not handle 'blink-matching-open'.
>
> Is there any way to make that work, too?
Hardly. 'blink-matching-paren' is not timer-based. Doing any parsing
in between would slow down typing.
> Some people don't like
> show-paren-mode, but use 'blink-matching-open' instead.
With 'blink-matching-paren' on do C-M-% and type [)]. People who use
'blink-matching-paren' do not type complex regexps.
martin
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-10-01 14:28 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2021-10-01 15:00 ` martin rudalics
0 siblings, 0 replies; 23+ messages in thread
From: martin rudalics @ 2021-10-01 15:00 UTC (permalink / raw)
To: ndame, Lars Ingebrigtsen; +Cc: 50766
[-- Attachment #1: Type: text/plain, Size: 430 bytes --]
> I wonder if it could be a generic feature which besides working in the
> minibuffer for regexps would also work when typing escaped parens in
> in strings, e.g. when using a string regexp in a program:
>
> "stuff ( \\( ) "
>
> Here it could indicate the mismatching parens.
I can only offer you my old regexp-lock-mode (attached). In an .el
buffer do M-x turn-on-regexp-lock-mode and tell me how it works.
martin
[-- Attachment #2: regexp-lock.el --]
[-- Type: text/x-emacs-lisp, Size: 70051 bytes --]
;;; regexp-lock.el --- minor mode for highlighting Emacs Lisp regexps
;; Copyright (C) 2005 Martin Rudalics
;; Time-stamp: "2021-10-01 12:10:57 martin"
;; Author: Martin Rudalics <rudalics@gmx.at>
;; Keywords: regular expressions
;; Version: 0.1
;; regexp-lock.el is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; regexp-lock.el is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;; Commentary:
;; Regexp Lock is a minor mode for highlighting regular expressions in Emacs
;; Lisp mode.
;; `regexp-lock-mode' turns on/off Regexp Lock in the current buffer. For
;; further information consult the documentation of `regexp-lock-mode'.
;; To turn on Regexp Lock in any Emacs Lisp file you open, add the lines
;; (require 'regexp-lock)
;; (add-hook 'emacs-lisp-mode-hook 'turn-on-regexp-lock-mode)
;; to your .emacs.
;;; Code:
;; _____________________________________________________________________________
;;
;;; Faces and customizable variables
;; _____________________________________________________________________________
;;
(defgroup regexp-lock nil
"Highlight regular expressions in Lisp modes."
:version "22.1"
:group 'font-lock)
(defface regexp-lock-regexp
'((((class color)) :background "Grey87")
(t :underline t))
"Face for highlighting regexp at point."
:group 'regexp-lock)
(defface regexp-lock-group
'((((class color)) :bold t :foreground "Black" :background "Orange")
(t :bold t))
"Face for highlighting group numbers in regexp at point."
:group 'regexp-lock)
(defface regexp-lock-match
'((((class color)) :background "Turquoise1")
(t :underline t))
"Face for highlighting match of regexp at point."
:group 'regexp-lock)
(defface regexp-lock-match-group
'((((class color)) :bold t :foreground "Black" :background "Turquoise1")
(t :bold t))
"Face for highlighting group numbers in match of regexp at point."
:group 'regexp-lock)
(defface regexp-lock-match-other
'((((class color)) :background "PaleTurquoise1")
(t :underline t))
"Face for highlighting other matches of regexp at point."
:group 'regexp-lock)
(defcustom regexp-lock-minor-mode-string nil
"*String to display in mode line when Regexp Lock is enabled."
:type '(choice string (const :tag "none" nil))
:group 'regexp-lock)
(defcustom regexp-lock-regexp-string
"\\\\\\\\[](|)>}`'=_sSwWcCbB0-9]\\|\\[\\(?:[ ^:]\\|\\\\[tnf]\\)\\|\\][*+?]"
"*Strings matching this regexp are considered regexp subexpressions.
This regexp is used to discriminate strings representing regular
expressions from \"ordinary\" strings. The default value has Regexp
Lock search for one of the following:
- two backslashes preceding any of the characters expected in regexp
backslash constructs but \"[\", \"{\" and \"<\" - the latter being
excluded because the corresponding constructs have a special meaning
in `substitute-command-keys'
- a left bracket followed by a space, a caret, a colon, or a backslash
that precedes one of the characters \"t\", \"n\", or \"f\"
- a right bracket followed by one of \"*\", \"+\", or \"?\"
If any of these items is present in a string, that individual string is
considered part of a regular expression. If, moreover, the string
literally appears within the argument list of a `concat' or `mapconcat',
all components of that list are considered regular expressions too."
:type 'regexp
:group 'regexp-lock)
(defcustom regexp-lock-redo-delay 0.1
"*Time in seconds Regexp Lock waits before refontifying text.
By default, Regexp Lock refontifies text in order to correctly assign
the text properties of all regexps displayed. When the value of this
variable is nil Regexp Lock never refontifies text. As a consequence
regexps may appear improperly fontified after a buffer has been altered,
scrolled, or is displayed for the first time."
:type '(choice (const :tag "never" nil) (number :tag "seconds"))
:set (lambda (symbol value)
(set-default symbol value)
(when (boundp 'regexp-lock-redo-timer)
(when regexp-lock-redo-timer
(cancel-timer regexp-lock-redo-timer)
(setq regexp-lock-redo-timer nil))
(when value
(setq regexp-lock-redo-timer
(run-with-idle-timer value t 'regexp-lock-redo)))))
:group 'regexp-lock)
(defcustom regexp-lock-pause nil
"*Time in seconds Regexp Lock pauses during refontifying and rechecking.
When the value of this variable is nil `regexp-lock-redo' and
`regexp-lock-recheck' never pause."
:type '(choice (const :tag "never" nil) (number :tag "seconds"))
:group 'regexp-lock)
(defcustom regexp-lock-redo-size 500
"*Number of characters Regexp Lock refontifies without pause."
:type 'integer
:group 'regexp-lock)
(defcustom regexp-lock-recheck-delay 1
"*Time in seconds Regexp Lock waits before rechecking.
Rechecking is needed since refontification \(`regexp-lock-redo'\) can
not tell whether a multi-line string that matches - or does not match -
`regexp-lock-regexp-string' did so in earlier fontifications too. The
function `regexp-lock-recheck' periodically checks strings whether they
\(still\) qualify as regexp subexpressions. It does so by searching
windows for `regexp-lock-regexp-string' and requesting refontification
whenever the semantics of a string might have changed. If the value of
regexp-lock-recheck-delay is nil no rechecking is done.
In practice, the semantics of expressions change rarely. A noticeable
exception occurs when you compose a regexp spanning multiple lines and
the first match for `regexp-lock-regexp-string' does not occur on the
first lines."
:type '(choice (const :tag "never" nil) (number :tag "seconds"))
:set (lambda (symbol value)
(set-default symbol value)
(when (boundp 'regexp-lock-recheck-timer)
(when regexp-lock-recheck-timer
(cancel-timer regexp-lock-recheck-timer)
(setq regexp-lock-recheck-timer nil))
(when value
(setq regexp-lock-recheck-timer
(run-with-idle-timer value t 'regexp-lock-recheck)))))
:group 'regexp-lock)
(defcustom regexp-lock-show-priority 1000
"*Priority of overlays highlighting the regexp at point.
Regexp Lock uses this priority for overlays highlighting the regexp at
point and group numbers."
:type 'integer
:group 'regexp-lock)
(defcustom regexp-lock-show-delay 0.2
"*Time in seconds to wait before highlighting the regexp at point.
Regexp Lock waits this many seconds before highlighting the regexp at
point and any group numbers. A value of nil means that no such
highlighting is performed."
:type '(choice (const :tag "never" nil) (number :tag "seconds"))
:set (lambda (symbol value)
(set-default symbol value)
(when (boundp 'regexp-lock-show-timer)
(when regexp-lock-show-timer
(cancel-timer regexp-lock-show-timer))
(setq regexp-lock-show-timer nil)
(when value
(setq regexp-lock-show-timer
(run-with-idle-timer value t 'regexp-lock-show)))))
:group 'regexp-lock)
(defcustom regexp-lock-match-before-group "{"
"*String displayed before group number of matching expression.
Matching the regexp at point has Regexp Lock display group numbers of
corresponding regexp subexpressions. These numbers are indicated with
the help of overlays appearing before and after the match. If two or
more subexpressions match at the same position, you may discriminate
them more easily by displaying this string before any group number."
:type 'string
:group 'regexp-lock)
(defcustom regexp-lock-match-after-group "}"
"*String displayed after group number of matching expression.
Matching the regexp at point has Regexp Lock display group numbers of
corresponding regexp subexpressions. These numbers are indicated with
the help of overlays appearing before and after the match. If two or
more subexpressions match at the same position, you may discriminate
them more easily by displaying this string after any group number."
:type 'string
:group 'regexp-lock)
(defcustom regexp-lock-hook nil
"Hook run after Regexp Lock has been turned on or off."
:type 'hook
:group 'regexp-lock)
;; _____________________________________________________________________________
;;
;;; Mode definitions
;; _____________________________________________________________________________
;;
(define-minor-mode regexp-lock-mode
"Toggle Regexp Lock.
Regexp Lock is a minor mode for highlighting regular expressions in
Emacs Lisp mode. When activated, it has font-lock modify syntactic
properties and appearance of regexp constituents as follows:
- Ordinary brackets, parentheses, and semicolons are assigned the
`symbol' syntax-table property. As a consequence, `forward-sexp' and
`backward-sexp' within strings will skip parenthesized groups and
alternatives in a more intuitive way. `blink-matching-open' and
`show-paren-mode' will not falsely indicate mismatching parens.
- Brackets delimiting character alternatives are highlighted with
`font-lock-regexp-grouping-construct' face. Special parentheses and
brackets that don't match are signaled with `font-lock-warning-face'.
- Highlight the regular expression at point with `regexp-lock-regexp'
face. Also overlay the backslashes used to escape subgroup delimiting
parens with the associated group number. Group numbers are displayed
with `regexp-lock-group' face. These overlays are installed whenever
`point' is immediately before or after a string or subgroup delimiter
of the regexp at point.
The commands \\[regexp-lock-match-next] and \\[regexp-lock-match-prev]
can be used to highlight the next respectively previous expression
matching the regexp at point in another window. These commands use
`eval' to evaluate the regexp at point. For the current match they
highlight:
- The entire match `(match-string 0)' with `regexp-lock-match' face.
- Group numbers corresponding to subgroup matches are highlighted with
`regexp-lock-match-group' face. In addition, the strings specified by
`regexp-lock-match-before-group' and `regexp-lock-match-after-group'
are used to separate group numbers.
Matches before and after the current match are highlighted with
`regexp-lock-match-other' face. If necessary, Regexp Lock splits the
selected window in order to display matches. Initially, matches are
shown for the buffer containing the regexp at point. Matches for any
other buffer can be shown by switching to that buffer in the window
displaying matches.
Finally, Regexp Lock provides a function `regexp-lock-increment' which
permits to in-/decrement arguments of `match-beginning' or `match-end'
within the region.
Caveats:
- Regexp Lock uses a number of heuristics to detect regexps. Hence you
will occasionally see ordinary strings highlighted as regexps as well
as regexps highlighted as ordinary strings. In some cases customizing
the variable `regexp-lock-regexp-string' might help.
- Regexp Lock analyzes regular expressions literally. Hence if you
write something like
\(defvar foo \"\\\\(\") \(defvar bar (concat foo \"bar\\\\)\"))
Regexp Lock is not able to indicate group numbers correctly and will
additionally issue two warnings.
- Regexp Lock expects that a regexp produced by `regexp-opt' is
contained in a grouping construct iff the second argument of
regexp-opt is present and does not equal one of the character
sequences `nil' or `()'.
- Regexp Lock does not recognize expressions constructed by `rx' or
`sregex'.
- Regexp Lock consumes processor resources. On battery-powered systems
you should turn it off whenever you don't need it."
:lighter regexp-lock-minor-mode-string
:group 'regexp-lock
:keymap '(("\C-c(" . regexp-lock-match-next)
("\C-c)" . regexp-lock-match-prev)
("\C-c#" . regexp-lock-increment))
(if regexp-lock-mode
(regexp-lock-activate)
(regexp-lock-deactivate))
(run-hooks 'regexp-lock-hook))
(defun turn-on-regexp-lock-mode ()
"Unequivocally turn on `regexp-lock-mode'."
(interactive)
(regexp-lock-mode 1))
;; _____________________________________________________________________________
;;
;;; Local definitions
;; _____________________________________________________________________________
;;
(defvar regexp-lock-redo t
"When non-nil refontify this buffer.")
(defvar regexp-lock-redo-timer nil
"Idle timer for `regexp-lock-redo'.")
(defvar regexp-lock-recheck t
"When non-nil recheck this buffer.")
(defvar regexp-lock-recheck-timer nil
"Idle timer for `regexp-lock-recheck'.")
(defvar regexp-lock-overlays nil
"Overlays used by `regexp-lock-show'.")
(defvar regexp-lock-show-timer nil
"Idle timer for `regexp-lock-show'.")
(defvar regexp-lock-match-regexp nil
"`regexp-lock-match' searches for this regexp.")
(defvar regexp-lock-match-window nil
"`regexp-lock-match' display matches in this window.")
(defvar regexp-lock-match-buffer nil
"`regexp-lock-match-window' displays this buffer.")
(defvar regexp-lock-match-overlays nil
"Overlays that highlight matches in `regexp-lock-match-window'.")
(defvar regexp-lock-match-from (make-marker)
"Marker for match begin in `regexp-lock-match-buffer'.")
(defvar regexp-lock-match-to (make-marker)
"Marker for match end in `regexp-lock-match-buffer'.")
(eval-when-compile
(defmacro save-regexp-lock (&rest body)
"Eval BODY with match-data, excursion, restrictions saved, buffer widened."
`(save-match-data
(save-excursion
(save-restriction
(widen)
(progn ,@body)))))
(put 'save-regexp-lock 'lisp-indent-function 0)
(def-edebug-spec save-regexp-lock let)
(defmacro with-regexp-lock (&rest body)
"Eval BODY, preserving current buffer's modified and undo states."
(let ((modified (make-symbol "modified")))
`(let ((,modified (buffer-modified-p))
(buffer-undo-list t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
deactivate-mark
buffer-file-name
buffer-file-truename)
(unwind-protect
(progn ,@body)
(unless ,modified
(restore-buffer-modified-p nil))))))
(put 'with-regexp-lock 'lisp-indent-function 0)
(def-edebug-spec with-regexp-lock let))
(defsubst regexp-lock-string-face-p (face)
"Return t when character at `point' has `font-lock-string-face' face property."
(or (and (listp face)
(memq 'font-lock-string-face face))
(eq face 'font-lock-string-face)))
(defsubst regexp-lock-syntactic-face-p (face)
"Return t when face property at `point' indicates syntactic context.
More precisely, return t when character at point has one of
`font-lock-string-face', `font-lock-comment-face', or
`font-lock-doc-face' face property."
(or (and (listp face)
(or (memq 'font-lock-string-face face)
(memq 'font-lock-comment-face face)
(memq 'font-lock-doc-face face)))
(memq face '(font-lock-string-face
font-lock-comment-face
font-lock-doc-face))))
;; the following function is commented out in font-lock.el
(defun remove-text-property (start end property &optional object)
"Remove a property from text from START to END.
Argument PROPERTY is the property to remove.
Optional argument OBJECT is the string or buffer containing the text.
Return t if the property was actually removed, nil otherwise."
(remove-text-properties start end (list property) object))
;; the following function is commented out in font-lock.el
(defun remove-single-text-property (start end prop value &optional object)
"Remove a specific property value from text from START to END.
Arguments PROP and VALUE specify the property and value to remove. The
resulting property values are not equal to VALUE nor lists containing VALUE.
Optional argument OBJECT is the string or buffer containing the text."
(let ((start (text-property-not-all start end prop nil object)) next prev)
(while start
(setq next (next-single-property-change start prop object end)
prev (get-text-property start prop object))
(cond ((and (symbolp prev) (eq value prev))
(remove-text-property start next prop object))
((and (listp prev) (memq value prev))
(let ((new (delq value prev)))
(cond ((null new)
(remove-text-property start next prop object))
((= (length new) 1)
(put-text-property start next prop (car new) object))
(t
(put-text-property start next prop new object))))))
(setq start (text-property-not-all next end prop nil object)))))
;; _____________________________________________________________________________
;;
;;; Activate / Deactivate
;; _____________________________________________________________________________
;;
(defun regexp-lock-activate ()
"Activate Regexp Lock in current buffer."
(if (not (memq major-mode
'(emacs-lisp-mode lisp-mode lisp-interaction-mode reb-mode)))
(error "Regexp Lock can be used in Lisp modes only")
;; turn on font-lock if necessary and integrate ourselves
(unless font-lock-mode (font-lock-mode 1))
(set (make-local-variable 'font-lock-extra-managed-props)
(append font-lock-extra-managed-props
(list 'syntax-table 'regexp-lock)))
(font-lock-add-keywords nil '(regexp-lock-fontify . nil) t)
(font-lock-unfontify-buffer)
(save-restriction
(widen)
(with-regexp-lock
(remove-text-properties (point-min) (point-max) '(fontified t))))
;; syntax properties
(set (make-local-variable 'parse-sexp-lookup-properties) t)
;; hooks
(add-hook 'after-change-functions 'regexp-lock-after-change nil t)
(add-hook 'window-scroll-functions 'regexp-lock-window-redo t t)
(add-hook 'window-size-change-functions 'regexp-lock-frame-redo)
(add-hook 'change-major-mode-hook 'regexp-lock-deactivate nil t)
;; redo-timer
(when regexp-lock-redo-timer
(cancel-timer regexp-lock-redo-timer)
(setq regexp-lock-redo-timer nil))
(when regexp-lock-redo-delay
(setq regexp-lock-redo-timer
(run-with-idle-timer regexp-lock-redo-delay t 'regexp-lock-redo)))
(set (make-local-variable 'regexp-lock-redo) nil)
;; recheck-timer
(when regexp-lock-recheck-timer
(cancel-timer regexp-lock-recheck-timer)
(setq regexp-lock-recheck-timer nil))
(when regexp-lock-recheck-delay
(setq regexp-lock-recheck-timer
(run-with-idle-timer
regexp-lock-recheck-delay t 'regexp-lock-recheck)))
(set (make-local-variable 'regexp-lock-recheck) nil)
;; show-timer
(when regexp-lock-show-timer
(cancel-timer regexp-lock-show-timer)
(setq regexp-lock-show-timer nil))
(when regexp-lock-show-delay
(setq regexp-lock-show-timer
(run-with-idle-timer regexp-lock-show-delay t 'regexp-lock-show)))))
(defun regexp-lock-deactivate ()
"Deactivate Regexp Lock in current buffer."
;; syntax properties
(setq parse-sexp-lookup-properties nil)
;; local hooks
(remove-hook 'after-change-functions 'regexp-lock-after-change)
(remove-hook 'window-scroll-functions 'regexp-lock-window-redo)
(remove-hook 'change-major-mode-hook 'regexp-lock-deactivate)
(remove-hook 'pre-command-hook 'regexp-lock-match-pre-command)
;; redo
(with-regexp-lock
(remove-text-properties (point-min) (point-max) '(regexp-lock-redo nil)))
;; font lock
(font-lock-unfontify-buffer)
(setq font-lock-extra-managed-props
(delq 'syntax-table
(delq 'regexp-lock
font-lock-extra-managed-props)))
(font-lock-remove-keywords nil '(regexp-lock-fontify . nil))
(save-restriction
(widen)
(with-regexp-lock
(remove-text-properties (point-min) (point-max) '(fontified t))))
(unless (catch 'found
(dolist (buffer (buffer-list))
(when (with-current-buffer buffer regexp-lock-mode)
(throw 'found t))))
;; markers
(set-marker regexp-lock-match-from nil)
(set-marker regexp-lock-match-to nil)
;; global hook
(remove-hook 'window-size-change-functions 'regexp-lock-frame-redo)
;; redo-timer
(when regexp-lock-redo-timer
(cancel-timer regexp-lock-redo-timer)
(setq regexp-lock-redo-timer nil))
;; recheck-timer
(when regexp-lock-recheck-timer
(cancel-timer regexp-lock-recheck-timer)
(setq regexp-lock-recheck-timer nil))
;; show-timer
(when regexp-lock-show-timer
(cancel-timer regexp-lock-show-timer)
(setq regexp-lock-show-timer nil))))
;; _____________________________________________________________________________
;;
;;; Text Properties
;; _____________________________________________________________________________
;;
(defun regexp-lock-after-change (start end old-len)
"Mark text after buffer change to trigger `regexp-lock-redo'."
(when regexp-lock-mode
(with-regexp-lock
(save-excursion
(goto-char start)
(if (save-match-data
(save-excursion
(beginning-of-line)
(re-search-forward
regexp-lock-regexp-string (max end (line-end-position)) t)))
(put-text-property
(line-beginning-position) (min (max end (1+ start)) (point-max))
'regexp-lock-redo 2)
(put-text-property
(line-beginning-position) (min (max end (1+ start)) (point-max))
'regexp-lock-redo t))
(setq regexp-lock-redo t)))))
(defun regexp-lock-window-redo (window start)
"Mark text after window scroll to trigger `regexp-lock-redo'."
(with-current-buffer (window-buffer window)
(when regexp-lock-mode
(setq regexp-lock-redo t))))
(defun regexp-lock-frame-redo (frame)
"Mark text after window size change to trigger `regexp-lock-redo'."
;; Use frame-first-window since selected-window may be on a different frame.
(with-selected-window (frame-first-window frame)
(dolist (window (window-list frame 'nominibuf))
(with-current-buffer (window-buffer window)
(when regexp-lock-mode
(setq regexp-lock-redo t))))))
(defun regexp-lock-redo ()
"Refontify with Regexp Lock.
Currently this operates on all windows of the selected frame."
(catch 'input
(let ((current-buffer (current-buffer))
(current-point (point))
(current-point-min (point-min))
(current-point-max (point-max)))
(dolist (window (window-list nil 'nominibuf))
(with-current-buffer (window-buffer window)
(when (and regexp-lock-mode regexp-lock-redo font-lock-mode)
(let ((window-start (window-start window))
(window-end (window-end window))
(parse-sexp-ignore-comments t))
(save-regexp-lock
(let* ((bod (save-excursion
;; bod is the last beginning-of-defun
;; preceding start of window or point-min
(goto-char window-start)
(or (condition-case nil
(progn
(beginning-of-defun)
(line-beginning-position))
(error (point-min)))
(point-min))))
(eod (save-excursion
;; eod is the first end-of-defun following
;; end of window or point-max
(goto-char window-end)
(or (condition-case nil
(progn
(beginning-of-defun -1)
(max window-end
(line-beginning-position)))
(error (point-max)))
(point-max))))
;; from is the first redo position between bod
;; and eod
(from (min (or (text-property-any
bod eod 'regexp-lock-redo t)
eod)
(or (text-property-any
bod eod 'fontified nil)
eod)))
to)
(when (and from (< from eod))
(save-excursion
(goto-char from)
(setq from (line-beginning-position)))
;; adjust from
(when (or (< from bod)
(and (> from bod)
(not (get-text-property
(1- from) 'fontified))))
;; refontify from bod
(setq from bod))
;; initialize to
(when (or (< from window-end)
(not (equal (get-text-property
(1- from) 'regexp-lock)
(get-text-property
from 'regexp-lock))))
(setq to (min (save-excursion
(goto-char
(+ from regexp-lock-redo-size))
(line-beginning-position 2))
eod))
;; fontify
(while (and (< from to)
(or (not regexp-lock-pause)
(save-excursion
(with-current-buffer current-buffer
(save-restriction
(goto-char current-point)
(narrow-to-region
current-point-min
current-point-max)
(sit-for regexp-lock-pause))))
(throw 'input t)))
(with-regexp-lock
;; record the following two properties _now_
;; since font-lock may fontify past to
(let ((fontified-at-to
(get-text-property to 'fontified))
(lock-at-to
(get-text-property to 'regexp-lock)))
(put-text-property from to 'fontified t)
(if jit-lock-mode
;; as jit-lock-fontify-now
(condition-case err
(run-hook-with-args
'jit-lock-functions from to)
(quit (put-text-property
from to 'fontified nil)
(funcall
'signal (car err) (cdr err))))
;; plain font-lock-fontify-region
(font-lock-fontify-region from to))
(remove-text-properties
from to '(regexp-lock-redo nil))
(setq from to)
(when (and (< to eod)
(or (not fontified-at-to)
(not (equal (get-text-property
(1- to) 'regexp-lock)
lock-at-to))))
(put-text-property
to (min (1+ to) (point-max))
'regexp-lock-redo t)
(setq to (min (save-excursion
(goto-char
(+ to regexp-lock-redo-size))
(line-beginning-position 2))
eod))))))))))
;; keep the following always _within_ the outermost
;; let to avoid that other idle timers get confused
(timer-activate-when-idle regexp-lock-show-timer t)
(setq regexp-lock-redo nil)
(setq regexp-lock-recheck t))))
(or (not regexp-lock-pause)
(sit-for regexp-lock-pause)
(throw 'input t))))))
(defsubst regexp-lock-set-redo (from to)
"Set `regexp-lock-redo' from `regexp-lock-recheck'.
This sets the `regexp-lock-redo' text-property at FROM as well as the
buffer-local value of `regexp-lock-redo' to t. Values are set if a
match for `regexp-lock-regexp-string' is found before TO and the
`regexp-lock' text-property at FROM is not set or no match before TO
exists and the `regexp-lock' text-property is set."
(if (re-search-forward regexp-lock-regexp-string to 'to)
;; match for regexp-lock-regexp-string
(unless (get-text-property from 'regexp-lock)
;; regexp-lock not set, redo
(with-regexp-lock
(put-text-property from (1+ from) 'regexp-lock-redo t))
(setq regexp-lock-redo t))
;; no match for regexp-lock-regexp-string
(when (get-text-property from 'regexp-lock)
;; regexp-lock set, redo
(with-regexp-lock
(put-text-property from (1+ from) 'regexp-lock-redo t))
(setq regexp-lock-redo t))))
(defun regexp-lock-recheck ()
"Recheck windows with Regexp Lock.
Currently this operates on all windows of the selected frame."
(catch 'input
(let ((current-buffer (current-buffer))
(current-point (point))
(current-point-min (point-min))
(current-point-max (point-max)))
(dolist (window (window-list nil 'nominibuf))
(with-current-buffer (window-buffer window)
(when (and regexp-lock-mode regexp-lock-recheck font-lock-mode)
(let ((window-start (window-start window))
(window-end (window-end window))
(parse-sexp-ignore-comments t))
(save-regexp-lock
(let* ((from (save-excursion
;; from is the last beginning-of-defun
;; preceding start of window or point-min
(goto-char window-start)
(or (condition-case nil
(progn
(beginning-of-defun)
(line-beginning-position))
(error (point-min)))
(point-min))))
to face)
;; check iff from has been already fontified
(when (get-text-property from 'fontified)
(goto-char from)
(while (re-search-forward "\\(\"\\)\
\\|(\\(\\(?:map\\)?concat\\)\\>\
\\|(\\(re-search-\\(?:for\\|back\\)ward\\|looking-\\(?:at\\|back\\)\\|string-match\\|replace-regexp-in-string\
\\|message\\|error\\|skip-\\(?:syntax\\|chars\\)-\\(?:for\\|back\\)ward\\|search-\\(?:for\\|back\\)ward\\)\\>"
window-end 'window-end)
(setq face (get-text-property
(or (match-end 1) (match-beginning 0))
'face))
(cond
((match-beginning 1)
;; double-quote
(cond
((and (regexp-lock-string-face-p face)
(save-excursion
(condition-case nil
(progn
(setq from (match-beginning 1))
(goto-char from)
(forward-sexp)
(setq to (point)))
(error nil))))
(regexp-lock-set-redo from to)
(goto-char (min to window-end)))
((and (or (and (listp face)
(memq 'font-lock-doc-face face))
(eq 'font-lock-doc-face face))
(save-excursion
(condition-case nil
(progn
(goto-char (match-beginning 1))
(forward-sexp)
(setq to (point)))
(error nil))))
;; doc-string, skip
(goto-char (min to window-end)))))
((match-beginning 2)
;; concat, mapconcat
(when (and (not (regexp-lock-syntactic-face-p face))
(save-excursion
(condition-case nil
(progn
(setq from (match-beginning 0))
(goto-char from)
(forward-sexp)
(setq to (point)))
(error nil)))
(goto-char from))
(regexp-lock-set-redo from to)
(goto-char (min to window-end))))
((match-beginning 3)
;; re-search- / looking- / string-match /
;; replace-regexp-in-string /
;; message / error / search- / skip-syntax- /
;; skip-chars-, skip
(if (and (not (regexp-lock-syntactic-face-p face))
(save-excursion
(condition-case nil
(progn
(goto-char (match-beginning 0))
(forward-sexp)
(setq to (point)))
(error nil))))
(goto-char (min to window-end))
(goto-char (min (point) window-end)))))))
(setq regexp-lock-recheck nil)
(when regexp-lock-redo
;; activate regexp-lock-redo-timer
(timer-activate-when-idle
regexp-lock-redo-timer t)))))))))
(or (not regexp-lock-pause)
(sit-for regexp-lock-pause)
(throw 'input t))))
(defun regexp-lock-fontify (bound)
"Fontify region from `point' to BOUND."
(let ((lock (unless (= (point) (point-min))
(get-text-property (1- (point)) 'regexp-lock)))
;; `lock' - the `regexp-lock' text property - is interpreted as:
;; nil - no regexp around point (nil is not stored as text property)
;; 0 - the following sexp is a regexp
;; 1 - within a regexp-string that is not argument of a `concat'
;; >= 2 - within a `concat' that has at least one regexp argument
;; within a character alternative values are negative
(from (point))
(parse-sexp-ignore-comments t)
to face)
(while (< (point) bound)
(catch 'lock
(if lock
(while (re-search-forward
"\\(^\\s(\\)\\|\\(\"\\)\\|\\(?:\\\\\\\\\\)\\(?:\\(?:\\\\\\\\\\)\\|\\([()]\\)\\|\\(|\\)\\|\\(\\[\\)\\|\\(\\]\\)\\)\
\\|\\(\\\\[][()]\\)\\|\\(\\[:[a-zA-Z]+:\\]\\)\\|\\(\\[\\)\\|\\(\\]\\)\\|\\(;\\)\\|\\((\\)\\|\\()\\)\\|`\\(\\sw\\sw+\\)'" bound 'bound)
(setq face (get-text-property (1- (point)) 'face))
(cond
((match-beginning 1)
;; paren in column zero, throw
(put-text-property from (match-beginning 1) 'regexp-lock lock)
(setq lock nil)
(throw 'lock nil))
((match-beginning 2)
;; double-quote, ignore for lock not in {-1,0,1}
(cond
((zerop lock)
;; start new regexp-string
(put-text-property from (match-beginning 2) 'regexp-lock 0)
(setq from (match-beginning 2))
(goto-char (1+ from))
(setq lock 1))
((and (or (= lock 1) (= lock -1))
;; the following skips adjacent double-quotes as in
;; "string1""string2" which should not do much harm
(regexp-lock-string-face-p face)
(or (= (point) bound) ; fails with escaped `"' at eob
(not (regexp-lock-string-face-p
(get-text-property (point) 'face)))))
;; terminate current regexp-string
(put-text-property from (point) 'regexp-lock lock)
(when (= lock -1)
;; unclosed character alternative, warn
(put-text-property
(1- (point)) (point) 'face 'font-lock-warning-face))
(setq lock nil)
(throw 'lock nil))))
((and (match-beginning 12)
(not (regexp-lock-syntactic-face-p face)))
;; non-syntactic left paren, expects lock not in {-1,1}
(put-text-property from (match-beginning 12) 'regexp-lock lock)
(setq from (match-beginning 12))
(cond
((>= lock 2) (setq lock (1+ lock)))
((<= lock -2) (setq lock (1- lock)))
((zerop lock) (setq lock 2))
(t (setq lock nil) ; looses
(throw 'lock nil))))
((and (match-beginning 13)
(not (regexp-lock-syntactic-face-p face)))
;; non-syntactic right paren, expects lock not in {-1,1}
(put-text-property from (match-end 13) 'regexp-lock lock)
(setq from (match-end 13))
(cond
((> lock 2) (setq lock (1- lock)))
((< lock -2) (setq lock (1+ lock)))
(t (when (= lock -2)
;; unclosed character alternative, warn
(put-text-property
(1- (point)) (point) 'face 'font-lock-warning-face))
(setq lock nil) ; end of sexp or looser
(throw 'lock nil))))
((regexp-lock-string-face-p face)
;; matches below are valid within strings only
(cond
((match-beginning 3) ; \\( or \\)
(when (< lock 0)
;; within character alternative, set symbol syntax
(put-text-property (1- (point)) (point) 'syntax-table '(3))
;; remove faces that are silly here
(remove-single-text-property
(match-beginning 0) (1- (match-end 0))
'face 'font-lock-regexp-backslash)
(remove-single-text-property
(1- (match-end 0)) (match-end 0)
'face 'font-lock-regexp-grouping-construct)))
((match-beginning 4) ; \\|
(when (< lock 0)
;; within character alternative remove regexp-lock faces
(remove-single-text-property
(match-beginning 0) (1- (match-end 0))
'face 'font-lock-regexp-backslash)
(remove-single-text-property
(1- (match-end 0)) (match-end 0)
'face 'font-lock-regexp-grouping-construct)))
((match-beginning 5) ; \\[
(let ((face (get-text-property (point) 'face)))
(when (and (listp face)
(memq 'font-lock-constant-face face))
;; remove font-lock-constant-face
(remove-single-text-property
(point) (next-single-property-change
(point) 'face nil (line-end-position))
'face 'font-lock-constant-face)))
(if (< lock 0)
;; within character alternative, reread bracket
(goto-char (1- (point)))
;; not within character alternative, set symbol syntax
(put-text-property
(1- (point)) (point) 'syntax-table '(3))))
((match-beginning 6) ; \\]
(if (< lock 0)
;; within character alternative, reread bracket
(goto-char (1- (point)))
;; not within character alternative, set symbol syntax
(put-text-property
(1- (point)) (point) 'syntax-table '(3))))
((match-beginning 7) ; escaped parenthesis or bracket
;; set symbol syntax for backslash and reread paren
(put-text-property
(match-beginning 0) (1+ (match-beginning 0))
'syntax-table '(3))
(goto-char (1+ (match-beginning 0))))
((match-beginning 8))
;; POSIX character class, skip
((match-beginning 9) ; [
(let ((face (get-text-property (point) 'face)))
(when (and (listp face)
(memq 'font-lock-constant-face face))
;; remove font-lock-constant-face
(remove-single-text-property
(point) (next-single-property-change
(point) 'face nil (line-end-position))
'face 'font-lock-constant-face)))
(if (< lock 0)
;; within character alternative, set symbol syntax
(put-text-property
(1- (point)) (point) 'syntax-table '(3))
;; start new character alternative
(put-text-property from (1- (point)) 'regexp-lock lock)
(setq from (1- (point)))
(setq lock (- lock))
(font-lock-prepend-text-property
(match-beginning 9) (match-end 9)
'face 'font-lock-regexp-grouping-construct)
(when (looking-at "\\(?:\\\\?\\^\\)?\\\\?\\(\\]\\)")
;; non-special right bracket, set symbol syntax
(put-text-property
(match-beginning 1) (match-end 1) 'syntax-table '(3))
(goto-char (match-end 1)))))
((match-beginning 10) ; ]
(if (> lock 0)
;; not within character alternative, warn
(font-lock-prepend-text-property
(match-beginning 10) (match-end 10)
'face 'font-lock-warning-face)
;; terminate alternative
(font-lock-prepend-text-property
(match-beginning 10) (match-end 10)
'face 'font-lock-regexp-grouping-construct)
(put-text-property from (point) 'regexp-lock lock)
(setq from (point))
(setq lock (- lock))))
((or (match-beginning 11)
(match-beginning 12)
(match-beginning 13)) ; (;), set symbol syntax
(put-text-property (1- (point)) (point) 'syntax-table '(3)))
((match-beginning 14) ; `..', remove constant face property
(remove-single-text-property
(match-beginning 0) (match-end 0)
'face 'font-lock-constant-face))))))
;; no lock
(while (re-search-forward "\\(\"\\)\
\\|(\\(re-search-\\(?:for\\|back\\)ward\\|looking-\\(?:at\\|back\\)\\|string-match\\|replace-regexp-in-string\\)\\>\
\\|(\\(\\(?:map\\)?concat\\)\\>\
\\|(\\(message\\|error\\|skip-\\(?:syntax\\|chars\\)-\\(?:for\\|back\\)ward\\|search-\\(?:for\\|back\\)ward\\)\\>"
bound 'bound)
(setq face (get-text-property
(or (match-end 1) (match-beginning 0)) 'face))
(cond
((match-beginning 1)
;; double-quote, search for `regexp-lock-regexp-string'
(cond
((and (regexp-lock-string-face-p face)
(save-excursion
(condition-case nil
(progn
(setq from (match-beginning 1))
(goto-char from)
(forward-sexp)
(setq to (point)))
(error nil))))
(if (re-search-forward regexp-lock-regexp-string to t)
;; plain string matching `regexp-lock-regexp-string'
(progn
(setq lock 1)
(goto-char (1+ from))
(throw 'lock nil))
;; plain string that does not match, skip
(goto-char (min to bound))))
((and (or (and (listp face) (memq 'font-lock-doc-face face))
(eq 'font-lock-doc-face face))
(save-excursion
(condition-case nil
(progn
(goto-char (match-beginning 1))
(forward-sexp)
(setq to (point)))
(error nil))))
;; doc-string, skip
(goto-char (min to bound)))))
((match-beginning 2)
;; re-search- / looking- / string-match / replace-regexp-in-string
(unless (regexp-lock-syntactic-face-p face)
(setq from (match-end 2))
(setq lock 0)
(throw 'lock nil)))
((match-beginning 3)
;; concat / mapconcat, search arguments for
;; `regexp-lock-regexp-string'
(if (and (not (regexp-lock-syntactic-face-p face))
(save-excursion
(condition-case nil
(progn
(setq from (match-beginning 0))
(goto-char from)
(forward-sexp)
(setq to (point)))
(error nil)))
(goto-char from)
(re-search-forward
(concat regexp-lock-regexp-string
"\\|regexp-opt") to 'to))
(progn
(setq lock 2)
(goto-char (1+ from))
(throw 'lock nil))
(goto-char (min (point) bound))))
((match-beginning 4)
;; message / error / search- / skip-syntax- / skip-chars-, skip
(if (and (not (regexp-lock-syntactic-face-p face))
(save-excursion
(condition-case nil
(progn
(goto-char (match-beginning 0))
(forward-sexp)
(setq to (point)))
(error nil))))
(goto-char (min to bound))
(goto-char (min (point) bound)))))))))
(when lock (put-text-property from bound 'regexp-lock lock))))
;; _____________________________________________________________________________
;;
;;; Overlays
;; _____________________________________________________________________________
;;
(defun regexp-lock-show ()
"Display numbers of regular expression groups.
Groups considered are subexpressions enclosed by escaped parentheses
`\\(' and `\\)'. Shy groups are not counted. Group numbers overlay one
or both backslashes of any `\\(' and `\\)' of the same regexp with the
number of the group. Overlays are highlighted whenever `point' is
before the left or after the right parenthesis of an `\\(' or `\\)'.
Hence the group enclosed by `\1(...\1)', for example, represents the
subexpression matching `(match-string 1)'. Overlays are also shown when
`point' is before a double-quote beginning, or after a double-quote
terminating a string that is part of the regular expression.
Group numbers are displayed whenever Emacs becomes idle after a delay of
`regexp-lock-show-delay' seconds. Group numbers are highlighted with
`regexp-lock-group' face."
(when regexp-lock-overlays
(dolist (overlay regexp-lock-overlays)
(delete-overlay overlay))
(setq regexp-lock-overlays nil))
(when (and regexp-lock-mode
(not (eq (selected-window) regexp-lock-match-window))
(or (and (< 2 (point)) ; \\^(
(< (point) (point-max))
(char-equal (char-after) ?\( )
(get-text-property (1- (point)) 'regexp-lock)
(> (get-text-property (1- (point)) 'regexp-lock) 0)
(char-equal (char-before) ?\\ )
(char-equal (char-before (1- (point))) ?\\ ))
(and (< 3 (point)) ; \\)^
(char-equal (char-before) ?\) )
(get-text-property (1- (point)) 'regexp-lock)
(> (get-text-property (1- (point)) 'regexp-lock) 0)
(char-equal (char-before (1- (point))) ?\\ )
(char-equal (char-before (- (point) 2)) ?\\ ))
(and (< (point) (point-max)) ; ^"
(char-equal (char-after) ?\" )
(get-text-property (point) 'regexp-lock)
(regexp-lock-string-face-p
(get-text-property (point) 'face))
(or (= (point) (point-min))
(not (regexp-lock-string-face-p
(get-text-property (1- (point)) 'face)))))
(and (< 3 (point)) ; "^
(char-equal (char-before) ?\" )
(get-text-property (1- (point)) 'regexp-lock)
(regexp-lock-string-face-p
(get-text-property (1- (point)) 'face))
(or (= (point) (point-max))
(not (regexp-lock-string-face-p
(get-text-property (point) 'face)))))))
(save-match-data
(save-excursion
(let* ((at (point)) (groups nil) (number 0) (total 0)
(from at) (to at)
(parse-sexp-ignore-comments t))
;; search beginning and end, tedious
(while (and (> from (point-min))
(get-text-property (1- from) 'regexp-lock)
(not (zerop (get-text-property (1- from) 'regexp-lock)))
(setq from (previous-single-property-change
(point) 'regexp-lock nil (point-min)))
(goto-char from)))
(goto-char at)
(while (and (< to (point-max))
(get-text-property to 'regexp-lock)
(setq to (next-single-property-change
(point) 'regexp-lock nil (point-max)))
(goto-char to)))
;; make overlay for group zero
(let ((overlay (make-overlay from to)))
(overlay-put overlay 'face 'regexp-lock-regexp)
(overlay-put overlay 'window (selected-window))
(overlay-put overlay 'cursor t)
(overlay-put overlay 'priority regexp-lock-show-priority)
(setq regexp-lock-overlays (cons overlay regexp-lock-overlays)))
;; using a fixed-size vector here would avoid consing but
;; introduce an upper limit on the number of groupings
(goto-char from)
(while (re-search-forward "\\(?:\\\\\\\\\\)\\(?:\\(?:\\\\\\\\\\)\\|\\((\\(\\?:\\)?\\)\\|\\()\\)\\)\\|\\(regexp-opt\\)" to t)
(cond
((and (match-beginning 4) ; (regexp-opt ...)
(not (regexp-lock-syntactic-face-p (match-beginning 4))))
(save-match-data
(let (at-too) ; Re-search from here.
(when (save-excursion
(goto-char (match-end 4))
(condition-case nil
(progn
(forward-sexp)
(forward-comment (buffer-size))
(setq at-too (point))
;; Anything but `nil' and `()' counts as non-nil.
(when (looking-at "\\(?:nil\\|()\\)")
(goto-char (match-end 0))
(forward-comment (buffer-size)))
(and (looking-at "[^)]")))
(error nil)))
(setq total (1+ total)))
(when at-too (goto-char at-too)))))
((or (not (regexp-lock-string-face-p
(get-text-property (1- (point)) 'face)))
(< (get-text-property (1- (point)) 'regexp-lock) 0)))
((match-beginning 2) ; \\(?:
(setq groups (cons 0 groups)))
((match-beginning 1) ; \\(
(setq number (1+ total))
(setq total (1+ total))
(let* ((number-string (number-to-string number))
(length (min (length number-string) 2))
(overlay (make-overlay
(- (match-beginning 1) length)
(match-beginning 1))))
(overlay-put overlay 'display
(propertize number-string 'face 'regexp-lock-group))
(overlay-put overlay 'window (selected-window))
(overlay-put overlay 'cursor t)
(overlay-put overlay 'priority regexp-lock-show-priority)
(setq regexp-lock-overlays (cons overlay regexp-lock-overlays)))
(setq groups (cons number groups)))
((match-beginning 3) ; \\)
(cond
(groups
(setq number (car groups))
(unless (zerop number)
(let* ((number-string (number-to-string number))
(length (min (length number-string) 2))
(overlay (make-overlay
(- (match-beginning 3) length)
(match-beginning 3))))
(overlay-put overlay 'display
(propertize
number-string 'face 'regexp-lock-group))
(overlay-put overlay 'window (selected-window))
(overlay-put overlay 'cursor t)
(overlay-put overlay 'priority regexp-lock-show-priority)
(setq regexp-lock-overlays
(cons overlay regexp-lock-overlays))))
(setq groups (cdr groups)))
(t ; no open group, warn
(let ((overlay (make-overlay (1- (match-end 3)) (match-end 3))))
(overlay-put overlay 'face font-lock-warning-face)
(overlay-put overlay 'window (selected-window))
(overlay-put overlay 'priority regexp-lock-show-priority)
(setq regexp-lock-overlays
(cons overlay regexp-lock-overlays))))))))
(when groups
;; unclosed group, warn
(let ((overlay (make-overlay (1- to) to)))
(overlay-put overlay 'face font-lock-warning-face)
(overlay-put overlay 'window (selected-window))
(overlay-put overlay 'priority regexp-lock-show-priority)
(setq regexp-lock-overlays
(cons overlay regexp-lock-overlays)))))))))
;; _____________________________________________________________________________
;;
;;; Matching
;; _____________________________________________________________________________
;;
(defun regexp-lock-match-pre-command ()
"Remove match overlays."
(when regexp-lock-match-overlays
(dolist (overlay regexp-lock-match-overlays)
(delete-overlay overlay))
(setq regexp-lock-match-overlays nil))
;; remove ourselves from pre-command-hook
(remove-hook 'pre-command-hook 'regexp-lock-match-pre-command))
(defun regexp-lock-match (direction)
"Highlight expressions matching current regexp."
(interactive)
(unless (and regexp-lock-match-regexp
(memq last-command
'(regexp-lock-match-next regexp-lock-match-prev)))
(if (or (and (< (point) (point-max))
(get-text-property (point) 'regexp-lock))
(and (> (point) (point-min))
(get-text-property (1- (point)) 'regexp-lock)))
(save-match-data
(save-excursion
(let* ((at (point)) (from at) (to at)
(parse-sexp-ignore-comments t))
;; search beginning and end, tedious
(while (and (> from (point-min))
(get-text-property (1- from) 'regexp-lock)
(not (zerop (get-text-property
(1- from) 'regexp-lock)))
(setq from (previous-single-property-change
(point) 'regexp-lock nil (point-min)))
(goto-char from)))
(goto-char at)
(while (and (< to (point-max))
(get-text-property to 'regexp-lock)
(setq to (next-single-property-change
(point) 'regexp-lock nil (point-max)))
(goto-char to)))
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
(setq regexp-lock-match-regexp
(condition-case var
(eval (read (current-buffer)))
;; display signal information
(error (message "%s" var) nil)))))))
(message "No regexp around point")))
(when regexp-lock-match-regexp
(if (and regexp-lock-match-window
(window-live-p regexp-lock-match-window)
(not (eq regexp-lock-match-window (selected-window))))
;; remember buffer
(setq regexp-lock-match-buffer (window-buffer regexp-lock-match-window))
;; unless regexp-lock-match-window is a live window different from
;; the selected one, split the selected window and make the newly
;; created one the new regexp-lock-match-window
(setq regexp-lock-match-window (split-window))
(if (and (not (eq (window-buffer regexp-lock-match-window)
regexp-lock-match-buffer))
(buffer-live-p regexp-lock-match-buffer))
(progn
;; when regexp-lock-match-buffer is a live buffer assert
;; that it is displayed in regexp-lock-match-window (make
;; sure we're not affected by Stefan's `set-window-buffer'
;; fix).
(set-window-buffer
regexp-lock-match-window regexp-lock-match-buffer)
(when (eq regexp-lock-match-window (selected-window))
(set-buffer regexp-lock-match-buffer)))
;; remember buffer
(setq regexp-lock-match-buffer
(window-buffer regexp-lock-match-window))))
(save-match-data
(save-excursion
(with-selected-window regexp-lock-match-window
;; handle direction changes in an intuitive way
(cond
((and (eq last-command 'regexp-lock-match-next)
(< direction 0)
(eq (marker-buffer regexp-lock-match-from)
regexp-lock-match-buffer))
;; use from marker
(goto-char regexp-lock-match-from))
((and (eq last-command 'regexp-lock-match-prev)
(> direction 0)
(eq (marker-buffer regexp-lock-match-to)
regexp-lock-match-buffer))
;; use to marker
(goto-char regexp-lock-match-to)))
(let ((at (point))
bound first)
(catch 'empty
(while (if (< direction 0)
(re-search-backward regexp-lock-match-regexp bound t)
(re-search-forward regexp-lock-match-regexp bound t))
(if (= (match-beginning 0) (match-end 0))
(progn
(message "Empty match ...")
(sit-for 1)
(throw 'empty nil))
(let ((overlay (make-overlay
(match-beginning 0) (match-end 0)))
(matches (cddr (match-data)))
(index 1))
(setq regexp-lock-match-overlays
(cons overlay regexp-lock-match-overlays))
(overlay-put overlay 'face
(if first
'regexp-lock-match-other
'regexp-lock-match))
(overlay-put overlay 'window regexp-lock-match-window)
(unless first
(setq first (point))
(set-marker regexp-lock-match-from (match-beginning 0))
(set-marker regexp-lock-match-to (match-end 0))
(setq bound
(save-excursion
(vertical-motion
(if (< direction 0)
(- (window-height))
(window-height)))
(setq bound (point))))
;; set pre-command-hook to remove match overlays eventually
(add-hook 'pre-command-hook 'regexp-lock-match-pre-command)
(while matches
(cond
((eq (car matches) nil)
(setq index (1+ index))
(setq matches (cddr matches)))
((integer-or-marker-p (car matches))
(setq overlay
(make-overlay (car matches) (cadr matches)))
(overlay-put
overlay 'before-string
(propertize (concat regexp-lock-match-before-group
(number-to-string index))
'face 'regexp-lock-match-group))
(overlay-put overlay 'priority index)
(overlay-put overlay 'window regexp-lock-match-window)
(setq regexp-lock-match-overlays
(cons overlay regexp-lock-match-overlays))
(overlay-put
overlay 'after-string
(propertize (concat (number-to-string index)
regexp-lock-match-after-group)
'face 'regexp-lock-match-group))
(overlay-put overlay 'priority index)
(overlay-put overlay 'window regexp-lock-match-window)
(setq regexp-lock-match-overlays
(cons overlay regexp-lock-match-overlays))
(setq index (1+ index))
(setq matches (cddr matches)))
(t (setq matches nil))))))))
(let ((to (or (and first regexp-lock-match-from) at)))
(save-excursion
(goto-char to)
(vertical-motion (- (window-height)))
(while (re-search-forward regexp-lock-match-regexp to t)
(cond
((= (match-beginning 0) (match-end 0))
(message "Empty match ...")
(sit-for 1)
(throw 'empty nil))
(t
(let ((overlay (make-overlay
(match-beginning 0) (match-end 0))))
(setq regexp-lock-match-overlays
(cons overlay regexp-lock-match-overlays))
(overlay-put overlay 'face 'regexp-lock-match-other)
(overlay-put
overlay 'window regexp-lock-match-window)))))
(goto-char (or (and first regexp-lock-match-to) to))
(setq to (save-excursion
(vertical-motion (window-height))
(point)))
(while (re-search-forward regexp-lock-match-regexp to t)
(cond
((= (match-beginning 0) (match-end 0))
(message "Empty match ...")
(sit-for 1)
(throw 'empty nil))
(t
(let ((overlay (make-overlay
(match-beginning 0) (match-end 0))))
(setq regexp-lock-match-overlays
(cons overlay regexp-lock-match-overlays))
(overlay-put overlay 'face 'regexp-lock-match-other)
(overlay-put
overlay 'window regexp-lock-match-window))))))))
(if first
(progn
(goto-char first)
(unless (pos-visible-in-window-p)
(if (< direction 0)
(recenter -3)
(recenter 3))))
(goto-char at)
(set-marker regexp-lock-match-from nil)
(set-marker regexp-lock-match-to nil)
(message "No (more) matches ...")
(sit-for 1))))))))
(defun regexp-lock-match-next ()
"Move to next matching expression."
(interactive)
(if (memq last-command '(regexp-lock-match-next regexp-lock-match-prev))
(regexp-lock-match 1)
(regexp-lock-match 0)))
(defun regexp-lock-match-prev ()
"Move to previous matching expression."
(interactive)
(regexp-lock-match -1))
;; _____________________________________________________________________________
;;
;;; Increment / Decrement group numbers
;; _____________________________________________________________________________
;;
(defun regexp-lock-increment (above increment start end)
"In-/Decrement group numbers within region.
Within region add INCREMENT to all arguments of `match-beginning',
`match-end', and `match-string' greater or equal ABOVE."
(interactive "nIn-/Decrement group numbers >=: \nnBy: \nr")
(save-excursion
(goto-char start)
(let ((count 0))
(while (re-search-forward
;; Added `replace-match' on 2009-08-04.
"\\((match-\\(?:beginning\\|end\\|string\\(?:-no-properties\\)?\\)[ \t\n\f]+\\([0-9]+\\))\\)\
\\|\\((replace-match\\)"
end t)
(cond
((match-beginning 1)
(let ((number (string-to-number (match-string 2))))
(when (>= number above)
(replace-match
(number-to-string (+ number increment)) nil nil nil 2)
(setq count (1+ count)))))
((match-beginning 3)
;; `replace-match' is hairy because the SUBEXP arg is optional.
(condition-case nil
(progn
(forward-sexp 4)
(forward-comment (buffer-size))
(when (looking-at "[0-9]+")
(let ((number (string-to-number (match-string 0))))
(when (>= number above)
(replace-match
(number-to-string (+ number increment)))
(setq count (1+ count))))))
(error nil)))))
(if (zerop count)
(message "No substitutions performed")
(message "%s substitution(s) performed" count)))))
(provide 'regexp-lock)
;;; regexp-lock.el ends here
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-10-01 15:00 ` martin rudalics
@ 2021-10-02 9:01 ` Lars Ingebrigtsen
2021-10-04 8:26 ` martin rudalics
0 siblings, 1 reply; 23+ messages in thread
From: Lars Ingebrigtsen @ 2021-10-02 9:01 UTC (permalink / raw)
To: martin rudalics; +Cc: ndame, 50766
martin rudalics <rudalics@gmx.at> writes:
> With 'blink-matching-paren' on do C-M-% and type [)]. People who use
> 'blink-matching-paren' do not type complex regexps.
We do indeed -- we just live with the bogus warnings from Emacs.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-10-02 9:01 ` Lars Ingebrigtsen
@ 2021-10-04 8:26 ` martin rudalics
2021-10-07 9:07 ` martin rudalics
0 siblings, 1 reply; 23+ messages in thread
From: martin rudalics @ 2021-10-04 8:26 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: ndame, 50766
>> With 'blink-matching-paren' on do C-M-% and type [)]. People who use
>> 'blink-matching-paren' do not type complex regexps.
>
> We do indeed -- we just live with the bogus warnings from Emacs.
So a fix for both has to hook into post-self-insert and after-change.
Which means I have to prime these before-change to avoid parsing the
buffer twice. Darn it!
martin
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-10-04 8:26 ` martin rudalics
@ 2021-10-07 9:07 ` martin rudalics
2022-08-26 12:50 ` Lars Ingebrigtsen
0 siblings, 1 reply; 23+ messages in thread
From: martin rudalics @ 2021-10-07 9:07 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: ndame, 50766
[-- Attachment #1: Type: text/plain, Size: 267 bytes --]
> Which means I have to prime these before-change to avoid parsing the
> buffer twice. Darn it!
> So a fix for both has to hook into post-self-insert and after-change.
I attach a preliminary patch that should work for both. Please give it
some testing.
martin
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: minibuffer.el.diff --]
[-- Type: text/x-patch; name="minibuffer.el.diff", Size: 8123 bytes --]
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 1e1a6f852e..fed08c9018 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -4242,6 +4242,170 @@ format-prompt
default)))
": "))
+(defvar minibuffer-regexp-mode)
+
+(defun minibuffer--regexp-propertize ()
+ "In current minibuffer propertize parens and slashes in regexps.
+Put punctuation `syntax-table' property on selected paren and
+backslash characters in current buffer to make `show-paren-mode'
+and `blink-matching-paren' more user-friendly."
+ (let (in-char-alt-p)
+ (save-excursion
+ (with-silent-modifications
+ (remove-text-properties (point-min) (point-max) '(syntax-table nil))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "\\(\\\\\\\\\\)\\|\\(?:\\(?:\\\\\\)\\(?:\\([(){}]\\)\\|\\(\\[\\)\\|\\(\\]\\)\\)\\)\
+\\|\\(\\[:[a-zA-Z]+:\\]\\)\\|\\(\\[\\)\\|\\(\\]\\)\\|\\([(){}]\\)"
+ (point-max) 'noerror)
+ (cond
+ ((match-beginning 1)) ; \\, skip
+ ((match-beginning 2) ; \( \) \{ \}
+ (if in-char-alt-p
+ ;; Within character alternative, set symbol syntax for
+ ;; paren only.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3))
+ ;; Not within character alternative, set symbol syntax for
+ ;; backslash only.
+ (put-text-property (- (point) 2) (1- (point)) 'syntax-table '(3))))
+ ((match-beginning 3) ; \[
+ (if in-char-alt-p
+ (progn
+ ;; Set symbol syntax for backslash.
+ (put-text-property (- (point) 2) (1- (point)) 'syntax-table '(3))
+ ;; Re-read bracket we might be before a character class.
+ (backward-char))
+ ;; Set symbol syntax for bracket.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3))))
+ ((match-beginning 4) ; \]
+ (if in-char-alt-p
+ (progn
+ ;; Within character alternative, set symbol syntax for
+ ;; backslash, exit alternative.
+ (put-text-property (- (point) 2) (1- (point)) 'syntax-table '(3))
+ (setq in-char-alt-p nil))
+ ;; Not within character alternative, set symbol syntax for
+ ;; bracket.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3))))
+ ((match-beginning 5)) ; POSIX character class, skip
+ ((match-beginning 6) ; [
+ (if in-char-alt-p
+ ;; Within character alternative, set symbol syntax.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3))
+ ;; Start new character alternative.
+ (setq in-char-alt-p t)
+ ;; Looking for immediately following non-closing ].
+ (when (looking-at "\\^?\\]")
+ ;; Non-special right bracket, set symbol syntax.
+ (goto-char (match-end 0))
+ (put-text-property (1- (point)) (point) 'syntax-table '(3)))))
+ ((match-beginning 7) ; ]
+ (if in-char-alt-p
+ (setq in-char-alt-p nil)
+ ;; The only warning we can emit before RET.
+ (message "Not in character alternative")))
+ ((match-beginning 8) ; (){}
+ ;; Plain parenthesis or brace, set symbol syntax.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3)))))))))
+
+;; The following variable is set by 'minibuffer--regexp-before-change'.
+;; If non-nil, either 'minibuffer--regexp-post-self-insert' or
+;; 'minibuffer--regexp-after-change', whichever comes next, will
+;; propertize the minibuffer via 'minibuffer--regexp-propertize' and
+;; reset this variable to nil, avoiding to propertize the buffer twice.
+(defvar-local minibuffer--regexp-primed nil
+ "Non-nil when minibuffer contents change.")
+
+(defun minibuffer--regexp-before-change (_a _b)
+ "`minibuffer-regexp-mode' function on `before-change-functions'."
+ (setq minibuffer--regexp-primed t))
+
+(defun minibuffer--regexp-after-change (_a _b _c)
+ "`minibuffer-regexp-mode' function on `after-change-functions'."
+ (when minibuffer--regexp-primed
+ (setq minibuffer--regexp-primed nil)
+ (minibuffer--regexp-propertize)))
+
+(defun minibuffer--regexp-post-self-insert ()
+ "`minibuffer-regexp-mode' function on `post-self-insert-hook'."
+ (when minibuffer--regexp-primed
+ (setq minibuffer--regexp-primed nil)
+ (minibuffer--regexp-propertize)))
+
+(defvar minibuffer--regexp-prompt-regexp
+ "\\(?:Posix search\\|RE search\\|Search for regexp\\|Query replace regexp\\)"
+ "Regular expression compiled from `minibuffer-regexp-prompts'.")
+
+(defcustom minibuffer-regexp-prompts
+ '("Posix search" "RE search" "Search for regexp" "Query replace regexp")
+ "List of minibuffer prompts that trigger `minibuffer-regexp-mode'.
+`minibuffer-regexp-mode' is activated in a specific minibuffer
+interaction if and only if a prompt in this list appears at the
+beginning of the minibuffer."
+ :type '(repeat (string :tag "Prompt"))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when val
+ (setq minibuffer--regexp-prompt-regexp
+ (concat "\\(?:" (mapconcat 'regexp-quote val "\\|") "\\)"))))
+ :version "29.1")
+
+(defun minibuffer--regexp-setup ()
+ "Function to activate`minibuffer-regexp-mode' in current buffer.
+Run by `minibuffer-setup-hook'."
+ (if (and minibuffer-regexp-mode
+ (save-excursion
+ (goto-char (point-min))
+ (looking-at minibuffer--regexp-prompt-regexp)))
+ (progn
+ (setq-local parse-sexp-lookup-properties t)
+ (add-hook 'before-change-functions #'minibuffer--regexp-before-change nil t)
+ (add-hook 'after-change-functions #'minibuffer--regexp-after-change nil t)
+ (add-hook 'post-self-insert-hook #'minibuffer--regexp-post-self-insert nil t))
+ ;; Make sure.
+ (minibuffer--regexp-exit)))
+
+(defun minibuffer--regexp-exit ()
+ "Function to deactivate `minibuffer-regexp-mode' in current buffer.
+Run by `minibuffer-exit-hook'."
+ (with-silent-modifications
+ (remove-text-properties (point-min) (point-max) '(syntax-table nil)))
+ (setq-local parse-sexp-lookup-properties nil)
+ (remove-hook 'before-change-functions #'minibuffer--regexp-before-change t)
+ (remove-hook 'after-change-functions #'minibuffer--regexp-after-change t)
+ (remove-hook 'post-self-insert-hook #'minibuffer--regexp-post-self-insert t))
+
+(define-minor-mode minibuffer-regexp-mode
+ "Minor mode for editing regular expressions in the minibuffer.
+Highlight parens via `show-paren-mode' and `blink-matching-paren'
+in a user-friendly way, avoid reporting alleged paren mismatches
+and make sexp navigation more intuitive.
+
+The list of prompts activating this mode in specific minibuffer
+interactions is customizable via `minibuffer-regexp-prompts'."
+ :global t
+ :initialize 'custom-initialize-delay
+ :init-value t
+ (if minibuffer-regexp-mode
+ (progn
+ (add-hook 'minibuffer-setup-hook #'minibuffer--regexp-setup)
+ (add-hook 'minibuffer-exit-hook #'minibuffer--regexp-exit))
+ ;; Clean up - why is Vminibuffer_list not available in Lisp?
+ (dolist (buffer (buffer-list))
+ (when (and (minibufferp)
+ parse-sexp-lookup-properties
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ (looking-at minibuffer--regexp-prompt-regexp))))
+ (with-current-buffer buffer
+ (with-silent-modifications
+ (remove-text-properties
+ (point-min) (point-max) '(syntax-table nil)))
+ (setq-local parse-sexp-lookup-properties t))))
+ (remove-hook 'minibuffer-setup-hook #'minibuffer--regexp-setup)
+ (remove-hook 'minibuffer-exit-hook #'minibuffer--regexp-exit)))
+
(provide 'minibuffer)
;;; minibuffer.el ends here
^ permalink raw reply related [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2021-10-07 9:07 ` martin rudalics
@ 2022-08-26 12:50 ` Lars Ingebrigtsen
2022-09-10 6:14 ` Lars Ingebrigtsen
0 siblings, 1 reply; 23+ messages in thread
From: Lars Ingebrigtsen @ 2022-08-26 12:50 UTC (permalink / raw)
To: martin rudalics; +Cc: ndame, 50766
martin rudalics <rudalics@gmx.at> writes:
> I attach a preliminary patch that should work for both. Please give it
> some testing.
Sorry, missed this.
I've tried this a bit now, and it seems to work well for me.
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2022-08-26 12:50 ` Lars Ingebrigtsen
@ 2022-09-10 6:14 ` Lars Ingebrigtsen
2023-09-03 8:37 ` Stefan Kangas
0 siblings, 1 reply; 23+ messages in thread
From: Lars Ingebrigtsen @ 2022-09-10 6:14 UTC (permalink / raw)
To: martin rudalics; +Cc: ndame, 50766
Lars Ingebrigtsen <larsi@gnus.org> writes:
>> I attach a preliminary patch that should work for both. Please give it
>> some testing.
>
> Sorry, missed this.
>
> I've tried this a bit now, and it seems to work well for me.
Is there anything further that should be done with this patch before
pushing to Emacs 29?
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2022-09-10 6:14 ` Lars Ingebrigtsen
@ 2023-09-03 8:37 ` Stefan Kangas
2023-09-04 7:45 ` martin rudalics
0 siblings, 1 reply; 23+ messages in thread
From: Stefan Kangas @ 2023-09-03 8:37 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: martin rudalics, 50766, ndame
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Lars Ingebrigtsen <larsi@gnus.org> writes:
>
>>> I attach a preliminary patch that should work for both. Please give it
>>> some testing.
>>
>> Sorry, missed this.
>>
>> I've tried this a bit now, and it seems to work well for me.
>
> Is there anything further that should be done with this patch before
> pushing to Emacs 29?
Ping. Martin, could we install this patch?
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2023-09-03 8:37 ` Stefan Kangas
@ 2023-09-04 7:45 ` martin rudalics
2023-09-05 22:52 ` Stefan Kangas
0 siblings, 1 reply; 23+ messages in thread
From: martin rudalics @ 2023-09-04 7:45 UTC (permalink / raw)
To: Stefan Kangas, Lars Ingebrigtsen; +Cc: ndame, 50766
>>>> I attach a preliminary patch that should work for both. Please give it
>>>> some testing.
>>>
>>> Sorry, missed this.
>>>
>>> I've tried this a bit now, and it seems to work well for me.
>>
>> Is there anything further that should be done with this patch before
>> pushing to Emacs 29?
Sorry, I must have missed that earlier message by Lars.
> Ping. Martin, could we install this patch?
If it still applies, you have tried it and think it's desirable, I can
write ChangeLog and NEWS entries.
Thanks, martin
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2023-09-04 7:45 ` martin rudalics
@ 2023-09-05 22:52 ` Stefan Kangas
2023-09-06 8:09 ` martin rudalics
0 siblings, 1 reply; 23+ messages in thread
From: Stefan Kangas @ 2023-09-05 22:52 UTC (permalink / raw)
To: martin rudalics, Lars Ingebrigtsen; +Cc: ndame, 50766
martin rudalics <rudalics@gmx.at> writes:
> >> Is there anything further that should be done with this patch before
> >> pushing to Emacs 29?
>
> Sorry, I must have missed that earlier message by Lars.
No worries.
> > Ping. Martin, could we install this patch?
>
> If it still applies, you have tried it and think it's desirable, I can
> write ChangeLog and NEWS entries.
It still applies, and it works here. Please go ahead.
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2023-09-05 22:52 ` Stefan Kangas
@ 2023-09-06 8:09 ` martin rudalics
2023-09-07 8:57 ` Eli Zaretskii
0 siblings, 1 reply; 23+ messages in thread
From: martin rudalics @ 2023-09-06 8:09 UTC (permalink / raw)
To: Stefan Kangas, Lars Ingebrigtsen; +Cc: ndame, 50766
[-- Attachment #1: Type: text/plain, Size: 470 bytes --]
>> If it still applies, you have tried it and think it's desirable, I can
>> write ChangeLog and NEWS entries.
>
> It still applies, and it works here. Please go ahead.
It did not apply to current master. I now built master for the first
time this year, rewrote the patch so it applies and added a short text
to the Elisp manual. I also enclose a NEWS and a ChangeLog entry.
Please tell me if something is missing and install however you see fit.
Thanks, martin
[-- Attachment #2: minibuffer.el.diff --]
[-- Type: text/x-patch, Size: 9181 bytes --]
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 8ff5c14055e..0b877a25e68 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2877,3 +2877,21 @@ Minibuffer Misc
keymap @code{minibuffer-inactive-mode-map}. This can be useful
if the minibuffer is in a separate frame. @xref{Minibuffers and Frames}.
@end deffn
+
+@deffn Command minibuffer-regexp-mode
+This is a minor mode for editing regular expressions in the minibuffer.
+It highlight parens via @code{show-paren-mode} and
+@code{blink-matching-paren} in a user-friendly way, avoids reporting
+alleged paren mismatches and makes sexp navigation more intuitive.
+
+The list of prompts activating this mode in specific minibuffer
+interactions is customizable via @code{minibuffer-regexp-prompts}, see
+below.
+@end deffn
+
+@defopt minibuffer-regexp-prompts
+List of minibuffer prompts that trigger @code{minibuffer-regexp-mode}.
+@code{minibuffer-regexp-mode} is activated in a specific minibuffer
+interaction if and only if a prompt in this list appears at the
+beginning of the minibuffer.
+@end defopt
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 52a286018a1..d43201eb36d 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -4663,6 +4663,170 @@ minibuffer-exit-on-screen-keyboard
(add-hook 'minibuffer-setup-hook #'minibuffer-setup-on-screen-keyboard)
(add-hook 'minibuffer-exit-hook #'minibuffer-exit-on-screen-keyboard)
+(defvar minibuffer-regexp-mode)
+
+(defun minibuffer--regexp-propertize ()
+ "In current minibuffer propertize parens and slashes in regexps.
+Put punctuation `syntax-table' property on selected paren and
+backslash characters in current buffer to make `show-paren-mode'
+and `blink-matching-paren' more user-friendly."
+ (let (in-char-alt-p)
+ (save-excursion
+ (with-silent-modifications
+ (remove-text-properties (point-min) (point-max) '(syntax-table nil))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "\\(\\\\\\\\\\)\\|\\(?:\\(?:\\\\\\)\\(?:\\([(){}]\\)\\|\\(\\[\\)\\|\\(\\]\\)\\)\\)\
+\\|\\(\\[:[a-zA-Z]+:\\]\\)\\|\\(\\[\\)\\|\\(\\]\\)\\|\\([(){}]\\)"
+ (point-max) 'noerror)
+ (cond
+ ((match-beginning 1)) ; \\, skip
+ ((match-beginning 2) ; \( \) \{ \}
+ (if in-char-alt-p
+ ;; Within character alternative, set symbol syntax for
+ ;; paren only.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3))
+ ;; Not within character alternative, set symbol syntax for
+ ;; backslash only.
+ (put-text-property (- (point) 2) (1- (point)) 'syntax-table '(3))))
+ ((match-beginning 3) ; \[
+ (if in-char-alt-p
+ (progn
+ ;; Set symbol syntax for backslash.
+ (put-text-property (- (point) 2) (1- (point)) 'syntax-table '(3))
+ ;; Re-read bracket we might be before a character class.
+ (backward-char))
+ ;; Set symbol syntax for bracket.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3))))
+ ((match-beginning 4) ; \]
+ (if in-char-alt-p
+ (progn
+ ;; Within character alternative, set symbol syntax for
+ ;; backslash, exit alternative.
+ (put-text-property (- (point) 2) (1- (point)) 'syntax-table '(3))
+ (setq in-char-alt-p nil))
+ ;; Not within character alternative, set symbol syntax for
+ ;; bracket.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3))))
+ ((match-beginning 5)) ; POSIX character class, skip
+ ((match-beginning 6) ; [
+ (if in-char-alt-p
+ ;; Within character alternative, set symbol syntax.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3))
+ ;; Start new character alternative.
+ (setq in-char-alt-p t)
+ ;; Looking for immediately following non-closing ].
+ (when (looking-at "\\^?\\]")
+ ;; Non-special right bracket, set symbol syntax.
+ (goto-char (match-end 0))
+ (put-text-property (1- (point)) (point) 'syntax-table '(3)))))
+ ((match-beginning 7) ; ]
+ (if in-char-alt-p
+ (setq in-char-alt-p nil)
+ ;; The only warning we can emit before RET.
+ (message "Not in character alternative")))
+ ((match-beginning 8) ; (){}
+ ;; Plain parenthesis or brace, set symbol syntax.
+ (put-text-property (1- (point)) (point) 'syntax-table '(3)))))))))
+
+;; The following variable is set by 'minibuffer--regexp-before-change'.
+;; If non-nil, either 'minibuffer--regexp-post-self-insert' or
+;; 'minibuffer--regexp-after-change', whichever comes next, will
+;; propertize the minibuffer via 'minibuffer--regexp-propertize' and
+;; reset this variable to nil, avoiding to propertize the buffer twice.
+(defvar-local minibuffer--regexp-primed nil
+ "Non-nil when minibuffer contents change.")
+
+(defun minibuffer--regexp-before-change (_a _b)
+ "`minibuffer-regexp-mode' function on `before-change-functions'."
+ (setq minibuffer--regexp-primed t))
+
+(defun minibuffer--regexp-after-change (_a _b _c)
+ "`minibuffer-regexp-mode' function on `after-change-functions'."
+ (when minibuffer--regexp-primed
+ (setq minibuffer--regexp-primed nil)
+ (minibuffer--regexp-propertize)))
+
+(defun minibuffer--regexp-post-self-insert ()
+ "`minibuffer-regexp-mode' function on `post-self-insert-hook'."
+ (when minibuffer--regexp-primed
+ (setq minibuffer--regexp-primed nil)
+ (minibuffer--regexp-propertize)))
+
+(defvar minibuffer--regexp-prompt-regexp
+ "\\(?:Posix search\\|RE search\\|Search for regexp\\|Query replace regexp\\)"
+ "Regular expression compiled from `minibuffer-regexp-prompts'.")
+
+(defcustom minibuffer-regexp-prompts
+ '("Posix search" "RE search" "Search for regexp" "Query replace regexp")
+ "List of minibuffer prompts that trigger `minibuffer-regexp-mode'.
+`minibuffer-regexp-mode' is activated in a specific minibuffer
+interaction if and only if a prompt in this list appears at the
+beginning of the minibuffer."
+ :type '(repeat (string :tag "Prompt"))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when val
+ (setq minibuffer--regexp-prompt-regexp
+ (concat "\\(?:" (mapconcat 'regexp-quote val "\\|") "\\)"))))
+ :version "30.1")
+
+(defun minibuffer--regexp-setup ()
+ "Function to activate`minibuffer-regexp-mode' in current buffer.
+Run by `minibuffer-setup-hook'."
+ (if (and minibuffer-regexp-mode
+ (save-excursion
+ (goto-char (point-min))
+ (looking-at minibuffer--regexp-prompt-regexp)))
+ (progn
+ (setq-local parse-sexp-lookup-properties t)
+ (add-hook 'before-change-functions #'minibuffer--regexp-before-change nil t)
+ (add-hook 'after-change-functions #'minibuffer--regexp-after-change nil t)
+ (add-hook 'post-self-insert-hook #'minibuffer--regexp-post-self-insert nil t))
+ ;; Make sure.
+ (minibuffer--regexp-exit)))
+
+(defun minibuffer--regexp-exit ()
+ "Function to deactivate `minibuffer-regexp-mode' in current buffer.
+Run by `minibuffer-exit-hook'."
+ (with-silent-modifications
+ (remove-text-properties (point-min) (point-max) '(syntax-table nil)))
+ (setq-local parse-sexp-lookup-properties nil)
+ (remove-hook 'before-change-functions #'minibuffer--regexp-before-change t)
+ (remove-hook 'after-change-functions #'minibuffer--regexp-after-change t)
+ (remove-hook 'post-self-insert-hook #'minibuffer--regexp-post-self-insert t))
+
+(define-minor-mode minibuffer-regexp-mode
+ "Minor mode for editing regular expressions in the minibuffer.
+Highlight parens via `show-paren-mode' and `blink-matching-paren'
+in a user-friendly way, avoid reporting alleged paren mismatches
+and make sexp navigation more intuitive.
+
+The list of prompts activating this mode in specific minibuffer
+interactions is customizable via `minibuffer-regexp-prompts'."
+ :global t
+ :initialize 'custom-initialize-delay
+ :init-value t
+ (if minibuffer-regexp-mode
+ (progn
+ (add-hook 'minibuffer-setup-hook #'minibuffer--regexp-setup)
+ (add-hook 'minibuffer-exit-hook #'minibuffer--regexp-exit))
+ ;; Clean up - why is Vminibuffer_list not available in Lisp?
+ (dolist (buffer (buffer-list))
+ (when (and (minibufferp)
+ parse-sexp-lookup-properties
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ (looking-at minibuffer--regexp-prompt-regexp))))
+ (with-current-buffer buffer
+ (with-silent-modifications
+ (remove-text-properties
+ (point-min) (point-max) '(syntax-table nil)))
+ (setq-local parse-sexp-lookup-properties t))))
+ (remove-hook 'minibuffer-setup-hook #'minibuffer--regexp-setup)
+ (remove-hook 'minibuffer-exit-hook #'minibuffer--regexp-exit)))
+
(provide 'minibuffer)
;;; minibuffer.el ends here
[-- Attachment #3: NEWS.txt --]
[-- Type: text/plain, Size: 312 bytes --]
+++
** New global minor mode 'minibuffer-regexp-mode'.
This is a minor mode for editing regular expressions in the minibuffer.
It highlight parens via ‘show-paren-mode’ and ‘blink-matching-paren’ in
a user-friendly way, avoids reporting alleged paren mismatches and makes
sexp navigation more intuitive.
[-- Attachment #4: ChangeLog --]
[-- Type: text/plain, Size: 679 bytes --]
New minor mode 'minibuffer-regexp-mode' for editing regexps in minibuffer
This highlights parens via `show-paren-mode' and
`blink-matching-paren' in a user-friendly way, avoids reporting
alleged paren mismatches and makes sexp navigation more
intuitive.
* lisp/minibuffer.el (minibuffer-regexp-mode)
(minibuffer--regexp-primed, minibuffer--regexp-prompt-regexp):
New variables.
(minibuffer--regexp-propertize, minibuffer--regexp-primed)
(minibuffer--regexp-before-change)
(minibuffer--regexp-after-change)
(minibuffer--regexp-post-self-insert, minibuffer--regexp-setup)
(minibuffer--regexp-exit, minibuffer-regexp-mode): New functions.
(minibuffer-regexp-prompts): New option.
^ permalink raw reply related [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2023-09-06 8:09 ` martin rudalics
@ 2023-09-07 8:57 ` Eli Zaretskii
2023-09-07 9:29 ` Stefan Kangas
2023-09-07 18:12 ` martin rudalics
0 siblings, 2 replies; 23+ messages in thread
From: Eli Zaretskii @ 2023-09-07 8:57 UTC (permalink / raw)
To: martin rudalics; +Cc: laszlomail, larsi, 50766-done, stefankangas
> Cc: ndame <laszlomail@protonmail.com>, 50766@debbugs.gnu.org
> Date: Wed, 6 Sep 2023 10:09:49 +0200
> From: martin rudalics <rudalics@gmx.at>
>
> It did not apply to current master. I now built master for the first
> time this year, rewrote the patch so it applies and added a short text
> to the Elisp manual. I also enclose a NEWS and a ChangeLog entry.
> Please tell me if something is missing and install however you see fit.
Thanks, installed on master with a few minor docs changes, and closing
the bug.
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2023-09-07 8:57 ` Eli Zaretskii
@ 2023-09-07 9:29 ` Stefan Kangas
2023-09-07 18:12 ` martin rudalics
1 sibling, 0 replies; 23+ messages in thread
From: Stefan Kangas @ 2023-09-07 9:29 UTC (permalink / raw)
To: Eli Zaretskii, martin rudalics; +Cc: laszlomail, larsi, 50766-done
Eli Zaretskii <eliz@gnu.org> writes:
> Thanks, installed on master with a few minor docs changes, and closing
> the bug.
Thanks.
^ permalink raw reply [flat|nested] 23+ messages in thread
* bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted
2023-09-07 8:57 ` Eli Zaretskii
2023-09-07 9:29 ` Stefan Kangas
@ 2023-09-07 18:12 ` martin rudalics
1 sibling, 0 replies; 23+ messages in thread
From: martin rudalics @ 2023-09-07 18:12 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: laszlomail, larsi, 50766-done, stefankangas
> Thanks, installed on master with a few minor docs changes, and closing
> the bug.
Thanks for the fixes.
martin
^ permalink raw reply [flat|nested] 23+ messages in thread
end of thread, other threads:[~2023-09-07 18:12 UTC | newest]
Thread overview: 23+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-23 16:59 bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-09-23 21:15 ` Lars Ingebrigtsen
2021-09-24 8:27 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-09-25 0:54 ` Lars Ingebrigtsen
2021-09-27 13:16 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-09-28 5:25 ` Lars Ingebrigtsen
2021-09-30 16:18 ` martin rudalics
2021-10-01 7:19 ` Lars Ingebrigtsen
2021-10-01 14:28 ` ndame via Bug reports for GNU Emacs, the Swiss army knife of text editors
2021-10-01 15:00 ` martin rudalics
2021-10-01 15:00 ` martin rudalics
2021-10-02 9:01 ` Lars Ingebrigtsen
2021-10-04 8:26 ` martin rudalics
2021-10-07 9:07 ` martin rudalics
2022-08-26 12:50 ` Lars Ingebrigtsen
2022-09-10 6:14 ` Lars Ingebrigtsen
2023-09-03 8:37 ` Stefan Kangas
2023-09-04 7:45 ` martin rudalics
2023-09-05 22:52 ` Stefan Kangas
2023-09-06 8:09 ` martin rudalics
2023-09-07 8:57 ` Eli Zaretskii
2023-09-07 9:29 ` Stefan Kangas
2023-09-07 18:12 ` martin rudalics
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).