Mercurial > emacs
annotate lisp/emacs-lisp/rx.el @ 49598:0d8b17d428b5
Trailing whitepace deleted.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Tue, 04 Feb 2003 13:24:35 +0000 |
parents | 05f00479612c |
children | 695cf19ef79e d7ddb3e565de |
rev | line source |
---|---|
39516 | 1 ;;; rx.el --- sexp notation for regular expressions |
2 | |
3 ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Gerd Moellmann <gerd@gnu.org> | |
6 ;; Maintainer: FSF | |
7 ;; Keywords: strings, regexps, extensions | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;; This is another implementation of sexp-form regular expressions. | |
29 ;; It was unfortunately written without being aware of the Sregex | |
30 ;; package coming with Emacs, but as things stand, Rx completely | |
31 ;; covers all regexp features, which Sregex doesn't, doesn't suffer | |
32 ;; from the bugs mentioned in the commentary section of Sregex, and | |
33 ;; uses a nicer syntax (IMHO, of course :-). | |
34 | |
35 ;; Rx translates a sexp notation for regular expressions into the | |
36 ;; usual string notation. The translation can be done at compile-time | |
37 ;; by using the `rx' macro. It can be done at run-time by calling | |
38 ;; function `rx-to-string'. See the documentation of `rx' for a | |
39 ;; complete description of the sexp notation. | |
40 ;; | |
41 ;; Some examples of string regexps and their sexp counterparts: | |
42 ;; | |
43 ;; "^[a-z]*" | |
44 ;; (rx (and line-start (0+ (in "a-z")))) | |
45 ;; | |
46 ;; "\n[^ \t]" | |
47 ;; (rx (and "\n" (not blank))), or | |
48 ;; (rx (and "\n" (not (any " \t")))) | |
49 ;; | |
50 ;; "\\*\\*\\* EOOH \\*\\*\\*\n" | |
51 ;; (rx "*** EOOH ***\n") | |
52 ;; | |
53 ;; "\\<\\(catch\\|finally\\)\\>[^_]" | |
54 ;; (rx (and word-start (submatch (or "catch" "finally")) word-end | |
55 ;; (not (any ?_)))) | |
56 ;; | |
57 ;; "[ \t\n]*:\\([^:]+\\|$\\)" | |
58 ;; (rx (and (zero-or-more (in " \t\n")) ":" | |
59 ;; (submatch (or line-end (one-or-more (not (any ?:))))))) | |
60 ;; | |
61 ;; "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" | |
62 ;; (rx (and line-start | |
63 ;; "content-transfer-encoding:" | |
48938
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
64 ;; (+ (? ?\n)) blank |
39516 | 65 ;; "quoted-printable" |
48938
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
66 ;; (+ (? ?\n)) blank)) |
39516 | 67 ;; |
68 ;; (concat "^\\(?:" something-else "\\)") | |
69 ;; (rx (and line-start (eval something-else))), statically or | |
70 ;; (rx-to-string '(and line-start ,something-else)), dynamically. | |
71 ;; | |
72 ;; (regexp-opt '(STRING1 STRING2 ...)) | |
73 ;; (rx (or STRING1 STRING2 ...)), or in other words, `or' automatically | |
74 ;; calls `regexp-opt' as needed. | |
75 ;; | |
76 ;; "^;;\\s-*\n\\|^\n" | |
77 ;; (rx (or (and line-start ";;" (0+ space) ?\n) | |
78 ;; (and line-start ?\n))) | |
79 ;; | |
80 ;; "\\$[I]d: [^ ]+ \\([^ ]+\\) " | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
81 ;; (rx (and "$Id: " |
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
82 ;; (1+ (not (in " "))) |
39516 | 83 ;; " " |
84 ;; (submatch (1+ (not (in " ")))) | |
48938
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
85 ;; " ")) |
39516 | 86 ;; |
87 ;; "\\\\\\\\\\[\\w+" | |
88 ;; (rx (and ?\\ ?\\ ?\[ (1+ word))) | |
89 ;; | |
90 ;; etc. | |
91 | |
92 ;;; History: | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
93 ;; |
39516 | 94 |
95 ;;; Code: | |
96 | |
97 | |
98 (defconst rx-constituents | |
99 '((and . (rx-and 1 nil)) | |
100 (or . (rx-or 1 nil)) | |
101 (not-newline . ".") | |
102 (anything . ".\\|\n") | |
103 (any . (rx-any 1 1 rx-check-any)) | |
104 (in . any) | |
105 (not . (rx-not 1 1 rx-check-not)) | |
106 (repeat . (rx-repeat 2 3)) | |
107 (submatch . (rx-submatch 1 nil)) | |
108 (group . submatch) | |
109 (zero-or-more . (rx-kleene 1 1)) | |
110 (one-or-more . (rx-kleene 1 1)) | |
111 (zero-or-one . (rx-kleene 1 1)) | |
112 (\? . zero-or-one) | |
113 (\?? . zero-or-one) | |
114 (* . zero-or-more) | |
115 (*? . zero-or-more) | |
116 (0+ . zero-or-more) | |
117 (+ . one-or-more) | |
118 (+? . one-or-more) | |
119 (1+ . one-or-more) | |
120 (optional . zero-or-one) | |
121 (minimal-match . (rx-greedy 1 1)) | |
122 (maximal-match . (rx-greedy 1 1)) | |
123 (line-start . "^") | |
124 (line-end . "$") | |
125 (string-start . "\\`") | |
126 (string-end . "\\'") | |
127 (buffer-start . "\\`") | |
128 (buffer-end . "\\'") | |
129 (point . "\\=") | |
130 (word-start . "\\<") | |
131 (word-end . "\\>") | |
132 (word-boundary . "\\b") | |
133 (syntax . (rx-syntax 1 1)) | |
134 (category . (rx-category 1 1 rx-check-category)) | |
135 (eval . (rx-eval 1 1)) | |
136 (regexp . (rx-regexp 1 1 stringp)) | |
137 (digit . "[[:digit:]]") | |
138 (control . "[[:cntrl:]]") | |
139 (hex-digit . "[[:xdigit:]]") | |
140 (blank . "[[:blank:]]") | |
141 (graphic . "[[:graph:]]") | |
142 (printing . "[[:print:]]") | |
143 (alphanumeric . "[[:alnum:]]") | |
144 (letter . "[[:alpha:]]") | |
145 (ascii . "[[:ascii:]]") | |
146 (nonascii . "[[:nonascii:]]") | |
147 (lower . "[[:lower:]]") | |
148 (punctuation . "[[:punct:]]") | |
149 (space . "[[:space:]]") | |
150 (upper . "[[:upper:]]") | |
151 (word . "[[:word:]]")) | |
152 "Alist of sexp form regexp constituents. | |
153 Each element of the alist has the form (SYMBOL . DEFN). | |
154 SYMBOL is a valid constituent of sexp regular expressions. | |
155 If DEFN is a string, SYMBOL is translated into DEFN. | |
156 If DEFN is a symbol, use the definition of DEFN, recursively. | |
157 Otherwise, DEFN must be a list (FUNCTION MIN-ARGS MAX-ARGS PREDICATE). | |
158 FUNCTION is used to produce code for SYMBOL. MIN-ARGS and MAX-ARGS | |
159 are the minimum and maximum number of arguments the function-form | |
160 sexp constituent SYMBOL may have in sexp regular expressions. | |
161 MAX-ARGS nil means no limit. PREDICATE, if specified, means that | |
162 all arguments must satisfy PREDICATE.") | |
163 | |
164 | |
165 (defconst rx-syntax | |
166 '((whitespace . ?-) | |
167 (punctuation . ?.) | |
168 (word . ?w) | |
169 (symbol . ?_) | |
170 (open-parenthesis . ?\() | |
171 (close-parenthesis . ?\)) | |
172 (expression-prefix . ?\') | |
173 (string-quote . ?\") | |
174 (paired-delimiter . ?$) | |
175 (escape . ?\\) | |
176 (character-quote . ?/) | |
177 (comment-start . ?<) | |
178 (comment-end . ?>)) | |
179 "Alist mapping Rx syntax symbols to syntax characters. | |
180 Each entry has the form (SYMBOL . CHAR), where SYMBOL is a valid | |
181 symbol in `(syntax SYMBOL)', and CHAR is the syntax character | |
182 corresponding to SYMBOL, as it would be used with \\s or \\S in | |
183 regular expressions.") | |
184 | |
185 | |
186 (defconst rx-categories | |
187 '((consonant . ?0) | |
188 (base-vowel . ?1) | |
189 (upper-diacritical-mark . ?2) | |
190 (lower-diacritical-mark . ?3) | |
191 (tone-mark . ?4) | |
192 (symbol . ?5) | |
193 (digit . ?6) | |
194 (vowel-modifying-diacritical-mark . ?7) | |
195 (vowel-sign . ?8) | |
196 (semivowel-lower . ?9) | |
197 (not-at-end-of-line . ?<) | |
198 (not-at-beginning-of-line . ?>) | |
199 (alpha-numeric-two-byte . ?A) | |
200 (chinse-two-byte . ?C) | |
201 (greek-two-byte . ?G) | |
202 (japanese-hiragana-two-byte . ?H) | |
203 (indian-two-byte . ?I) | |
204 (japanese-katakana-two-byte . ?K) | |
205 (korean-hangul-two-byte . ?N) | |
206 (cyrillic-two-byte . ?Y) | |
207 (ascii . ?a) | |
208 (arabic . ?b) | |
209 (chinese . ?c) | |
210 (ethiopic . ?e) | |
211 (greek . ?g) | |
212 (korean . ?h) | |
213 (indian . ?i) | |
214 (japanese . ?j) | |
215 (japanese-katakana . ?k) | |
216 (latin . ?l) | |
217 (lao . ?o) | |
218 (tibetan . ?q) | |
219 (japanese-roman . ?r) | |
220 (thai . ?t) | |
221 (vietnamese . ?v) | |
222 (hebrew . ?w) | |
223 (cyrillic . ?y) | |
224 (can-break . ?|)) | |
225 "Alist mapping symbols to category characters. | |
226 Each entry has the form (SYMBOL . CHAR), where SYMBOL is a valid | |
227 symbol in `(category SYMBOL)', and CHAR is the category character | |
228 corresponding to SYMBOL, as it would be used with `\\c' or `\\C' in | |
229 regular expression strings.") | |
230 | |
231 | |
232 (defvar rx-greedy-flag t | |
233 "Non-nil means produce greedy regular expressions for `zero-or-one', | |
234 `zero-or-more', and `one-or-more'. Dynamically bound.") | |
235 | |
236 | |
237 (defun rx-info (op) | |
238 "Return parsing/code generation info for OP. | |
239 If OP is the space character ASCII 32, return info for the symbol `?'. | |
240 If OP is the character `?', return info for the symbol `??'. | |
241 See also `rx-constituents'." | |
242 (cond ((eq op ? ) (setq op '\?)) | |
243 ((eq op ??) (setq op '\??))) | |
244 (while (and (not (null op)) (symbolp op)) | |
245 (setq op (cdr (assq op rx-constituents)))) | |
246 op) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
247 |
39516 | 248 |
249 (defun rx-check (form) | |
250 "Check FORM according to its car's parsing info." | |
251 (let* ((rx (rx-info (car form))) | |
252 (nargs (1- (length form))) | |
253 (min-args (nth 1 rx)) | |
254 (max-args (nth 2 rx)) | |
255 (type-pred (nth 3 rx))) | |
256 (when (and (not (null min-args)) | |
257 (< nargs min-args)) | |
258 (error "Rx form `%s' requires at least %d args" | |
259 (car form) min-args)) | |
260 (when (and (not (null max-args)) | |
261 (> nargs max-args)) | |
262 (error "Rx form `%s' accepts at most %d args" | |
263 (car form) max-args)) | |
264 (when (not (null type-pred)) | |
265 (dolist (sub-form (cdr form)) | |
266 (unless (funcall type-pred sub-form) | |
267 (error "Rx form `%s' requires args satisfying `%s'" | |
268 (car form) type-pred)))))) | |
269 | |
270 | |
271 (defun rx-and (form) | |
272 "Parse and produce code from FORM. | |
273 FORM is of the form `(and FORM1 ...)'." | |
274 (rx-check form) | |
48938
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
275 (concat "\\(?:" |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
276 (mapconcat |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
277 (function (lambda (x) (rx-to-string x 'no-group))) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
278 (cdr form) nil) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
279 "\\)")) |
39516 | 280 |
281 | |
282 (defun rx-or (form) | |
283 "Parse and produce code from FORM, which is `(or FORM1 ...)'." | |
284 (rx-check form) | |
285 (let ((all-args-strings t)) | |
286 (dolist (arg (cdr form)) | |
287 (unless (stringp arg) | |
288 (setq all-args-strings nil))) | |
289 (if all-args-strings | |
290 (regexp-opt (cdr form)) | |
291 (mapconcat #'rx-to-string (cdr form) "\\|")))) | |
292 | |
293 | |
294 (defun rx-quote-for-set (string) | |
295 "Transform STRING for use in a character set. | |
296 If STRING contains a `]', move it to the front. | |
297 If STRING starts with a '^', move it to the end." | |
298 (when (string-match "\\`\\(\\(?:.\\|\n\\)+\\)\\]\\(\\(?:.\\|\n\\)\\)*\\'" | |
299 string) | |
300 (setq string (concat "]" (match-string 1 string) | |
301 (match-string 2 string)))) | |
302 (when (string-match "\\`^\\(\\(?:.\\|\n\\)+\\)\\'" string) | |
303 (setq string (concat (substring string 1) "^"))) | |
304 string) | |
305 | |
306 | |
307 (defun rx-check-any (arg) | |
308 "Check arg ARG for Rx `any'." | |
309 (cond ((integerp arg) t) | |
310 ((and (stringp arg) (zerop (length arg))) | |
311 (error "String arg for Rx `any' must not be empty")) | |
312 ((stringp arg) t) | |
313 (t | |
314 (error "Rx `any' requires string or character arg")))) | |
315 | |
316 | |
317 (defun rx-any (form) | |
318 "Parse and produce code from FORM, which is `(any STRING)'. | |
319 STRING is optional. If it is omitted, build a regexp that | |
320 matches anything." | |
321 (rx-check form) | |
322 (let ((arg (cadr form))) | |
323 (cond ((integerp arg) | |
324 (char-to-string arg)) | |
325 ((= (length arg) 1) | |
326 arg) | |
327 (t | |
328 (concat "[" (rx-quote-for-set (cadr form)) "]"))))) | |
329 | |
330 | |
331 (defun rx-check-not (form) | |
332 "Check arguments of FORM. FORM is `(not ...)'." | |
333 (unless (or (memq form | |
334 '(digit control hex-digit blank graphic printing | |
335 alphanumeric letter ascii nonascii lower | |
336 punctuation space upper word)) | |
337 (and (consp form) | |
338 (memq (car form) '(not any in syntax category:)))) | |
339 (error "Rx `not' syntax error: %s" form)) | |
340 t) | |
341 | |
342 | |
343 (defun rx-not (form) | |
344 "Parse and produce code from FORM. FORM is `(not ...)'." | |
345 (rx-check form) | |
346 (let ((result (rx-to-string (cadr form) 'no-group))) | |
347 (cond ((string-match "\\`\\[^" result) | |
348 (if (= (length result) 4) | |
349 (substring result 2 3) | |
350 (concat "[" (substring result 2)))) | |
351 ((string-match "\\`\\[" result) | |
352 (concat "[^" (substring result 1))) | |
353 ((string-match "\\`\\\\s." result) | |
354 (concat "\\S" (substring result 2))) | |
355 ((string-match "\\`\\\\S." result) | |
356 (concat "\\s" (substring result 2))) | |
357 ((string-match "\\`\\\\c." result) | |
358 (concat "\\C" (substring result 2))) | |
359 ((string-match "\\`\\\\C." result) | |
360 (concat "\\c" (substring result 2))) | |
361 ((string-match "\\`\\\\B" result) | |
362 (concat "\\b" (substring result 2))) | |
363 ((string-match "\\`\\\\b" result) | |
364 (concat "\\B" (substring result 2))) | |
365 (t | |
366 (concat "[^" result "]"))))) | |
367 | |
368 | |
369 (defun rx-repeat (form) | |
370 "Parse and produce code from FORM. | |
371 FORM is either `(repeat N FORM1)' or `(repeat N M FORM1)'." | |
372 (rx-check form) | |
373 (cond ((= (length form) 3) | |
374 (unless (and (integerp (nth 1 form)) | |
375 (> (nth 1 form) 0)) | |
376 (error "Rx `repeat' requires positive integer first arg")) | |
377 (format "%s\\{%d\\}" (rx-to-string (nth 2 form)) (nth 1 form))) | |
378 ((or (not (integerp (nth 2 form))) | |
379 (< (nth 2 form) 0) | |
380 (not (integerp (nth 1 form))) | |
381 (< (nth 1 form) 0) | |
382 (< (nth 2 form) (nth 1 form))) | |
383 (error "Rx `repeat' range error")) | |
384 (t | |
385 (format "%s\\{%d,%d\\}" (rx-to-string (nth 3 form)) | |
386 (nth 1 form) (nth 2 form))))) | |
387 | |
388 | |
389 (defun rx-submatch (form) | |
390 "Parse and produce code from FORM, which is `(submatch ...)'." | |
48938
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
391 (concat "\\(" |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
392 (mapconcat (function (lambda (x) (rx-to-string x 'no-group))) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
393 (cdr form) nil) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
394 "\\)")) |
39516 | 395 |
396 (defun rx-kleene (form) | |
397 "Parse and produce code from FORM. | |
398 FORM is `(OP FORM1)', where OP is one of the `zero-or-one', | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
399 `zero-or-more' etc. operators. |
39516 | 400 If OP is one of `*', `+', `?', produce a greedy regexp. |
401 If OP is one of `*?', `+?', `??', produce a non-greedy regexp. | |
402 If OP is anything else, produce a greedy regexp if `rx-greedy-flag' | |
403 is non-nil." | |
404 (rx-check form) | |
405 (let ((suffix (cond ((memq (car form) '(* + ? )) "") | |
406 ((memq (car form) '(*? +? ??)) "?") | |
407 (rx-greedy-flag "") | |
408 (t "?"))) | |
409 (op (cond ((memq (car form) '(* *? 0+ zero-or-more)) "*") | |
410 ((memq (car form) '(+ +? 1+ one-or-more)) "+") | |
48938
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
411 (t "?"))) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
412 (result (rx-to-string (cadr form) 'no-group))) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
413 (if (not (rx-atomic-p result)) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
414 (setq result (concat "\\(?:" result "\\)"))) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
415 (concat result op suffix))) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
416 |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
417 (defun rx-atomic-p (r) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
418 "Return non-nil if regexp string R is atomic. |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
419 An atomic regexp R is one such that a suffix operator |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
420 appended to R will apply to all of R. For example, \"a\" |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
421 \"[abc]\" and \"\\(ab\\|ab*c\\)\" are atomic and \"ab\", |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
422 \"[ab]c\", and \"ab\\|ab*c\" are not atomic. |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
423 |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
424 This function may return false negatives, but it will not |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
425 return false positives. It is nevertheless useful in |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
426 situations where an efficiency shortcut can be taken iff a |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
427 regexp is atomic. The function can be improved to detect |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
428 more cases of atomic regexps. Presently, this function |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
429 detects the following categories of atomic regexp; |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
430 |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
431 a group or shy group: \\(...\\) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
432 a character class: [...] |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
433 a single character: a |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
434 |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
435 On the other hand, false negatives will be returned for |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
436 regexps that are atomic but end in operators, such as |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
437 \"a+\". I think these are rare. Probably such cases could |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
438 be detected without much effort. A guarantee of no false |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
439 negatives would require a theoretic specification of the set |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
440 of all atomic regexps." |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
441 (let ((l (length r))) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
442 (or (equal l 1) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
443 (and (>= l 6) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
444 (equal (substring r 0 2) "\\(") |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
445 (equal (substring r -2) "\\)")) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
446 (and (>= l 2) |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
447 (equal (substring r 0 1) "[") |
05f00479612c
(rx-and): Generate a shy group.
Richard M. Stallman <rms@gnu.org>
parents:
47257
diff
changeset
|
448 (equal (substring r -1) "]"))))) |
39516 | 449 |
450 | |
451 (defun rx-syntax (form) | |
452 "Parse and produce code from FORM, which is `(syntax SYMBOL)'." | |
453 (rx-check form) | |
454 (let ((syntax (assq (cadr form) rx-syntax))) | |
455 (unless syntax | |
456 (error "Unknown rx syntax `%s'" (cadr form))) | |
457 (format "\\s%c" (cdr syntax)))) | |
458 | |
459 | |
460 (defun rx-check-category (form) | |
461 "Check the argument FORM of a `(category FORM)'." | |
462 (unless (or (integerp form) | |
463 (cdr (assq form rx-categories))) | |
464 (error "Unknown category `%s'" form)) | |
465 t) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
466 |
39516 | 467 |
468 (defun rx-category (form) | |
469 "Parse and produce code from FORM, which is `(category SYMBOL ...)'." | |
470 (rx-check form) | |
471 (let ((char (if (integerp (cadr form)) | |
472 (cadr form) | |
473 (cdr (assq (cadr form) rx-categories))))) | |
474 (format "\\c%c" char))) | |
475 | |
476 | |
477 (defun rx-eval (form) | |
478 "Parse and produce code from FORM, which is `(eval FORM)'." | |
479 (rx-check form) | |
480 (rx-to-string (eval (cadr form)))) | |
481 | |
482 | |
483 (defun rx-greedy (form) | |
484 "Parse and produce code from FORM. If FORM is '(minimal-match | |
485 FORM1)', non-greedy versions of `*', `+', and `?' operators will be | |
486 used in FORM1. If FORM is '(maximal-match FORM1)', greedy operators | |
487 will be used." | |
488 (rx-check form) | |
489 (let ((rx-greedy-flag (eq (car form) 'maximal-match))) | |
490 (rx-to-string (cadr form)))) | |
491 | |
492 | |
493 (defun rx-regexp (form) | |
494 "Parse and produce code from FORM, which is `(regexp STRING)'." | |
495 (rx-check form) | |
496 (concat "\\(?:" (cadr form) "\\)")) | |
497 | |
498 | |
499 ;;;###autoload | |
500 (defun rx-to-string (form &optional no-group) | |
501 "Parse and produce code for regular expression FORM. | |
502 FORM is a regular expression in sexp form. | |
503 NO-GROUP non-nil means don't put shy groups around the result." | |
504 (cond ((stringp form) | |
505 (regexp-quote form)) | |
506 ((integerp form) | |
507 (regexp-quote (char-to-string form))) | |
508 ((symbolp form) | |
509 (let ((info (rx-info form))) | |
510 (cond ((stringp info) | |
511 info) | |
512 ((null info) | |
513 (error "Unknown Rx form `%s'" form)) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
514 (t |
39516 | 515 (funcall (nth 0 info) form))))) |
516 ((consp form) | |
517 (let ((info (rx-info (car form)))) | |
518 (unless (consp info) | |
519 (error "Unknown Rx form `%s'" (car form))) | |
520 (let ((result (funcall (nth 0 info) form))) | |
521 (if (or no-group (string-match "\\`\\\\[(]" result)) | |
522 result | |
523 (concat "\\(?:" result "\\)"))))) | |
524 (t | |
525 (error "Rx syntax error at `%s'" form)))) | |
526 | |
527 | |
528 ;;;###autoload | |
529 (defmacro rx (regexp) | |
530 "Translate a regular expression REGEXP in sexp form to a regexp string. | |
531 See also `rx-to-string' for how to do such a translation at run-time. | |
532 | |
533 The following are valid subforms of regular expressions in sexp | |
534 notation. | |
535 | |
536 STRING | |
537 matches string STRING literally. | |
538 | |
539 CHAR | |
540 matches character CHAR literally. | |
541 | |
542 `not-newline' | |
543 matches any character except a newline. | |
544 . | |
545 `anything' | |
546 matches any character | |
547 | |
548 `(any SET)' | |
549 matches any character in SET. SET may be a character or string. | |
550 Ranges of characters can be specified as `A-Z' in strings. | |
551 | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
552 '(in SET)' |
39516 | 553 like `any'. |
554 | |
555 `(not (any SET))' | |
556 matches any character not in SET | |
557 | |
558 `line-start' | |
559 matches the empty string, but only at the beginning of a line | |
560 in the text being matched | |
561 | |
562 `line-end' | |
563 is similar to `line-start' but matches only at the end of a line | |
564 | |
565 `string-start' | |
566 matches the empty string, but only at the beginning of the | |
567 string being matched against. | |
568 | |
569 `string-end' | |
570 matches the empty string, but only at the end of the | |
571 string being matched against. | |
572 | |
573 `buffer-start' | |
574 matches the empty string, but only at the beginning of the | |
575 buffer being matched against. | |
576 | |
577 `buffer-end' | |
578 matches the empty string, but only at the end of the | |
579 buffer being matched against. | |
580 | |
581 `point' | |
582 matches the empty string, but only at point. | |
583 | |
584 `word-start' | |
585 matches the empty string, but only at the beginning or end of a | |
586 word. | |
587 | |
588 `word-end' | |
589 matches the empty string, but only at the end of a word. | |
590 | |
591 `word-boundary' | |
592 matches the empty string, but only at the beginning or end of a | |
593 word. | |
594 | |
595 `(not word-boundary)' | |
596 matches the empty string, but not at the beginning or end of a | |
597 word. | |
598 | |
599 `digit' | |
600 matches 0 through 9. | |
601 | |
602 `control' | |
603 matches ASCII control characters. | |
604 | |
605 `hex-digit' | |
606 matches 0 through 9, a through f and A through F. | |
607 | |
608 `blank' | |
609 matches space and tab only. | |
610 | |
611 `graphic' | |
612 matches graphic characters--everything except ASCII control chars, | |
613 space, and DEL. | |
614 | |
615 `printing' | |
616 matches printing characters--everything except ASCII control chars | |
617 and DEL. | |
618 | |
619 `alphanumeric' | |
620 matches letters and digits. (But at present, for multibyte characters, | |
621 it matches anything that has word syntax.) | |
622 | |
623 `letter' | |
624 matches letters. (But at present, for multibyte characters, | |
625 it matches anything that has word syntax.) | |
626 | |
627 `ascii' | |
628 matches ASCII (unibyte) characters. | |
629 | |
630 `nonascii' | |
631 matches non-ASCII (multibyte) characters. | |
632 | |
633 `lower' | |
634 matches anything lower-case. | |
635 | |
636 `upper' | |
637 matches anything upper-case. | |
638 | |
639 `punctuation' | |
640 matches punctuation. (But at present, for multibyte characters, | |
641 it matches anything that has non-word syntax.) | |
642 | |
643 `space' | |
644 matches anything that has whitespace syntax. | |
645 | |
646 `word' | |
647 matches anything that has word syntax. | |
648 | |
649 `(syntax SYNTAX)' | |
650 matches a character with syntax SYNTAX. SYNTAX must be one | |
651 of the following symbols. | |
652 | |
653 `whitespace' (\\s- in string notation) | |
654 `punctuation' (\\s.) | |
655 `word' (\\sw) | |
656 `symbol' (\\s_) | |
657 `open-parenthesis' (\\s() | |
658 `close-parenthesis' (\\s)) | |
659 `expression-prefix' (\\s') | |
660 `string-quote' (\\s\") | |
661 `paired-delimiter' (\\s$) | |
662 `escape' (\\s\\) | |
663 `character-quote' (\\s/) | |
664 `comment-start' (\\s<) | |
665 `comment-end' (\\s>) | |
666 | |
667 `(not (syntax SYNTAX))' | |
668 matches a character that has not syntax SYNTAX. | |
669 | |
670 `(category CATEGORY)' | |
671 matches a character with category CATEGORY. CATEGORY must be | |
672 either a character to use for C, or one of the following symbols. | |
673 | |
674 `consonant' (\\c0 in string notation) | |
675 `base-vowel' (\\c1) | |
676 `upper-diacritical-mark' (\\c2) | |
677 `lower-diacritical-mark' (\\c3) | |
678 `tone-mark' (\\c4) | |
679 `symbol' (\\c5) | |
680 `digit' (\\c6) | |
681 `vowel-modifying-diacritical-mark' (\\c7) | |
682 `vowel-sign' (\\c8) | |
683 `semivowel-lower' (\\c9) | |
684 `not-at-end-of-line' (\\c<) | |
685 `not-at-beginning-of-line' (\\c>) | |
686 `alpha-numeric-two-byte' (\\cA) | |
687 `chinse-two-byte' (\\cC) | |
688 `greek-two-byte' (\\cG) | |
689 `japanese-hiragana-two-byte' (\\cH) | |
690 `indian-tow-byte' (\\cI) | |
691 `japanese-katakana-two-byte' (\\cK) | |
692 `korean-hangul-two-byte' (\\cN) | |
693 `cyrillic-two-byte' (\\cY) | |
694 `ascii' (\\ca) | |
695 `arabic' (\\cb) | |
696 `chinese' (\\cc) | |
697 `ethiopic' (\\ce) | |
698 `greek' (\\cg) | |
699 `korean' (\\ch) | |
700 `indian' (\\ci) | |
701 `japanese' (\\cj) | |
702 `japanese-katakana' (\\ck) | |
703 `latin' (\\cl) | |
704 `lao' (\\co) | |
705 `tibetan' (\\cq) | |
706 `japanese-roman' (\\cr) | |
707 `thai' (\\ct) | |
708 `vietnamese' (\\cv) | |
709 `hebrew' (\\cw) | |
710 `cyrillic' (\\cy) | |
711 `can-break' (\\c|) | |
712 | |
713 `(not (category CATEGORY))' | |
714 matches a character that has not category CATEGORY. | |
715 | |
716 `(and SEXP1 SEXP2 ...)' | |
717 matches what SEXP1 matches, followed by what SEXP2 matches, etc. | |
718 | |
719 `(submatch SEXP1 SEXP2 ...)' | |
720 like `and', but makes the match accessible with `match-end', | |
721 `match-beginning', and `match-string'. | |
722 | |
723 `(group SEXP1 SEXP2 ...)' | |
724 another name for `submatch'. | |
725 | |
726 `(or SEXP1 SEXP2 ...)' | |
727 matches anything that matches SEXP1 or SEXP2, etc. If all | |
728 args are strings, use `regexp-opt' to optimize the resulting | |
729 regular expression. | |
730 | |
731 `(minimal-match SEXP)' | |
732 produce a non-greedy regexp for SEXP. Normally, regexps matching | |
733 zero or more occurrances of something are \"greedy\" in that they | |
734 match as much as they can, as long as the overall regexp can | |
735 still match. A non-greedy regexp matches as little as possible. | |
736 | |
737 `(maximal-match SEXP)' | |
47257 | 738 produce a greedy regexp for SEXP. This is the default. |
39516 | 739 |
740 `(zero-or-more SEXP)' | |
741 matches zero or more occurrences of what SEXP matches. | |
742 | |
743 `(0+ SEXP)' | |
744 like `zero-or-more'. | |
745 | |
746 `(* SEXP)' | |
747 like `zero-or-more', but always produces a greedy regexp. | |
748 | |
749 `(*? SEXP)' | |
750 like `zero-or-more', but always produces a non-greedy regexp. | |
751 | |
752 `(one-or-more SEXP)' | |
753 matches one or more occurrences of A. | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
754 |
39516 | 755 `(1+ SEXP)' |
756 like `one-or-more'. | |
757 | |
758 `(+ SEXP)' | |
759 like `one-or-more', but always produces a greedy regexp. | |
760 | |
761 `(+? SEXP)' | |
762 like `one-or-more', but always produces a non-greedy regexp. | |
763 | |
764 `(zero-or-one SEXP)' | |
765 matches zero or one occurrences of A. | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48938
diff
changeset
|
766 |
39516 | 767 `(optional SEXP)' |
768 like `zero-or-one'. | |
769 | |
770 `(? SEXP)' | |
771 like `zero-or-one', but always produces a greedy regexp. | |
772 | |
773 `(?? SEXP)' | |
774 like `zero-or-one', but always produces a non-greedy regexp. | |
775 | |
776 `(repeat N SEXP)' | |
777 matches N occurrences of what SEXP matches. | |
778 | |
779 `(repeat N M SEXP)' | |
780 matches N to M occurrences of what SEXP matches. | |
781 | |
782 `(eval FORM)' | |
47257 | 783 evaluate FORM and insert result. If result is a string, |
39516 | 784 `regexp-quote' it. |
785 | |
786 `(regexp REGEXP)' | |
787 include REGEXP in string notation in the result." | |
788 | |
789 `(rx-to-string ',regexp)) | |
790 | |
791 | |
792 (provide 'rx) | |
793 | |
794 ;;; rx.el ends here |