From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: martin rudalics Newsgroups: gmane.emacs.bugs Subject: bug#50766: Regexp paren pairs in query-replace-regexp prompt should be highlighted Date: Fri, 1 Oct 2021 17:00:15 +0200 Message-ID: References: <1LWmgMt-iOZcz0k2N5IVTqgDu922CLEd8GATVBsqdQfVeBzIGEaVuORC9k0SXORQDkpqc8BO3zxOPFbQeMMhNHQmOvcvIOpOpoWL8CAVUq8=@protonmail.com> <87bl4jxacl.fsf@gnus.org> <877df5tqyj.fsf@gnus.org> <87h7e5gtk0.fsf@gnus.org> <87ilyhw6si.fsf@gnus.org> <1yqlcMml0l3wVdGLY1Z2JY5i9dsiJwkc19jcWETHoeEhfraWDi2lKO8u9B3wKdVZ6wJxOF3eTe4DJd-qq-jMAJ-kiIpyMqanJNYdhmrLZ2g=@protonmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------A908D8939D78C4D46252684E" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="14698"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 50766@debbugs.gnu.org To: ndame , Lars Ingebrigtsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Oct 01 17:01:18 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mWK2I-0003Y2-Cf for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 01 Oct 2021 17:01:18 +0200 Original-Received: from localhost ([::1]:37490 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mWK2G-0004Tz-89 for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 01 Oct 2021 11:01:16 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:53696) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mWK23-0004Tp-0C for bug-gnu-emacs@gnu.org; Fri, 01 Oct 2021 11:01:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:45552) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mWK22-0004vb-P8 for bug-gnu-emacs@gnu.org; Fri, 01 Oct 2021 11:01:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mWK22-0006l5-NA for bug-gnu-emacs@gnu.org; Fri, 01 Oct 2021 11:01:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: martin rudalics Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 01 Oct 2021 15:01:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 50766 X-GNU-PR-Package: emacs Original-Received: via spool by 50766-submit@debbugs.gnu.org id=B50766.163310043225927 (code B ref 50766); Fri, 01 Oct 2021 15:01:02 +0000 Original-Received: (at 50766) by debbugs.gnu.org; 1 Oct 2021 15:00:32 +0000 Original-Received: from localhost ([127.0.0.1]:57097 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mWK1V-0006k4-PK for submit@debbugs.gnu.org; Fri, 01 Oct 2021 11:00:32 -0400 Original-Received: from mout.gmx.net ([212.227.15.19]:38971) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mWK1R-0006jp-BX for 50766@debbugs.gnu.org; Fri, 01 Oct 2021 11:00:28 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1633100417; bh=mYWjGjhUXTmKg3jQuNHj7pBdFrU8qz66BSwkiS2ZDd8=; h=X-UI-Sender-Class:Subject:To:Cc:References:From:Date:In-Reply-To; b=GUnYX5GM7899fCrPC/mWkdsgZrj6zAfagTpigtinwDfI69vVAx7bUhwTEBrkhNYMC mIhsIbrH8/iRBTMTI504VS5keQrjYlWzhVSPv1RI0u7nycmlTXxmjq5sDTKS5LFxhL QLrbjSFCFJfR460j2gfUHFfjaLyM9VA8rqs+wMaA= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Original-Received: from [192.168.1.102] ([212.95.5.169]) by mail.gmx.net (mrgmx005 [212.227.17.190]) with ESMTPSA (Nemesis) id 1MWzfv-1mL6qH2VGj-00XJn4; Fri, 01 Oct 2021 17:00:16 +0200 In-Reply-To: <1yqlcMml0l3wVdGLY1Z2JY5i9dsiJwkc19jcWETHoeEhfraWDi2lKO8u9B3wKdVZ6wJxOF3eTe4DJd-qq-jMAJ-kiIpyMqanJNYdhmrLZ2g=@protonmail.com> Content-Language: en-US X-Provags-ID: V03:K1:UcHvEc/GQ5YhHgBDdvlsbA1fSZZdnrLHZ8pbP0xsuffYyof5f+3 mkTh+2Mj24S2/b+PQqecixfyI8r1W3TfApo8sSQqf1iK9WmYGi7rY8ZVLn6395A9bLy820K cjFwPnPVP/pSeEeqkXdMq1kVD3YSD4gG1obVnQMugBVpWMbKGiDuOW2nU1dCPKIJZIqT9qu A8G4dIkcpBos/0wc+5zVA== X-UI-Out-Filterresults: notjunk:1;V03:K0:6a77ar1VKM0=:EZy8cqrdZkRJk34ie/zWDD fRuTLn8xfz2gNGYOE3Zl+XzWbDQ5Lp1FdzzUiT0UV9PRmYDRj1asrvJE2OVh9I+zc7+stEIuE adS0YoWqU5LYqoWeEKQnklkpKmKGCtJ23mQArHDbP5/K38g8H/D3zqEpfS9j2nQynRdNUIelo tRbmBnxBSm+sdWT19ab/jF7RubXJxEBNz3xlOjJcMuNe93KNqmHKfZyeKmp6IZZSzWh6+8hvr bSFp+b9h2G9tEnKC+34n8y1JMkLkjhmRJkixgY3Lyu7HFaEt5ghloscqBOPoO/I4Fydp4ubCS 5p1bKAmRGZDMZ70lT/cSgdSlyINW3K4W571oIvxCJL06Ko6uKMkm8ItgYUk9Y/V8vJcsOTsC2 OpFxD1KunIHe2H1A7EEw0qaG0HOgY9iyFHqd74//0/086c1hZzAqtFagxLlUzW3xZ0vgy72wG ZbRrTzZ7oBnT6fdizBvaE+OlIuqbKF+TDfHE8U+OUDqmC6iy9Q4kWleZ/w+D3PFE3vPcXpCq3 jepH/acwuwHDd9hfkCBGAfxB05Fs+MDZsTCausPsOzL4ZT40xusppPvSoazAdO8WKLt4x24CJ joJhNxTmV2aoD6u7eIfAqsFDjRIbxrWXKgpbB5OkRuKWOqTmdoqgwxZeWWU2IK7ji6hCmR2Wd 6xSXNnsPy9BmahtCF3JiXPgPaJv3VvxyPK54k0iQFr7qFSc+2jPS+QrkKvgQ2WOzDgg9j1Uo/ jambWphNDpQWksOgf49KU0IliLGrJLBcmFQp/Eex/ZSczTzNir06McbJfCBUd7AXa3/OOZlB X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:216054 Archived-At: This is a multi-part message in MIME format. --------------A908D8939D78C4D46252684E Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit > 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 --------------A908D8939D78C4D46252684E Content-Type: text/x-emacs-lisp; name="regexp-lock.el" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="regexp-lock.el" ;;; 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 ;; 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 --------------A908D8939D78C4D46252684E--