From: Andreas Gerler Date: Sun, 22 Dec 2024 12:16:10 +0000 (+0100) Subject: update pcre2el X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=5916a56d5303bb39bb7b2e1004734cc839891116;p=emacsconfig.git update pcre2el Signed-off-by: Andreas Gerler --- diff --git a/elpa/pcre2el-20230503.1929/pcre2el-autoloads.el b/elpa/pcre2el-20230503.1929/pcre2el-autoloads.el deleted file mode 100644 index af7563f8..00000000 --- a/elpa/pcre2el-20230503.1929/pcre2el-autoloads.el +++ /dev/null @@ -1,246 +0,0 @@ -;;; pcre2el-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "pcre2el" "pcre2el.el" (0 0 0 0)) -;;; Generated autoloads from pcre2el.el - -(defvar pcre-mode nil "\ -Non-nil if PCRE mode is enabled. -See the `pcre-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `pcre-mode'.") - -(custom-autoload 'pcre-mode "pcre2el" nil) - -(autoload 'pcre-mode "pcre2el" "\ -Use emulated PCRE syntax for regexps wherever possible. - -This is a minor mode. If called interactively, toggle the `PCRE -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='pcre-mode)'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -Advises the `interactive' specs of `read-regexp' and the -following other functions so that they read PCRE syntax and -translate to its Emacs equivalent: - -- `align-regexp' -- `find-tag-regexp' -- `sort-regexp-fields' -- `isearch-message-prefix' -- `ibuffer-do-replace-regexp' - -Also alters the behavior of `isearch-mode' when searching by regexp. - -\(fn &optional ARG)" t nil) - -(autoload 'pcre-query-replace-regexp "pcre2el" "\ -Perform `query-replace-regexp' using PCRE syntax. - -Consider using `pcre-mode' instead of this function." t nil) - -(autoload 'rxt-elisp-to-pcre "pcre2el" "\ -Translate REGEXP, a regexp in Emacs Lisp syntax, to Perl-compatible syntax. - -Interactively, reads the regexp in one of three ways. With a -prefix arg, reads from minibuffer without string escaping, like -`query-replace-regexp'. Without a prefix arg, uses the text of -the region if it is active. Otherwise, uses the result of -evaluating the sexp before point (which might be a string regexp -literal or an expression that produces a string). - -Displays the translated PCRE regexp in the echo area and copies -it to the kill ring. - -Emacs regexp features such as syntax classes which cannot be -translated to PCRE will cause an error. - -\(fn REGEXP)" t nil) - -(autoload 'rxt-elisp-to-rx "pcre2el" "\ -Translate REGEXP, a regexp in Emacs Lisp syntax, to `rx' syntax. - -See `rxt-elisp-to-pcre' for a description of the interactive -behavior and `rx' for documentation of the S-expression based -regexp syntax. - -\(fn REGEXP)" t nil) - -(autoload 'rxt-elisp-to-strings "pcre2el" "\ -Return a list of all strings matched by REGEXP, an Emacs Lisp regexp. - -See `rxt-elisp-to-pcre' for a description of the interactive behavior. - -This is useful primarily for getting back the original list of -strings from a regexp generated by `regexp-opt', but it will work -with any regexp without unbounded quantifiers (*, +, {2, } and so -on). - -Throws an error if REGEXP contains any infinite quantifiers. - -\(fn REGEXP)" t nil) - -(autoload 'rxt-toggle-elisp-rx "pcre2el" "\ -Toggle the regexp near point between Elisp string and rx syntax." t nil) - -(autoload 'rxt-pcre-to-elisp "pcre2el" "\ -Translate PCRE, a regexp in Perl-compatible syntax, to Emacs Lisp. - -Interactively, uses the contents of the region if it is active, -otherwise reads from the minibuffer. Prints the Emacs translation -in the echo area and copies it to the kill ring. - -PCRE regexp features that cannot be translated into Emacs syntax -will cause an error. See the commentary section of pcre2el.el for -more details. - -\(fn PCRE &optional FLAGS)" t nil) - -(defalias 'pcre-to-elisp 'rxt-pcre-to-elisp) - -(autoload 'rxt-pcre-to-rx "pcre2el" "\ -Translate PCRE, a regexp in Perl-compatible syntax, to `rx' syntax. - -See `rxt-pcre-to-elisp' for a description of the interactive behavior. - -\(fn PCRE &optional FLAGS)" t nil) - -(autoload 'rxt-pcre-to-strings "pcre2el" "\ -Return a list of all strings matched by PCRE, a Perl-compatible regexp. - -See `rxt-elisp-to-pcre' for a description of the interactive -behavior and `rxt-elisp-to-strings' for why this might be useful. - -Throws an error if PCRE contains any infinite quantifiers. - -\(fn PCRE &optional FLAGS)" t nil) - -(autoload 'rxt-explain-elisp "pcre2el" "\ -Insert the pretty-printed `rx' syntax for REGEXP in a new buffer. - -REGEXP is a regular expression in Emacs Lisp syntax. See -`rxt-elisp-to-pcre' for a description of how REGEXP is read -interactively. - -\(fn REGEXP)" t nil) - -(autoload 'rxt-explain-pcre "pcre2el" "\ -Insert the pretty-printed `rx' syntax for REGEXP in a new buffer. - -REGEXP is a regular expression in PCRE syntax. See -`rxt-pcre-to-elisp' for a description of how REGEXP is read -interactively. - -\(fn REGEXP &optional FLAGS)" t nil) - -(autoload 'rxt-quote-pcre "pcre2el" "\ -Return a PCRE regexp which matches TEXT literally. - -Any PCRE metacharacters in TEXT will be quoted with a backslash. - -\(fn TEXT)" nil nil) - -(autoload 'rxt-explain "pcre2el" "\ -Pop up a buffer with pretty-printed `rx' syntax for the regex at point. - -Chooses regex syntax to read based on current major mode, calling -`rxt-explain-elisp' if buffer is in `emacs-lisp-mode' or -`lisp-interaction-mode', or `rxt-explain-pcre' otherwise." t nil) - -(autoload 'rxt-convert-syntax "pcre2el" "\ -Convert regex at point to other kind of syntax, depending on major mode. - -For buffers in `emacs-lisp-mode' or `lisp-interaction-mode', -calls `rxt-elisp-to-pcre' to convert to PCRE syntax. Otherwise, -calls `rxt-pcre-to-elisp' to convert to Emacs syntax. - -The converted syntax is displayed in the echo area and copied to -the kill ring; see the two functions named above for details." t nil) - -(autoload 'rxt-convert-to-rx "pcre2el" "\ -Convert regex at point to RX syntax. Chooses Emacs or PCRE syntax by major mode." t nil) - -(autoload 'rxt-convert-to-strings "pcre2el" "\ -Convert regex at point to RX syntax. Chooses Emacs or PCRE syntax by major mode." t nil) - -(autoload 'rxt-mode "pcre2el" "\ -Regex translation utilities. - -This is a minor mode. If called interactively, toggle the `Rxt -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `rxt-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -\(fn &optional ARG)" t nil) - -(autoload 'turn-on-rxt-mode "pcre2el" "\ -Turn on `rxt-mode' in the current buffer." t nil) - -(put 'rxt-global-mode 'globalized-minor-mode t) - -(defvar rxt-global-mode nil "\ -Non-nil if Rxt-Global mode is enabled. -See the `rxt-global-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `rxt-global-mode'.") - -(custom-autoload 'rxt-global-mode "pcre2el" nil) - -(autoload 'rxt-global-mode "pcre2el" "\ -Toggle Rxt mode in all buffers. -With prefix ARG, enable Rxt-Global mode if ARG is positive; otherwise, -disable it. - -If called from Lisp, toggle the mode if ARG is `toggle'. -Enable the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -Rxt mode is enabled in all buffers where `turn-on-rxt-mode' would do -it. - -See `rxt-mode' for more information on Rxt mode. - -\(fn &optional ARG)" t nil) - -(register-definition-prefixes "pcre2el" '("pcre-" "rxt-")) - -;;;*** - -;;;### (autoloads nil nil ("pcre2el-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; pcre2el-autoloads.el ends here diff --git a/elpa/pcre2el-20230503.1929/pcre2el-pkg.el b/elpa/pcre2el-20230503.1929/pcre2el-pkg.el deleted file mode 100644 index 245af70a..00000000 --- a/elpa/pcre2el-20230503.1929/pcre2el-pkg.el +++ /dev/null @@ -1,12 +0,0 @@ -(define-package "pcre2el" "20230503.1929" "regexp syntax converter" - '((emacs "25.1")) - :commit "b941ed8a96299868171fac625ecffec77de3e986" :authors - '(("joddie ")) - :maintainers - '(("joddie ")) - :maintainer - '("joddie ") - :url "https://github.com/joddie/pcre2el") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/pcre2el-20230503.1929/pcre2el.el b/elpa/pcre2el-20230503.1929/pcre2el.el deleted file mode 100644 index fa74c45b..00000000 --- a/elpa/pcre2el-20230503.1929/pcre2el.el +++ /dev/null @@ -1,3167 +0,0 @@ -;;; pcre2el.el --- regexp syntax converter -*- lexical-binding: t -*- - -;; Copyright (C) 2012-2015 Jon Oddie - -;; Author: joddie -;; Hacked additionally by: opensource at hardakers dot net -;; Created: 14 Feb 2012 -;; Updated: 13 December 2015 -;; Version: 1.11 -;; Url: https://github.com/joddie/pcre2el -;; Package-Requires: ((emacs "25.1")) - -;; This file is NOT part of GNU Emacs. - -;; This program 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 3 of the -;; License, or (at your option) any later version. -;; -;; This program 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. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. - -;; This file incorporates work covered by the following copyright and -;; permission notice: -;; -;; Copyright (c) 1993-2002 Richard Kelsey and Jonathan Rees -;; Copyright (c) 1994-2002 by Olin Shivers and Brian D. Carlstrom. -;; Copyright (c) 1999-2002 by Martin Gasbichler. -;; Copyright (c) 2001-2002 by Michael Sperber. -;; All rights reserved. -;; -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions -;; are met: 1. Redistributions of source code must retain the above -;; copyright notice, this list of conditions and the following -;; disclaimer. 2. Redistributions in binary form must reproduce the -;; above copyright notice, this list of conditions and the following -;; disclaimer in the documentation and/or other materials provided -;; with the distribution. 3. The name of the authors may not be used -;; to endorse or promote products derived from this software without -;; specific prior written permission. -;; -;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS "AS IS" AND ANY EXPRESS OR -;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY -;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE -;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -;;; Commentary: - -;; 1 Overview -;; ========== - -;; `pcre2el' or `rxt' (RegeXp Translator or RegeXp Tools) is a utility -;; for working with regular expressions in Emacs, based on a -;; recursive-descent parser for regexp syntax. In addition to converting -;; (a subset of) PCRE syntax into its Emacs equivalent, it can do the -;; following: - -;; - convert Emacs syntax to PCRE -;; - convert either syntax to `rx', an S-expression based regexp syntax -;; - untangle complex regexps by showing the parse tree in `rx' form and -;; highlighting the corresponding chunks of code -;; - show the complete list of strings (productions) matching a regexp, -;; provided the list is finite -;; - provide live font-locking of regexp syntax (so far only for Elisp -;; buffers -- other modes on the TODO list) - - -;; 2 Usage -;; ======= - -;; Enable `rxt-mode' or its global equivalent `rxt-global-mode' to get -;; the default key-bindings. There are three sets of commands: commands -;; that take a PCRE regexp, commands which take an Emacs regexp, and -;; commands that try to do the right thing based on the current -;; mode. Currently, this means Emacs syntax in `emacs-lisp-mode' and -;; `lisp-interaction-mode', and PCRE syntax everywhere else. - -;; The default key bindings all begin with `C-c /' and have a mnemonic -;; structure: `C-c / ', or just `C-c / ' for the -;; "do what I mean" commands. The complete list of key bindings is given -;; here and explained in more detail below: - -;; - "Do-what-I-mean" commands: -;; `C-c / /': `rxt-explain' -;; `C-c / c': `rxt-convert-syntax' -;; `C-c / x': `rxt-convert-to-rx' -;; `C-c / '': `rxt-convert-to-strings' - -;; - Commands that work on a PCRE regexp: -;; `C-c / p e': `rxt-pcre-to-elisp' -;; `C-c / %': `pcre-query-replace-regexp' -;; `C-c / p x': `rxt-pcre-to-rx' -;; `C-c / p '': `rxt-pcre-to-strings' -;; `C-c / p /': `rxt-explain-pcre' - -;; - Commands that work on an Emacs regexp: -;; `C-c / e /': `rxt-explain-elisp' -;; `C-c / e p': `rxt-elisp-to-pcre' -;; `C-c / e x': `rxt-elisp-to-rx' -;; `C-c / e '': `rxt-elisp-to-strings' -;; `C-c / e t': `rxt-toggle-elisp-rx' -;; `C-c / t': `rxt-toggle-elisp-rx' - - -;; 2.1 Interactive input and output -;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -;; When used interactively, the conversion commands can read a regexp -;; either from the current buffer or from the minibuffer. The output is -;; displayed in the minibuffer and copied to the kill-ring. - -;; - When called with a prefix argument (`C-u'), they read a regular -;; expression from the minibuffer literally, without further processing -;; -- meaning there's no need to double the backslashes if it's an -;; Emacs regexp. This is the same way commands like -;; `query-replace-regexp' read input. - -;; - When the region is active, they use they the region contents, again -;; literally (without any translation of string syntax). - -;; - With neither a prefix arg nor an active region, the behavior depends -;; on whether the command expects an Emacs regexp or a PCRE one. - -;; Commands that take an Emacs regexp behave like `C-x C-e': they -;; evaluate the sexp before point (which could be simply a string -;; literal) and use its value. This is designed for use in Elisp -;; buffers. As a special case, if point is *inside* a string, it's -;; first moved to the string end, so in practice they should work as -;; long as point is somewhere within the regexp literal. - -;; Commands that take a PCRE regexp try to read a Perl-style delimited -;; regex literal *after* point in the current buffer, including its -;; flags. For example, putting point before the `m' in the following -;; example and doing `C-c / p e' (`rxt-pcre-to-elisp') displays -;; `\(?:bar\|foo\)', correctly stripping out the whitespace and -;; comment: - -;; ,---- -;; | $x =~ m/ foo | (?# comment) bar /x -;; `---- - -;; The PCRE reader currently only works with `/ ... /' delimiters. It -;; will ignore any preceding `m', `s', or `qr' operator, as well as the -;; replacement part of an `s' construction. - -;; Readers for other PCRE-using languages are on the TODO list. - -;; The translation functions display their result in the minibuffer and -;; copy it to the kill ring. When translating something into Elisp -;; syntax, you might need to use the result either literally (e.g. for -;; interactive input to a command like `query-replace-regexp'), or as a -;; string to paste into Lisp code. To allow both uses, -;; `rxt-pcre-to-elisp' copies both versions successively to the -;; kill-ring. The literal regexp without string quoting is the top -;; element of the kill-ring, while the Lisp string is the -;; second-from-top. You can paste the literal regexp somewhere by doing -;; `C-y', or the Lisp string by `C-y M-y'. - - -;; 2.2 Syntax conversion commands -;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -;; `rxt-convert-syntax' (`C-c / c') converts between Emacs and PCRE -;; syntax, depending on the major mode in effect when called. -;; Alternatively, you can specify the conversion direction explicitly by -;; using either `rxt-pcre-to-elisp' (`C-c / p e') or `rxt-elisp-to-pcre' -;; (`C-c / e p'). - -;; Similarly, `rxt-convert-to-rx' (`C-c / x') converts either kind of -;; syntax to `rx' form, while `rxt-convert-pcre-to-rx' (`C-c / p x') and -;; `rxt-convert-elisp-to-rx' (`C-c / e x') convert to `rx' from a -;; specified source type. - -;; In Elisp buffers, you can use `rxt-toggle-elisp-rx' (`C-c / t' or `C-c -;; / e t') to switch the regexp at point back and forth between string -;; and `rx' syntax. Point should either be within an `rx' or -;; `rx-to-string' form or a string literal for this to work. - - -;; 2.3 PCRE mode (experimental) -;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -;; If you want to use emulated PCRE regexp syntax in all Emacs commands, -;; try `pcre-mode', which uses Emacs's advice system to make all commands -;; that read regexps using the minibuffer use emulated PCRE syntax. It -;; should also work with Isearch. - -;; This feature is still fairly experimental. It may fail to work or do -;; the wrong thing with certain commands. Please report bugs. - -;; `pcre-query-replace-regexp' was originally defined to do query-replace -;; using emulated PCRE regexps, and is now made somewhat obsolete by -;; `pcre-mode'. It is bound to `C-c / %' by default, by analogy with -;; `M-%'. Put the following in your `.emacs' if you want to use -;; PCRE-style query replacement everywhere: - -;; ,---- -;; | (global-set-key [(meta %)] 'pcre-query-replace-regexp) -;; `---- - -;; 2.5 Explain regexps -;; ~~~~~~~~~~~~~~~~~~~ - -;; When syntax-highlighting isn't enough to untangle some gnarly regexp -;; you find in the wild, try the 'explain' commands: `rxt-explain' (`C-c -;; / /'), `rxt-explain-pcre' (`C-c / p') and `rxt-explain-elisp' (`C-c / -;; e'). These display the original regexp along with its pretty-printed -;; `rx' equivalent in a new buffer. Moving point around either in the -;; original regexp or the `rx' translation highlights corresponding -;; pieces of syntax, which can aid in seeing things like the scope of -;; quantifiers. - -;; I call them "explain" commands because the `rx' form is close to a -;; plain syntax tree, and this plus the wordiness of the operators -;; usually helps to clarify what is going on. People who dislike Lisp -;; syntax might disagree with this assessment. - - -;; 2.6 Generate all matching strings (productions) -;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -;; Occasionally you come across a regexp which is designed to match a -;; finite set of strings, e.g. a set of keywords, and it would be useful -;; to recover the original set. (In Emacs you can generate such regexps -;; using `regexp-opt'). The commands `rxt-convert-to-strings' (`C-c / -;; ′'), `rxt-pcre-to-strings' (`C-c / p ′') or `rxt-elisp-to-strings' -;; (`C-c / e ′') accomplish this by generating all the matching strings -;; ("productions") of a regexp. (The productions are copied to the kill -;; ring as a Lisp list). - -;; An example in Lisp code: - -;; ,---- -;; | (regexp-opt '("cat" "caterpillar" "catatonic")) -;; | ;; => "\\(?:cat\\(?:atonic\\|erpillar\\)?\\)" -;; | (rxt-elisp-to-strings "\\(?:cat\\(?:atonic\\|erpillar\\)?\\)") -;; | ;; => '("cat" "caterpillar" "catatonic") -;; `---- - -;; For obvious reasons, these commands only work with regexps that don't -;; include any unbounded quantifiers like `+' or `*'. They also can't -;; enumerate all the characters that match a named character class like -;; `[[:alnum:]]'. In either case they will give a (hopefully meaningful) -;; error message. Due to the nature of permutations, it's still possible -;; for a finite regexp to generate a huge number of productions, which -;; will eat memory and slow down your Emacs. Be ready with `C-g' if -;; necessary. - - -;; 2.7 RE-Builder support -;; ~~~~~~~~~~~~~~~~~~~~~~ - -;; The Emacs RE-Builder is a useful visual tool which allows using -;; several different built-in syntaxes via `reb-change-syntax' (`C-c -;; TAB'). It supports Elisp read and literal syntax and `rx', but it can -;; only convert from the symbolic forms to Elisp, not the other way. This -;; package hacks the RE-Builder to also work with emulated PCRE syntax, -;; and to convert transparently between Elisp, PCRE and rx syntaxes. PCRE -;; mode reads a delimited Perl-like literal of the form `/ ... /', and it -;; should correctly support using the `x' and `s' flags. - - -;; 2.8 Use from Lisp -;; ~~~~~~~~~~~~~~~~~ - -;; Example of using the conversion functions: -;; ,---- -;; | (rxt-pcre-to-elisp "(abc|def)\\w+\\d+") -;; | ;; => "\\(\\(?:abc\\|def\\)\\)[_[:alnum:]]+[[:digit:]]+" -;; `---- - -;; All the conversion functions take a single string argument, the regexp -;; to translate: - -;; - `rxt-pcre-to-elisp' -;; - `rxt-pcre-to-rx' -;; - `rxt-pcre-to-strings' -;; - `rxt-elisp-to-pcre' -;; - `rxt-elisp-to-rx' -;; - `rxt-elisp-to-strings' - - -;; 3 Bugs and Limitations -;; ====================== - -;; 3.1 Limitations on PCRE syntax -;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -;; PCRE has a complicated syntax and semantics, only some of which can be -;; translated into Elisp. The following subset of PCRE should be -;; correctly parsed and converted: - -;; - parenthesis grouping `( .. )', including shy matches `(?: ... )' -;; - backreferences (various syntaxes), but only up to 9 per expression -;; - alternation `|' -;; - greedy and non-greedy quantifiers `*', `*?', `+', `+?', `?' and `??' -;; (all of which are the same in Elisp as in PCRE) -;; - numerical quantifiers `{M,N}' -;; - beginning/end of string `\A', `\Z' -;; - string quoting `\Q .. \E' -;; - word boundaries `\b', `\B' (these are the same in Elisp) -;; - single character escapes `\a', `\c', `\e', `\f', `\n', `\r', `\t', -;; `\x', and `\octal digits' (but see below about non-ASCII characters) -;; - character classes `[...]' including Posix escapes -;; - character classes `\d', `\D', `\h', `\H', `\s', `\S', `\v', `\V' -;; both within character class brackets and outside -;; - word and non-word characters `\w' and `\W' (Emacs has the same -;; syntax, but its meaning is different) -;; - `s' (single line) and `x' (extended syntax) flags, in regexp -;; literals, or set within the expression via `(?xs-xs)' or `(?xs-xs: -;; .... )' syntax -;; - comments `(?# ... )' - -;; Most of the more esoteric PCRE features can't really be supported by -;; simple translation to Elisp regexps. These include the different -;; lookaround assertions, conditionals, and the "backtracking control -;; verbs" `(* ...)' . OTOH, there are a few other syntaxes which are -;; currently unsupported and possibly could be: - -;; - `\L', `\U', `\l', `\u' case modifiers -;; - `\g{...}' backreferences - - -;; 3.2 Other limitations -;; ~~~~~~~~~~~~~~~~~~~~~ - -;; - The order of alternatives and characters in char classes sometimes -;; gets shifted around, which is annoying. -;; - Although the string parser tries to interpret PCRE's octal and -;; hexadecimal escapes correctly, there are problems with matching -;; 8-bit characters that I don't use enough to properly understand, -;; e.g.: -;; ,---- -;; | (string-match-p (rxt-pcre-to-elisp "\\377") "\377") => nil -;; `---- -;; A fix for this would be welcome. - -;; - Most of PCRE's rules for how `^', `\A', `$' and `\Z' interact with -;; newlines are not implemented, since they seem less relevant to -;; Emacs's buffer-oriented rather than line-oriented model. However, -;; the different meanings of the `.' metacharacter *are* implemented -;; (it matches newlines with the `/s' flag, but not otherwise). - -;; - Not currently namespace clean (both `rxt-' and a couple of `pcre-' -;; functions). - - -;; 3.3 TODO: -;; ~~~~~~~~~ - -;; - Python-specific extensions to PCRE? -;; - Language-specific stuff to enable regexp font-locking and explaining -;; in different modes. Each language would need two functions, which -;; could be kept in an alist: - -;; 1. A function to read PCRE regexps, taking the string syntax into -;; account. E.g., Python has single-quoted, double-quoted and raw -;; strings, each with different quoting rules. PHP has the kind of -;; belt-and-suspenders solution you would expect: regexps are in -;; strings, /and/ you have to include the `/ ... /' delimiters! -;; Duh. - -;; 2. A function to copy faces back from the parsed string to the -;; original buffer text. This has to recognize any escape sequences -;; so they can be treated as a single character. - - -;; 4 Internal details -;; ================== - -;; `rxt' defines an internal syntax tree representation of regular -;; expressions, parsers for Elisp and PCRE syntax, and 'unparsers' -;; to convert the internal representation to PCRE or `rx' syntax. -;; Converting from the internal representation to Emacs syntax is -;; done by converting to `rx' form and passing it to `rx-to-string'. -;; See `rxt-parse-re', `rxt-adt->pcre', and `rxt-adt->rx' for -;; details. - -;; This code is partially based on Olin Shivers' reference SRE -;; implementation in scsh, although it is simplified in some respects and -;; extended in others. See `scsh/re.scm', `scsh/spencer.scm' and -;; `scsh/posixstr.scm' in the `scsh' source tree for details. In -;; particular, `pcre2el' steals the idea of an abstract data type for -;; regular expressions and the general structure of the string regexp -;; parser and unparser. The data types for character sets are extended in -;; order to support symbolic translation between character set -;; expressions without assuming a small (Latin1) character set. The -;; string parser is also extended to parse a bigger variety of -;; constructions, including POSIX character classes and various Emacs and -;; Perl regexp assertions. Otherwise, only the bare minimum of scsh's -;; abstract data type is implemented. - - -;; 5 Soapbox -;; ========= - -;; Emacs regexps have their annoyances, but it is worth getting used to -;; them. The Emacs assertions for word boundaries, symbol boundaries, and -;; syntax classes depending on the syntax of the mode in effect are -;; especially useful. (PCRE has `\b' for word-boundary, but AFAIK it -;; doesn't have separate assertions for beginning-of-word and -;; end-of-word). Other things that might be done with huge regexps in -;; other languages can be expressed more understandably in Elisp using -;; combinations of `save-excursion' with the various searches (regexp, -;; literal, skip-syntax-forward, sexp-movement functions, etc.). - -;; There's not much point in using `rxt-pcre-to-elisp' to use PCRE -;; notation in a Lisp program you're going to maintain, since you still -;; have to double all the backslashes. Better to just use the converted -;; result (or better yet, the `rx' form). - - -;; 6 History and acknowledgments -;; ============================= - -;; This was originally created out of an answer to a stackoverflow -;; question: -;; [http://stackoverflow.com/questions/9118183/elisp-mechanism-for-converting-pcre-regexps-to-emacs-regexps] - -;; Thanks to: - -;; - Wes Hardaker (hardaker) for the initial inspiration and subsequent -;; hacking -;; - priyadarshan for requesting RX support -;; - Daniel Colascione (dcolascione) for a patch to support Emacs's -;; explicitly-numbered match groups -;; - Aaron Meurer (asmeurer) for requesting Isearch support -;; - Philippe Vaucher (silex) for a patch to support `ibuffer-do-replace-regexp' -;; in PCRE mode - -;;; Code: - -(require 'cl-lib) -(require 'rx) -(require 're-builder) -(require 'advice) -(require 'ring) -(require 'pcase) - -;;; Customization group -(defgroup rxt nil - "Regex syntax converter and utilities." - :version 1.2 - :group 'tools - :group 'lisp - :link '(emacs-commentary-link :tag "commentary" "pcre2el.el") - :link '(emacs-library-link :tag "lisp file" "pcre2el.el") - :link '(url-link :tag "web page" "https://github.com/joddie/pcre2el")) - -(defface rxt-highlight-face - '((((min-colors 16581375) (background light)) :background "#eee8d5") - (((min-colors 16581375) (background dark)) :background "#222222")) - "Face for highlighting corresponding regex syntax in - `rxt-explain' buffers." - :group 'rxt) - -(defcustom rxt-verbose-rx-translation nil - "Non-nil if `rxt-pcre-to-rx' and `rxt-elisp-to-rx' should use - verbose `rx' primitives. - -Verbose primitives are things like `line-start' instead of `bol', -etc." - :group 'rxt - :type 'boolean) - -(defcustom rxt-explain-verbosely t - "Non-nil if `rxt-explain-elisp' and `rxt-explain-pcre' should - use verbose `rx' primitives. - -This overrides the value of `rxt-verbose-rx-translation' for -these commands only." - :group 'rxt - :type 'boolean) - - -;;;; Macros and functions for writing interactive input and output - -;; Macros for handling return values. If called interactively, -;; display the value in the echo area and copy it to the kill ring, -;; otherwise just return the value. PCREs are copied as unquoted -;; strings for yanking into Perl, JS, etc. `rx' forms and other sexps -;; are copied as `read'-able literals for yanking into Elisp buffers. -;; Emacs regexps are copied twice: once as an unquoted value for -;; interactive use, and once as a readable string literal for yanking -;; into Elisp buffers. -(defmacro rxt-return-pcre (expr) - (let ((value (make-symbol "value"))) - `(let ((,value ,expr)) - (when (called-interactively-p 'any) - (rxt--kill-pcre ,value)) - ,value))) - -(defmacro rxt-return-sexp (expr) - (let ((value (make-symbol "value"))) - `(let ((,value ,expr)) - (when (called-interactively-p 'any) - (rxt--kill-sexp ,value)) - ,value))) - -(defmacro rxt-return-emacs-regexp (expr) - (let ((value (make-symbol "value"))) - `(let ((,value ,expr)) - (when (called-interactively-p 'any) - (rxt--kill-emacs-regexp ,value)) - ,value))) - -(defun rxt--kill-sexp (value) - (let ((lisp-literal (prin1-to-string value))) - (message "%s" lisp-literal) - (kill-new lisp-literal))) - -(defun rxt--kill-pcre (value) - (message "%s" value) - (kill-new value)) - -(defun rxt--kill-emacs-regexp (value) - (let ((lisp-literal (prin1-to-string value))) - (message "%s" value) - (kill-new lisp-literal) - (kill-new value))) - -;; Read an Elisp regexp interactively. -;; -;; Three possibilities: -;; -;; 1) With a prefix arg, reads literally from the minibuffer, w/o -;; using string syntax -- just like query-replace-regexp, etc. -;; -;; 2) If the region is active, use the text of the region literally -;; (again w/o string syntax) -;; -;; 3) Otherwise, eval the sexp before point (which might be a string -;; literal or an expression) and use its value. Falls back to method -;; (1) if this fails to produce a string value. -;; -(cl-defun rxt-interactive/elisp (&optional (prompt "Emacs regexp: ")) - (list - (cond (current-prefix-arg - (read-string prompt)) - - ((use-region-p) - (buffer-substring-no-properties (region-beginning) (region-end))) - - (t - (condition-case nil - (save-excursion - (while (nth 3 (syntax-ppss)) (forward-char)) - (let ((re (eval (elisp--preceding-sexp)))) - (if (stringp re) re - (read-string prompt)))) - (error - (read-string prompt))))))) - -;; Read a PCRE regexp interactively. -;; -;; Three possibilities: As above, except that without prefix arg or -;; active region, tries to read a delimited regexp literal like /.../, -;; m/.../, or qr/.../ following point in the current buffer. Falls -;; back to reading from minibuffer if that fails. -;; -;; Returns the regexp, with flags as text properties. -;; -;; TODO: Different delimiters -(cl-defun rxt-interactive/pcre (&optional (prompt "PCRE regexp: ")) - (list - (cond (current-prefix-arg - (rxt--read-pcre prompt)) - - ((use-region-p) - (buffer-substring-no-properties (region-beginning) (region-end))) - - (t - (condition-case nil - (rxt-read-delimited-pcre) - (error ; Fall back to reading from minibuffer - (rxt--read-pcre prompt))))) - nil)) - -(define-minor-mode rxt--read-pcre-mode - "Minor-mode with key-bindings for toggling PCRE flags. - -You should not normally call this directly. It will be enabled -in minibuffers for `read-regexp' and in the `re-builder' buffer -when `pcre-mode' is active. These bindings will also be added to -`isearch-mode-map' in `pcre-mode'." - :initial-value nil - :lighter nil - :keymap - `((,(kbd "C-c s") . ,#'rxt--toggle-s-mode) - (,(kbd "C-c x") . ,#'rxt--toggle-x-mode) - (,(kbd "C-c i") . ,#'rxt--toggle-i-mode))) - -(defun rxt--read-pcre (prompt) - "Read a PCRE regexp for translation, together with option flags. - -The `s', `x', and `i' flags can be toggled using the following -commands: \\ - -\\[rxt--toggle-s-mode] : toggle `s' (single-line) mode -\\[rxt--toggle-x-mode] : toggle `x' (extended) mode -\\[rxt--toggle-i-mode] : toggle `i' (case-insensitive) mode - -In single-line mode, `.' will also match newlines. -In extended mode, whitespace is ignored. - -Case-insensitive mode emulates matching without case, -independently of Emacs's builtin `case-fold-search' setting. -Note that this does not apply to backreferences." - (minibuffer-with-setup-hook #'rxt--read-pcre-mode - (read-from-minibuffer prompt))) - -(defun rxt--toggle-s-mode () - "Toggle emulated PCRE single-line (s) flag." - (interactive) - (rxt--toggle-flag ?s)) - -(defun rxt--toggle-x-mode () - "Toggle emulated PCRE extended (x) flag." - (interactive) - (rxt--toggle-flag ?x)) - -(defun rxt--toggle-i-mode () - "Toggle emulated PCRE case-insensitive (i) flag." - (interactive) - (rxt--toggle-flag ?i)) - -(defun rxt--toggle-flag (char) - "Toggle CHAR, a PCRE flag." - (cond - ((derived-mode-p 'reb-mode) ; RE-Builder - (rxt--toggle-flag-re-builder char)) - ((minibufferp) - (rxt--toggle-flag-minibuffer char)) - (isearch-mode - (rxt--toggle-flag-isearch char)) - (t - (error "Not in minibuffer, RE-Builder or isearch mode.")))) - -(defun rxt--toggle-flag-re-builder (char) - (save-excursion - (goto-char (point-max)) - (search-backward "/") - (forward-char) - (when (looking-at (rx (* (any ?i ?s ?x)))) - (let ((inhibit-modification-hooks t)) - (replace-match (rxt--xor-flags (match-string 0) char) t t)))) - (reb-do-update)) - -(defun rxt--toggle-flag-minibuffer (char) - (setf (buffer-substring (minibuffer-prompt-end) (point-max)) - (rxt--toggle-flag-string (minibuffer-contents) char)) - (when - (and (= (point) (minibuffer-prompt-end)) - (looking-at (rx "(?" (group (+ (any ?i ?s ?x))) ")"))) - (forward-sexp))) - -(defun rxt--toggle-flag-isearch (char) - (when isearch-regexp - (setq isearch-string - (rxt--toggle-flag-string isearch-string char)) - (setq isearch-message - (mapconcat #'isearch-text-char-description isearch-string "")) - (isearch-search-and-update))) - -(defun rxt--toggle-flag-string (string char) - (if (string-match (rx string-start "(?" (group (+ (any ?i ?s ?x))) ")") - string) - (let ((flags (rxt--xor-flags (match-string 1 string) char))) - (if (string= flags "") - (replace-match "" t t string) - (replace-match flags t t string 1))) - (format "(?%c)%s" char string))) - -(defun rxt--xor-flags (flags char) - (concat - (sort - (cl-set-exclusive-or (string-to-list flags) (list char)) - #'<))) - - -;;;; Minor mode for using emulated PCRE syntax - -(defvar pcre-old-isearch-search-fun-function nil - "Original value of `isearch-search-fun-function' before entering `pcre-mode.' - -This function is wrapped by `pcre-isearch-search-fun-function' -and restored on exit from `pcre-mode'.") -(make-variable-buffer-local 'pcre-old-isearch-search-fun-function) - -(defvar pcre-old-isearch-key-bindings nil - "Alist of key-bindings to restore in `isearch-mode-map' on exiting `pcre-mode'.") - -;;;###autoload -(define-minor-mode pcre-mode - "Use emulated PCRE syntax for regexps wherever possible. - -Advises the `interactive' specs of `read-regexp' and the -following other functions so that they read PCRE syntax and -translate to its Emacs equivalent: - -- `align-regexp' -- `find-tag-regexp' -- `sort-regexp-fields' -- `isearch-message-prefix' -- `ibuffer-do-replace-regexp' - -Also alters the behavior of `isearch-mode' when searching by regexp." - :init-value nil - :lighter " PCRE" - :keymap nil - :global t - - (if pcre-mode - ;; Enabling - (progn - ;; Enable advice - (ad-enable-regexp "pcre-mode") - ;; Set up isearch hooks - (add-hook 'isearch-mode-hook #'pcre-isearch-mode-hook) - (add-hook 'isearch-mode-end-hook #'pcre-isearch-mode-end-hook) - ;; Add the keybindings of `rxt--read-pcre-mode-map' to - ;; `isearch-mode-map' (so that they do not cause an exit from - ;; `isearch-mode'), and save any existing bindings for those - ;; keys to restore on exit from `pcre-mode'. - (setq pcre-old-isearch-key-bindings - (cl-loop for key being the key-seqs of rxt--read-pcre-mode-map - for def = (lookup-key isearch-mode-map key) - collect (cons (copy-sequence key) - (if (numberp def) nil def)))) - (cl-loop for key being the key-seqs of rxt--read-pcre-mode-map - using (key-bindings def) - do (define-key isearch-mode-map key def))) - - ;; Disable advice - (ad-disable-regexp "pcre-mode") - ;; Remove from isearch hooks - (remove-hook 'isearch-mode-hook #'pcre-isearch-mode-hook) - (remove-hook 'isearch-mode-end-hook #'pcre-isearch-mode-end-hook) - ;; Restore key-bindings - (cl-loop for (key . def) in pcre-old-isearch-key-bindings - do (define-key isearch-mode-map key def))) - - ;; "Activating" advice re-computes the function definitions, which - ;; is necessary whether enabling or disabling - (ad-activate-regexp "pcre-mode")) - -;;; Cache of PCRE -> Elisp translations -(defvar pcre-mode-cache-size 100 - "Number of PCRE-to-Emacs translations to keep in the `pcre-mode' cache.") - -(defvar pcre-mode-cache (make-hash-table :test 'equal) - "Cache of PCRE-to-Emacs translations used in `pcre-mode'. - -Keys are PCRE regexps, values are their Emacs equivalents.") - -(defvar pcre-mode-reverse-cache (make-hash-table :test 'equal) - "Cache of original PCREs translated to Emacs syntax in `pcre-mode'. - -Keys are translated Emacs regexps, values are their original PCRE -form. This is used to display the original PCRE regexp in place -of its translated form.") - -(defvar pcre-cache-ring (make-ring pcre-mode-cache-size) - "Ring of PCRE-to-Emacs translations used in `pcre-mode'. - -When the ring fills up, the oldest element is removed and the -corresponding entries are deleted from the hash tables -`pcre-mode-cache' and `pcre-mode-reverse-cache'.") - -(defun pcre-to-elisp/cached (pcre) - "Translate PCRE to Emacs syntax, caching both forms." - (or (gethash pcre pcre-mode-cache) - (let ((elisp (rxt-pcre-to-elisp pcre))) - (pcre-set-cache pcre elisp) - elisp))) - -(defun pcre-set-cache (pcre-regexp emacs-regexp) - "Add a PCRE-to-Emacs translation to the `pcre-mode' cache." - (when (and (not (zerop (length pcre-regexp))) - (not (zerop (length emacs-regexp))) - (not (gethash pcre-regexp pcre-mode-cache))) - (if (= (ring-length pcre-cache-ring) (ring-size pcre-cache-ring)) - (let* ((old-item (ring-remove pcre-cache-ring)) - (old-pcre (car old-item)) - (old-emacs (cdr old-item))) - (remhash old-pcre pcre-mode-cache) - (remhash old-emacs pcre-mode-reverse-cache)) - (puthash pcre-regexp emacs-regexp pcre-mode-cache) - (puthash emacs-regexp pcre-regexp pcre-mode-reverse-cache) - (ring-insert pcre-cache-ring (cons pcre-regexp emacs-regexp))))) - -;;; Isearch advice -(defun pcre-isearch-mode-hook () - (when (not (eq isearch-search-fun-function #'isearch-search-fun-default)) - (message "Warning: pcre-mode overriding existing isearch function `%s'" - isearch-search-fun-function)) - ;; Prevent an infinite loop, if a previous isearch in pcre-mode - ;; exited without restoring the original search function for some - ;; reason - (unless (eq isearch-search-fun-function #'pcre-isearch-search-fun-function) - (setq pcre-old-isearch-search-fun-function isearch-search-fun-function)) - (set (make-local-variable 'isearch-search-fun-function) - #'pcre-isearch-search-fun-function)) - -(defun pcre-isearch-mode-end-hook () - (setq isearch-search-fun-function pcre-old-isearch-search-fun-function)) - -(defun pcre-isearch-search-fun-function () - "Enable isearching using emulated PCRE syntax. - -This is set as the value of `isearch-search-fun-function' when -`pcre-mode' is enabled. Returns a function which searches using -emulated PCRE regexps when `isearch-regexp' is true." - (lambda (string bound noerror) - (let ((real-search-function - (funcall (or pcre-old-isearch-search-fun-function 'isearch-search-fun-default)))) - (if (not isearch-regexp) - (funcall real-search-function string bound noerror) - ;; Raise an error if the regexp ends in an incomplete escape - ;; sequence (= odd number of backslashes). - ;; TODO: Perhaps this should really be handled in rxt-pcre-to-elisp? - (if (isearch-backslash string) (rxt-error "Trailing backslash")) - (funcall real-search-function - (pcre-to-elisp/cached string) bound noerror))))) - -(defadvice isearch-message-prefix (after pcre-mode disable) - "Add \"PCRE\" to the Isearch message when searching by regexp in `pcre-mode'." - (when (and isearch-regexp - ;; Prevent an inaccurate message if our callback was - ;; removed somehow - (eq isearch-search-fun-function #'pcre-isearch-search-fun-function)) - (let ((message ad-return-value)) - ;; Some hackery to give replacement the same fontification as - ;; the original - (when - (let ((case-fold-search t)) (string-match "regexp" message)) - (let* ((match (match-string 0 message)) - (properties (text-properties-at 0 match)) - (replacement (apply #'propertize "PCRE regexp" properties)) - (new-message (replace-match replacement t t message))) - (setq ad-return-value new-message)))))) - -(defadvice isearch-fallback - (before pcre-mode (want-backslash &optional allow-invalid to-barrier) disable) - "Hack to fall back correctly in `pcre-mode'. " - ;; A dirty hack to the internals of isearch. Falling back to a - ;; previous match position is necessary when the (Emacs) regexp ends - ;; in "*", "?", "\{" or "\|": this is handled in - ;; `isearch-process-search-char' by calling `isearch-fallback' with - ;; `t' for the value of the first parameter, `want-backslash', in - ;; the last two cases. With PCRE regexps, falling back should take - ;; place on "*", "?", "{" or "|", with no backslashes required. - ;; This advice handles the last two cases by unconditionally setting - ;; `want-backslash' to nil. - (ad-set-arg 0 nil)) - -(defadvice isearch-edit-string - (around pcre-mode disable) - "Add PCRE mode-toggling keys to Isearch minibuffer in regexp mode." - (if isearch-regexp - (minibuffer-with-setup-hook - #'rxt--read-pcre-mode - ad-do-it) - ad-do-it)) - -;;; evil-mode advice -(defadvice evil-search-function - (around pcre-mode (forward regexp-p wrap) disable) - (if (and regexp-p (not isearch-mode)) - (let ((real-search-function ad-do-it)) - (setq ad-return-value - (pcre-decorate-search-function real-search-function))) - ad-do-it)) - -(eval-after-load 'evil - '(when pcre-mode - (ad-enable-advice 'evil-search-function 'around 'pcre-mode) - (ad-activate 'evil-search-function))) - -(defun pcre-decorate-search-function (real-search-function) - (lambda (string &optional bound noerror count) - (funcall real-search-function - (pcre-to-elisp/cached string) - bound noerror count))) - -;;; Other hooks and defadvices - -;;;###autoload -(defun pcre-query-replace-regexp () - "Perform `query-replace-regexp' using PCRE syntax. - -Consider using `pcre-mode' instead of this function." - (interactive) - (let ((old-pcre-mode pcre-mode)) - (unwind-protect - (progn - (pcre-mode +1) - (call-interactively #'query-replace-regexp)) - (pcre-mode (if old-pcre-mode 1 0))))) - - -(defadvice add-to-history - (before pcre-mode (history-var newelt &optional maxelt keep-all) disable) - "Add the original PCRE to query-replace history in `pcre-mode'." - (when (eq history-var query-replace-from-history-variable) - (let ((original (gethash newelt pcre-mode-reverse-cache))) - (when original - (ad-set-arg 1 original))))) - -(defadvice query-replace-descr - (before pcre-mode (from) disable) - "Use the original PCRE in Isearch prompts in `pcre-mode'." - (let ((original (gethash from pcre-mode-reverse-cache))) - (when original - (ad-set-arg 0 original)))) - -;;; The `interactive' specs of the following functions are lifted -;;; wholesale from the original built-ins, which see. -(defadvice read-regexp - (around pcre-mode first (prompt &optional defaults history) disable) - "Read regexp using PCRE syntax and convert to Elisp equivalent." - (ad-set-arg 0 (concat "[PCRE] " prompt)) - (minibuffer-with-setup-hook - #'rxt--read-pcre-mode - ad-do-it) - (setq ad-return-value - (pcre-to-elisp/cached ad-return-value))) - -(defadvice align-regexp - (before pcre-mode first (beg end regexp &optional group spacing repeat) disable) - "Read regexp using PCRE syntax and convert to Elisp equivalent." - (interactive - (append - (list (region-beginning) (region-end)) - (if current-prefix-arg - (list (rxt-pcre-to-elisp - (read-string "Complex align using PCRE regexp: " - "(\\s*)")) - (string-to-number - (read-string - "Parenthesis group to modify (justify if negative): " "1")) - (string-to-number - (read-string "Amount of spacing (or column if negative): " - (number-to-string align-default-spacing))) - (y-or-n-p "Repeat throughout line? ")) - (list (concat "\\(\\s-*\\)" - (rxt-pcre-to-elisp - (read-string "Align PCRE regexp: "))) - 1 align-default-spacing nil))))) - -(defadvice ibuffer-do-replace-regexp - (before pcre-mode first (from-str to-str) disable) - "Read regexp using PCRE syntax and convert to Elisp equivalent." - (interactive - (let* ((from-str (read-from-minibuffer "[PCRE] Replace regexp: ")) - (to-str (read-from-minibuffer (concat "[PCRE] Replace " from-str " with: ")))) - (list (rxt-pcre-to-elisp from-str) to-str)))) - -(defadvice find-tag-regexp - (before pcre-mode first (regexp &optional next-p other-window) disable) - "Read regexp using PCRE syntax and convert to Elisp equivalent. -Perform `find-tag-regexp' using emulated PCRE regexp syntax." - (interactive - (let ((args (find-tag-interactive "[PCRE] Find tag regexp: " t))) - (list (rxt-pcre-to-elisp (nth 0 args)) - (nth 1 args) (nth 2 args))))) - -(defadvice sort-regexp-fields - (before pcre-mode first (reverse record-regexp key-regexp beg end) disable) - "Read regexp using PCRE syntax and convert to Elisp equivalent." - (interactive "P\nsPCRE regexp specifying records to sort: \n\ -sPCRE regexp specifying key within record: \nr") - (ad-set-arg 1 (rxt-pcre-to-elisp (ad-get-arg 1))) - (ad-set-arg 2 (rxt-pcre-to-elisp (ad-get-arg 2)))) - - - -;;; Commands that take Emacs-style regexps as input - -;;;###autoload -(defun rxt-elisp-to-pcre (regexp) - "Translate REGEXP, a regexp in Emacs Lisp syntax, to Perl-compatible syntax. - -Interactively, reads the regexp in one of three ways. With a -prefix arg, reads from minibuffer without string escaping, like -`query-replace-regexp'. Without a prefix arg, uses the text of -the region if it is active. Otherwise, uses the result of -evaluating the sexp before point (which might be a string regexp -literal or an expression that produces a string). - -Displays the translated PCRE regexp in the echo area and copies -it to the kill ring. - -Emacs regexp features such as syntax classes which cannot be -translated to PCRE will cause an error." - (interactive (rxt-interactive/elisp)) - (rxt-return-pcre (rxt-adt->pcre (rxt-parse-elisp regexp)))) - -;;;###autoload -(defun rxt-elisp-to-rx (regexp) - "Translate REGEXP, a regexp in Emacs Lisp syntax, to `rx' syntax. - -See `rxt-elisp-to-pcre' for a description of the interactive -behavior and `rx' for documentation of the S-expression based -regexp syntax." - (interactive (rxt-interactive/elisp)) - (rxt-return-sexp (rxt-adt->rx (rxt-parse-elisp regexp)))) - -;;;###autoload -(defun rxt-elisp-to-strings (regexp) - "Return a list of all strings matched by REGEXP, an Emacs Lisp regexp. - -See `rxt-elisp-to-pcre' for a description of the interactive behavior. - -This is useful primarily for getting back the original list of -strings from a regexp generated by `regexp-opt', but it will work -with any regexp without unbounded quantifiers (*, +, {2, } and so -on). - -Throws an error if REGEXP contains any infinite quantifiers." - (interactive (rxt-interactive/elisp)) - (rxt-return-sexp (rxt-adt->strings (rxt-parse-elisp regexp)))) - -;;;###autoload -(defun rxt-toggle-elisp-rx () - "Toggle the regexp near point between Elisp string and rx syntax." - (interactive) - ;; First, position point before the regex form near point (either - ;; a string literal or a list beginning `rx' or `rx-to-string'). - (let* ((context (syntax-ppss)) - (string-start (nth 8 context))) - (cond (string-start (goto-char string-start)) - ((looking-back "\"" nil t) (backward-sexp)) - ((looking-at "\"") nil) - (t - ;; Search backwards, leaving point in place on error - (goto-char - (save-excursion - (skip-syntax-forward "-") - (while (not (looking-at - (rx "(" (or "rx" "rx-to-string") symbol-end))) - (backward-up-list)) - (point)))))) - - ;; Read and replace the regex following point - (let* ((regex (read (current-buffer))) - (print-escape-newlines t)) - (save-excursion - (if (listp regex) - ;; Replace rx form with string value - (prin1 (eval regex) (current-buffer)) - ;; Pretty-print rx form - (save-restriction - (let* ((start (point)) - (rx--syntax-codes (rxt-elisp-to-rx regex)) - (rx--form - (pcase rx--syntax-codes - (`(seq . ,rest) `(rx . ,rest)) - (form `(rx ,form))))) - (rxt-print rx--form) - (narrow-to-region start (point))) - (pp-buffer) - ;; remove the extra newline that pp-buffer inserts - (goto-char (point-max)) - (delete-region - (point) - (save-excursion (skip-chars-backward " \t\n") (point)))))) - (kill-sexp -1) - (indent-pp-sexp))) - - - -;;; Commands that translate PCRE to other formats - -;;;###autoload -(defun rxt-pcre-to-elisp (pcre &optional flags) - "Translate PCRE, a regexp in Perl-compatible syntax, to Emacs Lisp. - -Interactively, uses the contents of the region if it is active, -otherwise reads from the minibuffer. Prints the Emacs translation -in the echo area and copies it to the kill ring. - -PCRE regexp features that cannot be translated into Emacs syntax -will cause an error. See the commentary section of pcre2el.el for -more details." - (interactive (rxt-interactive/pcre)) - (rxt-return-emacs-regexp - (rx-to-string - (rxt-pcre-to-rx (rxt--add-flags pcre flags)) - t))) - -;;;###autoload -(defalias 'pcre-to-elisp 'rxt-pcre-to-elisp) - -;;;###autoload -(defun rxt-pcre-to-rx (pcre &optional flags) - "Translate PCRE, a regexp in Perl-compatible syntax, to `rx' syntax. - -See `rxt-pcre-to-elisp' for a description of the interactive behavior." - (interactive (rxt-interactive/pcre)) - (rxt-return-sexp (rxt-adt->rx (rxt-parse-pcre (rxt--add-flags pcre flags))))) - -;;;###autoload -(defun rxt-pcre-to-strings (pcre &optional flags) - "Return a list of all strings matched by PCRE, a Perl-compatible regexp. - -See `rxt-elisp-to-pcre' for a description of the interactive -behavior and `rxt-elisp-to-strings' for why this might be useful. - -Throws an error if PCRE contains any infinite quantifiers." - (interactive (rxt-interactive/pcre)) - (rxt-return-sexp (rxt-adt->strings (rxt-parse-pcre (rxt--add-flags pcre flags))))) - -(defun rxt--add-flags (pcre flags) - "Prepend FLAGS to PCRE." - (if (not (zerop (length flags))) - (concat "(?" flags ")" pcre) - pcre)) - - -;;; Regexp explaining functions to display pretty-printed rx syntax - -;; When the `rxt-explain' flag is non-nil, `rxt-adt->rx' records -;; location information for each element of the generated `rx' form, -;; allowing highlighting corresponding pieces of syntax at point. -(defvar rxt-explain nil) - -(defvar rxt-highlight-overlays nil - "List of active location-highlighting overlays in rxt-help-mode buffer.") - -;;;###autoload -(defun rxt-explain-elisp (regexp) - "Insert the pretty-printed `rx' syntax for REGEXP in a new buffer. - -REGEXP is a regular expression in Emacs Lisp syntax. See -`rxt-elisp-to-pcre' for a description of how REGEXP is read -interactively." - (interactive (rxt-interactive/elisp)) - (let ((rxt-explain t) - (rxt-verbose-rx-translation rxt-explain-verbosely)) - (rxt-pp-rx regexp (rxt-elisp-to-rx regexp)))) - -;;;###autoload -(defun rxt-explain-pcre (regexp &optional flags) - "Insert the pretty-printed `rx' syntax for REGEXP in a new buffer. - -REGEXP is a regular expression in PCRE syntax. See -`rxt-pcre-to-elisp' for a description of how REGEXP is read -interactively." - (interactive (rxt-interactive/pcre)) - (let ((rxt-explain t) - (rxt-verbose-rx-translation rxt-explain-verbosely)) - (rxt-pp-rx regexp (rxt-pcre-to-rx regexp flags)))) - -;;;###autoload -(defun rxt-quote-pcre (text) - "Return a PCRE regexp which matches TEXT literally. - -Any PCRE metacharacters in TEXT will be quoted with a backslash." - (rxt-adt->pcre (rxt-string text))) - - -;;;; Commands that depend on the major mode in effect - -;; Macro: interactively call one of two functions depending on the -;; major mode -(defmacro rxt-mode-dispatch (elisp-function pcre-function) - `(if (memq major-mode '(emacs-lisp-mode lisp-interaction-mode)) - (call-interactively #',elisp-function) - (call-interactively #',pcre-function))) - -;;;###autoload -(defun rxt-explain () - "Pop up a buffer with pretty-printed `rx' syntax for the regex at point. - -Chooses regex syntax to read based on current major mode, calling -`rxt-explain-elisp' if buffer is in `emacs-lisp-mode' or -`lisp-interaction-mode', or `rxt-explain-pcre' otherwise." - (interactive) - (rxt-mode-dispatch rxt-explain-elisp rxt-explain-pcre)) - -;;;###autoload -(defun rxt-convert-syntax () - "Convert regex at point to other kind of syntax, depending on major mode. - -For buffers in `emacs-lisp-mode' or `lisp-interaction-mode', -calls `rxt-elisp-to-pcre' to convert to PCRE syntax. Otherwise, -calls `rxt-pcre-to-elisp' to convert to Emacs syntax. - -The converted syntax is displayed in the echo area and copied to -the kill ring; see the two functions named above for details." - (interactive) - (rxt-mode-dispatch rxt-elisp-to-pcre rxt-pcre-to-elisp)) - -;;;###autoload -(defun rxt-convert-to-rx () - "Convert regex at point to RX syntax. Chooses Emacs or PCRE syntax by major mode." - (interactive) - (rxt-mode-dispatch rxt-elisp-to-rx rxt-pcre-to-rx)) - -;;;###autoload -(defun rxt-convert-to-strings () - "Convert regex at point to RX syntax. Chooses Emacs or PCRE syntax by major mode." - (interactive) - (rxt-mode-dispatch rxt-elisp-to-strings rxt-pcre-to-strings)) - - - -;;; Minor mode and keybindings - -(defvar rxt-mode-map - (let ((map (make-sparse-keymap))) - ;; Generic - (define-key map (kbd "C-c / /") 'rxt-explain) - (define-key map (kbd "C-c / c") 'rxt-convert-syntax) - (define-key map (kbd "C-c / x") 'rxt-convert-to-rx) - (define-key map (kbd "C-c / '") 'rxt-convert-to-strings) - - ;; From PCRE - (define-key map (kbd "C-c / p /") 'rxt-explain-pcre) - (define-key map (kbd "C-c / p e") 'rxt-pcre-to-elisp) - (define-key map (kbd "C-c / p x") 'rxt-pcre-to-rx) - (define-key map (kbd "C-c / p '") 'rxt-pcre-to-strings) - - ;; From Elisp - (define-key map (kbd "C-c / e /") 'rxt-explain-elisp) - (define-key map (kbd "C-c / e p") 'rxt-elisp-to-pcre) - (define-key map (kbd "C-c / e x") 'rxt-elisp-to-rx) - (define-key map (kbd "C-c / e '") 'rxt-elisp-to-strings) - (define-key map (kbd "C-c / e t") 'rxt-toggle-elisp-rx) - (define-key map (kbd "C-c / t") 'rxt-toggle-elisp-rx) - - ;; Search - (define-key map (kbd "C-c / %") 'pcre-query-replace-regexp) - - map) - "Keymap for `rxt-mode'.") - -;;;###autoload -(define-minor-mode rxt-mode - "Regex translation utilities." - :init-value nil - :lighter nil - :keymap rxt-mode-map) - -;;;###autoload -(defun turn-on-rxt-mode () - "Turn on `rxt-mode' in the current buffer." - (interactive) - (rxt-mode 1)) - -;;;###autoload -(define-globalized-minor-mode rxt-global-mode rxt-mode - turn-on-rxt-mode) - - -;;;; Syntax explanations - -;; Major mode for displaying pretty-printed S-exp syntax -(define-derived-mode rxt-help-mode emacs-lisp-mode "Regexp Explain" - (setq buffer-read-only t) - (add-hook 'post-command-hook 'rxt-highlight-text nil t) - (rxt-highlight-text)) - -;; Hack: stop paredit-mode interfering with `rxt-print' -(eval-when-compile (declare-function paredit-mode "paredit.el")) -(add-hook 'rxt-help-mode-hook - (lambda () - (if (and (boundp 'paredit-mode) - paredit-mode) - (paredit-mode 0)))) - -(define-key rxt-help-mode-map "q" 'quit-window) -(define-key rxt-help-mode-map "z" 'kill-this-buffer) -(define-key rxt-help-mode-map "n" 'next-line) -(define-key rxt-help-mode-map "p" 'previous-line) -(define-key rxt-help-mode-map "f" 'forward-list) -(define-key rxt-help-mode-map "b" 'backward-list) -(define-key rxt-help-mode-map "u" 'backward-up-list) -(define-key rxt-help-mode-map "d" 'down-list) - -(defvar rxt--print-with-overlays nil) -(defvar rxt--print-depth 0) - -(defconst rxt--print-char-alist - '((?\a . "\\a") - (?\b . "\\b") - (?\t . "\\t") - (?\n . "\\n") - (?\v . "\\v") - (?\f . "\\f") - (?\r . "\\r") - (?\e . "\\e") - (?\s . "\\s") - (?\\ . "\\\\") - (?\d . "\\d")) - "Alist of characters to print using an escape sequence in Elisp source. -See (info \"(elisp) Basic Char Syntax\").") - -(defconst rxt--whitespace-display-regexp - (rx-to-string `(any ,@(mapcar #'car rxt--print-char-alist)))) - -(defconst rxt--print-special-chars - '(?\( ?\) ?\\ ?\| ?\; ?\' ?\` ?\" ?\# ?\. ?\,) - "Characters which require a preceding backslash in Elisp source. -See (info \"(elisp) Basic Char Syntax\").") - -(defun rxt-pp-rx (regexp rx) - "Display string regexp REGEXP with its `rx' form RX in an `rxt-help-mode' buffer." - (with-current-buffer (get-buffer-create "* Regexp Explain *") - (let ((print-escape-newlines t) - (inhibit-read-only t)) - (erase-buffer) - (rxt-help-mode) - (insert (rxt--propertize-whitespace regexp)) - (newline 2) - (save-excursion - (let ((sexp-begin (point)) - (rxt--print-with-overlays t)) - (rxt-print rx) - (narrow-to-region sexp-begin (point)) - (pp-buffer) - (widen))) - (rxt-highlight-text)) - (pop-to-buffer (current-buffer)))) - -(cl-defun rxt-print (rx) - "Insert RX, an `rx' form, into the current buffer, optionally adding overlays. - -Similar to `print' or `prin1', but ensures that `rx' forms are -printed readably, using character or integer syntax depending on -context. - -If `rxt--print-with-overlays' is non-nil, also creates overlays linking -elements of RX to their corresponding locations in the source -string (see `rxt-explain-elisp', `rxt-explain-pcre' and -`rxt--make-help-overlays')." - (let ((start (point))) - (cl-typecase rx - (cons - (pcase rx - (`(,(and (or `repeat `**) head) - ,(and (pred integerp) from) - ,(and (pred integerp) to) - . ,rest) - (insert (format "(%s %d %d" head from to)) - (rxt--print-list-tail rest)) - (`(,(and (or `repeat `= `>=) head) - ,(and (pred integerp) n) - . ,rest) - (insert (format "(%s %d" head n)) - (rxt--print-list-tail rest)) - (_ - (rxt--print-list-tail rx t)))) - (symbol - (cl-case rx - ;; `print' escapes the ? characters in the rx operators *? - ;; and +?, but this looks bad and is not strictly necessary: - ;; (eq (read "*?") (read "*\\?")) => t - ;; (eq (read "+?") (read "+\\?")) => t - ((*? +?) (insert (symbol-name rx))) - (t (prin1 rx (current-buffer))))) - (string - (insert (rxt--propertize-whitespace (prin1-to-string rx)))) - (character - (cond - ((eq ? rx) - (insert "?")) - ((memq rx rxt--print-special-chars) - (insert "?\\" rx)) - ((assq rx rxt--print-char-alist) - (insert "?" (assoc-default rx rxt--print-char-alist))) - (t - (insert "?" (char-to-string rx))))) - (t - (prin1 rx (current-buffer)))) - (when rxt--print-with-overlays - (rxt--make-help-overlays rx start (point))))) - -(defun rxt--print-list-tail (tail &optional open-paren) - (let ((rxt--print-depth (1+ rxt--print-depth))) - (let ((done nil)) - (while (not done) - (cl-typecase tail - (null - (insert ")") - (setq done t)) - (cons - (if open-paren - (progn - (insert "(") - (setq open-paren nil)) - (insert " ")) - (rxt-print (car tail)) - (setq tail (cdr tail))) - (t - (insert " . ") - (rxt-print tail) - (insert ")") - (setq done t))))))) - -(defun rxt--make-help-overlays (rx start end) - (let ((location (rxt-location rx))) - (when (and location - (rxt-location-start location) - (rxt-location-end location)) - (let* ((sexp-begin (copy-marker start t)) - (sexp-end (copy-marker end)) - (sexp-bounds (list sexp-begin sexp-end)) - - (source-begin (1+ (rxt-location-start location))) - (source-end (1+ (rxt-location-end location))) - (source-bounds (list source-begin source-end)) - - (bounds (list source-bounds sexp-bounds)) - - (sexp-ol (make-overlay sexp-begin sexp-end (current-buffer) t nil)) - (source-ol (make-overlay source-begin source-end (current-buffer) t nil))) - (dolist (ol (list sexp-ol source-ol)) - (overlay-put ol 'priority rxt--print-depth) - (overlay-put ol 'rxt-bounds bounds)))))) - -(defun rxt--propertize-whitespace (string) - (let ((string (copy-sequence string)) - (start 0)) - (while (string-match rxt--whitespace-display-regexp string start) - (put-text-property (match-beginning 0) (match-end 0) - 'display - (assoc-default (string-to-char (match-string 0 string)) - rxt--print-char-alist) - string) - (setq start (match-end 0))) - string)) - -(defun rxt-highlight-text () - "Highlight the regex syntax at point and its corresponding RX/string form." - (let ((all-bounds (get-char-property (point) 'rxt-bounds))) - (mapc #'delete-overlay rxt-highlight-overlays) - (setq rxt-highlight-overlays nil) - (dolist (bounds all-bounds) - (cl-destructuring-bind (begin end) bounds - (let ((overlay (make-overlay begin end))) - (push overlay rxt-highlight-overlays) - (overlay-put overlay 'face 'rxt-highlight-face)))))) - - -;;;; Error handling - -(if (fboundp 'define-error) - (define-error 'rxt-invalid-regexp "Invalid regexp" 'invalid-regexp) - (put 'rxt-invalid-regexp - 'error-conditions - '(rxt-invalid-regexp invalid-regexp error)) - (put 'rxt-invalid-regexp 'error-message "Invalid regexp")) - -(defun rxt-error (&rest format-args) - (signal 'rxt-invalid-regexp (list (apply #'format format-args)))) - - -;;;; Regexp syntax tree data type - -;; Base class from which other elements of the syntax-tree inherit -(cl-defstruct rxt-syntax-tree) - -;; Struct representing the original source location -(cl-defstruct rxt-location - source ; Either a string or a buffer - start end ; Offsets, 0- or 1-indexed as appropriate - ) - -(defun rxt-location-text (location) - (if (not (rxt-location-p location)) - nil - (let ((start (rxt-location-start location)) - (end (rxt-location-end location)) - (source (rxt-location-source location))) - (cond - ((buffer-live-p source) - (with-current-buffer source - (buffer-substring-no-properties start end))) - ((stringp source) - (substring source start end)) - (t nil))))) - -;; Hash table mapping from syntax-tree elements to source locations. -(defvar rxt-location-map (make-hash-table :weakness 'key)) - -(defun rxt-location (object) - (gethash object rxt-location-map)) - -(gv-define-setter rxt-location (value object) - `(puthash ,object ,value rxt-location-map)) - -(defun rxt-source-text (object) - (rxt-location-text (rxt-location object))) - -(defun rxt-to-string (tree) - "Return a readable representation of TREE, a regex syntax-tree object." - (or (rxt-source-text tree) - (let ((print-level 1)) - (prin1-to-string tree)))) -(defalias 'rxt-syntax-tree-readable 'rxt-to-string) - -;; FIXME -(defvar rxt-pcre-case-fold nil) - -;; Literal string -(cl-defstruct - (rxt-string - (:constructor rxt-string (chars &optional case-fold)) - (:include rxt-syntax-tree)) - chars - (case-fold rxt-pcre-case-fold)) - -(defun rxt-empty-string () - (rxt-string "")) - -(defun rxt-trivial-p (re) - (and (rxt-string-p re) - (equal (rxt-string-chars re) ""))) - -;;; Other primitives -(cl-defstruct (rxt-primitive - (:constructor rxt-primitive (pcre rx)) - (:include rxt-syntax-tree)) - pcre rx) - -(defun rxt-bos () (rxt-primitive "\\A" 'bos)) -(defun rxt-eos () (rxt-primitive "\\Z" 'eos)) - -(defun rxt-bol () (rxt-primitive "^" 'bol)) -(defun rxt-eol () (rxt-primitive "$" 'eol)) - -;; FIXME -(defun rxt-anything () (rxt-primitive "." 'anything)) -(defun rxt-nonl () (rxt-primitive "." 'nonl)) - -(defun rxt-word-boundary () (rxt-primitive "\\b" 'word-boundary)) -(defun rxt-not-word-boundary () (rxt-primitive "\\B" 'not-word-boundary)) - -(defun rxt-wordchar () (rxt-primitive "\\w" 'wordchar)) -(defun rxt-not-wordchar () (rxt-primitive "\\W" 'not-wordchar)) - -(defun rxt-symbol-start () (rxt-primitive nil 'symbol-start)) -(defun rxt-symbol-end () (rxt-primitive nil 'symbol-end)) - -(defun rxt-bow () (rxt-primitive nil 'bow)) -(defun rxt-eow () (rxt-primitive nil 'eow)) - -;;; Sequence -(cl-defstruct - (rxt-seq - (:constructor make-rxt-seq (elts)) - (:include rxt-syntax-tree)) - elts) - -;; Slightly smart sequence constructor: -;; - Flattens nested sequences -;; - Drops trivial "" elements -;; - Empty sequence => "" -;; - Singleton sequence is reduced to its one element. -(defun rxt-seq (&rest res) ; Flatten nested seqs & drop ""'s. - (let ((res (rxt-seq-flatten res))) - (if (consp res) - (if (consp (cdr res)) - (make-rxt-seq res) ; General case - (car res)) ; Singleton sequence - (rxt-empty-string)))) ; Empty seq -- "" - -(defun rxt-seq-flatten (res) - (if (consp res) - (let ((re (car res)) - (tail (rxt-seq-flatten (cdr res)))) - (cond ((rxt-seq-p re) ; Flatten nested seqs - (append (rxt-seq-flatten (rxt-seq-elts re)) tail)) - ((rxt-trivial-p re) tail) ; Drop trivial elts - ((and (rxt-string-p re) ; Flatten strings - (consp tail) - (rxt-string-p (car tail))) - (cons - (rxt-string-concat re (car tail)) - (cdr tail))) - (t (cons re tail)))) - '())) - -(defun rxt-string-concat (str1 str2) - (if (not (eq (rxt-string-case-fold str1) - (rxt-string-case-fold str2))) - (make-rxt-seq (list str1 str2)) - (let ((result - (rxt-string (concat (rxt-string-chars str1) - (rxt-string-chars str2)) - (rxt-string-case-fold str1))) - (first (rxt-location str1)) - (last (rxt-location str2))) - (when (and first last) - (setf (rxt-location result) - (make-rxt-location :source (rxt-location-source first) - :start (rxt-location-start first) - :end (rxt-location-end last)))) - result))) - -;;; Choice (alternation/union) -(cl-defstruct - (rxt-choice - (:constructor make-rxt-choice (elts)) - (:include rxt-syntax-tree)) - elts) - -;;; The empty choice represents a regexp that never matches in any context -(defvar rxt-empty (make-rxt-choice nil)) -(defun rxt-empty-p (re) - (or - (and (rxt-choice-p re) - (null (rxt-choice-elts re))) - (rxt-empty-char-set-p re))) - -(defun rxt-choice (&rest alternatives) - "Construct the alternation (union) of several regexps. - -ALTERNATIVES should be a list of `rxt-syntax-tree' objects. -The return value is an `rxt-choice' object representing a regexp -which matches any one of ALTERNATIVES, but simplified in the -following ways: - -- If ALTERNATIVES contains only one element, it is returned unchanged. - -- All existing `rxt-choice' elements in ALTERNATIVES are replaced - by a flat list of their subexpressions: symbolically, - a|(b|(c|d)) is replaced by a|b|c|d - -- All character sets and single-character strings in ALTERNATIVES - are combined together into one or two character sets, - respecting case-folding behaviour." - (cl-destructuring-bind (other-elements char-set case-fold-char-set) - (rxt--simplify-alternatives alternatives) - (let ((simplified-alternatives - (append (if (not (rxt-empty-p char-set)) - (list char-set) - '()) - (if (not (rxt-empty-p case-fold-char-set)) - (list case-fold-char-set) - '()) - other-elements))) - (pcase simplified-alternatives - (`() - rxt-empty) - (`(,element) - element) - (_ - (make-rxt-choice simplified-alternatives)))))) - -(defun rxt--simplify-alternatives (alternatives) - "Simplify a set of regexp alternatives. - -ALTERNATIVES should be a list of `rxt-syntax-tree' objects to be combined -into an `rxt-choice' structure. The result is a three-element -list (OTHER-ELEMENTS CHAR-SET CASE-FOLDED-CHAR-SET): - -- CHAR-SET is an `rxt-char-set-union' containing the union of all - case-sensitive character sets and single-character strings in - RES. - -- CASE-FOLDED-CHAR-SET is similar but combines all the - case-insensitive character sets and single-character strings. - -- OTHER-ELEMENTS is a list of all other elements, with all - `rxt-choice' structures replaced by a flat list of their - component subexpressions." - (if (null alternatives) - (list '() - (make-rxt-char-set-union :case-fold nil) - (make-rxt-char-set-union :case-fold t)) - (let* ((re (car alternatives))) - (cl-destructuring-bind (tail char-set case-fold-char-set) - (rxt--simplify-alternatives (cdr alternatives)) - (cond ((rxt-choice-p re) ; Flatten nested choices - (list - (append (rxt-choice-elts re) tail) - char-set - case-fold-char-set)) - - ((rxt-empty-p re) ; Drop empty re's. - (list tail char-set case-fold-char-set)) - - ((rxt-char-set-union-p re) ; Fold char sets together - (if (rxt-char-set-union-case-fold re) - (list tail - char-set - (rxt-char-set-union case-fold-char-set re)) - (list tail - (rxt-char-set-union char-set re) - case-fold-char-set))) - - ((and (rxt-string-p re) ; Same for 1-char strings - (= 1 (length (rxt-string-chars re)))) - (if (rxt-string-case-fold re) - (list tail - char-set - (rxt-char-set-union case-fold-char-set re)) - (list tail - (rxt-char-set-union char-set re) - case-fold-char-set))) - - (t ; Otherwise. - (list (cons re tail) char-set case-fold-char-set))))))) - -;;; Repetition -(cl-defstruct (rxt-repeat - (:include rxt-syntax-tree)) - from to body greedy) - -(cl-defun rxt-repeat (from to body &optional (greedy t)) - (if (equal to 0) - (rxt-empty-string) - (make-rxt-repeat :from from :to to - :body body :greedy greedy))) - -;;; Submatch -(cl-defstruct - (rxt-submatch - (:constructor rxt-submatch (body)) - (:include rxt-syntax-tree)) - body) - -;;; Numbered submatch (Emacs only) -(cl-defstruct - (rxt-submatch-numbered - (:constructor rxt-submatch-numbered (n body)) - (:include rxt-syntax-tree)) - n - body) - -;;; Backreference -(cl-defstruct - (rxt-backref - (:constructor rxt-backref (n)) - (:include rxt-syntax-tree)) - n) - -;;; Syntax classes (Emacs only) -(cl-defstruct (rxt-syntax-class - (:include rxt-syntax-tree)) - symbol) - -(defun rxt-syntax-class (symbol) - (if (assoc symbol rx--syntax-codes) - (make-rxt-syntax-class :symbol symbol) - (rxt-error "Invalid syntax class symbol `%s'" symbol))) - -;;; Character categories (Emacs only) -(cl-defstruct (rxt-char-category - (:include rxt-syntax-tree)) - symbol) - -(defun rxt-char-category (symbol) - (if (assoc symbol rx--categories) - (make-rxt-char-category :symbol symbol) - (rxt-error "Invalid character category symbol `%s'" symbol))) - - -;;; Char sets -;; ::= -;; | -;; | - -(cl-defstruct (rxt-char-set (:include rxt-syntax-tree))) - -;; An rxt-char-set-union represents the union of any number of -;; characters, character ranges, and POSIX character classes: anything -;; that can be represented in string notation as a class [ ... ] -;; without the negation operator. -(cl-defstruct (rxt-char-set-union - (:include rxt-char-set)) - chars ; list of single characters - ranges ; list of ranges (from . to) - classes ; list of character classes - (case-fold rxt-pcre-case-fold)) - -;; Test for empty character set -(defun rxt-empty-char-set-p (cset) - (and (rxt-char-set-union-p cset) - (null (rxt-char-set-union-chars cset)) - (null (rxt-char-set-union-ranges cset)) - (null (rxt-char-set-union-classes cset)))) - -;; Simple union constructor -(defun rxt-char-set-union (&rest items) - "Construct an regexp character set representing the union of ITEMS. - -Each element of ITEMS may be either: a character; a -single-character string; a single-character `rxt-string' object; -a cons, (FROM . TO) representing a range of characters; a symbol, -representing a named character class; or an `rxt-char-set-union' -object. All `rxt-char-set-union' objects in ITEMS must have the -same `case-fold' property." - (let ((chars '()) - (ranges '()) - (classes '()) - (case-fold 'undetermined)) - (dolist (item items) - (cl-etypecase item - (character - (push item chars)) - - (string - (cl-assert (= 1 (length item))) - (push (string-to-char item) chars)) - - (rxt-string - (cl-assert (= 1 (length (rxt-string-chars item)))) - (push (string-to-char (rxt-string-chars item)) chars)) - - (cons ; range (from . to) - (cl-check-type (car item) character) - (cl-check-type (cdr item) character) - (push item ranges)) - - (symbol ; named character class - (push item classes)) - - (rxt-char-set-union - (if (eq case-fold 'undetermined) - (setq case-fold (rxt-char-set-union-case-fold item)) - (unless (eq case-fold (rxt-char-set-union-case-fold item)) - (error "Cannot construct union of char-sets with unlike case-fold setting: %S" item))) - (setq chars (nconc chars (rxt-char-set-union-chars item))) - (setq ranges (nconc ranges (rxt-char-set-union-ranges item))) - (setq classes (nconc classes (rxt-char-set-union-classes item)))))) - - (make-rxt-char-set-union :chars chars :ranges ranges :classes classes - :case-fold (if (eq case-fold 'undetermined) - rxt-pcre-case-fold - case-fold)))) - -(defun rxt--all-char-set-union-chars (char-set) - "Return a list of all characters in CHAR-SET." - (cl-assert (rxt-char-set-union-p char-set)) - (append - (rxt-char-set-union-chars char-set) - (cl-loop for (start . end) in (rxt-char-set-union-ranges char-set) - nconc (cl-loop for char from start to end collect char)))) - -(defun rxt--simplify-char-set (char-set &optional case-fold-p) - "Return a minimal char-set to match the same characters as CHAR-SET. - -With optional argument CASE-FOLD-P, return a char-set which -emulates case-folding behaviour by including both uppercase and -lowercase versions of all characters in CHAR-SET." - (cl-assert (rxt-char-set-union-p char-set)) - (let* ((classes (rxt-char-set-union-classes char-set)) - (all-chars - (if case-fold-p - (cl-loop for char in (rxt--all-char-set-union-chars char-set) - nconc (list (upcase char) (downcase char))) - (rxt--all-char-set-union-chars char-set))) - (all-ranges - (rxt--extract-ranges (rxt--remove-redundant-chars all-chars classes)))) - (let ((singletons nil) - (ranges nil)) - (cl-loop for (start . end) in all-ranges - do - (cond ((= start end) (push start singletons)) - ((= (1+ start) end) - (push start singletons) - (push end singletons)) - (t (push (cons start end) ranges)))) - (make-rxt-char-set-union :chars (nreverse singletons) - :ranges (nreverse ranges) - :classes classes - :case-fold (if case-fold-p - nil - (rxt-char-set-union-case-fold char-set)))))) - -(defun rxt--remove-redundant-chars (chars classes) - "Remove all characters which match a character class in CLASSES from CHARS." - (if (null classes) - chars - (string-to-list - (replace-regexp-in-string - (rx-to-string `(any ,@classes)) - "" - (apply #'string chars))))) - -(defun rxt--extract-ranges (chars) - "Return a list of all contiguous ranges in CHARS. - -CHARS should be a list of characters (integers). The return -value is a list of conses (START . END) representing ranges, such -that the union of all the ranges represents the same of -characters as CHARS. - -Example: - (rxt--extract-ranges (list ?a ?b ?c ?q ?x ?y ?z)) - => ((?a . ?c) (?q . ?q) (?x . ?z))" - (let ((array - (apply #'vector - (cl-remove-duplicates - (sort (copy-sequence chars) #'<))))) - (cl-labels - ((recur (start end) - (if (< end start) - nil - (let ((min (aref array start)) - (max (aref array end))) - (if (= (- max min) (- end start)) - (list (cons min max)) - (let* ((split-point (/ (+ start end) 2)) - (left (recur start split-point)) - (right (recur (1+ split-point) end))) - (pcre2el-merge left right)))))) - (pcre2el-merge (left right) - (cond ((null left) right) - ((null right) left) - (t - (let ((last-left (car (last left))) - (first-right (car right))) - (if (= (1+ (cdr last-left)) - (car first-right)) - (append (cl-subseq left 0 -1) - (list - (cons (car last-left) - (cdr first-right))) - (cl-subseq right 1)) - (append left right))))))) - (recur 0 (1- (length array)))))) - -;;; Set complement of character set, syntax class, or character -;;; category - -;; In general, all character sets that can be represented in string -;; notation as [^ ... ] (but see `rxt-char-set-intersection', below), plus -;; Emacs' \Sx and \Cx constructions. -(cl-defstruct (rxt-char-set-negation - (:include rxt-char-set)) - elt) - -(defun rxt-negate (char-set) - "Construct the logical complement (negation) of CHAR-SET. - -CHAR-SET may be any of the following types: `rxt-char-set-union', -`rxt-syntax-class', `rxt-char-category', or `rxt-char-set-negation'." - (cl-etypecase char-set - ((or rxt-char-set-union rxt-syntax-class rxt-char-category) - (make-rxt-char-set-negation :elt char-set)) - - (rxt-char-set-negation - (rxt-char-set-negation-elt char-set)))) - -;;; Intersections of char sets - -;; These are difficult to represent in general, but can be constructed -;; in Perl using double negation; for example: [^\Wabc] means the set -;; complement of [abc] with respect to the universe of "word -;; characters": (& (~ (~ word)) (~ ("abc"))) == (& word (~ ("abc"))) -;; == (- word ("abc")) - -(cl-defstruct (rxt-char-set-intersection - (:include rxt-char-set)) - elts) - -;; Intersection constructor -(defun rxt-char-set-intersection (&rest charsets) - (let ((elts '()) - (cmpl (make-rxt-char-set-union))) - (dolist (cset (rxt-int-flatten charsets)) - (cond - ((rxt-char-set-negation-p cset) - ;; Fold negated charsets together: ~A & ~B = ~(A|B) - (setq cmpl (rxt-char-set-union cmpl (rxt-char-set-negation-elt cset)))) - - ((rxt-char-set-union-p cset) - (push cset elts)) - - (t - (rxt-error "Can't take intersection of non-character-set %S" cset)))) - - (if (null elts) - (rxt-negate cmpl) - (unless (rxt-empty-char-set-p cmpl) - (push (rxt-negate cmpl) elts)) - (if (null (cdr elts)) - (car elts) ; singleton case - (make-rxt-char-set-intersection :elts elts))))) - -;; Constructor helper: flatten nested intersections -(defun rxt-int-flatten (csets) - (if (consp csets) - (let ((cset (car csets)) - (tail (rxt-int-flatten (cdr csets)))) - (if (rxt-char-set-intersection-p cset) - (append (rxt-int-flatten (rxt-char-set-intersection-elts cset)) tail) - (cons cset tail))) - '())) - - - -;;;; Macros for building the parser - -(defmacro rxt-token-case (&rest cases) - "Consume a token at point and evaluate corresponding forms. - -CASES is a list of `cond'-like clauses, (REGEXP BODY ...) where -the REGEXPs define possible tokens which may appear at point. The -CASES are considered in order. For each case, if the text at -point matches REGEXP, then point is moved to the end of the -matched token, the corresponding BODY is evaluated and their -value returned. The matched token is available within the BODY -forms as (match-string 0). - -There can be a default case where REGEXP is `t', which evaluates -the corresponding FORMS but does not move point. - -Returns `nil' if none of the CASES matches." - (declare (debug (&rest (sexp &rest form)))) - `(cond - ,@(cl-loop for (token . action) in cases - collect - (if (eq token t) - `(t ,@action) - `((looking-at ,token) - (goto-char (match-end 0)) - ,@action))))) - -(defmacro rxt-with-source-location (&rest body) - "Evaluate BODY and record source location information on its value. - -BODY may evaluate to any kind of object, but its value should -generally not be `eq' to any other object." - (declare (debug (&rest form))) - (let ((begin (make-symbol "begin")) - (value (make-symbol "value"))) - `(let ((,begin (point)) - (,value ,(macroexp-progn body))) - (setf (rxt-location ,value) - (make-rxt-location :source rxt-source-text-string - :start (1- ,begin) - :end (1- (point)))) - ,value))) - -;; Read PCRE + flags -(defun rxt-read-delimited-pcre () - "Read a Perl-style delimited regexp and flags from the current buffer. - -Point should be before the regexp literal before calling -this. Currently only regexps delimited by / ... / are supported. -A preceding \"m\", \"qr\" or \"s\" will be ignored, as will the -replacement string in an s/.../.../ construction. - -Returns two strings: the regexp and the flags." - (save-excursion - (skip-syntax-forward "-") - - ;; Skip m, qr, s - (let ((is-subst (rxt-token-case - ("s" t) - ((rx (or "m" "qr")) nil)))) - - (when (not (looking-at "/")) - (error "Only Perl regexps delimited by slashes are supported")) - (let ((beg (match-end 0)) - (delim (rx (not (any "\\")) - (group "/")))) - (search-forward-regexp delim) - (let ((end (match-beginning 1))) - (when is-subst (search-forward-regexp delim)) - (let ((pcre (buffer-substring-no-properties beg end))) - (rxt-token-case - ("[gimosx]*" - (rxt--add-flags pcre (match-string-no-properties 0)))))))))) - - -;;;; Elisp and PCRE string notation parser - -;;; Parser constants -(defconst rxt-pcre-char-set-alist - `((?w . ; "word" characters - (?_ alnum)) - (?d . ; digits - (digit)) - (?h . ; horizontal whitespace - (#x0009 #x0020 #x00A0 #x1680 #x180E #x2000 #x2001 #x2002 #x2003 - #x2004 #x2005 #x2006 #x2007 #x2008 #x2009 #x200A #x202F - #x205F #x3000)) - (?s . ; whitespace - (9 10 12 13 32)) - (?v . ; vertical whitespace - (#x000A #x000B #x000C #x000D #x0085 #x2028 #x2029)))) - -(defconst rxt-pcre-named-classes-regexp - (rx "[:" - (submatch - (or "alnum" "alpha" "ascii" "blank" "cntrl" "digit" "graph" "lower" - "print" "punct" "space" "upper" "word" "xdigit")) - ":]")) - -(defconst rxt-elisp-named-classes-regexp - (rx "[:" - (submatch - (or "alnum" "alpha" "ascii" "blank" "cntrl" "digit" "graph" "lower" - "print" "punct" "space" "upper" "word" "xdigit" - "unibyte" "nonascii" "multibyte")) - ":]")) - -;;; The following dynamically bound variables control the operation of -;;; the parser (see `rxt-parse-re'.) -(defvar rxt-parse-pcre nil - "t if the rxt string parser is parsing PCRE syntax, nil for Elisp syntax. - -This should only be let-bound internally, never set otherwise.") - -(defvar rxt-pcre-extended-mode nil - "t if the rxt string parser is emulating PCRE's \"extended\" mode. - -In extended mode (indicated by /x in Perl/PCRE), whitespace -outside of character classes and \\Q...\\E quoting is ignored, -and a `#' character introduces a comment that extends to the end -of line.") - -(defvar rxt-pcre-s-mode nil - "t if the rxt string parser is emulating PCRE's single-line \"/s\" mode. - -When /s is used, PCRE's \".\" matches newline characters, which -otherwise it would not match.") - -(defvar rxt-pcre-case-fold nil - "non-nil to emulate PCRE's case-insensitive \"/i\" mode in translated regexps.") - -(defvar rxt-branch-end-regexp nil) -(defvar rxt-choice-regexp nil) -(defvar rxt-brace-begin-regexp nil) -(defvar rxt-m-to-n-brace-regexp nil) -(defvar rxt-m-to-?-brace-regexp nil) -(defvar rxt-m-brace-regexp nil) -(defvar rxt-named-classes-regexp nil) - -(defvar rxt-subgroup-count nil) -(defvar rxt-source-text-string nil) - -(defun rxt-parse-pcre (re) - (rxt-parse-re re t)) - -(defun rxt-parse-elisp (re) - (rxt-parse-re re nil)) - -(defun rxt-parse-re (re pcre-p) - (let* ((rxt-parse-pcre pcre-p) - (rxt-pcre-extended-mode nil) - (rxt-pcre-s-mode nil) - (rxt-pcre-case-fold nil) - - ;; Bind regexps to match syntax that differs between PCRE and - ;; Elisp only in the addition of a backslash "\" - (escape (if pcre-p "" "\\")) - (rxt-choice-regexp - (rx-to-string `(seq ,escape "|"))) - (rxt-branch-end-regexp - (rx-to-string `(or buffer-end - (seq ,escape (or "|" ")"))))) - (rxt-brace-begin-regexp - (rx-to-string `(seq ,escape "{"))) - (rxt-m-to-n-brace-regexp - (rx-to-string - `(seq - (submatch (* (any "0-9"))) "," (submatch (+ (any "0-9"))) - ,escape "}"))) - (rxt-m-to-?-brace-regexp - (rx-to-string - `(seq (submatch (+ (any "0-9"))) "," ,escape "}"))) - (rxt-m-brace-regexp - (rx-to-string - `(seq (submatch (+ (any "0-9"))) ,escape "}"))) - - ;; Named character classes [: ... :] differ slightly - (rxt-named-classes-regexp - (if pcre-p - rxt-pcre-named-classes-regexp - rxt-elisp-named-classes-regexp)) - - (rxt-subgroup-count 0) - (case-fold-search nil)) - (with-temp-buffer - (insert re) - (goto-char (point-min)) - (let ((rxt-source-text-string re)) - (rxt-parse-exp))))) - -;; Parse a complete regex: a number of branches separated by | or -;; \|, as determined by `rxt-branch-end-regexp'. -(defun rxt-parse-exp () - ;; These variables are let-bound here because in PCRE mode they may - ;; be set internally by (?x) or (?s) constructions, whose scope - ;; lasts until the end of a sub-expression - (rxt-with-source-location - (let ((rxt-pcre-extended-mode rxt-pcre-extended-mode) - (rxt-pcre-s-mode rxt-pcre-s-mode) - (rxt-pcre-case-fold rxt-pcre-case-fold)) - (if (eobp) - (rxt-seq) - (let ((branches '())) - (cl-block nil - (while t - (let ((branch (rxt-parse-branch))) - (push branch branches) - (rxt-token-case - (rxt-choice-regexp nil) - (t (cl-return (apply #'rxt-choice (reverse branches))))))))))))) - -;; Skip over whitespace and comments in PCRE extended mode -(defun rxt-extended-skip () - (when rxt-pcre-extended-mode - (skip-syntax-forward "-") - (while (looking-at "#") - (beginning-of-line 2) - (skip-syntax-forward "-")))) - -;; Parse a regexp "branch": a sequence of pieces -(defun rxt-parse-branch () - (rxt-extended-skip) - (rxt-with-source-location - (let ((pieces '()) - (branch-start-p t)) - (while (not (looking-at rxt-branch-end-regexp)) - (push (rxt-parse-piece branch-start-p) pieces) - (setq branch-start-p nil)) - (apply #'rxt-seq (reverse pieces))))) - -;; Parse a regexp "piece": an atom (`rxt-parse-atom') plus any -;; following quantifiers -(defun rxt-parse-piece (&optional branch-begin) - (rxt-extended-skip) - (rxt-with-source-location - (let ((atom (rxt-parse-atom branch-begin))) - (rxt-parse-quantifiers atom)))) - -;; Parse any and all quantifiers after ATOM and return the quantified -;; regexp, or ATOM unchanged if no quantifiers -(defun rxt-parse-quantifiers (atom) - (catch 'done - (while (not (eobp)) - (let ((atom1 (rxt-parse-quantifier atom))) - (if (eq atom1 atom) - (throw 'done t) - (setq atom atom1))))) - atom) - -;; Possibly parse a single quantifier after ATOM and return the -;; quantified atom, or ATOM if no quantifier -(defun rxt-parse-quantifier (atom) - (rxt-extended-skip) - (rxt-token-case - ((rx "*?") (rxt-repeat 0 nil atom nil)) - ((rx "*") (rxt-repeat 0 nil atom t)) - ((rx "+?") (rxt-repeat 1 nil atom nil)) - ((rx "+") (rxt-repeat 1 nil atom t)) - ((rx "??") (rxt-repeat 0 1 atom nil)) - ((rx "?") (rxt-repeat 0 1 atom t)) - ;; Brace expression "{M,N}", "{M,}", "{M}" - (rxt-brace-begin-regexp - (cl-destructuring-bind (from to) - (rxt-parse-braces) - (rxt-repeat from to atom))) - ;; No quantifiers found - (t atom))) - -;; Parse a regexp atom, i.e. an element that binds to any following -;; quantifiers. This includes characters, character classes, -;; parenthesized groups, assertions, etc. -(defun rxt-parse-atom (&optional branch-begin) - (if (eobp) - (rxt-error "Unexpected end of regular expression") - (if rxt-parse-pcre - (rxt-parse-atom/pcre) - (rxt-parse-atom/el branch-begin)))) - -(defun rxt-parse-atom/common () - (rxt-token-case - ((rx "[") (rxt-parse-char-class)) - ((rx "\\b") (rxt-word-boundary)) - ((rx "\\B") (rxt-not-word-boundary)))) - -(defun rxt-parse-atom/el (branch-begin) - (rxt-with-source-location - (or (rxt-parse-atom/common) - (rxt-token-case - ;; "." wildcard - ((rx ".") (rxt-nonl)) - ;; "^" and "$" are metacharacters only at beginning or end of a - ;; branch in Elisp; elsewhere they are literals - ((rx "^") - (if branch-begin - (rxt-bol) - (rxt-string "^"))) - ((rx "$") - (if (looking-at rxt-branch-end-regexp) - (rxt-eol) - (rxt-string "$"))) - ;; Beginning & end of string, word, symbol - ((rx "\\`") (rxt-bos)) - ((rx "\\'") (rxt-eos)) - ((rx "\\<") (rxt-bow)) - ((rx "\\>") (rxt-eow)) - ((rx "\\_<") (rxt-symbol-start)) - ((rx "\\_>") (rxt-symbol-end)) - ;; Subgroup - ((rx "\\(") (rxt-parse-subgroup/el)) - ;; Word/non-word characters (meaning depending on syntax table) - ((rx "\\w") (rxt-wordchar)) - ((rx "\\W") (rxt-not-wordchar)) - ;; Other syntax categories - ((rx "\\" (submatch (any ?S ?s)) (submatch nonl)) - (let ((negated (string= (match-string 1) "S")) - (syntax - (car (rassoc (string-to-char (match-string 2)) - rx--syntax-codes)))) - (if syntax - (let ((re (rxt-syntax-class syntax))) - (if negated (rxt-negate re) re)) - (rxt-error "Invalid syntax class `\\%s'" (match-string 0))))) - ;; Character categories - ((rx "\\" (submatch (any ?C ?c)) (submatch nonl)) - (let ((negated (string= (match-string 1) "C")) - (category - (car (rassoc (string-to-char (match-string 2)) - rx--categories)))) - (if category - (let ((re (rxt-char-category category))) - (if negated (rxt-negate re) re)) - (rxt-error "Invalid character category `%s'" (match-string 0))))) - ;; Backreference - ((rx (seq "\\" (submatch (any "1-9")))) - (rxt-backref (string-to-number (match-string 1)))) - ;; Other escaped characters - ((rx (seq "\\" (submatch nonl))) - (rxt-string (match-string 1))) - ;; Normal characters - ((rx (or "\n" nonl)) - (rxt-string (match-string 0))))))) - -(defun rxt-parse-atom/pcre () - (rxt-extended-skip) - (rxt-with-source-location - (or - ;; Is it an atom that's the same in Elisp? - (rxt-parse-atom/common) - ;; Is it common to PCRE regex and character class syntax? - (let ((char (rxt-parse-escapes/pcre))) - (and char - (rxt-string (char-to-string char)))) - ;; Otherwise: - (rxt-token-case - ;; "." wildcard - ((rx ".") - (if rxt-pcre-s-mode - (rxt-anything) - (rxt-nonl))) - ;; Beginning & end of string/line - ((rx "^") (rxt-bol)) - ((rx "$") (rxt-eol)) - ((rx "\\A") (rxt-bos)) - ((rx "\\Z") (rxt-eos)) - ;; Subgroup - ((rx "(") (rxt-parse-subgroup/pcre)) - ;; Metacharacter quoting - ((rx "\\Q") - ;; It would seem simple to take all the characters between \Q - ;; and \E and make an rxt-string, but \Q...\E isn't an atom: - ;; any quantifiers afterward should bind only to the last - ;; character, not the whole string. - (let ((begin (point))) - (search-forward "\\E" nil t) - (let* ((end (match-beginning 0)) - (str (buffer-substring-no-properties begin (1- end))) - (char (char-to-string (char-before end)))) - (rxt-seq (rxt-string str) - (rxt-parse-quantifiers (rxt-string char)))))) - ;; Pre-defined character sets - ((rx "\\" (submatch (any "d" "D" "h" "H" "s" "S" "v" "V" "w" "W"))) - (rxt--pcre-char-set (string-to-char (match-string 1)))) - ;; \ + digits: backreference or octal char? - ((rx "\\" (submatch (+ (any "0-9")))) - (let* ((digits (match-string 1)) - (dec (string-to-number digits))) - ;; from "man pcrepattern": If the number is less than 10, or if - ;; there have been at least that many previous capturing left - ;; parentheses in the expression, the entire sequence is taken - ;; as a back reference. - (if (and (> dec 0) - (or (< dec 10) - (>= rxt-subgroup-count dec))) - (progn - (when rxt-pcre-case-fold - (display-warning - 'rxt "Backreferences with case-folding are handled poorly")) - (rxt-backref dec)) - ;; from "man pcrepattern": if the decimal number is greater - ;; than 9 and there have not been that many capturing - ;; subpatterns, PCRE re-reads up to three octal digits - ;; following the backslash, and uses them to generate a data - ;; character. Any subsequent digits stand for themselves. - (goto-char (match-beginning 1)) - (re-search-forward (rx (** 0 3 (any "0-7")))) - (rxt-string (char-to-string (string-to-number (match-string 0) 8)))))) - ;; Other escaped characters - ((rx "\\" (submatch nonl)) (rxt-string (match-string 1))) - ;; Everything else - ((rx (or (any "\n") nonl)) (rxt-string (match-string 0))))))) - -(defun rxt-parse-escapes/pcre () - "Consume a one-char PCRE escape at point and return its codepoint equivalent. - -Handles only those character escapes which have the same meaning -in character classes as outside them." - (rxt-token-case - ((rx "\\a") #x07) ; bell - ((rx "\\e") #x1b) ; escape - ((rx "\\f") #x0c) ; formfeed - ((rx "\\n") #x0a) ; linefeed - ((rx "\\r") #x0d) ; carriage return - ((rx "\\t") #x09) ; tab - ;; Control character - ((rx "\\c" (submatch nonl)) - ;; from `man pcrepattern': - ;; The precise effect of \cx is as follows: if x is a lower case - ;; letter, it is converted to upper case. Then bit 6 of the - ;; character (hex 40) is inverted. - (logxor (string-to-char (upcase (match-string 1))) #x40)) - ;; Hex escapes - ((rx "\\x" (submatch (** 1 2 (any "0-9" "A-Z" "a-z")))) - (string-to-number (match-string 1) 16)) - ((rx "\\x{" (submatch (* (any "0-9" "A-Z" "a-z"))) "}") - (string-to-number (match-string 1) 16)))) - -(defun rxt-parse-subgroup/pcre () - (catch 'return - (let ((shy nil) - (extended-mode rxt-pcre-extended-mode) - (single-line-mode rxt-pcre-s-mode) - (case-fold rxt-pcre-case-fold)) - (rxt-extended-skip) - ;; Check for special (? ..) and (* ...) syntax - (rxt-token-case - ((rx "?") ; (? - (rxt-token-case - ((rx ")") ; Empty group (?) - (throw 'return (rxt-empty-string))) - (":" (setq shy t)) ; Shy group (?: - ("#" ; Comment (?# - (search-forward ")") - (throw 'return (rxt-empty-string))) - ((rx (or ; Flags (?isx-isx - (seq (group (* (any "gimosx"))) "-" (group (+ (any "gimosx")))) - (seq (group (+ (any "gimosx")))))) - (let ((token (match-string 0)) - (on (or (match-string 1) (match-string 3))) - (off (or (match-string 2) ""))) - (if (cl-find ?x on) (setq extended-mode t)) - (if (cl-find ?s on) (setq single-line-mode t)) - (if (cl-find ?i on) (setq case-fold t)) - (if (cl-find ?x off) (setq extended-mode nil)) - (if (cl-find ?s off) (setq single-line-mode nil)) - (if (cl-find ?i off) (setq case-fold nil)) - (when (string-match-p "[gmo]" token) - (display-warning - 'rxt (format "Unhandled PCRE flags in (?%s" token)))) - (rxt-token-case - (":" (setq shy t)) ; Shy group with flags (?isx-isx: ... - (")" ; Set flags (?isx-isx) - ;; Set flags for the remainder of the current subexpression - (setq rxt-pcre-extended-mode extended-mode - rxt-pcre-s-mode single-line-mode - rxt-pcre-case-fold case-fold) - (throw 'return (rxt-empty-string))))) - ;; Other constructions like (?=, (?!, etc. are not recognised - (t (rxt-error "Unrecognized PCRE extended construction `(?%c'" - (char-after))))) - - ;; No special (* ...) verbs are recognised - ((rx "*") - (let ((begin (point))) - (search-forward ")" nil 'go-to-end) - (rxt-error "Unrecognized PCRE extended construction `(*%s'" - (buffer-substring begin (point)))))) - - ;; Parse the remainder of the subgroup - (unless shy (cl-incf rxt-subgroup-count)) - (let* ((rxt-pcre-extended-mode extended-mode) - (rxt-pcre-s-mode single-line-mode) - (rxt-pcre-case-fold case-fold) - (rx (rxt-parse-exp))) - (rxt-extended-skip) - (rxt-token-case - (")" (if shy rx (rxt-submatch rx))) - (t (rxt-error "Subexpression missing close paren"))))))) - -(defun rxt-parse-subgroup/el () - (let ((kind - (rxt-token-case - ((rx "?:") - (cl-incf rxt-subgroup-count) - 'shy) - ((rx "?" (group (+ (in "0-9"))) ":") - (let ((n (string-to-number (match-string 1)))) - (when (< rxt-subgroup-count n) - (setf rxt-subgroup-count n)) - n)) - ((rx "?") ; Reserved - (rxt-error "Unknown match group sequence"))))) - (let ((rx (rxt-parse-exp))) - (rxt-token-case - ((rx "\\)") - (cond ((eq kind 'shy) rx) - ((numberp kind) - (rxt-submatch-numbered kind rx)) - (t (rxt-submatch rx)))) - (t (rxt-error "Subexpression missing close paren")))))) - -(defun rxt-parse-braces () - (rxt-token-case - (rxt-m-to-n-brace-regexp - (list (string-to-number (match-string 1)) - (string-to-number (match-string 2)))) - (rxt-m-to-?-brace-regexp - (list (string-to-number (match-string 1)) nil)) - (rxt-m-brace-regexp - (let ((a (string-to-number (match-string 1)))) - (list a a))) - (t - (let ((begin (point))) - (search-forward "}" nil 'go-to-end) - (rxt-error "Bad brace expression {%s" - (buffer-substring-no-properties begin (point))))))) - -;; Parse a character set range [...] -(defun rxt-parse-char-class () - (when (eobp) - (rxt-error "Missing close right bracket in regexp")) - (rxt-with-source-location - (let* ((negated (rxt-token-case - ((rx "^") t) - (t nil))) - (begin (point)) - (result - (if negated - (rxt-negate (rxt-char-set-union)) - (rxt-char-set-union))) - (transformer - (if negated #'rxt-negate #'identity)) - (builder - (if negated #'rxt-char-set-intersection #'rxt-choice))) - (catch 'done - (while t - (when (eobp) - (rxt-error "Missing close right bracket in regexp")) - (if (and (looking-at (rx "]")) - (not (= (point) begin))) - (throw 'done result) - (let ((piece (funcall transformer (rxt-parse-char-class-piece)))) - (setq result (funcall builder result piece)))))) - (forward-char) ; Skip over closing "]" - result))) - -;; Parse a single character, a character range, or a posix class -;; within a character set context. Returns an `rxt-char-set'. -(defun rxt-parse-char-class-piece () - (let ((atom (rxt-parse-char-class-atom))) - (cl-typecase atom - (rxt-char-set ; return unchanged - atom) - (integer ; character: check for range - (let ((range-end (rxt-maybe-parse-range-end))) - (if range-end - (rxt-char-set-union (cons atom range-end)) - (rxt-char-set-union atom)))) - (t ; transform into character set - (rxt-char-set-union atom))))) - -;; Parse a single character or named class within a charset. -;; -;; Returns an integer (a character), a symbol (representing a named -;; character class) or an `rxt-char-set' (for pre-defined character -;; classes like \d, \W, etc.) -(defun rxt-parse-char-class-atom () - (or - ;; First, check for PCRE-specific backslash sequences - (and rxt-parse-pcre - (rxt-parse-char-class-atom/pcre)) - ;; Char-class syntax - (rxt-token-case - ;; Named classes [:alnum:], ... - (rxt-named-classes-regexp - (intern (match-string 1))) - ;; Error on unknown posix-class-like syntax - ((rx "[:" (* (any "a-z")) ":]") - (rxt-error "Unknown posix character class `%s'" (match-string 0))) - ;; Error on [= ... ]= collation syntax - ((rx "[" (submatch (any "." "=")) - (* (any "a-z")) (backref 1) "]") - (rxt-error "Unsupported collation syntax `%s'" (match-string 0))) - ;; Other characters stand for themselves - ((rx (or "\n" nonl)) - (string-to-char (match-string 0)))))) - -;; Parse backslash escapes inside PCRE character classes -(defun rxt-parse-char-class-atom/pcre () - (or (rxt-parse-escapes/pcre) - (rxt-token-case - ;; Backslash + digits => octal char - ((rx "\\" (submatch (** 1 3 (any "0-7")))) - (string-to-number (match-string 1) 8)) - ;; Pre-defined character sets - ((rx "\\" (submatch (any "d" "D" "h" "H" "s" "S" "v" "V" "w" "W"))) - (rxt--pcre-char-set (string-to-char (match-string 1)))) - ;; "\b" inside character classes is a backspace - ((rx "\\b") ?\C-h) - ;; Ignore other escapes - ((rx "\\" (submatch nonl)) - (string-to-char (match-string 1)))))) - -;; Look for a range tail (the "-z" in "a-z") after parsing a single -;; character within in a character set. Returns either a character -;; representing the range end, or nil. -(defun rxt-maybe-parse-range-end () - (let ((range-end nil) (end-position nil)) - (when (looking-at (rx "-" (not (any "]")))) - (save-excursion - (forward-char) - (setq range-end (rxt-parse-char-class-atom) - end-position (point)))) - - (if (characterp range-end) - ;; This is a range: move point after it and return the ending character - (progn - (goto-char end-position) - range-end) - ;; Not a range. - nil))) - -;; Return the pre-defined PCRE char-set associated with CHAR: i.e. \d -;; is digits, \D non-digits, \s space characters, etc. -(defun rxt--pcre-char-set (char) - (let* ((base-char (downcase char)) - (negated (/= char base-char)) - (elements (assoc-default base-char rxt-pcre-char-set-alist)) - (base-char-set (apply #'rxt-char-set-union elements))) - (if negated - (rxt-negate base-char-set) - base-char-set))) - - -;;;; Unparser to `rx' syntax - -(defconst rxt-rx-verbose-equivalents - '((bol . line-start) - (eol . line-end) - (nonl . not-newline) - (bos . string-start) - (eos . string-end) - (bow . word-start) - (eow . word-end) - (seq . sequence)) - "Alist of verbose equivalents for short `rx' primitives.") - -(defun rxt-rx-symbol (sym) - (if rxt-verbose-rx-translation - (or (assoc-default sym rxt-rx-verbose-equivalents) - sym) - sym)) - -(defun rxt-adt->rx (re) - (let ((rx - (cl-typecase re - (rxt-primitive - (rxt-rx-symbol (rxt-primitive-rx re))) - - (rxt-string - (if (or (not (rxt-string-case-fold re)) - (string= "" (rxt-string-chars re))) - (rxt-string-chars re) - `(seq - ,@(cl-loop for char across (rxt-string-chars re) - collect `(any ,(upcase char) ,(downcase char)))))) - - (rxt-seq - `(seq ,@(mapcar #'rxt-adt->rx (rxt-seq-elts re)))) - - (rxt-choice - `(or ,@(mapcar #'rxt-adt->rx (rxt-choice-elts re)))) - - (rxt-submatch - (if (rxt-seq-p (rxt-submatch-body re)) - `(submatch - ,@(mapcar #'rxt-adt->rx (rxt-seq-elts (rxt-submatch-body re)))) - `(submatch ,(rxt-adt->rx (rxt-submatch-body re))))) - - (rxt-submatch-numbered - (if (rxt-seq-p (rxt-submatch-numbered-p re)) - `(,(rxt-rx-symbol 'submatch-n) - ,(rxt-submatch-numbered-n re) - ,@(mapcar #'rxt-adt->rx - (rxt-seq-elts - (rxt-submatch-numbered-body re)))) - `(,(rxt-rx-symbol 'submatch-n) - ,(rxt-submatch-numbered-n re) - ,(rxt-adt->rx (rxt-submatch-numbered-body re))))) - - (rxt-backref - (let ((n (rxt-backref-n re))) - (if (<= n 9) - `(backref ,(rxt-backref-n re)) - (rxt-error "Too many backreferences (%s)" n)))) - - (rxt-syntax-class - `(syntax ,(rxt-syntax-class-symbol re))) - - (rxt-char-category - `(category ,(rxt-char-category-symbol re))) - - (rxt-repeat - (let ((from (rxt-repeat-from re)) - (to (rxt-repeat-to re)) - (greedy (rxt-repeat-greedy re)) - (body (rxt-adt->rx (rxt-repeat-body re)))) - (if rxt-verbose-rx-translation - (let ((rx - (cond - ((and (zerop from) (null to)) - `(zero-or-more ,body)) - ((and (equal from 1) (null to)) - `(one-or-more ,body)) - ((and (zerop from) (equal to 1)) - `(zero-or-one ,body)) - ((null to) - `(>= ,from ,body)) - ((equal from to) - `(repeat ,from ,body)) - (t - `(** ,from ,to ,body))))) - (if greedy - (if rxt-explain - rx ; Readable but not strictly accurate. Fixme? - `(maximal-match ,rx)) - `(minimal-match ,rx))) - (cond - ((and (zerop from) (null to)) - `(,(if greedy '* '*?) ,body)) - ((and (equal from 1) (null to)) - `(,(if greedy '+ '+?) ,body)) - ((and (zerop from) (equal to 1)) - `(,(if greedy '\? ??) ,body)) - ((null to) - `(>= ,from ,body)) - ((equal from to) - `(= ,from ,body)) - (t - `(** ,from ,to ,body)))))) - - (rxt-char-set-union - (let* ((case-fold (rxt-char-set-union-case-fold re)) - (re (rxt--simplify-char-set re case-fold)) - (chars (rxt-char-set-union-chars re)) - (ranges (rxt-char-set-union-ranges re)) - (classes (rxt-char-set-union-classes re)) - (case-fold (rxt-char-set-union-case-fold re))) - ;; Do not let the byte compiler optimize this variable out. - (ignore case-fold) - (if (and (null chars) (null ranges) (= 1 (length classes))) - (car classes) - `(any ,@chars ,@ranges ,@classes)))) - - (rxt-char-set-negation - `(not ,(rxt-adt->rx (rxt-char-set-negation-elt re)))) - - (t - (rxt-error "No RX translation of `%s'" (rxt-to-string re)))))) - - ;; Store source information on each fragment of the generated RX - ;; sexp for rxt-explain mode - (when rxt-explain - ;; Use gensyms to store unique source information for multiple - ;; occurrences of primitives like `bol' - (when (symbolp rx) - (setq rx (make-symbol (symbol-name rx)))) - (setf (rxt-location rx) (rxt-location re))) - rx)) - - -;;;; 'Unparser' to PCRE notation - -;;; Based on scsh/posixstr.scm in scsh - -;; To ensure that the operator precedence in the generated regexp does -;; what we want, we need to keep track of what kind of production is -;; returned from each step. Therefore these functions return a string -;; and a numeric "level" which lets the function using the generated -;; regexp know whether it has to be parenthesized: -;; -;; 0: an already parenthesized expression -;; -;; 1: a "piece" binds to any succeeding quantifiers -;; -;; 2: a "branch", or concatenation of pieces, needs parenthesizing to -;; bind to quantifiers -;; -;; 3: a "top", or alternation of branches, needs parenthesizing to -;; bind to quantifiers or to concatenation -;; -;; This idea is stolen straight out of the scsh implementation. - -(defun rxt-adt->pcre (re) - (cl-destructuring-bind (s _) (rxt-adt->pcre/lev re) s)) - -(defun rxt-adt->pcre/lev (re) - (cl-typecase re - (rxt-primitive - (let ((s (rxt-primitive-pcre re))) - (if s - (list s 1) - (rxt-error "No PCRE translation of `%s'" (rxt-to-string re))))) - - (rxt-string (rxt-string->pcre re)) - (rxt-seq (rxt-seq->pcre re)) - (rxt-choice (rxt-choice->pcre re)) - (rxt-submatch (rxt-submatch->pcre re)) - (rxt-backref - (list (format "\\%d" (rxt-backref-n re)) 1)) - (rxt-repeat (rxt-repeat->pcre re)) - - ((or rxt-char-set-union rxt-char-set-negation) - (rxt-char-set->pcre re)) - - ;; FIXME - ;; ((rxt-char-set-intersection re) (rxt-char-set-intersection->pcre re)) - - (t - (rxt-error "No PCRE translation of `%s'" (rxt-to-string re))))) - -(defconst rxt-pcre-metachars (rx (any "\\^.$|()[]*+?{}"))) -(defconst rxt-pcre-charset-metachars (rx (any "]" "[" "\\" "^" "-"))) - -(defun rxt-string->pcre (re) - (let ((chars (rxt-string-chars re))) - (list - (replace-regexp-in-string - rxt-pcre-metachars - "\\\\\\&" chars) - ;; A one-character string is a 'piece' (it binds to a following - ;; quantifier). A longer string is a 'branch' (it has to be - ;; enclosed in parentheses to bind to a following quantifier). - (if (> (length chars) 1) 2 1)))) - -(defun rxt-seq->pcre (re) - (let ((elts (rxt-seq-elts re))) - (if (null elts) - "" - (rxt-seq-elts->pcre elts)))) - -(defun rxt-seq-elts->pcre (elts) - (cl-destructuring-bind - (s lev) (rxt-adt->pcre/lev (car elts)) - (if (null (cdr elts)) - (list s lev) - (cl-destructuring-bind - (s1 lev1) (rxt-seq-elts->pcre (cdr elts)) - (list (concat (rxt-paren-if-necessary s lev) - (rxt-paren-if-necessary s1 lev1)) - 2))))) - -(defun rxt-paren-if-necessary (s lev) - (if (< lev 3) - s - (concat "(?:" s ")"))) - -(defun rxt-choice->pcre (re) - (let ((elts (rxt-choice-elts re))) - (if (null elts) - nil - (rxt-choice-elts->pcre elts)))) - -(defun rxt-choice-elts->pcre (elts) - (cl-destructuring-bind - (s lev) (rxt-adt->pcre/lev (car elts)) - (if (null (cdr elts)) - (list s lev) - (cl-destructuring-bind - (s1 _lev1) (rxt-choice-elts->pcre (cdr elts)) - (list (concat s "|" s1) 3))))) - -(defun rxt-submatch->pcre (re) - (cl-destructuring-bind - (s _lev) (rxt-adt->pcre/lev (rxt-submatch-body re)) - (list (concat "(" s ")") 0))) - -(defun rxt-repeat->pcre (re) - (let ((from (rxt-repeat-from re)) - (to (rxt-repeat-to re)) - (body (rxt-repeat-body re)) - (greedy (rxt-repeat-greedy re))) - (cl-destructuring-bind - (s lev) (rxt-adt->pcre/lev body) - (cond - ((and to (= from 1) (= to 1)) (list s lev)) - ((and to (= from 0) (= to 0)) (list "" 2)) - (t - (when (> lev 1) ; parenthesize non-atoms - (setq s (concat "(?:" s ")") - lev 0)) - (list (if to - (cond ((and (= from 0) (= to 1)) - (concat s (if greedy "?" "??"))) - ((= from to) - (concat s "{" (number-to-string to) "}")) - (t - (concat s "{" (number-to-string from) - "," (number-to-string to) "}"))) - (cond ((= from 0) - (concat s (if greedy "*" "*?"))) - ((= from 1) - (concat s (if greedy "+" "+?"))) - (t (concat s "{" (number-to-string from) ",}")))) - 1)))))) - -(defun rxt-char-set->pcre (re) - (cond ((rxt-char-set-union-p re) - (list - (concat "[" (rxt-char-set->pcre/chars re) "]") 1)) - - ((rxt-char-set-negation-p re) - (let ((elt (rxt-char-set-negation-elt re))) - (if (rxt-char-set-union-p elt) - (list - (concat "[^" (rxt-char-set->pcre/chars elt) "]") 1) - (rxt-error "No PCRE translation of `%s'" (rxt-to-string elt))))) - - (t - (rxt-error "Non-char-set in rxt-char-set->pcre: %s" re)))) - -;; Fortunately, easier in PCRE than in POSIX! -(defun rxt-char-set->pcre/chars (re) - (cl-flet - ((escape - (char) - (let ((s (char-to-string char))) - (cond ((string-match rxt-pcre-charset-metachars s) - (concat "\\" s)) - - ((and (not (string= s " ")) - (string-match "[^[:graph:]]" s)) - (format "\\x{%x}" char)) - - (t s))))) - - (let ((chars (rxt-char-set-union-chars re)) - (ranges (rxt-char-set-union-ranges re)) - (classes (rxt-char-set-union-classes re))) - - (concat - (mapconcat #'escape chars "") - (mapconcat #'(lambda (rg) - (format "%s-%s" - (escape (car rg)) - (escape (cdr rg)))) - ranges "") - (mapconcat #'(lambda (class) - (format "[:%s:]" class)) - classes ""))))) - - -;;;; Generate all productions of a finite regexp - -(defun rxt-adt->strings (re) - (cl-typecase re - (rxt-primitive - (list "")) - (rxt-string - (list (rxt-string-chars re))) - (rxt-seq - (rxt-seq-elts->strings (rxt-seq-elts re))) - (rxt-choice - (rxt-choice-elts->strings (rxt-choice-elts re))) - (rxt-submatch - (rxt-adt->strings (rxt-submatch-body re))) - (rxt-submatch-numbered - (rxt-adt->strings (rxt-submatch-numbered-body re))) - (rxt-repeat - (rxt-repeat->strings re)) - (rxt-char-set-union - (rxt-char-set->strings re)) - (t - (error "Can't generate productions of %s" - (rxt-syntax-tree-readable re))))) - -(defun rxt-concat-product (heads tails) - (cl-mapcan - (lambda (hs) - (mapcar - (lambda (ts) (concat hs ts)) - tails)) - heads)) - -(defun rxt-seq-elts->strings (elts) - (if (null elts) - '("") - (let ((heads (rxt-adt->strings (car elts))) - (tails (rxt-seq-elts->strings (cdr elts)))) - (rxt-concat-product heads tails)))) - -(defun rxt-choice-elts->strings (elts) - (if (null elts) - '() - (append (rxt-adt->strings (car elts)) - (rxt-choice-elts->strings (cdr elts))))) - -(defun rxt-repeat->strings (re) - (let ((from (rxt-repeat-from re)) - (to (rxt-repeat-to re))) - (if (not to) - (error "Can't generate all productions of unbounded repeat \"%s\"" - (rxt-syntax-tree-readable re)) - (let ((strings (rxt-adt->strings (rxt-repeat-body re)))) - (rxt-repeat-n-m->strings from to strings))))) - -(defun rxt-repeat-n-m->strings (from to strings) - (cond - ((zerop to) '("")) - ((= to from) (rxt-repeat-n->strings from strings)) - (t ; to > from - (let* ((strs-n (rxt-repeat-n->strings from strings)) - (accum (cl-copy-list strs-n))) - (dotimes (_i (- to from)) - (setq strs-n (rxt-concat-product strs-n strings)) - (setq accum (nconc accum strs-n))) - accum)))) - -(defun rxt-repeat-n->strings (n strings) - ;; n > 1 - (cond ((zerop n) '("")) - ((= n 1) strings) - (t - (rxt-concat-product - (rxt-repeat-n->strings (- n 1) strings) - strings)))) - -(defun rxt-char-set->strings (re) - (if (rxt-char-set-union-classes re) - (error "Can't generate all productions of named character classes in \"%s\"" - (rxt-syntax-tree-readable re)) - (let ((chars (mapcar #'char-to-string (rxt-char-set-union-chars re)))) - (dolist (range (rxt-char-set-union-ranges re)) - (let ((end (cdr range))) - (cl-do ((i (car range) (+ i 1))) - ((> i end)) - (push (char-to-string i) chars)))) - chars))) - - -;;;; RE-Builder hacks - -(defadvice reb-update-modestring - (after rxt () activate compile) - "This function is hacked for emulated PCRE syntax and regexp conversion." - (setq reb-mode-string - (concat - (format " (%s)" reb-re-syntax) - reb-mode-string)) - (force-mode-line-update)) - -(defadvice reb-change-syntax - (around rxt (&optional syntax) activate compile) - "This function is hacked for emulated PCRE syntax and regexp conversion." - (interactive - (list (intern - (completing-read (format "Select syntax (%s): " reb-re-syntax) - '(read string pcre sregex rx) - nil t "" nil (symbol-name reb-re-syntax))))) - (unless (memq syntax '(read string pcre lisp-re sregex rx)) - (error "Invalid syntax: %s" syntax)) - (let ((re-builder-buffer (get-buffer reb-buffer))) - (setq reb-re-syntax syntax) - (when re-builder-buffer - (with-current-buffer reb-target-buffer - (cl-case syntax - (rx - (let ((rx (rxt-elisp-to-rx reb-regexp))) - (setq reb-regexp-src - (with-temp-buffer - (insert "\n" "'") - (rxt-print rx) - (buffer-string))))) - (pcre - (setq reb-regexp-src (rxt-elisp-to-pcre reb-regexp))))) - (with-current-buffer re-builder-buffer - ;; Hack: prevent reb-auto-update from clobbering the - ;; reb-regexp-src we just set - (let ((inhibit-modification-hooks t)) - (reb-initialize-buffer)) - ;; Enable flag-toggling bindings for PCRE syntax - (rxt--re-builder-switch-pcre-mode))))) - -(defadvice reb-read-regexp - (around rxt () activate compile) - "This function is hacked for emulated PCRE syntax and regexp conversion." - (if (eq reb-re-syntax 'pcre) - (setq ad-return-value - (save-excursion - (goto-char (point-min)) - (rxt-read-delimited-pcre))) - ad-do-it)) - -(defadvice reb-insert-regexp - (around rxt () activate compile) - "This function is hacked for emulated PCRE syntax and regexp conversion." - (if (eq reb-re-syntax 'pcre) - (let ((src (if (fboundp #'reb-target-value) - (reb-target-value 'reb-regexp-src) - (reb-target-binding reb-regexp-src)))) - (if src - (insert "\n/" (replace-regexp-in-string "/" "\\/" src t t) "/") - (insert "\n//"))) - ad-do-it)) - -(defadvice reb-cook-regexp - (around rxt (re) activate compile) - "This function is hacked for emulated PCRE syntax and regexp conversion." - (if (eq reb-re-syntax 'pcre) - (setq ad-return-value (rxt-pcre-to-elisp re)) - ad-do-it)) - -(defadvice reb-update-regexp - (around rxt () activate compile) - "This function is hacked for emulated PCRE syntax and regexp conversion." - (setq ad-return-value - (let* ((re-src (reb-read-regexp)) - (re (reb-cook-regexp re-src))) - (with-current-buffer reb-target-buffer - (let ((oldre reb-regexp)) - (prog1 - (not (string= oldre re)) - (setq reb-regexp re) - ;; Update the source re if format requires translation - (when (or (reb-lisp-syntax-p) (eq reb-re-syntax 'pcre)) - (setq reb-regexp-src re-src)))))))) - -(defun rxt--re-builder-switch-pcre-mode () - (rxt--read-pcre-mode - (if (eq reb-re-syntax 'pcre) 1 0))) - -(add-hook 'reb-mode-hook #'rxt--re-builder-switch-pcre-mode) - -(provide 'rxt) -(provide 'pcre2el) - - -;;; pcre2el.el ends here diff --git a/elpa/pcre2el-20240629.2322/pcre2el-autoloads.el b/elpa/pcre2el-20240629.2322/pcre2el-autoloads.el new file mode 100644 index 00000000..dea16342 --- /dev/null +++ b/elpa/pcre2el-20240629.2322/pcre2el-autoloads.el @@ -0,0 +1,223 @@ +;;; pcre2el-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from pcre2el.el + +(defvar pcre-mode nil "\ +Non-nil if PCRE mode is enabled. +See the `pcre-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `pcre-mode'.") +(custom-autoload 'pcre-mode "pcre2el" nil) +(autoload 'pcre-mode "pcre2el" "\ +Use emulated PCRE syntax for regexps wherever possible. + +Advises the `interactive' specs of `read-regexp' and the +following other functions so that they read PCRE syntax and +translate to its Emacs equivalent: + +- `align-regexp' +- `find-tag-regexp' +- `sort-regexp-fields' +- `isearch-message-prefix' +- `ibuffer-do-replace-regexp' + +Also alters the behavior of `isearch-mode' when searching by regexp. + +This is a global minor mode. If called interactively, toggle the `PCRE +mode' mode. If the prefix argument is positive, enable the mode, and if +it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='pcre-mode)'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(autoload 'pcre-query-replace-regexp "pcre2el" "\ +Perform `query-replace-regexp' using PCRE syntax. + +Consider using `pcre-mode' instead of this function." t) +(autoload 'rxt-elisp-to-pcre "pcre2el" "\ +Translate REGEXP, a regexp in Emacs Lisp syntax, to Perl-compatible syntax. + +Interactively, reads the regexp in one of three ways. With a +prefix arg, reads from minibuffer without string escaping, like +`query-replace-regexp'. Without a prefix arg, uses the text of +the region if it is active. Otherwise, uses the result of +evaluating the sexp before point (which might be a string regexp +literal or an expression that produces a string). + +Displays the translated PCRE regexp in the echo area and copies +it to the kill ring. + +Emacs regexp features such as syntax classes which cannot be +translated to PCRE will cause an error. + +(fn REGEXP)" t) +(autoload 'rxt-elisp-to-rx "pcre2el" "\ +Translate REGEXP, a regexp in Emacs Lisp syntax, to `rx' syntax. + +See `rxt-elisp-to-pcre' for a description of the interactive +behavior and `rx' for documentation of the S-expression based +regexp syntax. + +(fn REGEXP)" t) +(autoload 'rxt-elisp-to-strings "pcre2el" "\ +Return a list of all strings matched by REGEXP, an Emacs Lisp regexp. + +See `rxt-elisp-to-pcre' for a description of the interactive behavior. + +This is useful primarily for getting back the original list of +strings from a regexp generated by `regexp-opt', but it will work +with any regexp without unbounded quantifiers (*, +, {2, } and so +on). + +Throws an error if REGEXP contains any infinite quantifiers. + +(fn REGEXP)" t) +(autoload 'rxt-toggle-elisp-rx "pcre2el" "\ +Toggle the regexp near point between Elisp string and rx syntax." t) +(autoload 'rxt-pcre-to-elisp "pcre2el" "\ +Translate PCRE, a regexp in Perl-compatible syntax, to Emacs Lisp. + +Interactively, uses the contents of the region if it is active, +otherwise reads from the minibuffer. Prints the Emacs translation +in the echo area and copies it to the kill ring. + +PCRE regexp features that cannot be translated into Emacs syntax +will cause an error. See the commentary section of pcre2el.el for +more details. + +(fn PCRE &optional FLAGS)" t) +(defalias 'pcre-to-elisp 'rxt-pcre-to-elisp) +(autoload 'rxt-pcre-to-rx "pcre2el" "\ +Translate PCRE, a regexp in Perl-compatible syntax, to `rx' syntax. + +See `rxt-pcre-to-elisp' for a description of the interactive behavior. + +(fn PCRE &optional FLAGS)" t) +(autoload 'rxt-pcre-to-strings "pcre2el" "\ +Return a list of all strings matched by PCRE, a Perl-compatible regexp. + +See `rxt-elisp-to-pcre' for a description of the interactive +behavior and `rxt-elisp-to-strings' for why this might be useful. + +Throws an error if PCRE contains any infinite quantifiers. + +(fn PCRE &optional FLAGS)" t) +(autoload 'rxt-explain-elisp "pcre2el" "\ +Insert the pretty-printed `rx' syntax for REGEXP in a new buffer. + +REGEXP is a regular expression in Emacs Lisp syntax. See +`rxt-elisp-to-pcre' for a description of how REGEXP is read +interactively. + +(fn REGEXP)" t) +(autoload 'rxt-explain-pcre "pcre2el" "\ +Insert the pretty-printed `rx' syntax for REGEXP in a new buffer. + +REGEXP is a regular expression in PCRE syntax. See +`rxt-pcre-to-elisp' for a description of how REGEXP is read +interactively. + +(fn REGEXP &optional FLAGS)" t) +(autoload 'rxt-quote-pcre "pcre2el" "\ +Return a PCRE regexp which matches TEXT literally. + +Any PCRE metacharacters in TEXT will be quoted with a backslash. + +(fn TEXT)") +(autoload 'rxt-explain "pcre2el" "\ +Pop up a buffer with pretty-printed `rx' syntax for the regex at point. + +Chooses regex syntax to read based on current major mode, calling +`rxt-explain-elisp' if buffer is in `emacs-lisp-mode' or +`lisp-interaction-mode', or `rxt-explain-pcre' otherwise." t) +(autoload 'rxt-convert-syntax "pcre2el" "\ +Convert regex at point to other kind of syntax, depending on major mode. + +For buffers in `emacs-lisp-mode' or `lisp-interaction-mode', +calls `rxt-elisp-to-pcre' to convert to PCRE syntax. Otherwise, +calls `rxt-pcre-to-elisp' to convert to Emacs syntax. + +The converted syntax is displayed in the echo area and copied to +the kill ring; see the two functions named above for details." t) +(autoload 'rxt-convert-to-rx "pcre2el" "\ +Convert regex at point to RX syntax. Chooses Emacs or PCRE syntax by major mode." t) +(autoload 'rxt-convert-to-strings "pcre2el" "\ +Convert regex at point to RX syntax. Chooses Emacs or PCRE syntax by major mode." t) +(autoload 'rxt-mode "pcre2el" "\ +Regex translation utilities. + +This is a minor mode. If called interactively, toggle the `Rxt mode' +mode. If the prefix argument is positive, enable the mode, and if it is +zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable the +mode if ARG is nil, omitted, or is a positive number. Disable the mode +if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate the variable `rxt-mode'. + +The mode's hook is called both when the mode is enabled and when it is +disabled. + +(fn &optional ARG)" t) +(autoload 'turn-on-rxt-mode "pcre2el" "\ +Turn on `rxt-mode' in the current buffer." t) +(put 'rxt-global-mode 'globalized-minor-mode t) +(defvar rxt-global-mode nil "\ +Non-nil if Rxt-Global mode is enabled. +See the `rxt-global-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `rxt-global-mode'.") +(custom-autoload 'rxt-global-mode "pcre2el" nil) +(autoload 'rxt-global-mode "pcre2el" "\ +Toggle Rxt mode in all buffers. +With prefix ARG, enable Rxt-Global mode if ARG is positive; otherwise, +disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +Rxt mode is enabled in all buffers where `turn-on-rxt-mode' would do +it. + +See `rxt-mode' for more information on Rxt mode. + +(fn &optional ARG)" t) +(register-definition-prefixes "pcre2el" '("pcre-" "rxt-")) + +;;; End of scraped data + +(provide 'pcre2el-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; pcre2el-autoloads.el ends here diff --git a/elpa/pcre2el-20240629.2322/pcre2el-pkg.el b/elpa/pcre2el-20240629.2322/pcre2el-pkg.el new file mode 100644 index 00000000..4626ac02 --- /dev/null +++ b/elpa/pcre2el-20240629.2322/pcre2el-pkg.el @@ -0,0 +1,9 @@ +;; -*- no-byte-compile: t; lexical-binding: nil -*- +(define-package "pcre2el" "20240629.2322" + "Regexp syntax converter." + '((emacs "25.1")) + :url "https://github.com/joddie/pcre2el" + :commit "b4d846d80dddb313042131cf2b8fbf647567e000" + :revdesc "b4d846d80ddd" + :authors '(("joddie" . "jonxfieldatgmail.com")) + :maintainers '(("joddie" . "jonxfieldatgmail.com"))) diff --git a/elpa/pcre2el-20240629.2322/pcre2el.el b/elpa/pcre2el-20240629.2322/pcre2el.el new file mode 100644 index 00000000..d3e34322 --- /dev/null +++ b/elpa/pcre2el-20240629.2322/pcre2el.el @@ -0,0 +1,3170 @@ +;;; pcre2el.el --- regexp syntax converter -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2015 Jon Oddie + +;; Author: joddie +;; Hacked additionally by: opensource at hardakers dot net +;; Created: 14 Feb 2012 +;; Updated: 13 December 2015 +;; Package-Version: 20240629.2322 +;; Package-Revision: b4d846d80ddd +;; Url: https://github.com/joddie/pcre2el +;; Package-Requires: ((emacs "25.1")) + +;; This file is NOT part of GNU Emacs. + +;; This program 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 3 of the +;; License, or (at your option) any later version. +;; +;; This program 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. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;; This file incorporates work covered by the following copyright and +;; permission notice: +;; +;; Copyright (c) 1993-2002 Richard Kelsey and Jonathan Rees +;; Copyright (c) 1994-2002 by Olin Shivers and Brian D. Carlstrom. +;; Copyright (c) 1999-2002 by Martin Gasbichler. +;; Copyright (c) 2001-2002 by Michael Sperber. +;; All rights reserved. +;; +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions +;; are met: 1. Redistributions of source code must retain the above +;; copyright notice, this list of conditions and the following +;; disclaimer. 2. Redistributions in binary form must reproduce the +;; above copyright notice, this list of conditions and the following +;; disclaimer in the documentation and/or other materials provided +;; with the distribution. 3. The name of the authors may not be used +;; to endorse or promote products derived from this software without +;; specific prior written permission. +;; +;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS "AS IS" AND ANY EXPRESS OR +;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY +;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +;;; Commentary: + +;; 1 Overview +;; ========== + +;; `pcre2el' or `rxt' (RegeXp Translator or RegeXp Tools) is a utility +;; for working with regular expressions in Emacs, based on a +;; recursive-descent parser for regexp syntax. In addition to converting +;; (a subset of) PCRE syntax into its Emacs equivalent, it can do the +;; following: + +;; - convert Emacs syntax to PCRE +;; - convert either syntax to `rx', an S-expression based regexp syntax +;; - untangle complex regexps by showing the parse tree in `rx' form and +;; highlighting the corresponding chunks of code +;; - show the complete list of strings (productions) matching a regexp, +;; provided the list is finite +;; - provide live font-locking of regexp syntax (so far only for Elisp +;; buffers -- other modes on the TODO list) + + +;; 2 Usage +;; ======= + +;; Enable `rxt-mode' or its global equivalent `rxt-global-mode' to get +;; the default key-bindings. There are three sets of commands: commands +;; that take a PCRE regexp, commands which take an Emacs regexp, and +;; commands that try to do the right thing based on the current +;; mode. Currently, this means Emacs syntax in `emacs-lisp-mode' and +;; `lisp-interaction-mode', and PCRE syntax everywhere else. + +;; The default key bindings all begin with `C-c /' and have a mnemonic +;; structure: `C-c / ', or just `C-c / ' for the +;; "do what I mean" commands. The complete list of key bindings is given +;; here and explained in more detail below: + +;; - "Do-what-I-mean" commands: +;; `C-c / /': `rxt-explain' +;; `C-c / c': `rxt-convert-syntax' +;; `C-c / x': `rxt-convert-to-rx' +;; `C-c / '': `rxt-convert-to-strings' + +;; - Commands that work on a PCRE regexp: +;; `C-c / p e': `rxt-pcre-to-elisp' +;; `C-c / %': `pcre-query-replace-regexp' +;; `C-c / p x': `rxt-pcre-to-rx' +;; `C-c / p '': `rxt-pcre-to-strings' +;; `C-c / p /': `rxt-explain-pcre' + +;; - Commands that work on an Emacs regexp: +;; `C-c / e /': `rxt-explain-elisp' +;; `C-c / e p': `rxt-elisp-to-pcre' +;; `C-c / e x': `rxt-elisp-to-rx' +;; `C-c / e '': `rxt-elisp-to-strings' +;; `C-c / e t': `rxt-toggle-elisp-rx' +;; `C-c / t': `rxt-toggle-elisp-rx' + + +;; 2.1 Interactive input and output +;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +;; When used interactively, the conversion commands can read a regexp +;; either from the current buffer or from the minibuffer. The output is +;; displayed in the minibuffer and copied to the kill-ring. + +;; - When called with a prefix argument (`C-u'), they read a regular +;; expression from the minibuffer literally, without further processing +;; -- meaning there's no need to double the backslashes if it's an +;; Emacs regexp. This is the same way commands like +;; `query-replace-regexp' read input. + +;; - When the region is active, they use they the region contents, again +;; literally (without any translation of string syntax). + +;; - With neither a prefix arg nor an active region, the behavior depends +;; on whether the command expects an Emacs regexp or a PCRE one. + +;; Commands that take an Emacs regexp behave like `C-x C-e': they +;; evaluate the sexp before point (which could be simply a string +;; literal) and use its value. This is designed for use in Elisp +;; buffers. As a special case, if point is *inside* a string, it's +;; first moved to the string end, so in practice they should work as +;; long as point is somewhere within the regexp literal. + +;; Commands that take a PCRE regexp try to read a Perl-style delimited +;; regex literal *after* point in the current buffer, including its +;; flags. For example, putting point before the `m' in the following +;; example and doing `C-c / p e' (`rxt-pcre-to-elisp') displays +;; `\(?:bar\|foo\)', correctly stripping out the whitespace and +;; comment: + +;; ,---- +;; | $x =~ m/ foo | (?# comment) bar /x +;; `---- + +;; The PCRE reader currently only works with `/ ... /' delimiters. It +;; will ignore any preceding `m', `s', or `qr' operator, as well as the +;; replacement part of an `s' construction. + +;; Readers for other PCRE-using languages are on the TODO list. + +;; The translation functions display their result in the minibuffer and +;; copy it to the kill ring. When translating something into Elisp +;; syntax, you might need to use the result either literally (e.g. for +;; interactive input to a command like `query-replace-regexp'), or as a +;; string to paste into Lisp code. To allow both uses, +;; `rxt-pcre-to-elisp' copies both versions successively to the +;; kill-ring. The literal regexp without string quoting is the top +;; element of the kill-ring, while the Lisp string is the +;; second-from-top. You can paste the literal regexp somewhere by doing +;; `C-y', or the Lisp string by `C-y M-y'. + + +;; 2.2 Syntax conversion commands +;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +;; `rxt-convert-syntax' (`C-c / c') converts between Emacs and PCRE +;; syntax, depending on the major mode in effect when called. +;; Alternatively, you can specify the conversion direction explicitly by +;; using either `rxt-pcre-to-elisp' (`C-c / p e') or `rxt-elisp-to-pcre' +;; (`C-c / e p'). + +;; Similarly, `rxt-convert-to-rx' (`C-c / x') converts either kind of +;; syntax to `rx' form, while `rxt-convert-pcre-to-rx' (`C-c / p x') and +;; `rxt-convert-elisp-to-rx' (`C-c / e x') convert to `rx' from a +;; specified source type. + +;; In Elisp buffers, you can use `rxt-toggle-elisp-rx' (`C-c / t' or `C-c +;; / e t') to switch the regexp at point back and forth between string +;; and `rx' syntax. Point should either be within an `rx' or +;; `rx-to-string' form or a string literal for this to work. + + +;; 2.3 PCRE mode (experimental) +;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +;; If you want to use emulated PCRE regexp syntax in all Emacs commands, +;; try `pcre-mode', which uses Emacs's advice system to make all commands +;; that read regexps using the minibuffer use emulated PCRE syntax. It +;; should also work with Isearch. + +;; This feature is still fairly experimental. It may fail to work or do +;; the wrong thing with certain commands. Please report bugs. + +;; `pcre-query-replace-regexp' was originally defined to do query-replace +;; using emulated PCRE regexps, and is now made somewhat obsolete by +;; `pcre-mode'. It is bound to `C-c / %' by default, by analogy with +;; `M-%'. Put the following in your `.emacs' if you want to use +;; PCRE-style query replacement everywhere: + +;; ,---- +;; | (global-set-key [(meta %)] 'pcre-query-replace-regexp) +;; `---- + +;; 2.5 Explain regexps +;; ~~~~~~~~~~~~~~~~~~~ + +;; When syntax-highlighting isn't enough to untangle some gnarly regexp +;; you find in the wild, try the 'explain' commands: `rxt-explain' (`C-c +;; / /'), `rxt-explain-pcre' (`C-c / p') and `rxt-explain-elisp' (`C-c / +;; e'). These display the original regexp along with its pretty-printed +;; `rx' equivalent in a new buffer. Moving point around either in the +;; original regexp or the `rx' translation highlights corresponding +;; pieces of syntax, which can aid in seeing things like the scope of +;; quantifiers. + +;; I call them "explain" commands because the `rx' form is close to a +;; plain syntax tree, and this plus the wordiness of the operators +;; usually helps to clarify what is going on. People who dislike Lisp +;; syntax might disagree with this assessment. + + +;; 2.6 Generate all matching strings (productions) +;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +;; Occasionally you come across a regexp which is designed to match a +;; finite set of strings, e.g. a set of keywords, and it would be useful +;; to recover the original set. (In Emacs you can generate such regexps +;; using `regexp-opt'). The commands `rxt-convert-to-strings' (`C-c / +;; ′'), `rxt-pcre-to-strings' (`C-c / p ′') or `rxt-elisp-to-strings' +;; (`C-c / e ′') accomplish this by generating all the matching strings +;; ("productions") of a regexp. (The productions are copied to the kill +;; ring as a Lisp list). + +;; An example in Lisp code: + +;; ,---- +;; | (regexp-opt '("cat" "caterpillar" "catatonic")) +;; | ;; => "\\(?:cat\\(?:atonic\\|erpillar\\)?\\)" +;; | (rxt-elisp-to-strings "\\(?:cat\\(?:atonic\\|erpillar\\)?\\)") +;; | ;; => '("cat" "caterpillar" "catatonic") +;; `---- + +;; For obvious reasons, these commands only work with regexps that don't +;; include any unbounded quantifiers like `+' or `*'. They also can't +;; enumerate all the characters that match a named character class like +;; `[[:alnum:]]'. In either case they will give a (hopefully meaningful) +;; error message. Due to the nature of permutations, it's still possible +;; for a finite regexp to generate a huge number of productions, which +;; will eat memory and slow down your Emacs. Be ready with `C-g' if +;; necessary. + + +;; 2.7 RE-Builder support +;; ~~~~~~~~~~~~~~~~~~~~~~ + +;; The Emacs RE-Builder is a useful visual tool which allows using +;; several different built-in syntaxes via `reb-change-syntax' (`C-c +;; TAB'). It supports Elisp read and literal syntax and `rx', but it can +;; only convert from the symbolic forms to Elisp, not the other way. This +;; package hacks the RE-Builder to also work with emulated PCRE syntax, +;; and to convert transparently between Elisp, PCRE and rx syntaxes. PCRE +;; mode reads a delimited Perl-like literal of the form `/ ... /', and it +;; should correctly support using the `x' and `s' flags. + + +;; 2.8 Use from Lisp +;; ~~~~~~~~~~~~~~~~~ + +;; Example of using the conversion functions: +;; ,---- +;; | (rxt-pcre-to-elisp "(abc|def)\\w+\\d+") +;; | ;; => "\\(\\(?:abc\\|def\\)\\)[_[:alnum:]]+[[:digit:]]+" +;; `---- + +;; All the conversion functions take a single string argument, the regexp +;; to translate: + +;; - `rxt-pcre-to-elisp' +;; - `rxt-pcre-to-rx' +;; - `rxt-pcre-to-strings' +;; - `rxt-elisp-to-pcre' +;; - `rxt-elisp-to-rx' +;; - `rxt-elisp-to-strings' + + +;; 3 Bugs and Limitations +;; ====================== + +;; 3.1 Limitations on PCRE syntax +;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +;; PCRE has a complicated syntax and semantics, only some of which can be +;; translated into Elisp. The following subset of PCRE should be +;; correctly parsed and converted: + +;; - parenthesis grouping `( .. )', including shy matches `(?: ... )' +;; - backreferences (various syntaxes), but only up to 9 per expression +;; - alternation `|' +;; - greedy and non-greedy quantifiers `*', `*?', `+', `+?', `?' and `??' +;; (all of which are the same in Elisp as in PCRE) +;; - numerical quantifiers `{M,N}' +;; - beginning/end of string `\A', `\Z' +;; - string quoting `\Q .. \E' +;; - word boundaries `\b', `\B' (these are the same in Elisp) +;; - single character escapes `\a', `\c', `\e', `\f', `\n', `\r', `\t', +;; `\x', and `\octal digits' (but see below about non-ASCII characters) +;; - character classes `[...]' including Posix escapes +;; - character classes `\d', `\D', `\h', `\H', `\s', `\S', `\v', `\V' +;; both within character class brackets and outside +;; - word and non-word characters `\w' and `\W' (Emacs has the same +;; syntax, but its meaning is different) +;; - `s' (single line) and `x' (extended syntax) flags, in regexp +;; literals, or set within the expression via `(?xs-xs)' or `(?xs-xs: +;; .... )' syntax +;; - comments `(?# ... )' + +;; Most of the more esoteric PCRE features can't really be supported by +;; simple translation to Elisp regexps. These include the different +;; lookaround assertions, conditionals, and the "backtracking control +;; verbs" `(* ...)' . OTOH, there are a few other syntaxes which are +;; currently unsupported and possibly could be: + +;; - `\L', `\U', `\l', `\u' case modifiers +;; - `\g{...}' backreferences + + +;; 3.2 Other limitations +;; ~~~~~~~~~~~~~~~~~~~~~ + +;; - The order of alternatives and characters in char classes sometimes +;; gets shifted around, which is annoying. +;; - Although the string parser tries to interpret PCRE's octal and +;; hexadecimal escapes correctly, there are problems with matching +;; 8-bit characters that I don't use enough to properly understand, +;; e.g.: +;; ,---- +;; | (string-match-p (rxt-pcre-to-elisp "\\377") "\377") => nil +;; `---- +;; A fix for this would be welcome. + +;; - Most of PCRE's rules for how `^', `\A', `$' and `\Z' interact with +;; newlines are not implemented, since they seem less relevant to +;; Emacs's buffer-oriented rather than line-oriented model. However, +;; the different meanings of the `.' metacharacter *are* implemented +;; (it matches newlines with the `/s' flag, but not otherwise). + +;; - Not currently namespace clean (both `rxt-' and a couple of `pcre-' +;; functions). + + +;; 3.3 TODO: +;; ~~~~~~~~~ + +;; - Python-specific extensions to PCRE? +;; - Language-specific stuff to enable regexp font-locking and explaining +;; in different modes. Each language would need two functions, which +;; could be kept in an alist: + +;; 1. A function to read PCRE regexps, taking the string syntax into +;; account. E.g., Python has single-quoted, double-quoted and raw +;; strings, each with different quoting rules. PHP has the kind of +;; belt-and-suspenders solution you would expect: regexps are in +;; strings, /and/ you have to include the `/ ... /' delimiters! +;; Duh. + +;; 2. A function to copy faces back from the parsed string to the +;; original buffer text. This has to recognize any escape sequences +;; so they can be treated as a single character. + + +;; 4 Internal details +;; ================== + +;; `rxt' defines an internal syntax tree representation of regular +;; expressions, parsers for Elisp and PCRE syntax, and 'unparsers' +;; to convert the internal representation to PCRE or `rx' syntax. +;; Converting from the internal representation to Emacs syntax is +;; done by converting to `rx' form and passing it to `rx-to-string'. +;; See `rxt-parse-re', `rxt-adt->pcre', and `rxt-adt->rx' for +;; details. + +;; This code is partially based on Olin Shivers' reference SRE +;; implementation in scsh, although it is simplified in some respects and +;; extended in others. See `scsh/re.scm', `scsh/spencer.scm' and +;; `scsh/posixstr.scm' in the `scsh' source tree for details. In +;; particular, `pcre2el' steals the idea of an abstract data type for +;; regular expressions and the general structure of the string regexp +;; parser and unparser. The data types for character sets are extended in +;; order to support symbolic translation between character set +;; expressions without assuming a small (Latin1) character set. The +;; string parser is also extended to parse a bigger variety of +;; constructions, including POSIX character classes and various Emacs and +;; Perl regexp assertions. Otherwise, only the bare minimum of scsh's +;; abstract data type is implemented. + + +;; 5 Soapbox +;; ========= + +;; Emacs regexps have their annoyances, but it is worth getting used to +;; them. The Emacs assertions for word boundaries, symbol boundaries, and +;; syntax classes depending on the syntax of the mode in effect are +;; especially useful. (PCRE has `\b' for word-boundary, but AFAIK it +;; doesn't have separate assertions for beginning-of-word and +;; end-of-word). Other things that might be done with huge regexps in +;; other languages can be expressed more understandably in Elisp using +;; combinations of `save-excursion' with the various searches (regexp, +;; literal, skip-syntax-forward, sexp-movement functions, etc.). + +;; There's not much point in using `rxt-pcre-to-elisp' to use PCRE +;; notation in a Lisp program you're going to maintain, since you still +;; have to double all the backslashes. Better to just use the converted +;; result (or better yet, the `rx' form). + + +;; 6 History and acknowledgments +;; ============================= + +;; This was originally created out of an answer to a stackoverflow +;; question: +;; [http://stackoverflow.com/questions/9118183/elisp-mechanism-for-converting-pcre-regexps-to-emacs-regexps] + +;; Thanks to: + +;; - Wes Hardaker (hardaker) for the initial inspiration and subsequent +;; hacking +;; - priyadarshan for requesting RX support +;; - Daniel Colascione (dcolascione) for a patch to support Emacs's +;; explicitly-numbered match groups +;; - Aaron Meurer (asmeurer) for requesting Isearch support +;; - Philippe Vaucher (silex) for a patch to support `ibuffer-do-replace-regexp' +;; in PCRE mode + +;;; Code: + +(require 'cl-lib) +(require 'rx) +(require 're-builder) +(require 'advice) +(require 'ring) +(require 'pcase) + +;;; Customization group +(defgroup rxt nil + "Regex syntax converter and utilities." + :version 1.2 + :group 'tools + :group 'lisp + :link '(emacs-commentary-link :tag "commentary" "pcre2el.el") + :link '(emacs-library-link :tag "lisp file" "pcre2el.el") + :link '(url-link :tag "web page" "https://github.com/joddie/pcre2el")) + +(defface rxt-highlight-face + '((((min-colors 16581375) (background light)) :background "#eee8d5") + (((min-colors 16581375) (background dark)) :background "#222222")) + "Face for highlighting corresponding regex syntax in + `rxt-explain' buffers." + :group 'rxt) + +(defcustom rxt-verbose-rx-translation nil + "Non-nil if `rxt-pcre-to-rx' and `rxt-elisp-to-rx' should use + verbose `rx' primitives. + +Verbose primitives are things like `line-start' instead of `bol', +etc." + :group 'rxt + :type 'boolean) + +(defcustom rxt-explain-verbosely t + "Non-nil if `rxt-explain-elisp' and `rxt-explain-pcre' should + use verbose `rx' primitives. + +This overrides the value of `rxt-verbose-rx-translation' for +these commands only." + :group 'rxt + :type 'boolean) + + +;;;; Macros and functions for writing interactive input and output + +;; Macros for handling return values. If called interactively, +;; display the value in the echo area and copy it to the kill ring, +;; otherwise just return the value. PCREs are copied as unquoted +;; strings for yanking into Perl, JS, etc. `rx' forms and other sexps +;; are copied as `read'-able literals for yanking into Elisp buffers. +;; Emacs regexps are copied twice: once as an unquoted value for +;; interactive use, and once as a readable string literal for yanking +;; into Elisp buffers. +(defmacro rxt-return-pcre (expr) + (let ((value (make-symbol "value"))) + `(let ((,value ,expr)) + (when (called-interactively-p 'any) + (rxt--kill-pcre ,value)) + ,value))) + +(defmacro rxt-return-sexp (expr) + (let ((value (make-symbol "value"))) + `(let ((,value ,expr)) + (when (called-interactively-p 'any) + (rxt--kill-sexp ,value)) + ,value))) + +(defmacro rxt-return-emacs-regexp (expr) + (let ((value (make-symbol "value"))) + `(let ((,value ,expr)) + (when (called-interactively-p 'any) + (rxt--kill-emacs-regexp ,value)) + ,value))) + +(defun rxt--kill-sexp (value) + (let ((lisp-literal (prin1-to-string value))) + (message "%s" lisp-literal) + (kill-new lisp-literal))) + +(defun rxt--kill-pcre (value) + (message "%s" value) + (kill-new value)) + +(defun rxt--kill-emacs-regexp (value) + (let ((lisp-literal (prin1-to-string value))) + (message "%s" value) + (kill-new lisp-literal) + (kill-new value))) + +;; Read an Elisp regexp interactively. +;; +;; Three possibilities: +;; +;; 1) With a prefix arg, reads literally from the minibuffer, w/o +;; using string syntax -- just like query-replace-regexp, etc. +;; +;; 2) If the region is active, use the text of the region literally +;; (again w/o string syntax) +;; +;; 3) Otherwise, eval the sexp before point (which might be a string +;; literal or an expression) and use its value. Falls back to method +;; (1) if this fails to produce a string value. +;; +(cl-defun rxt-interactive/elisp (&optional (prompt "Emacs regexp: ")) + (list + (cond (current-prefix-arg + (read-string prompt)) + + ((use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end))) + + (t + (condition-case nil + (save-excursion + (while (nth 3 (syntax-ppss)) (forward-char)) + (let ((re (eval (elisp--preceding-sexp)))) + (if (stringp re) re + (read-string prompt)))) + (error + (read-string prompt))))))) + +;; Read a PCRE regexp interactively. +;; +;; Three possibilities: As above, except that without prefix arg or +;; active region, tries to read a delimited regexp literal like /.../, +;; m/.../, or qr/.../ following point in the current buffer. Falls +;; back to reading from minibuffer if that fails. +;; +;; Returns the regexp, with flags as text properties. +;; +;; TODO: Different delimiters +(cl-defun rxt-interactive/pcre (&optional (prompt "PCRE regexp: ")) + (list + (cond (current-prefix-arg + (rxt--read-pcre prompt)) + + ((use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end))) + + (t + (condition-case nil + (rxt-read-delimited-pcre) + (error ; Fall back to reading from minibuffer + (rxt--read-pcre prompt))))) + nil)) + +(define-minor-mode rxt--read-pcre-mode + "Minor-mode with key-bindings for toggling PCRE flags. + +You should not normally call this directly. It will be enabled +in minibuffers for `read-regexp' and in the `re-builder' buffer +when `pcre-mode' is active. These bindings will also be added to +`isearch-mode-map' in `pcre-mode'." + :initial-value nil + :lighter nil + :keymap + `((,(kbd "C-c s") . ,#'rxt--toggle-s-mode) + (,(kbd "C-c x") . ,#'rxt--toggle-x-mode) + (,(kbd "C-c i") . ,#'rxt--toggle-i-mode))) + +(defun rxt--read-pcre (prompt) + "Read a PCRE regexp for translation, together with option flags. + +The `s', `x', and `i' flags can be toggled using the following +commands: \\ + +\\[rxt--toggle-s-mode] : toggle `s' (single-line) mode +\\[rxt--toggle-x-mode] : toggle `x' (extended) mode +\\[rxt--toggle-i-mode] : toggle `i' (case-insensitive) mode + +In single-line mode, `.' will also match newlines. +In extended mode, whitespace is ignored. + +Case-insensitive mode emulates matching without case, +independently of Emacs's builtin `case-fold-search' setting. +Note that this does not apply to backreferences." + (minibuffer-with-setup-hook #'rxt--read-pcre-mode + (read-from-minibuffer prompt))) + +(defun rxt--toggle-s-mode () + "Toggle emulated PCRE single-line (s) flag." + (interactive) + (rxt--toggle-flag ?s)) + +(defun rxt--toggle-x-mode () + "Toggle emulated PCRE extended (x) flag." + (interactive) + (rxt--toggle-flag ?x)) + +(defun rxt--toggle-i-mode () + "Toggle emulated PCRE case-insensitive (i) flag." + (interactive) + (rxt--toggle-flag ?i)) + +(defun rxt--toggle-flag (char) + "Toggle CHAR, a PCRE flag." + (cond + ((derived-mode-p 'reb-mode) ; RE-Builder + (rxt--toggle-flag-re-builder char)) + ((minibufferp) + (rxt--toggle-flag-minibuffer char)) + (isearch-mode + (rxt--toggle-flag-isearch char)) + (t + (error "Not in minibuffer, RE-Builder or isearch mode.")))) + +(defun rxt--toggle-flag-re-builder (char) + (save-excursion + (goto-char (point-max)) + (search-backward "/") + (forward-char) + (when (looking-at (rx (* (any ?i ?s ?x)))) + (let ((inhibit-modification-hooks t)) + (replace-match (rxt--xor-flags (match-string 0) char) t t)))) + (reb-do-update)) + +(defun rxt--toggle-flag-minibuffer (char) + (setf (buffer-substring (minibuffer-prompt-end) (point-max)) + (rxt--toggle-flag-string (minibuffer-contents) char)) + (when + (and (= (point) (minibuffer-prompt-end)) + (looking-at (rx "(?" (group (+ (any ?i ?s ?x))) ")"))) + (forward-sexp))) + +(defun rxt--toggle-flag-isearch (char) + (when isearch-regexp + (setq isearch-string + (rxt--toggle-flag-string isearch-string char)) + (setq isearch-message + (mapconcat #'isearch-text-char-description isearch-string "")) + (isearch-search-and-update))) + +(defun rxt--toggle-flag-string (string char) + (if (string-match (rx string-start "(?" (group (+ (any ?i ?s ?x))) ")") + string) + (let ((flags (rxt--xor-flags (match-string 1 string) char))) + (if (string= flags "") + (replace-match "" t t string) + (replace-match flags t t string 1))) + (format "(?%c)%s" char string))) + +(defun rxt--xor-flags (flags char) + (concat + (sort + (cl-set-exclusive-or (string-to-list flags) (list char)) + #'<))) + + +;;;; Minor mode for using emulated PCRE syntax + +(defvar pcre-old-isearch-search-fun-function nil + "Original value of `isearch-search-fun-function' before entering `pcre-mode.' + +This function is wrapped by `pcre-isearch-search-fun-function' +and restored on exit from `pcre-mode'.") +(make-variable-buffer-local 'pcre-old-isearch-search-fun-function) + +(defvar pcre-old-isearch-key-bindings nil + "Alist of key-bindings to restore in `isearch-mode-map' on exiting `pcre-mode'.") + +;;;###autoload +(define-minor-mode pcre-mode + "Use emulated PCRE syntax for regexps wherever possible. + +Advises the `interactive' specs of `read-regexp' and the +following other functions so that they read PCRE syntax and +translate to its Emacs equivalent: + +- `align-regexp' +- `find-tag-regexp' +- `sort-regexp-fields' +- `isearch-message-prefix' +- `ibuffer-do-replace-regexp' + +Also alters the behavior of `isearch-mode' when searching by regexp." + :init-value nil + :lighter " PCRE" + :keymap nil + :global t + + (if pcre-mode + ;; Enabling + (progn + ;; Enable advice + (ad-enable-regexp "pcre-mode") + ;; Set up isearch hooks + (add-hook 'isearch-mode-hook #'pcre-isearch-mode-hook) + (add-hook 'isearch-mode-end-hook #'pcre-isearch-mode-end-hook) + ;; Add the keybindings of `rxt--read-pcre-mode-map' to + ;; `isearch-mode-map' (so that they do not cause an exit from + ;; `isearch-mode'), and save any existing bindings for those + ;; keys to restore on exit from `pcre-mode'. + (setq pcre-old-isearch-key-bindings + (cl-loop for key being the key-seqs of rxt--read-pcre-mode-map + for def = (lookup-key isearch-mode-map key) + collect (cons (copy-sequence key) + (if (numberp def) nil def)))) + (cl-loop for key being the key-seqs of rxt--read-pcre-mode-map + using (key-bindings def) + do (define-key isearch-mode-map key def))) + + ;; Disable advice + (ad-disable-regexp "pcre-mode") + ;; Remove from isearch hooks + (remove-hook 'isearch-mode-hook #'pcre-isearch-mode-hook) + (remove-hook 'isearch-mode-end-hook #'pcre-isearch-mode-end-hook) + ;; Restore key-bindings + (cl-loop for (key . def) in pcre-old-isearch-key-bindings + do (define-key isearch-mode-map key def))) + + ;; "Activating" advice re-computes the function definitions, which + ;; is necessary whether enabling or disabling + (ad-activate-regexp "pcre-mode")) + +;;; Cache of PCRE -> Elisp translations +(defvar pcre-mode-cache-size 100 + "Number of PCRE-to-Emacs translations to keep in the `pcre-mode' cache.") + +(defvar pcre-mode-cache (make-hash-table :test 'equal) + "Cache of PCRE-to-Emacs translations used in `pcre-mode'. + +Keys are PCRE regexps, values are their Emacs equivalents.") + +(defvar pcre-mode-reverse-cache (make-hash-table :test 'equal) + "Cache of original PCREs translated to Emacs syntax in `pcre-mode'. + +Keys are translated Emacs regexps, values are their original PCRE +form. This is used to display the original PCRE regexp in place +of its translated form.") + +(defvar pcre-cache-ring (make-ring pcre-mode-cache-size) + "Ring of PCRE-to-Emacs translations used in `pcre-mode'. + +When the ring fills up, the oldest element is removed and the +corresponding entries are deleted from the hash tables +`pcre-mode-cache' and `pcre-mode-reverse-cache'.") + +(defun pcre-to-elisp/cached (pcre) + "Translate PCRE to Emacs syntax, caching both forms." + (or (gethash pcre pcre-mode-cache) + (let ((elisp (rxt-pcre-to-elisp pcre))) + (pcre-set-cache pcre elisp) + elisp))) + +(defun pcre-set-cache (pcre-regexp emacs-regexp) + "Add a PCRE-to-Emacs translation to the `pcre-mode' cache." + (when (and (not (zerop (length pcre-regexp))) + (not (zerop (length emacs-regexp))) + (not (gethash pcre-regexp pcre-mode-cache))) + (if (= (ring-length pcre-cache-ring) (ring-size pcre-cache-ring)) + (let* ((old-item (ring-remove pcre-cache-ring)) + (old-pcre (car old-item)) + (old-emacs (cdr old-item))) + (remhash old-pcre pcre-mode-cache) + (remhash old-emacs pcre-mode-reverse-cache)) + (puthash pcre-regexp emacs-regexp pcre-mode-cache) + (puthash emacs-regexp pcre-regexp pcre-mode-reverse-cache) + (ring-insert pcre-cache-ring (cons pcre-regexp emacs-regexp))))) + +;;; Isearch advice +(defun pcre-isearch-mode-hook () + (when (not (eq isearch-search-fun-function #'isearch-search-fun-default)) + (message "Warning: pcre-mode overriding existing isearch function `%s'" + isearch-search-fun-function)) + ;; Prevent an infinite loop, if a previous isearch in pcre-mode + ;; exited without restoring the original search function for some + ;; reason + (unless (eq isearch-search-fun-function #'pcre-isearch-search-fun-function) + (setq pcre-old-isearch-search-fun-function isearch-search-fun-function)) + (set (make-local-variable 'isearch-search-fun-function) + #'pcre-isearch-search-fun-function)) + +(defun pcre-isearch-mode-end-hook () + (setq isearch-search-fun-function pcre-old-isearch-search-fun-function)) + +(defun pcre-isearch-search-fun-function () + "Enable isearching using emulated PCRE syntax. + +This is set as the value of `isearch-search-fun-function' when +`pcre-mode' is enabled. Returns a function which searches using +emulated PCRE regexps when `isearch-regexp' is true." + (lambda (string bound noerror) + (let ((real-search-function + (funcall (or pcre-old-isearch-search-fun-function 'isearch-search-fun-default)))) + (if (not isearch-regexp) + (funcall real-search-function string bound noerror) + ;; Raise an error if the regexp ends in an incomplete escape + ;; sequence (= odd number of backslashes). + ;; TODO: Perhaps this should really be handled in rxt-pcre-to-elisp? + (if (isearch-backslash string) (rxt-error "Trailing backslash")) + (funcall real-search-function + (pcre-to-elisp/cached string) bound noerror))))) + +(defadvice isearch-message-prefix (after pcre-mode disable) + "Add \"PCRE\" to the Isearch message when searching by regexp in `pcre-mode'." + (when (and isearch-regexp + ;; Prevent an inaccurate message if our callback was + ;; removed somehow + (eq isearch-search-fun-function #'pcre-isearch-search-fun-function)) + (let ((message ad-return-value)) + ;; Some hackery to give replacement the same fontification as + ;; the original + (when + (let ((case-fold-search t)) (string-match "regexp" message)) + (let* ((match (match-string 0 message)) + (properties (text-properties-at 0 match)) + (replacement (apply #'propertize "PCRE regexp" properties)) + (new-message (replace-match replacement t t message))) + (setq ad-return-value new-message)))))) + +(defadvice isearch-fallback + (before pcre-mode (want-backslash &optional allow-invalid to-barrier) disable) + "Hack to fall back correctly in `pcre-mode'. " + ;; A dirty hack to the internals of isearch. Falling back to a + ;; previous match position is necessary when the (Emacs) regexp ends + ;; in "*", "?", "\{" or "\|": this is handled in + ;; `isearch-process-search-char' by calling `isearch-fallback' with + ;; `t' for the value of the first parameter, `want-backslash', in + ;; the last two cases. With PCRE regexps, falling back should take + ;; place on "*", "?", "{" or "|", with no backslashes required. + ;; This advice handles the last two cases by unconditionally setting + ;; `want-backslash' to nil. + (ad-set-arg 0 nil)) + +(defadvice isearch-edit-string + (around pcre-mode disable) + "Add PCRE mode-toggling keys to Isearch minibuffer in regexp mode." + (if isearch-regexp + (minibuffer-with-setup-hook + #'rxt--read-pcre-mode + ad-do-it) + ad-do-it)) + +;;; evil-mode advice +(defadvice evil-search-function + (around pcre-mode (forward regexp-p wrap) disable) + (if (and regexp-p (not isearch-mode)) + (let ((real-search-function ad-do-it)) + (setq ad-return-value + (pcre-decorate-search-function real-search-function))) + ad-do-it)) + +(eval-after-load 'evil + '(when pcre-mode + (ad-enable-advice 'evil-search-function 'around 'pcre-mode) + (ad-activate 'evil-search-function))) + +(defun pcre-decorate-search-function (real-search-function) + (lambda (string &optional bound noerror count) + (funcall real-search-function + (pcre-to-elisp/cached string) + bound noerror count))) + +;;; Other hooks and defadvices + +;;;###autoload +(defun pcre-query-replace-regexp () + "Perform `query-replace-regexp' using PCRE syntax. + +Consider using `pcre-mode' instead of this function." + (interactive) + (let ((old-pcre-mode pcre-mode)) + (unwind-protect + (progn + (pcre-mode +1) + (call-interactively #'query-replace-regexp)) + (pcre-mode (if old-pcre-mode 1 0))))) + + +(defadvice add-to-history + (before pcre-mode (history-var newelt &optional maxelt keep-all) disable) + "Add the original PCRE to query-replace history in `pcre-mode'." + (when (eq history-var query-replace-from-history-variable) + (let ((original (gethash newelt pcre-mode-reverse-cache))) + (when original + (ad-set-arg 1 original))))) + +(defadvice query-replace-descr + (before pcre-mode (from) disable) + "Use the original PCRE in Isearch prompts in `pcre-mode'." + (let ((original (gethash from pcre-mode-reverse-cache))) + (when original + (ad-set-arg 0 original)))) + +;;; The `interactive' specs of the following functions are lifted +;;; wholesale from the original built-ins, which see. +(defadvice read-regexp + (around pcre-mode first (prompt &optional defaults history) disable) + "Read regexp using PCRE syntax and convert to Elisp equivalent." + (ad-set-arg 0 (concat "[PCRE] " prompt)) + (minibuffer-with-setup-hook + #'rxt--read-pcre-mode + ad-do-it) + (setq ad-return-value + (pcre-to-elisp/cached ad-return-value))) + +(defadvice align-regexp + (before pcre-mode first (beg end regexp &optional group spacing repeat) disable) + "Read regexp using PCRE syntax and convert to Elisp equivalent." + (interactive + (append + (list (region-beginning) (region-end)) + (if current-prefix-arg + (list (rxt-pcre-to-elisp + (read-string "Complex align using PCRE regexp: " + "(\\s*)")) + (string-to-number + (read-string + "Parenthesis group to modify (justify if negative): " "1")) + (string-to-number + (read-string "Amount of spacing (or column if negative): " + (number-to-string align-default-spacing))) + (y-or-n-p "Repeat throughout line? ")) + (list (concat "\\(\\s-*\\)" + (rxt-pcre-to-elisp + (read-string "Align PCRE regexp: "))) + 1 align-default-spacing nil))))) + +(defadvice ibuffer-do-replace-regexp + (before pcre-mode first (from-str to-str) disable) + "Read regexp using PCRE syntax and convert to Elisp equivalent." + (interactive + (let* ((from-str (read-from-minibuffer "[PCRE] Replace regexp: ")) + (to-str (read-from-minibuffer (concat "[PCRE] Replace " from-str " with: ")))) + (list (rxt-pcre-to-elisp from-str) to-str)))) + +(defadvice find-tag-regexp + (before pcre-mode first (regexp &optional next-p other-window) disable) + "Read regexp using PCRE syntax and convert to Elisp equivalent. +Perform `find-tag-regexp' using emulated PCRE regexp syntax." + (interactive + (let ((args (find-tag-interactive "[PCRE] Find tag regexp: " t))) + (list (rxt-pcre-to-elisp (nth 0 args)) + (nth 1 args) (nth 2 args))))) + +(defadvice sort-regexp-fields + (before pcre-mode first (reverse record-regexp key-regexp beg end) disable) + "Read regexp using PCRE syntax and convert to Elisp equivalent." + (interactive "P\nsPCRE regexp specifying records to sort: \n\ +sPCRE regexp specifying key within record: \nr") + (ad-set-arg 1 (rxt-pcre-to-elisp (ad-get-arg 1))) + (ad-set-arg 2 (rxt-pcre-to-elisp (ad-get-arg 2)))) + + + +;;; Commands that take Emacs-style regexps as input + +;;;###autoload +(defun rxt-elisp-to-pcre (regexp) + "Translate REGEXP, a regexp in Emacs Lisp syntax, to Perl-compatible syntax. + +Interactively, reads the regexp in one of three ways. With a +prefix arg, reads from minibuffer without string escaping, like +`query-replace-regexp'. Without a prefix arg, uses the text of +the region if it is active. Otherwise, uses the result of +evaluating the sexp before point (which might be a string regexp +literal or an expression that produces a string). + +Displays the translated PCRE regexp in the echo area and copies +it to the kill ring. + +Emacs regexp features such as syntax classes which cannot be +translated to PCRE will cause an error." + (interactive (rxt-interactive/elisp)) + (rxt-return-pcre (rxt-adt->pcre (rxt-parse-elisp regexp)))) + +;;;###autoload +(defun rxt-elisp-to-rx (regexp) + "Translate REGEXP, a regexp in Emacs Lisp syntax, to `rx' syntax. + +See `rxt-elisp-to-pcre' for a description of the interactive +behavior and `rx' for documentation of the S-expression based +regexp syntax." + (interactive (rxt-interactive/elisp)) + (rxt-return-sexp (rxt-adt->rx (rxt-parse-elisp regexp)))) + +;;;###autoload +(defun rxt-elisp-to-strings (regexp) + "Return a list of all strings matched by REGEXP, an Emacs Lisp regexp. + +See `rxt-elisp-to-pcre' for a description of the interactive behavior. + +This is useful primarily for getting back the original list of +strings from a regexp generated by `regexp-opt', but it will work +with any regexp without unbounded quantifiers (*, +, {2, } and so +on). + +Throws an error if REGEXP contains any infinite quantifiers." + (interactive (rxt-interactive/elisp)) + (rxt-return-sexp (rxt-adt->strings (rxt-parse-elisp regexp)))) + +;;;###autoload +(defun rxt-toggle-elisp-rx () + "Toggle the regexp near point between Elisp string and rx syntax." + (interactive) + ;; First, position point before the regex form near point (either + ;; a string literal or a list beginning `rx' or `rx-to-string'). + (let* ((context (syntax-ppss)) + (string-start (nth 8 context))) + (cond (string-start (goto-char string-start)) + ((looking-back "\"" nil t) (backward-sexp)) + ((looking-at "\"") nil) + (t + ;; Search backwards, leaving point in place on error + (goto-char + (save-excursion + (skip-syntax-forward "-") + (while (not (looking-at + (rx "(" (or "rx" "rx-to-string") symbol-end))) + (backward-up-list)) + (point)))))) + + ;; Read and replace the regex following point + (let* ((regex (read (current-buffer))) + (print-escape-newlines t)) + (save-excursion + (if (listp regex) + ;; Replace rx form with string value + (prin1 (eval regex) (current-buffer)) + ;; Pretty-print rx form + (save-restriction + (let* ((start (point)) + (rx--syntax-codes (rxt-elisp-to-rx regex)) + (rx--form + (pcase rx--syntax-codes + (`(seq . ,rest) `(rx . ,rest)) + (form `(rx ,form))))) + (rxt-print rx--form) + (narrow-to-region start (point))) + (pp-buffer) + ;; remove the extra newline that pp-buffer inserts + (goto-char (point-max)) + (delete-region + (point) + (save-excursion (skip-chars-backward " \t\n") (point)))))) + (kill-sexp -1) + (indent-pp-sexp))) + + + +;;; Commands that translate PCRE to other formats + +;;;###autoload +(defun rxt-pcre-to-elisp (pcre &optional flags) + "Translate PCRE, a regexp in Perl-compatible syntax, to Emacs Lisp. + +Interactively, uses the contents of the region if it is active, +otherwise reads from the minibuffer. Prints the Emacs translation +in the echo area and copies it to the kill ring. + +PCRE regexp features that cannot be translated into Emacs syntax +will cause an error. See the commentary section of pcre2el.el for +more details." + (interactive (rxt-interactive/pcre)) + (rxt-return-emacs-regexp + (rx-to-string + (rxt-pcre-to-rx (rxt--add-flags pcre flags)) + t))) + +;;;###autoload +(defalias 'pcre-to-elisp 'rxt-pcre-to-elisp) + +;;;###autoload +(defun rxt-pcre-to-rx (pcre &optional flags) + "Translate PCRE, a regexp in Perl-compatible syntax, to `rx' syntax. + +See `rxt-pcre-to-elisp' for a description of the interactive behavior." + (interactive (rxt-interactive/pcre)) + (rxt-return-sexp (rxt-adt->rx (rxt-parse-pcre (rxt--add-flags pcre flags))))) + +;;;###autoload +(defun rxt-pcre-to-strings (pcre &optional flags) + "Return a list of all strings matched by PCRE, a Perl-compatible regexp. + +See `rxt-elisp-to-pcre' for a description of the interactive +behavior and `rxt-elisp-to-strings' for why this might be useful. + +Throws an error if PCRE contains any infinite quantifiers." + (interactive (rxt-interactive/pcre)) + (rxt-return-sexp (rxt-adt->strings (rxt-parse-pcre (rxt--add-flags pcre flags))))) + +(defun rxt--add-flags (pcre flags) + "Prepend FLAGS to PCRE." + (if (not (zerop (length flags))) + (concat "(?" flags ")" pcre) + pcre)) + + +;;; Regexp explaining functions to display pretty-printed rx syntax + +;; When the `rxt-explain' flag is non-nil, `rxt-adt->rx' records +;; location information for each element of the generated `rx' form, +;; allowing highlighting corresponding pieces of syntax at point. +(defvar rxt-explain nil) + +(defvar rxt-highlight-overlays nil + "List of active location-highlighting overlays in rxt-help-mode buffer.") + +;;;###autoload +(defun rxt-explain-elisp (regexp) + "Insert the pretty-printed `rx' syntax for REGEXP in a new buffer. + +REGEXP is a regular expression in Emacs Lisp syntax. See +`rxt-elisp-to-pcre' for a description of how REGEXP is read +interactively." + (interactive (rxt-interactive/elisp)) + (let ((rxt-explain t) + (rxt-verbose-rx-translation rxt-explain-verbosely)) + (rxt-pp-rx regexp (rxt-elisp-to-rx regexp)))) + +;;;###autoload +(defun rxt-explain-pcre (regexp &optional flags) + "Insert the pretty-printed `rx' syntax for REGEXP in a new buffer. + +REGEXP is a regular expression in PCRE syntax. See +`rxt-pcre-to-elisp' for a description of how REGEXP is read +interactively." + (interactive (rxt-interactive/pcre)) + (let ((rxt-explain t) + (rxt-verbose-rx-translation rxt-explain-verbosely)) + (rxt-pp-rx regexp (rxt-pcre-to-rx regexp flags)))) + +;;;###autoload +(defun rxt-quote-pcre (text) + "Return a PCRE regexp which matches TEXT literally. + +Any PCRE metacharacters in TEXT will be quoted with a backslash." + (rxt-adt->pcre (rxt-string text))) + + +;;;; Commands that depend on the major mode in effect + +;; Macro: interactively call one of two functions depending on the +;; major mode +(defmacro rxt-mode-dispatch (elisp-function pcre-function) + `(if (memq major-mode '(emacs-lisp-mode lisp-interaction-mode)) + (call-interactively #',elisp-function) + (call-interactively #',pcre-function))) + +;;;###autoload +(defun rxt-explain () + "Pop up a buffer with pretty-printed `rx' syntax for the regex at point. + +Chooses regex syntax to read based on current major mode, calling +`rxt-explain-elisp' if buffer is in `emacs-lisp-mode' or +`lisp-interaction-mode', or `rxt-explain-pcre' otherwise." + (interactive) + (rxt-mode-dispatch rxt-explain-elisp rxt-explain-pcre)) + +;;;###autoload +(defun rxt-convert-syntax () + "Convert regex at point to other kind of syntax, depending on major mode. + +For buffers in `emacs-lisp-mode' or `lisp-interaction-mode', +calls `rxt-elisp-to-pcre' to convert to PCRE syntax. Otherwise, +calls `rxt-pcre-to-elisp' to convert to Emacs syntax. + +The converted syntax is displayed in the echo area and copied to +the kill ring; see the two functions named above for details." + (interactive) + (rxt-mode-dispatch rxt-elisp-to-pcre rxt-pcre-to-elisp)) + +;;;###autoload +(defun rxt-convert-to-rx () + "Convert regex at point to RX syntax. Chooses Emacs or PCRE syntax by major mode." + (interactive) + (rxt-mode-dispatch rxt-elisp-to-rx rxt-pcre-to-rx)) + +;;;###autoload +(defun rxt-convert-to-strings () + "Convert regex at point to RX syntax. Chooses Emacs or PCRE syntax by major mode." + (interactive) + (rxt-mode-dispatch rxt-elisp-to-strings rxt-pcre-to-strings)) + + + +;;; Minor mode and keybindings + +(defvar rxt-mode-map + (let ((map (make-sparse-keymap))) + ;; Generic + (define-key map (kbd "C-c / /") 'rxt-explain) + (define-key map (kbd "C-c / c") 'rxt-convert-syntax) + (define-key map (kbd "C-c / x") 'rxt-convert-to-rx) + (define-key map (kbd "C-c / '") 'rxt-convert-to-strings) + + ;; From PCRE + (define-key map (kbd "C-c / p /") 'rxt-explain-pcre) + (define-key map (kbd "C-c / p e") 'rxt-pcre-to-elisp) + (define-key map (kbd "C-c / p x") 'rxt-pcre-to-rx) + (define-key map (kbd "C-c / p '") 'rxt-pcre-to-strings) + + ;; From Elisp + (define-key map (kbd "C-c / e /") 'rxt-explain-elisp) + (define-key map (kbd "C-c / e p") 'rxt-elisp-to-pcre) + (define-key map (kbd "C-c / e x") 'rxt-elisp-to-rx) + (define-key map (kbd "C-c / e '") 'rxt-elisp-to-strings) + (define-key map (kbd "C-c / e t") 'rxt-toggle-elisp-rx) + (define-key map (kbd "C-c / t") 'rxt-toggle-elisp-rx) + + ;; Search + (define-key map (kbd "C-c / %") 'pcre-query-replace-regexp) + + map) + "Keymap for `rxt-mode'.") + +;;;###autoload +(define-minor-mode rxt-mode + "Regex translation utilities." + :init-value nil + :lighter nil + :keymap rxt-mode-map) + +;;;###autoload +(defun turn-on-rxt-mode () + "Turn on `rxt-mode' in the current buffer." + (interactive) + (rxt-mode 1)) + +;;;###autoload +(define-globalized-minor-mode rxt-global-mode rxt-mode + turn-on-rxt-mode) + + +;;;; Syntax explanations + +;; Major mode for displaying pretty-printed S-exp syntax +(define-derived-mode rxt-help-mode emacs-lisp-mode "Regexp Explain" + (setq buffer-read-only t) + (add-hook 'post-command-hook 'rxt-highlight-text nil t) + (rxt-highlight-text)) + +;; Hack: stop paredit-mode interfering with `rxt-print' +(eval-when-compile (declare-function paredit-mode "paredit.el")) +(add-hook 'rxt-help-mode-hook + (lambda () + (if (and (boundp 'paredit-mode) + paredit-mode) + (paredit-mode 0)))) + +(define-key rxt-help-mode-map "q" 'quit-window) +(define-key rxt-help-mode-map "z" 'kill-this-buffer) +(define-key rxt-help-mode-map "n" 'next-line) +(define-key rxt-help-mode-map "p" 'previous-line) +(define-key rxt-help-mode-map "f" 'forward-list) +(define-key rxt-help-mode-map "b" 'backward-list) +(define-key rxt-help-mode-map "u" 'backward-up-list) +(define-key rxt-help-mode-map "d" 'down-list) + +(defvar rxt--print-with-overlays nil) +(defvar rxt--print-depth 0) + +(defconst rxt--print-char-alist + '((?\a . "\\a") + (?\b . "\\b") + (?\t . "\\t") + (?\n . "\\n") + (?\v . "\\v") + (?\f . "\\f") + (?\r . "\\r") + (?\e . "\\e") + (?\s . "\\s") + (?\\ . "\\\\") + (?\d . "\\d")) + "Alist of characters to print using an escape sequence in Elisp source. +See (info \"(elisp) Basic Char Syntax\").") + +(defconst rxt--whitespace-display-regexp + (rx-to-string `(any ,@(mapcar #'car rxt--print-char-alist)))) + +(defconst rxt--print-special-chars + '(?\( ?\) ?\\ ?\| ?\; ?\' ?\` ?\" ?\# ?\. ?\,) + "Characters which require a preceding backslash in Elisp source. +See (info \"(elisp) Basic Char Syntax\").") + +(defun rxt-pp-rx (regexp rx) + "Display string regexp REGEXP with its `rx' form RX in an `rxt-help-mode' buffer." + (with-current-buffer (get-buffer-create "* Regexp Explain *") + (let ((print-escape-newlines t) + (inhibit-read-only t)) + (erase-buffer) + (rxt-help-mode) + (insert (rxt--propertize-whitespace regexp)) + (newline 2) + (save-excursion + (let ((sexp-begin (point)) + (rxt--print-with-overlays t)) + (rxt-print rx) + (narrow-to-region sexp-begin (point)) + (pp-buffer) + (widen))) + (rxt-highlight-text)) + (pop-to-buffer (current-buffer)))) + +(cl-defun rxt-print (rx) + "Insert RX, an `rx' form, into the current buffer, optionally adding overlays. + +Similar to `print' or `prin1', but ensures that `rx' forms are +printed readably, using character or integer syntax depending on +context. + +If `rxt--print-with-overlays' is non-nil, also creates overlays linking +elements of RX to their corresponding locations in the source +string (see `rxt-explain-elisp', `rxt-explain-pcre' and +`rxt--make-help-overlays')." + (let ((start (point))) + (cl-typecase rx + (cons + (pcase rx + (`(,(and (or `repeat `**) head) + ,(and (pred integerp) from) + ,(and (pred integerp) to) + . ,rest) + (insert (format "(%s %d %d" head from to)) + (rxt--print-list-tail rest)) + (`(,(and (or `repeat `= `>=) head) + ,(and (pred integerp) n) + . ,rest) + (insert (format "(%s %d" head n)) + (rxt--print-list-tail rest)) + (_ + (rxt--print-list-tail rx t)))) + (symbol + (cl-case rx + ;; `print' escapes the ? characters in the rx operators *? + ;; and +?, but this looks bad and is not strictly necessary: + ;; (eq (read "*?") (read "*\\?")) => t + ;; (eq (read "+?") (read "+\\?")) => t + ((*? +?) (insert (symbol-name rx))) + (t (prin1 rx (current-buffer))))) + (string + (insert (rxt--propertize-whitespace (prin1-to-string rx)))) + (character + (cond + ((eq ? rx) + (insert "?")) + ((memq rx rxt--print-special-chars) + (insert "?\\" rx)) + ((assq rx rxt--print-char-alist) + (insert "?" (assoc-default rx rxt--print-char-alist))) + (t + (insert "?" (char-to-string rx))))) + (t + (prin1 rx (current-buffer)))) + (when rxt--print-with-overlays + (rxt--make-help-overlays rx start (point))))) + +(defun rxt--print-list-tail (tail &optional open-paren) + (let ((rxt--print-depth (1+ rxt--print-depth))) + (let ((done nil)) + (while (not done) + (cl-typecase tail + (null + (insert ")") + (setq done t)) + (cons + (if open-paren + (progn + (insert "(") + (setq open-paren nil)) + (insert " ")) + (rxt-print (car tail)) + (setq tail (cdr tail))) + (t + (insert " . ") + (rxt-print tail) + (insert ")") + (setq done t))))))) + +(defun rxt--make-help-overlays (rx start end) + (let ((location (rxt-location rx))) + (when (and location + (rxt-location-start location) + (rxt-location-end location)) + (let* ((sexp-begin (copy-marker start t)) + (sexp-end (copy-marker end)) + (sexp-bounds (list sexp-begin sexp-end)) + + (source-begin (1+ (rxt-location-start location))) + (source-end (1+ (rxt-location-end location))) + (source-bounds (list source-begin source-end)) + + (bounds (list source-bounds sexp-bounds)) + + (sexp-ol (make-overlay sexp-begin sexp-end (current-buffer) t nil)) + (source-ol (make-overlay source-begin source-end (current-buffer) t nil))) + (dolist (ol (list sexp-ol source-ol)) + (overlay-put ol 'priority rxt--print-depth) + (overlay-put ol 'rxt-bounds bounds)))))) + +(defun rxt--propertize-whitespace (string) + (let ((string (copy-sequence string)) + (start 0)) + (while (string-match rxt--whitespace-display-regexp string start) + (put-text-property (match-beginning 0) (match-end 0) + 'display + (assoc-default (string-to-char (match-string 0 string)) + rxt--print-char-alist) + string) + (setq start (match-end 0))) + string)) + +(defun rxt-highlight-text () + "Highlight the regex syntax at point and its corresponding RX/string form." + (let ((all-bounds (get-char-property (point) 'rxt-bounds))) + (mapc #'delete-overlay rxt-highlight-overlays) + (setq rxt-highlight-overlays nil) + (dolist (bounds all-bounds) + (cl-destructuring-bind (begin end) bounds + (let ((overlay (make-overlay begin end))) + (push overlay rxt-highlight-overlays) + (overlay-put overlay 'face 'rxt-highlight-face)))))) + + +;;;; Error handling + +(if (fboundp 'define-error) + (define-error 'rxt-invalid-regexp "Invalid regexp" 'invalid-regexp) + (put 'rxt-invalid-regexp + 'error-conditions + '(rxt-invalid-regexp invalid-regexp error)) + (put 'rxt-invalid-regexp 'error-message "Invalid regexp")) + +(defun rxt-error (&rest format-args) + (signal 'rxt-invalid-regexp (list (apply #'format format-args)))) + + +;;;; Regexp syntax tree data type + +;; Base class from which other elements of the syntax-tree inherit +(cl-defstruct rxt-syntax-tree) + +;; Struct representing the original source location +(cl-defstruct rxt-location + source ; Either a string or a buffer + start end ; Offsets, 0- or 1-indexed as appropriate + ) + +(defun rxt-location-text (location) + (if (not (rxt-location-p location)) + nil + (let ((start (rxt-location-start location)) + (end (rxt-location-end location)) + (source (rxt-location-source location))) + (cond + ((buffer-live-p source) + (with-current-buffer source + (buffer-substring-no-properties start end))) + ((stringp source) + (substring source start end)) + (t nil))))) + +;; Hash table mapping from syntax-tree elements to source locations. +(defvar rxt-location-map (make-hash-table :weakness 'key)) + +(defun rxt-location (object) + (gethash object rxt-location-map)) + +(gv-define-setter rxt-location (value object) + `(puthash ,object ,value rxt-location-map)) + +(defun rxt-source-text (object) + (rxt-location-text (rxt-location object))) + +(defun rxt-to-string (tree) + "Return a readable representation of TREE, a regex syntax-tree object." + (or (rxt-source-text tree) + (let ((print-level 1)) + (prin1-to-string tree)))) +(defalias 'rxt-syntax-tree-readable 'rxt-to-string) + +;; FIXME +(defvar rxt-pcre-case-fold nil) + +;; Literal string +(cl-defstruct + (rxt-string + (:constructor rxt-string (chars &optional case-fold)) + (:include rxt-syntax-tree)) + chars + (case-fold rxt-pcre-case-fold)) + +(defun rxt-empty-string () + (rxt-string "")) + +(defun rxt-trivial-p (re) + (and (rxt-string-p re) + (equal (rxt-string-chars re) ""))) + +;;; Other primitives +(cl-defstruct (rxt-primitive + (:constructor rxt-primitive (pcre rx)) + (:include rxt-syntax-tree)) + pcre rx) + +(defun rxt-bos () (rxt-primitive "\\A" 'bos)) +(defun rxt-eos () (rxt-primitive "\\Z" 'eos)) + +(defun rxt-bol () (rxt-primitive "^" 'bol)) +(defun rxt-eol () (rxt-primitive "$" 'eol)) + +;; FIXME +(defun rxt-anything () (rxt-primitive "." 'anything)) +(defun rxt-nonl () (rxt-primitive "." 'nonl)) + +(defun rxt-word-boundary () (rxt-primitive "\\b" 'word-boundary)) +(defun rxt-not-word-boundary () (rxt-primitive "\\B" 'not-word-boundary)) + +(defun rxt-wordchar () (rxt-primitive "\\w" 'wordchar)) +(defun rxt-not-wordchar () (rxt-primitive "\\W" 'not-wordchar)) + +(defun rxt-symbol-start () (rxt-primitive nil 'symbol-start)) +(defun rxt-symbol-end () (rxt-primitive nil 'symbol-end)) + +(defun rxt-bow () (rxt-primitive nil 'bow)) +(defun rxt-eow () (rxt-primitive nil 'eow)) + +;;; Sequence +(cl-defstruct + (rxt-seq + (:constructor make-rxt-seq (elts)) + (:include rxt-syntax-tree)) + elts) + +;; Slightly smart sequence constructor: +;; - Flattens nested sequences +;; - Drops trivial "" elements +;; - Empty sequence => "" +;; - Singleton sequence is reduced to its one element. +(defun rxt-seq (&rest res) ; Flatten nested seqs & drop ""'s. + (let ((res (rxt-seq-flatten res))) + (if (consp res) + (if (consp (cdr res)) + (make-rxt-seq res) ; General case + (car res)) ; Singleton sequence + (rxt-empty-string)))) ; Empty seq -- "" + +(defun rxt-seq-flatten (res) + (if (consp res) + (let ((re (car res)) + (tail (rxt-seq-flatten (cdr res)))) + (cond ((rxt-seq-p re) ; Flatten nested seqs + (append (rxt-seq-flatten (rxt-seq-elts re)) tail)) + ((rxt-trivial-p re) tail) ; Drop trivial elts + ((and (rxt-string-p re) ; Flatten strings + (consp tail) + (rxt-string-p (car tail))) + (cons + (rxt-string-concat re (car tail)) + (cdr tail))) + (t (cons re tail)))) + '())) + +(defun rxt-string-concat (str1 str2) + (if (not (eq (rxt-string-case-fold str1) + (rxt-string-case-fold str2))) + (make-rxt-seq (list str1 str2)) + (let ((result + (rxt-string (concat (rxt-string-chars str1) + (rxt-string-chars str2)) + (rxt-string-case-fold str1))) + (first (rxt-location str1)) + (last (rxt-location str2))) + (when (and first last) + (setf (rxt-location result) + (make-rxt-location :source (rxt-location-source first) + :start (rxt-location-start first) + :end (rxt-location-end last)))) + result))) + +;;; Choice (alternation/union) +(cl-defstruct + (rxt-choice + (:constructor make-rxt-choice (elts)) + (:include rxt-syntax-tree)) + elts) + +;;; The empty choice represents a regexp that never matches in any context +(defvar rxt-empty (make-rxt-choice nil)) +(defun rxt-empty-p (re) + (or + (and (rxt-choice-p re) + (null (rxt-choice-elts re))) + (rxt-empty-char-set-p re))) + +(defun rxt-choice (&rest alternatives) + "Construct the alternation (union) of several regexps. + +ALTERNATIVES should be a list of `rxt-syntax-tree' objects. +The return value is an `rxt-choice' object representing a regexp +which matches any one of ALTERNATIVES, but simplified in the +following ways: + +- If ALTERNATIVES contains only one element, it is returned unchanged. + +- All existing `rxt-choice' elements in ALTERNATIVES are replaced + by a flat list of their subexpressions: symbolically, + a|(b|(c|d)) is replaced by a|b|c|d + +- All character sets and single-character strings in ALTERNATIVES + are combined together into one or two character sets, + respecting case-folding behaviour." + (cl-destructuring-bind (other-elements char-set case-fold-char-set) + (rxt--simplify-alternatives alternatives) + (let ((simplified-alternatives + (append (if (not (rxt-empty-p char-set)) + (list char-set) + '()) + (if (not (rxt-empty-p case-fold-char-set)) + (list case-fold-char-set) + '()) + other-elements))) + (pcase simplified-alternatives + (`() + rxt-empty) + (`(,element) + element) + (_ + (make-rxt-choice simplified-alternatives)))))) + +(defun rxt--simplify-alternatives (alternatives) + "Simplify a set of regexp alternatives. + +ALTERNATIVES should be a list of `rxt-syntax-tree' objects to be combined +into an `rxt-choice' structure. The result is a three-element +list (OTHER-ELEMENTS CHAR-SET CASE-FOLDED-CHAR-SET): + +- CHAR-SET is an `rxt-char-set-union' containing the union of all + case-sensitive character sets and single-character strings in + RES. + +- CASE-FOLDED-CHAR-SET is similar but combines all the + case-insensitive character sets and single-character strings. + +- OTHER-ELEMENTS is a list of all other elements, with all + `rxt-choice' structures replaced by a flat list of their + component subexpressions." + (if (null alternatives) + (list '() + (make-rxt-char-set-union :case-fold nil) + (make-rxt-char-set-union :case-fold t)) + (let* ((re (car alternatives))) + (cl-destructuring-bind (tail char-set case-fold-char-set) + (rxt--simplify-alternatives (cdr alternatives)) + (cond ((rxt-choice-p re) ; Flatten nested choices + (list + (append (rxt-choice-elts re) tail) + char-set + case-fold-char-set)) + + ((rxt-empty-p re) ; Drop empty re's. + (list tail char-set case-fold-char-set)) + + ((rxt-char-set-union-p re) ; Fold char sets together + (if (rxt-char-set-union-case-fold re) + (list tail + char-set + (rxt-char-set-union case-fold-char-set re)) + (list tail + (rxt-char-set-union char-set re) + case-fold-char-set))) + + ((and (rxt-string-p re) ; Same for 1-char strings + (= 1 (length (rxt-string-chars re)))) + (if (rxt-string-case-fold re) + (list tail + char-set + (rxt-char-set-union case-fold-char-set re)) + (list tail + (rxt-char-set-union char-set re) + case-fold-char-set))) + + (t ; Otherwise. + (list (cons re tail) char-set case-fold-char-set))))))) + +;;; Repetition +(cl-defstruct (rxt-repeat + (:include rxt-syntax-tree)) + from to body greedy) + +(cl-defun rxt-repeat (from to body &optional (greedy t)) + (if (equal to 0) + (rxt-empty-string) + (make-rxt-repeat :from from :to to + :body body :greedy greedy))) + +;;; Submatch +(cl-defstruct + (rxt-submatch + (:constructor rxt-submatch (body)) + (:include rxt-syntax-tree)) + body) + +;;; Numbered submatch (Emacs only) +(cl-defstruct + (rxt-submatch-numbered + (:constructor rxt-submatch-numbered (n body)) + (:include rxt-syntax-tree)) + n + body) + +;;; Backreference +(cl-defstruct + (rxt-backref + (:constructor rxt-backref (n)) + (:include rxt-syntax-tree)) + n) + +;;; Syntax classes (Emacs only) +(cl-defstruct (rxt-syntax-class + (:include rxt-syntax-tree)) + symbol) + +(defun rxt-syntax-class (symbol) + (if (assoc symbol rx--syntax-codes) + (make-rxt-syntax-class :symbol symbol) + (rxt-error "Invalid syntax class symbol `%s'" symbol))) + +;;; Character categories (Emacs only) +(cl-defstruct (rxt-char-category + (:include rxt-syntax-tree)) + symbol) + +(defun rxt-char-category (symbol) + (if (assoc symbol rx--categories) + (make-rxt-char-category :symbol symbol) + (rxt-error "Invalid character category symbol `%s'" symbol))) + + +;;; Char sets +;; ::= +;; | +;; | + +(cl-defstruct (rxt-char-set (:include rxt-syntax-tree))) + +;; An rxt-char-set-union represents the union of any number of +;; characters, character ranges, and POSIX character classes: anything +;; that can be represented in string notation as a class [ ... ] +;; without the negation operator. +(cl-defstruct (rxt-char-set-union + (:include rxt-char-set)) + chars ; list of single characters + ranges ; list of ranges (from . to) + classes ; list of character classes + (case-fold rxt-pcre-case-fold)) + +;; Test for empty character set +(defun rxt-empty-char-set-p (cset) + (and (rxt-char-set-union-p cset) + (null (rxt-char-set-union-chars cset)) + (null (rxt-char-set-union-ranges cset)) + (null (rxt-char-set-union-classes cset)))) + +;; Simple union constructor +(defun rxt-char-set-union (&rest items) + "Construct an regexp character set representing the union of ITEMS. + +Each element of ITEMS may be either: a character; a +single-character string; a single-character `rxt-string' object; +a cons, (FROM . TO) representing a range of characters; a symbol, +representing a named character class; or an `rxt-char-set-union' +object. All `rxt-char-set-union' objects in ITEMS must have the +same `case-fold' property." + (let ((chars '()) + (ranges '()) + (classes '()) + (case-fold 'undetermined)) + (dolist (item items) + (cl-etypecase item + (character + (push item chars)) + + (string + (cl-assert (= 1 (length item))) + (push (string-to-char item) chars)) + + (rxt-string + (cl-assert (= 1 (length (rxt-string-chars item)))) + (push (string-to-char (rxt-string-chars item)) chars)) + + (cons ; range (from . to) + (cl-check-type (car item) character) + (cl-check-type (cdr item) character) + (push item ranges)) + + (symbol ; named character class + (push item classes)) + + (rxt-char-set-union + (if (eq case-fold 'undetermined) + (setq case-fold (rxt-char-set-union-case-fold item)) + (unless (eq case-fold (rxt-char-set-union-case-fold item)) + (error "Cannot construct union of char-sets with unlike case-fold setting: %S" item))) + (setq chars (nconc chars (rxt-char-set-union-chars item))) + (setq ranges (nconc ranges (rxt-char-set-union-ranges item))) + (setq classes (nconc classes (rxt-char-set-union-classes item)))))) + + (make-rxt-char-set-union :chars chars :ranges ranges :classes classes + :case-fold (if (eq case-fold 'undetermined) + rxt-pcre-case-fold + case-fold)))) + +(defun rxt--all-char-set-union-chars (char-set) + "Return a list of all characters in CHAR-SET." + (cl-assert (rxt-char-set-union-p char-set)) + (append + (rxt-char-set-union-chars char-set) + (cl-loop for (start . end) in (rxt-char-set-union-ranges char-set) + nconc (cl-loop for char from start to end collect char)))) + +(defun rxt--simplify-char-set (char-set &optional case-fold-p) + "Return a minimal char-set to match the same characters as CHAR-SET. + +With optional argument CASE-FOLD-P, return a char-set which +emulates case-folding behaviour by including both uppercase and +lowercase versions of all characters in CHAR-SET." + (cl-assert (rxt-char-set-union-p char-set)) + (let* ((classes (rxt-char-set-union-classes char-set)) + (all-chars + (if case-fold-p + (cl-loop for char in (rxt--all-char-set-union-chars char-set) + nconc (list (upcase char) (downcase char))) + (rxt--all-char-set-union-chars char-set))) + (all-ranges + (rxt--extract-ranges (rxt--remove-redundant-chars all-chars classes)))) + (let ((singletons nil) + (ranges nil)) + (cl-loop for (start . end) in all-ranges + do + (cond ((= start end) (push start singletons)) + ((= (1+ start) end) + (push start singletons) + (push end singletons)) + (t (push (cons start end) ranges)))) + (make-rxt-char-set-union :chars (nreverse singletons) + :ranges (nreverse ranges) + :classes classes + :case-fold (if case-fold-p + nil + (rxt-char-set-union-case-fold char-set)))))) + +(defun rxt--remove-redundant-chars (chars classes) + "Remove all characters which match a character class in CLASSES from CHARS." + (if (null classes) + chars + (string-to-list + (replace-regexp-in-string + (rx-to-string `(any ,@classes)) + "" + (apply #'string chars))))) + +(defun rxt--extract-ranges (chars) + "Return a list of all contiguous ranges in CHARS. + +CHARS should be a list of characters (integers). The return +value is a list of conses (START . END) representing ranges, such +that the union of all the ranges represents the same of +characters as CHARS. + +Example: + (rxt--extract-ranges (list ?a ?b ?c ?q ?x ?y ?z)) + => ((?a . ?c) (?q . ?q) (?x . ?z))" + (let ((array + (apply #'vector + (cl-remove-duplicates + (sort (copy-sequence chars) #'<))))) + (cl-labels + ((recur (start end) + (if (< end start) + nil + (let ((min (aref array start)) + (max (aref array end))) + (if (= (- max min) (- end start)) + (list (cons min max)) + (let* ((split-point (/ (+ start end) 2)) + (left (recur start split-point)) + (right (recur (1+ split-point) end))) + (pcre2el-merge left right)))))) + (pcre2el-merge (left right) + (cond ((null left) right) + ((null right) left) + (t + (let ((last-left (car (last left))) + (first-right (car right))) + (if (= (1+ (cdr last-left)) + (car first-right)) + (append (cl-subseq left 0 -1) + (list + (cons (car last-left) + (cdr first-right))) + (cl-subseq right 1)) + (append left right))))))) + (recur 0 (1- (length array)))))) + +;;; Set complement of character set, syntax class, or character +;;; category + +;; In general, all character sets that can be represented in string +;; notation as [^ ... ] (but see `rxt-char-set-intersection', below), plus +;; Emacs' \Sx and \Cx constructions. +(cl-defstruct (rxt-char-set-negation + (:include rxt-char-set)) + elt) + +(defun rxt-negate (char-set) + "Construct the logical complement (negation) of CHAR-SET. + +CHAR-SET may be any of the following types: `rxt-char-set-union', +`rxt-syntax-class', `rxt-char-category', or `rxt-char-set-negation'." + (cl-etypecase char-set + ((or rxt-char-set-union rxt-syntax-class rxt-char-category) + (make-rxt-char-set-negation :elt char-set)) + + (rxt-char-set-negation + (rxt-char-set-negation-elt char-set)))) + +;;; Intersections of char sets + +;; These are difficult to represent in general, but can be constructed +;; in Perl using double negation; for example: [^\Wabc] means the set +;; complement of [abc] with respect to the universe of "word +;; characters": (& (~ (~ word)) (~ ("abc"))) == (& word (~ ("abc"))) +;; == (- word ("abc")) + +(cl-defstruct (rxt-char-set-intersection + (:include rxt-char-set)) + elts) + +;; Intersection constructor +(defun rxt-char-set-intersection (&rest charsets) + (let ((elts '()) + (cmpl (make-rxt-char-set-union))) + (dolist (cset (rxt-int-flatten charsets)) + (cond + ((rxt-char-set-negation-p cset) + ;; Fold negated charsets together: ~A & ~B = ~(A|B) + (setq cmpl (rxt-char-set-union cmpl (rxt-char-set-negation-elt cset)))) + + ((rxt-char-set-union-p cset) + (push cset elts)) + + (t + (rxt-error "Can't take intersection of non-character-set %S" cset)))) + + (if (null elts) + (rxt-negate cmpl) + (unless (rxt-empty-char-set-p cmpl) + (push (rxt-negate cmpl) elts)) + (if (null (cdr elts)) + (car elts) ; singleton case + (make-rxt-char-set-intersection :elts elts))))) + +;; Constructor helper: flatten nested intersections +(defun rxt-int-flatten (csets) + (if (consp csets) + (let ((cset (car csets)) + (tail (rxt-int-flatten (cdr csets)))) + (if (rxt-char-set-intersection-p cset) + (append (rxt-int-flatten (rxt-char-set-intersection-elts cset)) tail) + (cons cset tail))) + '())) + + + +;;;; Macros for building the parser + +(defmacro rxt-token-case (&rest cases) + "Consume a token at point and evaluate corresponding forms. + +CASES is a list of `cond'-like clauses, (REGEXP BODY ...) where +the REGEXPs define possible tokens which may appear at point. The +CASES are considered in order. For each case, if the text at +point matches REGEXP, then point is moved to the end of the +matched token, the corresponding BODY is evaluated and their +value returned. The matched token is available within the BODY +forms as (match-string 0). + +There can be a default case where REGEXP is `t', which evaluates +the corresponding FORMS but does not move point. + +Returns `nil' if none of the CASES matches." + (declare (debug (&rest (sexp &rest form)))) + `(cond + ,@(cl-loop for (token . action) in cases + collect + (if (eq token t) + `(t ,@action) + `((looking-at ,token) + (goto-char (match-end 0)) + ,@action))))) + +(defmacro rxt-with-source-location (&rest body) + "Evaluate BODY and record source location information on its value. + +BODY may evaluate to any kind of object, but its value should +generally not be `eq' to any other object." + (declare (debug (&rest form))) + (let ((begin (make-symbol "begin")) + (value (make-symbol "value"))) + `(let ((,begin (point)) + (,value ,(macroexp-progn body))) + (setf (rxt-location ,value) + (make-rxt-location :source rxt-source-text-string + :start (1- ,begin) + :end (1- (point)))) + ,value))) + +;; Read PCRE + flags +(defun rxt-read-delimited-pcre () + "Read a Perl-style delimited regexp and flags from the current buffer. + +Point should be before the regexp literal before calling +this. Currently only regexps delimited by / ... / are supported. +A preceding \"m\", \"qr\" or \"s\" will be ignored, as will the +replacement string in an s/.../.../ construction. + +Returns two strings: the regexp and the flags." + (save-excursion + (skip-syntax-forward "-") + + ;; Skip m, qr, s + (let ((is-subst (rxt-token-case + ("s" t) + ((rx (or "m" "qr")) nil)))) + + (when (not (looking-at "/")) + (error "Only Perl regexps delimited by slashes are supported")) + (let ((beg (match-end 0)) + (delim (rx (not (any "\\")) + (group "/")))) + (search-forward-regexp delim) + (let ((end (match-beginning 1))) + (when is-subst (search-forward-regexp delim)) + (let ((pcre (buffer-substring-no-properties beg end))) + (rxt-token-case + ("[gimosx]*" + (rxt--add-flags pcre (match-string-no-properties 0)))))))))) + + +;;;; Elisp and PCRE string notation parser + +;;; Parser constants +(defconst rxt-pcre-char-set-alist + `((?w . ; "word" characters + (?_ alnum)) + (?d . ; digits + (digit)) + (?h . ; horizontal whitespace + (#x0009 #x0020 #x00A0 #x1680 #x180E #x2000 #x2001 #x2002 #x2003 + #x2004 #x2005 #x2006 #x2007 #x2008 #x2009 #x200A #x202F + #x205F #x3000)) + (?s . ; whitespace + (9 10 12 13 32)) + (?v . ; vertical whitespace + (#x000A #x000B #x000C #x000D #x0085 #x2028 #x2029)))) + +(defconst rxt-pcre-named-classes-regexp + (rx "[:" + (submatch + (or "alnum" "alpha" "ascii" "blank" "cntrl" "digit" "graph" "lower" + "print" "punct" "space" "upper" "word" "xdigit")) + ":]")) + +(defconst rxt-elisp-named-classes-regexp + (rx "[:" + (submatch + (or "alnum" "alpha" "ascii" "blank" "cntrl" "digit" "graph" "lower" + "print" "punct" "space" "upper" "word" "xdigit" + "unibyte" "nonascii" "multibyte")) + ":]")) + +;;; The following dynamically bound variables control the operation of +;;; the parser (see `rxt-parse-re'.) +(defvar rxt-parse-pcre nil + "t if the rxt string parser is parsing PCRE syntax, nil for Elisp syntax. + +This should only be let-bound internally, never set otherwise.") + +(defvar rxt-pcre-extended-mode nil + "t if the rxt string parser is emulating PCRE's \"extended\" mode. + +In extended mode (indicated by /x in Perl/PCRE), whitespace +outside of character classes and \\Q...\\E quoting is ignored, +and a `#' character introduces a comment that extends to the end +of line.") + +(defvar rxt-pcre-s-mode nil + "t if the rxt string parser is emulating PCRE's single-line \"/s\" mode. + +When /s is used, PCRE's \".\" matches newline characters, which +otherwise it would not match.") + +(defvar rxt-pcre-case-fold nil + "non-nil to emulate PCRE's case-insensitive \"/i\" mode in translated regexps.") + +(defvar rxt-branch-end-regexp nil) +(defvar rxt-choice-regexp nil) +(defvar rxt-brace-begin-regexp nil) +(defvar rxt-m-to-n-brace-regexp nil) +(defvar rxt-m-to-?-brace-regexp nil) +(defvar rxt-m-brace-regexp nil) +(defvar rxt-named-classes-regexp nil) + +(defvar rxt-subgroup-count nil) +(defvar rxt-source-text-string nil) + +(defun rxt-parse-pcre (re) + (rxt-parse-re re t)) + +(defun rxt-parse-elisp (re) + (rxt-parse-re re nil)) + +(defun rxt-parse-re (re pcre-p) + (let* ((rxt-parse-pcre pcre-p) + (rxt-pcre-extended-mode nil) + (rxt-pcre-s-mode nil) + (rxt-pcre-case-fold nil) + + ;; Bind regexps to match syntax that differs between PCRE and + ;; Elisp only in the addition of a backslash "\" + (escape (if pcre-p "" "\\")) + (rxt-choice-regexp + (rx-to-string `(seq ,escape "|"))) + (rxt-branch-end-regexp + (rx-to-string `(or buffer-end + (seq ,escape (or "|" ")"))))) + (rxt-brace-begin-regexp + (rx-to-string `(seq ,escape "{"))) + (rxt-m-to-n-brace-regexp + (rx-to-string + `(seq + (submatch (* (any "0-9"))) "," (submatch (+ (any "0-9"))) + ,escape "}"))) + (rxt-m-to-?-brace-regexp + (rx-to-string + `(seq (submatch (+ (any "0-9"))) "," ,escape "}"))) + (rxt-m-brace-regexp + (rx-to-string + `(seq (submatch (+ (any "0-9"))) ,escape "}"))) + + ;; Named character classes [: ... :] differ slightly + (rxt-named-classes-regexp + (if pcre-p + rxt-pcre-named-classes-regexp + rxt-elisp-named-classes-regexp)) + + (rxt-subgroup-count 0) + (case-fold-search nil)) + (with-temp-buffer + (insert re) + (goto-char (point-min)) + (let ((rxt-source-text-string re)) + (rxt-parse-exp))))) + +;; Parse a complete regex: a number of branches separated by | or +;; \|, as determined by `rxt-branch-end-regexp'. +(defun rxt-parse-exp () + ;; These variables are let-bound here because in PCRE mode they may + ;; be set internally by (?x) or (?s) constructions, whose scope + ;; lasts until the end of a sub-expression + (rxt-with-source-location + (let ((rxt-pcre-extended-mode rxt-pcre-extended-mode) + (rxt-pcre-s-mode rxt-pcre-s-mode) + (rxt-pcre-case-fold rxt-pcre-case-fold)) + (if (eobp) + (rxt-seq) + (let ((branches '())) + (cl-block nil + (while t + (let ((branch (rxt-parse-branch))) + (push branch branches) + (rxt-token-case + (rxt-choice-regexp nil) + (t (cl-return (apply #'rxt-choice (reverse branches))))))))))))) + +;; Skip over whitespace and comments in PCRE extended mode +(defun rxt-extended-skip () + (when rxt-pcre-extended-mode + (skip-syntax-forward "-") + (while (looking-at "#") + (beginning-of-line 2) + (skip-syntax-forward "-")))) + +;; Parse a regexp "branch": a sequence of pieces +(defun rxt-parse-branch () + (rxt-extended-skip) + (rxt-with-source-location + (let ((pieces '()) + (branch-start-p t)) + (while (not (looking-at rxt-branch-end-regexp)) + (push (rxt-parse-piece branch-start-p) pieces) + (setq branch-start-p nil)) + (apply #'rxt-seq (reverse pieces))))) + +;; Parse a regexp "piece": an atom (`rxt-parse-atom') plus any +;; following quantifiers +(defun rxt-parse-piece (&optional branch-begin) + (rxt-extended-skip) + (rxt-with-source-location + (let ((atom (rxt-parse-atom branch-begin))) + (rxt-parse-quantifiers atom)))) + +;; Parse any and all quantifiers after ATOM and return the quantified +;; regexp, or ATOM unchanged if no quantifiers +(defun rxt-parse-quantifiers (atom) + (catch 'done + (while (not (eobp)) + (let ((atom1 (rxt-parse-quantifier atom))) + (if (eq atom1 atom) + (throw 'done t) + (setq atom atom1))))) + atom) + +;; Possibly parse a single quantifier after ATOM and return the +;; quantified atom, or ATOM if no quantifier +(defun rxt-parse-quantifier (atom) + (rxt-extended-skip) + (rxt-token-case + ((rx "*?") (rxt-repeat 0 nil atom nil)) + ((rx "*") (rxt-repeat 0 nil atom t)) + ((rx "+?") (rxt-repeat 1 nil atom nil)) + ((rx "+") (rxt-repeat 1 nil atom t)) + ((rx "??") (rxt-repeat 0 1 atom nil)) + ((rx "?") (rxt-repeat 0 1 atom t)) + ;; Brace expression "{M,N}", "{M,}", "{M}" + (rxt-brace-begin-regexp + (cl-destructuring-bind (from to) + (rxt-parse-braces) + (rxt-repeat from to atom))) + ;; No quantifiers found + (t atom))) + +;; Parse a regexp atom, i.e. an element that binds to any following +;; quantifiers. This includes characters, character classes, +;; parenthesized groups, assertions, etc. +(defun rxt-parse-atom (&optional branch-begin) + (if (eobp) + (rxt-error "Unexpected end of regular expression") + (if rxt-parse-pcre + (rxt-parse-atom/pcre) + (rxt-parse-atom/el branch-begin)))) + +(defun rxt-parse-atom/common () + (rxt-token-case + ((rx "[") (rxt-parse-char-class)) + ((rx "\\b") (rxt-word-boundary)) + ((rx "\\B") (rxt-not-word-boundary)))) + +(defun rxt-parse-atom/el (branch-begin) + (rxt-with-source-location + (or (rxt-parse-atom/common) + (rxt-token-case + ;; "." wildcard + ((rx ".") (rxt-nonl)) + ;; "^" and "$" are metacharacters only at beginning or end of a + ;; branch in Elisp; elsewhere they are literals + ((rx "^") + (if branch-begin + (rxt-bol) + (rxt-string "^"))) + ((rx "$") + (if (looking-at rxt-branch-end-regexp) + (rxt-eol) + (rxt-string "$"))) + ;; Beginning & end of string, word, symbol + ((rx "\\`") (rxt-bos)) + ((rx "\\'") (rxt-eos)) + ((rx "\\<") (rxt-bow)) + ((rx "\\>") (rxt-eow)) + ((rx "\\_<") (rxt-symbol-start)) + ((rx "\\_>") (rxt-symbol-end)) + ;; Subgroup + ((rx "\\(") (rxt-parse-subgroup/el)) + ;; Word/non-word characters (meaning depending on syntax table) + ((rx "\\w") (rxt-wordchar)) + ((rx "\\W") (rxt-not-wordchar)) + ;; Other syntax categories + ((rx "\\" (submatch (any ?S ?s)) (submatch nonl)) + (let ((negated (string= (match-string 1) "S")) + (syntax + (car (rassoc (string-to-char (match-string 2)) + rx--syntax-codes)))) + (if syntax + (let ((re (rxt-syntax-class syntax))) + (if negated (rxt-negate re) re)) + (rxt-error "Invalid syntax class `\\%s'" (match-string 0))))) + ;; Character categories + ((rx "\\" (submatch (any ?C ?c)) (submatch nonl)) + (let ((negated (string= (match-string 1) "C")) + (category + (car (rassoc (string-to-char (match-string 2)) + rx--categories)))) + (if category + (let ((re (rxt-char-category category))) + (if negated (rxt-negate re) re)) + (rxt-error "Invalid character category `%s'" (match-string 0))))) + ;; Backreference + ((rx (seq "\\" (submatch (any "1-9")))) + (rxt-backref (string-to-number (match-string 1)))) + ;; Other escaped characters + ((rx (seq "\\" (submatch nonl))) + (rxt-string (match-string 1))) + ;; Normal characters + ((rx (or "\n" nonl)) + (rxt-string (match-string 0))))))) + +(defun rxt-parse-atom/pcre () + (rxt-extended-skip) + (rxt-with-source-location + (or + ;; Is it an atom that's the same in Elisp? + (rxt-parse-atom/common) + ;; Is it common to PCRE regex and character class syntax? + (let ((char (rxt-parse-escapes/pcre))) + (and char + (rxt-string (char-to-string char)))) + ;; Otherwise: + (rxt-token-case + ;; "." wildcard + ((rx ".") + (if rxt-pcre-s-mode + (rxt-anything) + (rxt-nonl))) + ;; Beginning & end of string/line + ((rx "^") (rxt-bol)) + ((rx "$") (rxt-eol)) + ((rx "\\A") (rxt-bos)) + ((rx "\\Z") (rxt-eos)) + ;; Subgroup + ((rx "(") (rxt-parse-subgroup/pcre)) + ;; Metacharacter quoting + ((rx "\\Q") + ;; It would seem simple to take all the characters between \Q + ;; and \E and make an rxt-string, but \Q...\E isn't an atom: + ;; any quantifiers afterward should bind only to the last + ;; character, not the whole string. + (let ((begin (point))) + (search-forward "\\E" nil t) + (let* ((end (match-beginning 0)) + (str (buffer-substring-no-properties begin (1- end))) + (char (char-to-string (char-before end)))) + (rxt-seq (rxt-string str) + (rxt-parse-quantifiers (rxt-string char)))))) + ;; Pre-defined character sets + ((rx "\\" (submatch (any "d" "D" "h" "H" "s" "S" "v" "V" "w" "W"))) + (rxt--pcre-char-set (string-to-char (match-string 1)))) + ;; \ + digits: backreference or octal char? + ((rx "\\" (submatch (+ (any "0-9")))) + (let* ((digits (match-string 1)) + (dec (string-to-number digits))) + ;; from "man pcrepattern": If the number is less than 10, or if + ;; there have been at least that many previous capturing left + ;; parentheses in the expression, the entire sequence is taken + ;; as a back reference. + (if (and (> dec 0) + (or (< dec 10) + (>= rxt-subgroup-count dec))) + (progn + (when rxt-pcre-case-fold + (display-warning + 'rxt "Backreferences with case-folding are handled poorly")) + (rxt-backref dec)) + ;; from "man pcrepattern": if the decimal number is greater + ;; than 9 and there have not been that many capturing + ;; subpatterns, PCRE re-reads up to three octal digits + ;; following the backslash, and uses them to generate a data + ;; character. Any subsequent digits stand for themselves. + (goto-char (match-beginning 1)) + (re-search-forward (rx (** 0 3 (any "0-7")))) + (rxt-string (char-to-string (string-to-number (match-string 0) 8)))))) + ;; Other escaped characters + ((rx "\\" (submatch nonl)) (rxt-string (match-string 1))) + ;; Everything else + ((rx (or (any "\n") nonl)) (rxt-string (match-string 0))))))) + +(defun rxt-parse-escapes/pcre () + "Consume a one-char PCRE escape at point and return its codepoint equivalent. + +Handles only those character escapes which have the same meaning +in character classes as outside them." + (rxt-token-case + ((rx "\\a") #x07) ; bell + ((rx "\\e") #x1b) ; escape + ((rx "\\f") #x0c) ; formfeed + ((rx "\\n") #x0a) ; linefeed + ((rx "\\r") #x0d) ; carriage return + ((rx "\\t") #x09) ; tab + ;; Control character + ((rx "\\c" (submatch nonl)) + ;; from `man pcrepattern': + ;; The precise effect of \cx is as follows: if x is a lower case + ;; letter, it is converted to upper case. Then bit 6 of the + ;; character (hex 40) is inverted. + (logxor (string-to-char (upcase (match-string 1))) #x40)) + ;; Hex escapes + ((rx "\\x" (submatch (** 1 2 (any "0-9" "A-Z" "a-z")))) + (string-to-number (match-string 1) 16)) + ((rx "\\x{" (submatch (* (any "0-9" "A-Z" "a-z"))) "}") + (string-to-number (match-string 1) 16)))) + +(defun rxt-parse-subgroup/pcre () + (catch 'return + (let ((shy nil) + (extended-mode rxt-pcre-extended-mode) + (single-line-mode rxt-pcre-s-mode) + (case-fold rxt-pcre-case-fold)) + (rxt-extended-skip) + ;; Check for special (? ..) and (* ...) syntax + (rxt-token-case + ((rx "?") ; (? + (rxt-token-case + ((rx ")") ; Empty group (?) + (throw 'return (rxt-empty-string))) + (":" (setq shy t)) ; Shy group (?: + ("#" ; Comment (?# + (search-forward ")") + (throw 'return (rxt-empty-string))) + ((rx (or ; Flags (?isx-isx + (seq (group (* (any "gimosx"))) "-" (group (+ (any "gimosx")))) + (seq (group (+ (any "gimosx")))))) + (let ((token (match-string 0)) + (on (or (match-string 1) (match-string 3))) + (off (or (match-string 2) ""))) + (if (cl-find ?x on) (setq extended-mode t)) + (if (cl-find ?s on) (setq single-line-mode t)) + (if (cl-find ?i on) (setq case-fold t)) + (if (cl-find ?x off) (setq extended-mode nil)) + (if (cl-find ?s off) (setq single-line-mode nil)) + (if (cl-find ?i off) (setq case-fold nil)) + (when (string-match-p "[gmo]" token) + (display-warning + 'rxt (format "Unhandled PCRE flags in (?%s" token)))) + (rxt-token-case + (":" (setq shy t)) ; Shy group with flags (?isx-isx: ... + (")" ; Set flags (?isx-isx) + ;; Set flags for the remainder of the current subexpression + (setq rxt-pcre-extended-mode extended-mode + rxt-pcre-s-mode single-line-mode + rxt-pcre-case-fold case-fold) + (throw 'return (rxt-empty-string))))) + ;; Other constructions like (?=, (?!, etc. are not recognised + (t (rxt-error "Unrecognized PCRE extended construction `(?%c'" + (char-after))))) + + ;; No special (* ...) verbs are recognised + ((rx "*") + (let ((begin (point))) + (search-forward ")" nil 'go-to-end) + (rxt-error "Unrecognized PCRE extended construction `(*%s'" + (buffer-substring begin (point)))))) + + ;; Parse the remainder of the subgroup + (unless shy (cl-incf rxt-subgroup-count)) + (let* ((rxt-pcre-extended-mode extended-mode) + (rxt-pcre-s-mode single-line-mode) + (rxt-pcre-case-fold case-fold) + (rx (rxt-parse-exp))) + (rxt-extended-skip) + (rxt-token-case + (")" (if shy rx (rxt-submatch rx))) + (t (rxt-error "Subexpression missing close paren"))))))) + +(defun rxt-parse-subgroup/el () + (let ((kind + (rxt-token-case + ((rx "?:") + (cl-incf rxt-subgroup-count) + 'shy) + ((rx "?" (group (+ (in "0-9"))) ":") + (let ((n (string-to-number (match-string 1)))) + (when (< rxt-subgroup-count n) + (setf rxt-subgroup-count n)) + n)) + ((rx "?") ; Reserved + (rxt-error "Unknown match group sequence"))))) + (let ((rx (rxt-parse-exp))) + (rxt-token-case + ((rx "\\)") + (cond ((eq kind 'shy) rx) + ((numberp kind) + (rxt-submatch-numbered kind rx)) + (t (rxt-submatch rx)))) + (t (rxt-error "Subexpression missing close paren")))))) + +(defun rxt-parse-braces () + (rxt-token-case + (rxt-m-to-n-brace-regexp + (list (string-to-number (match-string 1)) + (string-to-number (match-string 2)))) + (rxt-m-to-?-brace-regexp + (list (string-to-number (match-string 1)) nil)) + (rxt-m-brace-regexp + (let ((a (string-to-number (match-string 1)))) + (list a a))) + (t + (let ((begin (point))) + (search-forward "}" nil 'go-to-end) + (rxt-error "Bad brace expression {%s" + (buffer-substring-no-properties begin (point))))))) + +;; Parse a character set range [...] +(defun rxt-parse-char-class () + (when (eobp) + (rxt-error "Missing close right bracket in regexp")) + (rxt-with-source-location + (let* ((negated (rxt-token-case + ((rx "^") t) + (t nil))) + (begin (point)) + (result + (if negated + (rxt-negate (rxt-char-set-union)) + (rxt-char-set-union))) + (transformer + (if negated #'rxt-negate #'identity)) + (builder + (if negated #'rxt-char-set-intersection #'rxt-choice))) + (catch 'done + (while t + (when (eobp) + (rxt-error "Missing close right bracket in regexp")) + (if (and (looking-at (rx "]")) + (not (= (point) begin))) + (throw 'done result) + (let ((piece (funcall transformer (rxt-parse-char-class-piece)))) + (setq result (funcall builder result piece)))))) + (forward-char) ; Skip over closing "]" + result))) + +;; Parse a single character, a character range, or a posix class +;; within a character set context. Returns an `rxt-char-set'. +(defun rxt-parse-char-class-piece () + (let ((atom (rxt-parse-char-class-atom))) + (cl-typecase atom + (rxt-char-set ; return unchanged + atom) + (integer ; character: check for range + (let ((range-end (rxt-maybe-parse-range-end))) + (if range-end + (rxt-char-set-union (cons atom range-end)) + (rxt-char-set-union atom)))) + (t ; transform into character set + (rxt-char-set-union atom))))) + +;; Parse a single character or named class within a charset. +;; +;; Returns an integer (a character), a symbol (representing a named +;; character class) or an `rxt-char-set' (for pre-defined character +;; classes like \d, \W, etc.) +(defun rxt-parse-char-class-atom () + (or + ;; First, check for PCRE-specific backslash sequences + (and rxt-parse-pcre + (rxt-parse-char-class-atom/pcre)) + ;; Char-class syntax + (rxt-token-case + ;; Named classes [:alnum:], ... + (rxt-named-classes-regexp + (intern (match-string 1))) + ;; Error on unknown posix-class-like syntax + ((rx "[:" (* (any "a-z")) ":]") + (rxt-error "Unknown posix character class `%s'" (match-string 0))) + ;; Error on [= ... ]= collation syntax + ((rx "[" (submatch (any "." "=")) + (* (any "a-z")) (backref 1) "]") + (rxt-error "Unsupported collation syntax `%s'" (match-string 0))) + ;; Other characters stand for themselves + ((rx (or "\n" nonl)) + (string-to-char (match-string 0)))))) + +;; Parse backslash escapes inside PCRE character classes +(defun rxt-parse-char-class-atom/pcre () + (or (rxt-parse-escapes/pcre) + (rxt-token-case + ;; Backslash + digits => octal char + ((rx "\\" (submatch (** 1 3 (any "0-7")))) + (string-to-number (match-string 1) 8)) + ;; Pre-defined character sets + ((rx "\\" (submatch (any "d" "D" "h" "H" "s" "S" "v" "V" "w" "W"))) + (rxt--pcre-char-set (string-to-char (match-string 1)))) + ;; "\b" inside character classes is a backspace + ((rx "\\b") ?\C-h) + ;; Ignore other escapes + ((rx "\\" (submatch nonl)) + (string-to-char (match-string 1)))))) + +;; Look for a range tail (the "-z" in "a-z") after parsing a single +;; character within in a character set. Returns either a character +;; representing the range end, or nil. +(defun rxt-maybe-parse-range-end () + (let ((range-end nil) (end-position nil)) + (when (looking-at (rx "-" (not (any "]")))) + (save-excursion + (forward-char) + (setq range-end (rxt-parse-char-class-atom) + end-position (point)))) + + (if (characterp range-end) + ;; This is a range: move point after it and return the ending character + (progn + (goto-char end-position) + range-end) + ;; Not a range. + nil))) + +;; Return the pre-defined PCRE char-set associated with CHAR: i.e. \d +;; is digits, \D non-digits, \s space characters, etc. +(defun rxt--pcre-char-set (char) + (let* ((base-char (downcase char)) + (negated (/= char base-char)) + (elements (assoc-default base-char rxt-pcre-char-set-alist)) + (base-char-set (apply #'rxt-char-set-union elements))) + (if negated + (rxt-negate base-char-set) + base-char-set))) + + +;;;; Unparser to `rx' syntax + +(defconst rxt-rx-verbose-equivalents + '((bol . line-start) + (eol . line-end) + (nonl . not-newline) + (bos . string-start) + (eos . string-end) + (bow . word-start) + (eow . word-end) + (seq . sequence)) + "Alist of verbose equivalents for short `rx' primitives.") + +(defun rxt-rx-symbol (sym) + (if rxt-verbose-rx-translation + (or (assoc-default sym rxt-rx-verbose-equivalents) + sym) + sym)) + +(defun rxt-adt->rx (re) + (let ((rx + (cl-typecase re + (rxt-primitive + (rxt-rx-symbol (rxt-primitive-rx re))) + + (rxt-string + (if (or (not (rxt-string-case-fold re)) + (string= "" (rxt-string-chars re))) + (rxt-string-chars re) + `(seq + ,@(cl-loop for char across (rxt-string-chars re) + collect `(any ,(upcase char) ,(downcase char)))))) + + (rxt-seq + `(seq ,@(mapcar #'rxt-adt->rx (rxt-seq-elts re)))) + + (rxt-choice + `(or ,@(mapcar #'rxt-adt->rx (rxt-choice-elts re)))) + + (rxt-submatch + (if (rxt-seq-p (rxt-submatch-body re)) + `(submatch + ,@(mapcar #'rxt-adt->rx (rxt-seq-elts (rxt-submatch-body re)))) + `(submatch ,(rxt-adt->rx (rxt-submatch-body re))))) + + (rxt-submatch-numbered + (if (rxt-seq-p (rxt-submatch-numbered-p re)) + `(,(rxt-rx-symbol 'submatch-n) + ,(rxt-submatch-numbered-n re) + ,@(mapcar #'rxt-adt->rx + (rxt-seq-elts + (rxt-submatch-numbered-body re)))) + `(,(rxt-rx-symbol 'submatch-n) + ,(rxt-submatch-numbered-n re) + ,(rxt-adt->rx (rxt-submatch-numbered-body re))))) + + (rxt-backref + (let ((n (rxt-backref-n re))) + (if (<= n 9) + `(backref ,(rxt-backref-n re)) + (rxt-error "Too many backreferences (%s)" n)))) + + (rxt-syntax-class + `(syntax ,(rxt-syntax-class-symbol re))) + + (rxt-char-category + `(category ,(rxt-char-category-symbol re))) + + (rxt-repeat + (let ((from (rxt-repeat-from re)) + (to (rxt-repeat-to re)) + (greedy (rxt-repeat-greedy re)) + (body (rxt-adt->rx (rxt-repeat-body re)))) + (if rxt-verbose-rx-translation + (let ((rx + (cond + ((and (zerop from) (null to)) + `(zero-or-more ,body)) + ((and (equal from 1) (null to)) + `(one-or-more ,body)) + ((and (zerop from) (equal to 1)) + `(zero-or-one ,body)) + ((null to) + `(>= ,from ,body)) + ((equal from to) + `(repeat ,from ,body)) + (t + `(** ,from ,to ,body))))) + (if greedy + (if rxt-explain + rx ; Readable but not strictly accurate. Fixme? + `(maximal-match ,rx)) + `(minimal-match ,rx))) + (cond + ((and (zerop from) (null to)) + `(,(if greedy '* '*?) ,body)) + ((and (equal from 1) (null to)) + `(,(if greedy '+ '+?) ,body)) + ((and (zerop from) (equal to 1)) + `(,(if greedy '\? ??) ,body)) + ((null to) + `(>= ,from ,body)) + ((equal from to) + `(= ,from ,body)) + (t + `(** ,from ,to ,body)))))) + + (rxt-char-set-union + (let* ((case-fold (rxt-char-set-union-case-fold re)) + (re (rxt--simplify-char-set re case-fold)) + (chars (rxt-char-set-union-chars re)) + (ranges (rxt-char-set-union-ranges re)) + (classes (rxt-char-set-union-classes re)) + (case-fold (rxt-char-set-union-case-fold re))) + ;; Do not let the byte compiler optimize this variable out. + (ignore case-fold) + (if (and (null chars) (null ranges) (= 1 (length classes))) + (car classes) + `(any ,@chars ,@ranges ,@classes)))) + + (rxt-char-set-negation + `(not ,(rxt-adt->rx (rxt-char-set-negation-elt re)))) + + (t + (rxt-error "No RX translation of `%s'" (rxt-to-string re)))))) + + ;; Store source information on each fragment of the generated RX + ;; sexp for rxt-explain mode + (when rxt-explain + ;; Use gensyms to store unique source information for multiple + ;; occurrences of primitives like `bol' + (when (symbolp rx) + (setq rx (make-symbol (symbol-name rx)))) + (setf (rxt-location rx) (rxt-location re))) + rx)) + + +;;;; 'Unparser' to PCRE notation + +;;; Based on scsh/posixstr.scm in scsh + +;; To ensure that the operator precedence in the generated regexp does +;; what we want, we need to keep track of what kind of production is +;; returned from each step. Therefore these functions return a string +;; and a numeric "level" which lets the function using the generated +;; regexp know whether it has to be parenthesized: +;; +;; 0: an already parenthesized expression +;; +;; 1: a "piece" binds to any succeeding quantifiers +;; +;; 2: a "branch", or concatenation of pieces, needs parenthesizing to +;; bind to quantifiers +;; +;; 3: a "top", or alternation of branches, needs parenthesizing to +;; bind to quantifiers or to concatenation +;; +;; This idea is stolen straight out of the scsh implementation. + +(defun rxt-adt->pcre (re) + (cl-destructuring-bind (s _) (rxt-adt->pcre/lev re) s)) + +(defun rxt-adt->pcre/lev (re) + (cl-typecase re + (rxt-primitive + (let ((s (rxt-primitive-pcre re))) + (if s + (list s 1) + (rxt-error "No PCRE translation of `%s'" (rxt-to-string re))))) + + (rxt-string (rxt-string->pcre re)) + (rxt-seq (rxt-seq->pcre re)) + (rxt-choice (rxt-choice->pcre re)) + (rxt-submatch (rxt-submatch->pcre re)) + (rxt-backref + (list (format "\\%d" (rxt-backref-n re)) 1)) + (rxt-repeat (rxt-repeat->pcre re)) + + ((or rxt-char-set-union rxt-char-set-negation) + (rxt-char-set->pcre re)) + + ;; FIXME + ;; ((rxt-char-set-intersection re) (rxt-char-set-intersection->pcre re)) + + (t + (rxt-error "No PCRE translation of `%s'" (rxt-to-string re))))) + +(defconst rxt-pcre-metachars (rx (any "\\^.$|()[]*+?{}"))) +(defconst rxt-pcre-charset-metachars (rx (any "]" "[" "\\" "^" "-"))) + +(defun rxt-string->pcre (re) + (let ((chars (rxt-string-chars re))) + (list + (replace-regexp-in-string + rxt-pcre-metachars + "\\\\\\&" chars) + ;; A one-character string is a 'piece' (it binds to a following + ;; quantifier). A longer string is a 'branch' (it has to be + ;; enclosed in parentheses to bind to a following quantifier). + (if (> (length chars) 1) 2 1)))) + +(defun rxt-seq->pcre (re) + (let ((elts (rxt-seq-elts re))) + (if (null elts) + "" + (rxt-seq-elts->pcre elts)))) + +(defun rxt-seq-elts->pcre (elts) + (cl-destructuring-bind + (s lev) (rxt-adt->pcre/lev (car elts)) + (if (null (cdr elts)) + (list s lev) + (cl-destructuring-bind + (s1 lev1) (rxt-seq-elts->pcre (cdr elts)) + (list (concat (rxt-paren-if-necessary s lev) + (rxt-paren-if-necessary s1 lev1)) + 2))))) + +(defun rxt-paren-if-necessary (s lev) + (if (< lev 3) + s + (concat "(?:" s ")"))) + +(defun rxt-choice->pcre (re) + (let ((elts (rxt-choice-elts re))) + (if (null elts) + nil + (rxt-choice-elts->pcre elts)))) + +(defun rxt-choice-elts->pcre (elts) + (cl-destructuring-bind + (s lev) (rxt-adt->pcre/lev (car elts)) + (if (null (cdr elts)) + (list s lev) + (cl-destructuring-bind + (s1 _lev1) (rxt-choice-elts->pcre (cdr elts)) + (list (concat s "|" s1) 3))))) + +(defun rxt-submatch->pcre (re) + (cl-destructuring-bind + (s _lev) (rxt-adt->pcre/lev (rxt-submatch-body re)) + (list (concat "(" s ")") 0))) + +(defun rxt-repeat->pcre (re) + (let ((from (rxt-repeat-from re)) + (to (rxt-repeat-to re)) + (body (rxt-repeat-body re)) + (greedy (rxt-repeat-greedy re))) + (cl-destructuring-bind + (s lev) (rxt-adt->pcre/lev body) + (cond + ((and to (= from 1) (= to 1)) (list s lev)) + ((and to (= from 0) (= to 0)) (list "" 2)) + (t + (when (> lev 1) ; parenthesize non-atoms + (setq s (concat "(?:" s ")") + lev 0)) + (list (if to + (cond ((and (= from 0) (= to 1)) + (concat s (if greedy "?" "??"))) + ((= from to) + (concat s "{" (number-to-string to) "}")) + (t + (concat s "{" (number-to-string from) + "," (number-to-string to) "}"))) + (cond ((= from 0) + (concat s (if greedy "*" "*?"))) + ((= from 1) + (concat s (if greedy "+" "+?"))) + (t (concat s "{" (number-to-string from) ",}")))) + 1)))))) + +(defun rxt-char-set->pcre (re) + (cond ((rxt-char-set-union-p re) + (list + (concat "[" (rxt-char-set->pcre/chars re) "]") 1)) + + ((rxt-char-set-negation-p re) + (let ((elt (rxt-char-set-negation-elt re))) + (if (rxt-char-set-union-p elt) + (list + (concat "[^" (rxt-char-set->pcre/chars elt) "]") 1) + (rxt-error "No PCRE translation of `%s'" (rxt-to-string elt))))) + + (t + (rxt-error "Non-char-set in rxt-char-set->pcre: %s" re)))) + +;; Fortunately, easier in PCRE than in POSIX! +(defun rxt-char-set->pcre/chars (re) + (cl-flet + ((escape + (char) + (let ((s (char-to-string char))) + (cond ((string-match rxt-pcre-charset-metachars s) + (concat "\\" s)) + + ((and (not (string= s " ")) + (string-match "[^[:graph:]]" s)) + (format "\\x{%x}" char)) + + (t s))))) + + (let ((chars (rxt-char-set-union-chars re)) + (ranges (rxt-char-set-union-ranges re)) + (classes (rxt-char-set-union-classes re))) + + (concat + (mapconcat #'escape chars "") + (mapconcat #'(lambda (rg) + (format "%s-%s" + (escape (car rg)) + (escape (cdr rg)))) + ranges "") + (mapconcat #'(lambda (class) + (format "[:%s:]" class)) + classes ""))))) + + +;;;; Generate all productions of a finite regexp + +(defun rxt-adt->strings (re) + (cl-typecase re + (rxt-primitive + (list "")) + (rxt-string + (list (rxt-string-chars re))) + (rxt-seq + (rxt-seq-elts->strings (rxt-seq-elts re))) + (rxt-choice + (rxt-choice-elts->strings (rxt-choice-elts re))) + (rxt-submatch + (rxt-adt->strings (rxt-submatch-body re))) + (rxt-submatch-numbered + (rxt-adt->strings (rxt-submatch-numbered-body re))) + (rxt-repeat + (rxt-repeat->strings re)) + (rxt-char-set-union + (rxt-char-set->strings re)) + (t + (error "Can't generate productions of %s" + (rxt-syntax-tree-readable re))))) + +(defun rxt-concat-product (heads tails) + (cl-mapcan + (lambda (hs) + (mapcar + (lambda (ts) (concat hs ts)) + tails)) + heads)) + +(defun rxt-seq-elts->strings (elts) + (if (null elts) + '("") + (let ((heads (rxt-adt->strings (car elts))) + (tails (rxt-seq-elts->strings (cdr elts)))) + (rxt-concat-product heads tails)))) + +(defun rxt-choice-elts->strings (elts) + (if (null elts) + '() + (append (rxt-adt->strings (car elts)) + (rxt-choice-elts->strings (cdr elts))))) + +(defun rxt-repeat->strings (re) + (let ((from (rxt-repeat-from re)) + (to (rxt-repeat-to re))) + (if (not to) + (error "Can't generate all productions of unbounded repeat \"%s\"" + (rxt-syntax-tree-readable re)) + (let ((strings (rxt-adt->strings (rxt-repeat-body re)))) + (rxt-repeat-n-m->strings from to strings))))) + +(defun rxt-repeat-n-m->strings (from to strings) + (cond + ((zerop to) '("")) + ((= to from) (rxt-repeat-n->strings from strings)) + (t ; to > from + (let* ((strs-n (rxt-repeat-n->strings from strings)) + (accum (cl-copy-list strs-n))) + (dotimes (_i (- to from)) + (setq strs-n (rxt-concat-product strs-n strings)) + (setq accum (nconc accum strs-n))) + accum)))) + +(defun rxt-repeat-n->strings (n strings) + ;; n > 1 + (cond ((zerop n) '("")) + ((= n 1) strings) + (t + (rxt-concat-product + (rxt-repeat-n->strings (- n 1) strings) + strings)))) + +(defun rxt-char-set->strings (re) + (if (rxt-char-set-union-classes re) + (error "Can't generate all productions of named character classes in \"%s\"" + (rxt-syntax-tree-readable re)) + (let ((chars (mapcar #'char-to-string (rxt-char-set-union-chars re)))) + (dolist (range (rxt-char-set-union-ranges re)) + (let ((end (cdr range))) + (cl-do ((i (car range) (+ i 1))) + ((> i end)) + (push (char-to-string i) chars)))) + chars))) + + +;;;; RE-Builder hacks + +(defadvice reb-update-modestring + (after rxt () activate compile) + "This function is hacked for emulated PCRE syntax and regexp conversion." + (setq reb-mode-string + (concat + (format " (%s)" reb-re-syntax) + reb-mode-string)) + (force-mode-line-update)) + +(defadvice reb-change-syntax + (around rxt (&optional syntax) activate compile) + "This function is hacked for emulated PCRE syntax and regexp conversion." + (interactive + (list (intern + (completing-read (format "Select syntax (%s): " reb-re-syntax) + '(read string pcre sregex rx) + nil t "" nil (symbol-name reb-re-syntax))))) + (unless (memq syntax '(read string pcre lisp-re sregex rx)) + (error "Invalid syntax: %s" syntax)) + (let ((re-builder-buffer (get-buffer reb-buffer))) + (setq reb-re-syntax syntax) + (when re-builder-buffer + (with-current-buffer reb-target-buffer + (cl-case syntax + (rx + (let ((rx (rxt-elisp-to-rx reb-regexp))) + (setq reb-regexp-src + (with-temp-buffer + (insert "\n" "'") + (rxt-print rx) + (buffer-string))))) + (pcre + (setq reb-regexp-src (rxt-elisp-to-pcre reb-regexp))))) + (with-current-buffer re-builder-buffer + ;; Hack: prevent reb-auto-update from clobbering the + ;; reb-regexp-src we just set + (let ((inhibit-modification-hooks t)) + (reb-initialize-buffer)) + ;; Enable flag-toggling bindings for PCRE syntax + (rxt--re-builder-switch-pcre-mode))))) + +(defadvice reb-read-regexp + (around rxt () activate compile) + "This function is hacked for emulated PCRE syntax and regexp conversion." + (if (eq reb-re-syntax 'pcre) + (setq ad-return-value + (save-excursion + (goto-char (point-min)) + (rxt-read-delimited-pcre))) + ad-do-it)) + +(defadvice reb-insert-regexp + (around rxt () activate compile) + "This function is hacked for emulated PCRE syntax and regexp conversion." + (if (eq reb-re-syntax 'pcre) + (let ((src (cond ((fboundp 'reb-target-value) + (reb-target-value 'reb-regexp-src)) + ((fboundp 'reb-target-binding) + (reb-target-binding reb-regexp-src)) + ((error "BUG"))))) + (if src + (insert "\n/" (replace-regexp-in-string "/" "\\/" src t t) "/") + (insert "\n//"))) + ad-do-it)) + +(defadvice reb-cook-regexp + (around rxt (re) activate compile) + "This function is hacked for emulated PCRE syntax and regexp conversion." + (if (eq reb-re-syntax 'pcre) + (setq ad-return-value (rxt-pcre-to-elisp re)) + ad-do-it)) + +(defadvice reb-update-regexp + (around rxt () activate compile) + "This function is hacked for emulated PCRE syntax and regexp conversion." + (setq ad-return-value + (let* ((re-src (reb-read-regexp)) + (re (reb-cook-regexp re-src))) + (with-current-buffer reb-target-buffer + (let ((oldre reb-regexp)) + (prog1 + (not (string= oldre re)) + (setq reb-regexp re) + ;; Update the source re if format requires translation + (when (or (reb-lisp-syntax-p) (eq reb-re-syntax 'pcre)) + (setq reb-regexp-src re-src)))))))) + +(defun rxt--re-builder-switch-pcre-mode () + (rxt--read-pcre-mode + (if (eq reb-re-syntax 'pcre) 1 0))) + +(add-hook 'reb-mode-hook #'rxt--re-builder-switch-pcre-mode) + +(provide 'rxt) +(provide 'pcre2el) + + +;;; pcre2el.el ends here diff --git a/elpa/pcre2el-readme.txt b/elpa/pcre2el-readme.txt deleted file mode 100644 index 0ad9a30a..00000000 --- a/elpa/pcre2el-readme.txt +++ /dev/null @@ -1,381 +0,0 @@ -1 Overview -========== - - `pcre2el' or `rxt' (RegeXp Translator or RegeXp Tools) is a utility - for working with regular expressions in Emacs, based on a - recursive-descent parser for regexp syntax. In addition to converting - (a subset of) PCRE syntax into its Emacs equivalent, it can do the - following: - - - convert Emacs syntax to PCRE - - convert either syntax to `rx', an S-expression based regexp syntax - - untangle complex regexps by showing the parse tree in `rx' form and - highlighting the corresponding chunks of code - - show the complete list of strings (productions) matching a regexp, - provided the list is finite - - provide live font-locking of regexp syntax (so far only for Elisp - buffers -- other modes on the TODO list) - - -2 Usage -======= - - Enable `rxt-mode' or its global equivalent `rxt-global-mode' to get - the default key-bindings. There are three sets of commands: commands - that take a PCRE regexp, commands which take an Emacs regexp, and - commands that try to do the right thing based on the current - mode. Currently, this means Emacs syntax in `emacs-lisp-mode' and - `lisp-interaction-mode', and PCRE syntax everywhere else. - - The default key bindings all begin with `C-c /' and have a mnemonic - structure: `C-c / ', or just `C-c / ' for the - "do what I mean" commands. The complete list of key bindings is given - here and explained in more detail below: - - - "Do-what-I-mean" commands: - `C-c / /': `rxt-explain' - `C-c / c': `rxt-convert-syntax' - `C-c / x': `rxt-convert-to-rx' - `C-c / '': `rxt-convert-to-strings' - - - Commands that work on a PCRE regexp: - `C-c / p e': `rxt-pcre-to-elisp' - `C-c / %': `pcre-query-replace-regexp' - `C-c / p x': `rxt-pcre-to-rx' - `C-c / p '': `rxt-pcre-to-strings' - `C-c / p /': `rxt-explain-pcre' - - - Commands that work on an Emacs regexp: - `C-c / e /': `rxt-explain-elisp' - `C-c / e p': `rxt-elisp-to-pcre' - `C-c / e x': `rxt-elisp-to-rx' - `C-c / e '': `rxt-elisp-to-strings' - `C-c / e t': `rxt-toggle-elisp-rx' - `C-c / t': `rxt-toggle-elisp-rx' - - -2.1 Interactive input and output -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - When used interactively, the conversion commands can read a regexp - either from the current buffer or from the minibuffer. The output is - displayed in the minibuffer and copied to the kill-ring. - - - When called with a prefix argument (`C-u'), they read a regular - expression from the minibuffer literally, without further processing - -- meaning there's no need to double the backslashes if it's an - Emacs regexp. This is the same way commands like - `query-replace-regexp' read input. - - - When the region is active, they use they the region contents, again - literally (without any translation of string syntax). - - - With neither a prefix arg nor an active region, the behavior depends - on whether the command expects an Emacs regexp or a PCRE one. - - Commands that take an Emacs regexp behave like `C-x C-e': they - evaluate the sexp before point (which could be simply a string - literal) and use its value. This is designed for use in Elisp - buffers. As a special case, if point is *inside* a string, it's - first moved to the string end, so in practice they should work as - long as point is somewhere within the regexp literal. - - Commands that take a PCRE regexp try to read a Perl-style delimited - regex literal *after* point in the current buffer, including its - flags. For example, putting point before the `m' in the following - example and doing `C-c / p e' (`rxt-pcre-to-elisp') displays - `\(?:bar\|foo\)', correctly stripping out the whitespace and - comment: - - ,---- - | $x =~ m/ foo | (?# comment) bar /x - `---- - - The PCRE reader currently only works with `/ ... /' delimiters. It - will ignore any preceding `m', `s', or `qr' operator, as well as the - replacement part of an `s' construction. - - Readers for other PCRE-using languages are on the TODO list. - - The translation functions display their result in the minibuffer and - copy it to the kill ring. When translating something into Elisp - syntax, you might need to use the result either literally (e.g. for - interactive input to a command like `query-replace-regexp'), or as a - string to paste into Lisp code. To allow both uses, - `rxt-pcre-to-elisp' copies both versions successively to the - kill-ring. The literal regexp without string quoting is the top - element of the kill-ring, while the Lisp string is the - second-from-top. You can paste the literal regexp somewhere by doing - `C-y', or the Lisp string by `C-y M-y'. - - -2.2 Syntax conversion commands -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - `rxt-convert-syntax' (`C-c / c') converts between Emacs and PCRE - syntax, depending on the major mode in effect when called. - Alternatively, you can specify the conversion direction explicitly by - using either `rxt-pcre-to-elisp' (`C-c / p e') or `rxt-elisp-to-pcre' - (`C-c / e p'). - - Similarly, `rxt-convert-to-rx' (`C-c / x') converts either kind of - syntax to `rx' form, while `rxt-convert-pcre-to-rx' (`C-c / p x') and - `rxt-convert-elisp-to-rx' (`C-c / e x') convert to `rx' from a - specified source type. - - In Elisp buffers, you can use `rxt-toggle-elisp-rx' (`C-c / t' or `C-c - / e t') to switch the regexp at point back and forth between string - and `rx' syntax. Point should either be within an `rx' or - `rx-to-string' form or a string literal for this to work. - - -2.3 PCRE mode (experimental) -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - If you want to use emulated PCRE regexp syntax in all Emacs commands, - try `pcre-mode', which uses Emacs's advice system to make all commands - that read regexps using the minibuffer use emulated PCRE syntax. It - should also work with Isearch. - - This feature is still fairly experimental. It may fail to work or do - the wrong thing with certain commands. Please report bugs. - - `pcre-query-replace-regexp' was originally defined to do query-replace - using emulated PCRE regexps, and is now made somewhat obsolete by - `pcre-mode'. It is bound to `C-c / %' by default, by analogy with - `M-%'. Put the following in your `.emacs' if you want to use - PCRE-style query replacement everywhere: - - ,---- - | (global-set-key [(meta %)] 'pcre-query-replace-regexp) - `---- - -2.5 Explain regexps -~~~~~~~~~~~~~~~~~~~ - - When syntax-highlighting isn't enough to untangle some gnarly regexp - you find in the wild, try the 'explain' commands: `rxt-explain' (`C-c - / /'), `rxt-explain-pcre' (`C-c / p') and `rxt-explain-elisp' (`C-c / - e'). These display the original regexp along with its pretty-printed - `rx' equivalent in a new buffer. Moving point around either in the - original regexp or the `rx' translation highlights corresponding - pieces of syntax, which can aid in seeing things like the scope of - quantifiers. - - I call them "explain" commands because the `rx' form is close to a - plain syntax tree, and this plus the wordiness of the operators - usually helps to clarify what is going on. People who dislike Lisp - syntax might disagree with this assessment. - - -2.6 Generate all matching strings (productions) -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - Occasionally you come across a regexp which is designed to match a - finite set of strings, e.g. a set of keywords, and it would be useful - to recover the original set. (In Emacs you can generate such regexps - using `regexp-opt'). The commands `rxt-convert-to-strings' (`C-c / - ′'), `rxt-pcre-to-strings' (`C-c / p ′') or `rxt-elisp-to-strings' - (`C-c / e ′') accomplish this by generating all the matching strings - ("productions") of a regexp. (The productions are copied to the kill - ring as a Lisp list). - - An example in Lisp code: - - ,---- - | (regexp-opt '("cat" "caterpillar" "catatonic")) - | ;; => "\\(?:cat\\(?:atonic\\|erpillar\\)?\\)" - | (rxt-elisp-to-strings "\\(?:cat\\(?:atonic\\|erpillar\\)?\\)") - | ;; => '("cat" "caterpillar" "catatonic") - `---- - - For obvious reasons, these commands only work with regexps that don't - include any unbounded quantifiers like `+' or `*'. They also can't - enumerate all the characters that match a named character class like - `[[:alnum:]]'. In either case they will give a (hopefully meaningful) - error message. Due to the nature of permutations, it's still possible - for a finite regexp to generate a huge number of productions, which - will eat memory and slow down your Emacs. Be ready with `C-g' if - necessary. - - -2.7 RE-Builder support -~~~~~~~~~~~~~~~~~~~~~~ - - The Emacs RE-Builder is a useful visual tool which allows using - several different built-in syntaxes via `reb-change-syntax' (`C-c - TAB'). It supports Elisp read and literal syntax and `rx', but it can - only convert from the symbolic forms to Elisp, not the other way. This - package hacks the RE-Builder to also work with emulated PCRE syntax, - and to convert transparently between Elisp, PCRE and rx syntaxes. PCRE - mode reads a delimited Perl-like literal of the form `/ ... /', and it - should correctly support using the `x' and `s' flags. - - -2.8 Use from Lisp -~~~~~~~~~~~~~~~~~ - - Example of using the conversion functions: - ,---- - | (rxt-pcre-to-elisp "(abc|def)\\w+\\d+") - | ;; => "\\(\\(?:abc\\|def\\)\\)[_[:alnum:]]+[[:digit:]]+" - `---- - - All the conversion functions take a single string argument, the regexp - to translate: - - - `rxt-pcre-to-elisp' - - `rxt-pcre-to-rx' - - `rxt-pcre-to-strings' - - `rxt-elisp-to-pcre' - - `rxt-elisp-to-rx' - - `rxt-elisp-to-strings' - - -3 Bugs and Limitations -====================== - -3.1 Limitations on PCRE syntax -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - PCRE has a complicated syntax and semantics, only some of which can be - translated into Elisp. The following subset of PCRE should be - correctly parsed and converted: - - - parenthesis grouping `( .. )', including shy matches `(?: ... )' - - backreferences (various syntaxes), but only up to 9 per expression - - alternation `|' - - greedy and non-greedy quantifiers `*', `*?', `+', `+?', `?' and `??' - (all of which are the same in Elisp as in PCRE) - - numerical quantifiers `{M,N}' - - beginning/end of string `\A', `\Z' - - string quoting `\Q .. \E' - - word boundaries `\b', `\B' (these are the same in Elisp) - - single character escapes `\a', `\c', `\e', `\f', `\n', `\r', `\t', - `\x', and `\octal digits' (but see below about non-ASCII characters) - - character classes `[...]' including Posix escapes - - character classes `\d', `\D', `\h', `\H', `\s', `\S', `\v', `\V' - both within character class brackets and outside - - word and non-word characters `\w' and `\W' (Emacs has the same - syntax, but its meaning is different) - - `s' (single line) and `x' (extended syntax) flags, in regexp - literals, or set within the expression via `(?xs-xs)' or `(?xs-xs: - .... )' syntax - - comments `(?# ... )' - - Most of the more esoteric PCRE features can't really be supported by - simple translation to Elisp regexps. These include the different - lookaround assertions, conditionals, and the "backtracking control - verbs" `(* ...)' . OTOH, there are a few other syntaxes which are - currently unsupported and possibly could be: - - - `\L', `\U', `\l', `\u' case modifiers - - `\g{...}' backreferences - - -3.2 Other limitations -~~~~~~~~~~~~~~~~~~~~~ - - - The order of alternatives and characters in char classes sometimes - gets shifted around, which is annoying. - - Although the string parser tries to interpret PCRE's octal and - hexadecimal escapes correctly, there are problems with matching - 8-bit characters that I don't use enough to properly understand, - e.g.: - ,---- - | (string-match-p (rxt-pcre-to-elisp "\\377") "\377") => nil - `---- - A fix for this would be welcome. - - - Most of PCRE's rules for how `^', `\A', `$' and `\Z' interact with - newlines are not implemented, since they seem less relevant to - Emacs's buffer-oriented rather than line-oriented model. However, - the different meanings of the `.' metacharacter *are* implemented - (it matches newlines with the `/s' flag, but not otherwise). - - - Not currently namespace clean (both `rxt-' and a couple of `pcre-' - functions). - - -3.3 TODO: -~~~~~~~~~ - - - Python-specific extensions to PCRE? - - Language-specific stuff to enable regexp font-locking and explaining - in different modes. Each language would need two functions, which - could be kept in an alist: - - 1. A function to read PCRE regexps, taking the string syntax into - account. E.g., Python has single-quoted, double-quoted and raw - strings, each with different quoting rules. PHP has the kind of - belt-and-suspenders solution you would expect: regexps are in - strings, /and/ you have to include the `/ ... /' delimiters! - Duh. - - 2. A function to copy faces back from the parsed string to the - original buffer text. This has to recognize any escape sequences - so they can be treated as a single character. - - -4 Internal details -================== - - `rxt' defines an internal syntax tree representation of regular - expressions, parsers for Elisp and PCRE syntax, and 'unparsers' - to convert the internal representation to PCRE or `rx' syntax. - Converting from the internal representation to Emacs syntax is - done by converting to `rx' form and passing it to `rx-to-string'. - See `rxt-parse-re', `rxt-adt->pcre', and `rxt-adt->rx' for - details. - - This code is partially based on Olin Shivers' reference SRE - implementation in scsh, although it is simplified in some respects and - extended in others. See `scsh/re.scm', `scsh/spencer.scm' and - `scsh/posixstr.scm' in the `scsh' source tree for details. In - particular, `pcre2el' steals the idea of an abstract data type for - regular expressions and the general structure of the string regexp - parser and unparser. The data types for character sets are extended in - order to support symbolic translation between character set - expressions without assuming a small (Latin1) character set. The - string parser is also extended to parse a bigger variety of - constructions, including POSIX character classes and various Emacs and - Perl regexp assertions. Otherwise, only the bare minimum of scsh's - abstract data type is implemented. - - -5 Soapbox -========= - - Emacs regexps have their annoyances, but it is worth getting used to - them. The Emacs assertions for word boundaries, symbol boundaries, and - syntax classes depending on the syntax of the mode in effect are - especially useful. (PCRE has `\b' for word-boundary, but AFAIK it - doesn't have separate assertions for beginning-of-word and - end-of-word). Other things that might be done with huge regexps in - other languages can be expressed more understandably in Elisp using - combinations of `save-excursion' with the various searches (regexp, - literal, skip-syntax-forward, sexp-movement functions, etc.). - - There's not much point in using `rxt-pcre-to-elisp' to use PCRE - notation in a Lisp program you're going to maintain, since you still - have to double all the backslashes. Better to just use the converted - result (or better yet, the `rx' form). - - -6 History and acknowledgments -============================= - - This was originally created out of an answer to a stackoverflow - question: - [http://stackoverflow.com/questions/9118183/elisp-mechanism-for-converting-pcre-regexps-to-emacs-regexps] - - Thanks to: - - - Wes Hardaker (hardaker) for the initial inspiration and subsequent - hacking - - priyadarshan for requesting RX support - - Daniel Colascione (dcolascione) for a patch to support Emacs's - explicitly-numbered match groups - - Aaron Meurer (asmeurer) for requesting Isearch support - - Philippe Vaucher (silex) for a patch to support `ibuffer-do-replace-regexp' - in PCRE mode