· 7 years ago · Sep 11, 2018, 10:08 AM
1;;
2;; pcre2el.el -- quick and dirty conversion from PCRE-style regexps to
3;; Emacs Lisp syntax.
4;;
5;; Author: j.j.oddie at gmail.com
6;;
7;; This code is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published
9;; by the Free Software Foundation; either version 2, or (at your
10;; option) any later version.
11;;
12
13(eval-when-compile (require 'cl))
14
15(defvar pcre-horizontal-whitespace-chars
16 (mapconcat 'char-to-string
17 '(#x0009 #x0020 #x00A0 #x1680 #x180E #x2000 #x2001 #x2002 #x2003
18 #x2004 #x2005 #x2006 #x2007 #x2008 #x2009 #x200A #x202F
19 #x205F #x3000)
20 ""))
21
22(defvar pcre-vertical-whitespace-chars
23 (mapconcat 'char-to-string
24 '(#x000A #x000B #x000C #x000D #x0085 #x2028 #x2029) ""))
25
26(defvar pcre-whitespace-chars
27 (mapconcat 'char-to-string '(9 10 12 13 32) ""))
28
29(defvar pcre-horizontal-whitespace
30 (concat "[" pcre-horizontal-whitespace-chars "]"))
31
32(defvar pcre-non-horizontal-whitespace
33 (concat "[^" pcre-horizontal-whitespace-chars "]"))
34
35(defvar pcre-vertical-whitespace
36 (concat "[" pcre-vertical-whitespace-chars "]"))
37
38(defvar pcre-non-vertical-whitespace
39 (concat "[^" pcre-vertical-whitespace-chars "]"))
40
41(defvar pcre-whitespace (concat "[" pcre-whitespace-chars "]"))
42
43(defvar pcre-non-whitespace (concat "[^" pcre-whitespace-chars "]"))
44
45(eval-when-compile
46 (defmacro pcre-token-case (&rest cases)
47 "Consume a token at point and evaluate corresponding forms.
48
49CASES is a list of `cond'-like clauses, (REGEXP FORMS
50...). Considering CASES in order, if the text at point matches
51REGEXP then moves point over the matched string and returns the
52value of FORMS. Returns `nil' if none of the CASES matches."
53 (declare (debug (&rest (sexp &rest form))))
54 `(cond
55 ,@(mapcar
56 (lambda (case)
57 (let ((token (car case))
58 (action (cdr case)))
59 `((looking-at ,token)
60 (goto-char (match-end 0))
61 ,@action)))
62 cases)
63 (t nil))))
64
65(defun pcre-to-elisp (pcre)
66 "Convert PCRE, a regexp in PCRE notation, into Elisp string form."
67 (with-temp-buffer
68 (insert pcre)
69 (goto-char (point-min))
70 (let ((capture-count 0) (accum '())
71 (case-fold-search nil))
72 (while (not (eobp))
73 (let ((translated
74 (or
75 ;; Handle tokens that are treated the same in
76 ;; character classes
77 (pcre-re-or-class-token-to-elisp)
78
79 ;; Other tokens
80 (pcre-token-case
81 ("|" "\\|")
82 ("(" (incf capture-count) "\\(")
83 (")" "\\)")
84 ("{" "\\{")
85 ("}" "\\}")
86
87 ;; Character class
88 ("\\[" (pcre-char-class-to-elisp))
89
90 ;; Backslash + digits => backreference or octal char?
91 ("\\\\\\([0-9]+\\)"
92 (let* ((digits (match-string 1))
93 (dec (string-to-number digits)))
94 ;; from "man pcrepattern": If the number is
95 ;; less than 10, or if there have been at
96 ;; least that many previous capturing left
97 ;; parentheses in the expression, the entire
98 ;; sequence is taken as a back reference.
99 (cond ((< dec 10) (concat "\\" digits))
100 ((>= capture-count dec)
101 (error "backreference \\%s can't be used in Emacs regexps"
102 digits))
103 (t
104 ;; from "man pcrepattern": if the
105 ;; decimal number is greater than 9 and
106 ;; there have not been that many
107 ;; capturing subpatterns, PCRE re-reads
108 ;; up to three octal digits following
109 ;; the backslash, and uses them to
110 ;; generate a data character. Any
111 ;; subsequent digits stand for
112 ;; themselves.
113 (goto-char (match-beginning 1))
114 (re-search-forward "[0-7]\\{0,3\\}")
115 (char-to-string (string-to-number (match-string 0) 8))))))
116
117 ;; Regexp quoting.
118 ("\\\\Q"
119 (let ((beginning (point)))
120 (search-forward "\\E")
121 (regexp-quote (buffer-substring beginning (match-beginning 0)))))
122
123 ;; Various character classes
124 ("\\\\d" "[0-9]")
125 ("\\\\D" "[^0-9]")
126 ("\\\\h" pcre-horizontal-whitespace)
127 ("\\\\H" pcre-non-horizontal-whitespace)
128 ("\\\\s" pcre-whitespace)
129 ("\\\\S" pcre-non-whitespace)
130 ("\\\\v" pcre-vertical-whitespace)
131 ("\\\\V" pcre-non-vertical-whitespace)
132
133 ;; Use Emacs' native notion of word characters
134 ("\\\\[Ww]" (match-string 0))
135
136 ;; Any other escaped character
137 ("\\\\\\(.\\)" (regexp-quote (match-string 1)))
138
139 ;; Any normal character
140 ("." (match-string 0))))))
141 (push translated accum)))
142 (apply 'concat (reverse accum)))))
143
144(defun pcre-re-or-class-token-to-elisp ()
145 "Consume the PCRE token at point and return its Elisp equivalent.
146
147Handles only tokens which have the same meaning in character
148classes as outside them."
149 (pcre-token-case
150 ("\\\\a" (char-to-string #x07)) ; bell
151 ("\\\\c\\(.\\)" ; control character
152 (char-to-string
153 (- (string-to-char (upcase (match-string 1))) 64)))
154 ("\\\\e" (char-to-string #x1b)) ; escape
155 ("\\\\f" (char-to-string #x0c)) ; formfeed
156 ("\\\\n" (char-to-string #x0a)) ; linefeed
157 ("\\\\r" (char-to-string #x0d)) ; carriage return
158 ("\\\\t" (char-to-string #x09)) ; tab
159 ("\\\\x\\([A-Za-z0-9]\\{2\\}\\)"
160 (char-to-string (string-to-number (match-string 1) 16)))
161 ("\\\\x{\\([A-Za-z0-9]*\\)}"
162 (char-to-string (string-to-number (match-string 1) 16)))))
163
164(defun pcre-char-class-to-elisp ()
165 "Consume the remaining PCRE character class at point and return its Elisp equivalent.
166
167Point should be after the opening \"[\" when this is called, and
168will be just after the closing \"]\" when it returns."
169 (let ((accum '("["))
170 (alternatives '())
171 (negated nil))
172 (when (looking-at "\\^")
173 (setq negated t)
174 (push "^" accum)
175 (forward-char))
176 (when (looking-at "\\]") (push "]" accum) (forward-char))
177
178 (while (not (looking-at "\\]"))
179 (let ((translated
180 (or
181 (pcre-re-or-class-token-to-elisp)
182 (pcre-token-case
183 ;; Backslash + digits => always an octal char
184 ("\\\\\\([0-7]\\{1,3\\}\\)"
185 (char-to-string (string-to-number (match-string 1) 8)))
186
187 ;; Various character classes. To implement negative char classes,
188 ;; we cons them onto the list `alternatives' and
189 ;; transform the char class into a shy group with alternation
190 ("\\\\d" "0-9")
191 ("\\\\D" (push (if negated "[0-9]" "[^0-9]")
192 alternatives) "")
193 ("\\\\h" pcre-horizontal-whitespace-chars)
194 ("\\\\H" (push (if negated
195 pcre-horizontal-whitespace
196 pcre-non-horizontal-whitespace)
197 alternatives) "")
198 ("\\\\s" pcre-whitespace-chars)
199 ("\\\\S" (push (if negated
200 pcre-whitespace
201 pcre-non-whitespace)
202 alternatives) "")
203 ("\\\\v" pcre-vertical-whitespace-chars)
204 ("\\\\V" (push (if negated
205 pcre-vertical-whitespace
206 pcre-non-vertical-whitespace)
207 alternatives) "")
208 ("\\\\w" (push (if negated "\\W" "\\w")
209 alternatives) "")
210 ("\\\\W" (push (if negated "\\w" "\\W")
211 alternatives) "")
212
213 ;; Leave POSIX syntax unchanged
214 ("\\[:[a-z]*:\\]" (match-string 0))
215
216 ;; Ignore other escapes
217 ("\\\\\\(.\\)" (match-string 0))
218
219 ;; Copy everything else
220 ("." (match-string 0))))))
221 (push translated accum)))
222 (push "]" accum)
223 (forward-char)
224 (let ((class
225 (apply 'concat (reverse accum))))
226 (when (or (equal class "[]")
227 (equal class "[^]"))
228 (setq class ""))
229 (if (not alternatives)
230 class
231 (concat "\\(?:"
232 class "\\|"
233 (mapconcat 'identity
234 alternatives
235 "\\|")
236 "\\)")))))
237
238
239;;;; A few simple tests
240
241;; Regexp quoting
242(let* ((string "String $ with (( ) regexp \\ special [a-z] characters")
243 (re (pcre-to-elisp (concat "(\\Q" string "\\E)"))))
244 (assert (string-match re string))
245 (assert (equal (match-string 1 string) string))
246 (assert (equal (match-string 0 string) string)))
247
248;; Grouping, alternation
249(let ((re (pcre-to-elisp "(foo|bar)")))
250 (assert (string-match-p re "foo"))
251 (assert (string-match-p re "bar")))
252
253;; Grouping and character classes
254(let ((re (pcre-to-elisp "(\\D*):\\s*(\\d{3,5})$"))
255 (string "Answer: 3501"))
256 (assert (string-match re string))
257 (assert (equal (match-string 1 string) "Answer"))
258 (assert (equal (match-string 2 string) "3501"))
259
260 (assert (not (string-match re "bad: 23")))
261 (assert (not (string-match re "also bad: 944732"))))
262
263 ;;;; Weird rules for \digits
264;; \040 is another way of writing a space
265(assert (string-match-p (pcre-to-elisp "\040") " "))
266
267;; \40 is the same, provided there are fewer than 40 previous capturing subpatterns
268(assert (string-match-p (pcre-to-elisp "\40") " "))
269
270;; \7 is always a back reference
271(let ((re
272 (pcre-to-elisp
273 "(.)(.)(.)(.)(.)(.)(.)\\s*\\7")))
274 (assert (string-match-p re "abcdefg g"))
275 (assert (not (string-match-p re "abcdefg\th"))))
276
277;;\11 might be a back reference, or another way of writing a tab
278(assert
279 (string-match-p (pcre-to-elisp "\\11") "\t"))
280;; Backreferences greater than 9 don't work in Emacs regexps
281(assert
282 (condition-case nil
283 (progn (pcre-to-elisp "(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)\\11") nil)
284 (error t)))
285
286;; \011 is always a tab
287(assert
288 (string-match-p
289 (pcre-to-elisp "\\011") "\t"))
290
291;; \0113 is a tab followed by the character "3"
292(assert
293 (string-match-p
294 (pcre-to-elisp "\\0113") "\t3"))
295
296;; \113 might be a back reference, otherwise the character with octal
297;; code 113
298(assert
299 (string-match-p
300 (pcre-to-elisp "\\113")
301 (char-to-string #o113)))
302
303;; \377 might be a back reference, otherwise the byte consisting
304;; entirely of 1 bits
305(assert
306 (string-match-p
307 (pcre-to-elisp "\\377")
308 (char-to-string 255)))
309
310;; \81 is either a back reference, or a binary zero followed by the
311;; two characters "8" and "1"
312(assert
313 (string-match-p
314 (pcre-to-elisp "\\81")
315 (concat (char-to-string 0) "81")))
316
317
318;; Character classes with special characters
319(let ((re (pcre-to-elisp "^[\\d\\w]*$")))
320 (assert (string-match-p re "012foo"))
321 (assert (not (string-match-p re "numbers 847 and 23 words"))))
322
323(assert
324 (let ((case-fold-search t))
325 (string-match-p
326 (pcre-to-elisp "^[\\dA-Z]*$")
327 "235711deadbeef")))
328
329;; Negated specials in character classes
330(let ((re (pcre-to-elisp "^[^\\d]*$")))
331 (assert
332 (string-match-p re "words without numbers"))
333 (assert
334 (not (string-match-p re "words 2 and 4 numbers 8"))))
335
336;; Hexadecimal and octal escapes
337(assert
338 (string-match-p (pcre-to-elisp "\\xab") (char-to-string #xab))
339 (string-match-p (pcre-to-elisp "[\\xab]") (char-to-string #xab))
340 (string-match-p (pcre-to-elisp "\\x{237}") (char-to-string #x237))
341 (string-match-p (pcre-to-elisp "[\\x{237}]") (char-to-string #x237))
342 (string-match-p (pcre-to-elisp "[\\177]") (char-to-string #o177))
343 (string-match-p (pcre-to-elisp "[\\7]") (char-to-string 7)))
344
345;; Control characters
346(assert
347 (string-match-p (pcre-to-elisp "\\cx") (kbd "C-x"))
348 (string-match-p (pcre-to-elisp "\\cC\\cn") (kbd "C-c C-n")))
349
350;; Double negation in character classes (perverse)
351(assert
352 (string-match-p (pcre-to-elisp "^[^\\W]*$") "foo"))