|
2548
|
1 ;;; regexp-opt.el --- generate efficient regexps to match strings
|
|
|
2
|
|
|
3 ;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Author: Simon Marshall <simon@gnu.org>
|
|
|
6 ;; Maintainer: FSF
|
|
|
7 ;; Keywords: strings, regexps, extensions
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
11 ;; XEmacs 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 ;; XEmacs 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 XEmacs; 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
|
|
2550
|
26 ;;; Synched up with: GNU Emacs 21.3 + paren-in-char-set fix from CVS
|
|
|
27 ;;; revision 1.25. Some implementation differences in
|
|
|
28 ;;; regexp-opt-group and regexp-opt-charset but the APIs
|
|
|
29 ;;; are compatible and should return compatible (if not
|
|
|
30 ;;; exactly the same) regexps.
|
|
|
31
|
|
2548
|
32 ;;; Commentary:
|
|
|
33
|
|
2550
|
34 ;; The "opt" in "regexp-opt" stands for "optim\\(?:al\\|i\\(?:se\\|ze\\)\\)".
|
|
2548
|
35 ;;
|
|
|
36 ;; This package generates a regexp from a given list of strings (which matches
|
|
|
37 ;; one of those strings) so that the regexp generated by:
|
|
|
38 ;;
|
|
|
39 ;; (regexp-opt strings)
|
|
|
40 ;;
|
|
|
41 ;; is equivalent to, but more efficient than, the regexp generated by:
|
|
|
42 ;;
|
|
|
43 ;; (mapconcat 'regexp-quote strings "\\|")
|
|
|
44 ;;
|
|
|
45 ;; For example:
|
|
|
46 ;;
|
|
|
47 ;; (let ((strings '("cond" "if" "when" "unless" "while"
|
|
|
48 ;; "let" "let*" "progn" "prog1" "prog2"
|
|
|
49 ;; "save-restriction" "save-excursion" "save-window-excursion"
|
|
|
50 ;; "save-current-buffer" "save-match-data"
|
|
|
51 ;; "catch" "throw" "unwind-protect" "condition-case")))
|
|
|
52 ;; (concat "(" (regexp-opt strings t) "\\>"))
|
|
2550
|
53 ;; => "(\\(c\\(?:atch\\|ond\\(?:ition-case\\)?\\)\\|if\\|let\\*?\\|prog[12n]\\|save-\\(?:current-buffer\\|excursion\\|match-data\\|restriction\\|window-excursion\\)\\|throw\\|un\\(?:less\\|wind-protect\\)\\|wh\\(?:en\\|ile\\)\\)\\>"
|
|
2548
|
54 ;;
|
|
|
55 ;; Searching using the above example `regexp-opt' regexp takes approximately
|
|
|
56 ;; two-thirds of the time taken using the equivalent `mapconcat' regexp.
|
|
|
57
|
|
|
58 ;; Since this package was written to produce efficient regexps, not regexps
|
|
|
59 ;; efficiently, it is probably not a good idea to in-line too many calls in
|
|
|
60 ;; your code, unless you use the following trick with `eval-when-compile':
|
|
|
61 ;;
|
|
|
62 ;; (defvar definition-regexp
|
|
|
63 ;; (eval-when-compile
|
|
|
64 ;; (concat "^("
|
|
|
65 ;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias"
|
|
|
66 ;; "defvar" "defconst") t)
|
|
|
67 ;; "\\>")))
|
|
|
68 ;;
|
|
|
69 ;; The `byte-compile' code will be as if you had defined the variable thus:
|
|
|
70 ;;
|
|
|
71 ;; (defvar definition-regexp
|
|
|
72 ;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>")
|
|
|
73 ;;
|
|
|
74 ;; Note that if you use this trick for all instances of `regexp-opt' and
|
|
|
75 ;; `regexp-opt-depth' in your code, regexp-opt.el would only have to be loaded
|
|
|
76 ;; at compile time. But note also that using this trick means that should
|
|
|
77 ;; regexp-opt.el be changed, perhaps to fix a bug or to add a feature to
|
|
|
78 ;; improve the efficiency of `regexp-opt' regexps, you would have to recompile
|
|
|
79 ;; your code for such changes to have effect in your code.
|
|
|
80
|
|
|
81 ;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with
|
|
2550
|
82 ;; thanks for ideas also to Michael Ernst, Bob Glickstein, Dan Nicolaescu and
|
|
|
83 ;; Stefan Monnier.
|
|
|
84 ;; No doubt `regexp-opt' doesn't always produce optimal regexps, so code, ideas
|
|
|
85 ;; or any other information to improve things are welcome.
|
|
|
86 ;;
|
|
|
87 ;; One possible improvement would be to compile '("aa" "ab" "ba" "bb")
|
|
|
88 ;; into "[ab][ab]" rather than "a[ab]\\|b[ab]". I'm not sure it's worth
|
|
|
89 ;; it but if someone knows how to do it without going through too many
|
|
|
90 ;; contortions, I'm all ears.
|
|
2548
|
91
|
|
|
92 ;;; Code:
|
|
|
93
|
|
|
94 ;;;###autoload
|
|
2550
|
95 (defun regexp-opt (strings &optional paren)
|
|
2548
|
96 "Return a regexp to match a string in STRINGS.
|
|
|
97 Each string should be unique in STRINGS and should not contain any regexps,
|
|
|
98 quoted or not. If optional PAREN is non-nil, ensure that the returned regexp
|
|
2550
|
99 is enclosed by at least one regexp grouping construct.
|
|
2548
|
100 The returned regexp is typically more efficient than the equivalent regexp:
|
|
|
101
|
|
2550
|
102 (let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\")))
|
|
|
103 (concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close))
|
|
2548
|
104
|
|
|
105 If PAREN is `words', then the resulting regexp is additionally surrounded
|
|
|
106 by \\=\\< and \\>."
|
|
|
107 (save-match-data
|
|
|
108 ;; Recurse on the sorted list.
|
|
|
109 (let* ((max-lisp-eval-depth (* 1024 1024))
|
|
|
110 (completion-ignore-case nil)
|
|
|
111 (words (eq paren 'words))
|
|
2550
|
112 (open (cond ((stringp paren) paren) (paren "\\(")))
|
|
2548
|
113 (sorted-strings (sort (copy-sequence strings) 'string-lessp))
|
|
2550
|
114 (re (regexp-opt-group sorted-strings open)))
|
|
2548
|
115 (if words (concat "\\<" re "\\>") re))))
|
|
|
116
|
|
2550
|
117 (defconst regexp-opt-not-groupie*-re
|
|
|
118 (let* ((harmless-ch "[^\\\\[]")
|
|
|
119 (esc-pair-not-lp "\\\\[^(]")
|
|
|
120 (class-harmless-ch "[^][]")
|
|
|
121 (class-lb-harmless "[^]:]")
|
|
|
122 (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?")
|
|
|
123 (class-lb (concat "\\[\\(" class-lb-harmless
|
|
|
124 "\\|" class-lb-colon-maybe-charclass "\\)"))
|
|
|
125 (class
|
|
|
126 (concat "\\[^?]?"
|
|
|
127 "\\(" class-harmless-ch
|
|
|
128 "\\|" class-lb "\\)*"
|
|
|
129 "\\[?]")) ; special handling for bare [ at end of re
|
|
|
130 (shy-lp "\\\\(\\?:"))
|
|
|
131 (concat "\\(" harmless-ch "\\|" esc-pair-not-lp
|
|
|
132 "\\|" class "\\|" shy-lp "\\)*"))
|
|
|
133 "Matches any part of a regular expression EXCEPT for non-shy \"\\\\(\"s")
|
|
|
134
|
|
2548
|
135 ;;;###autoload
|
|
2550
|
136 (defun regexp-opt-depth (regexp)
|
|
2548
|
137 "Return the depth of REGEXP.
|
|
2550
|
138 This means the number of regexp grouping constructs (parenthesised expressions)
|
|
|
139 in REGEXP."
|
|
2548
|
140 (save-match-data
|
|
|
141 ;; Hack to signal an error if REGEXP does not have balanced parentheses.
|
|
|
142 (string-match regexp "")
|
|
|
143 ;; Count the number of open parentheses in REGEXP.
|
|
2550
|
144 (let ((count 0) start)
|
|
|
145 (while
|
|
|
146 (progn
|
|
|
147 (string-match regexp-opt-not-groupie*-re regexp start)
|
|
|
148 (setq start ( + (match-end 0) 2)) ; +2 for "\\(" after match-end.
|
|
|
149 (<= start (length regexp)))
|
|
|
150 (setq count (1+ count)))
|
|
2548
|
151 count)))
|
|
|
152
|
|
|
153 ;;; Workhorse functions.
|
|
|
154
|
|
|
155 (eval-when-compile
|
|
|
156 (require 'cl))
|
|
|
157
|
|
2550
|
158 (defun regexp-opt-group (strings &optional paren lax)
|
|
2548
|
159 "Return a regexp to match a string in STRINGS.
|
|
|
160 If PAREN non-nil, output regexp parentheses around returned regexp.
|
|
|
161 If LAX non-nil, don't output parentheses if it doesn't require them.
|
|
|
162 Merges keywords to avoid backtracking in Emacs' regexp matcher.
|
|
|
163
|
|
2550
|
164 The basic idea is to find the shortest common prefix or suffix, remove it
|
|
2548
|
165 and recurse. If there is no prefix, we divide the list into two so that
|
|
|
166 \(at least) one half will have at least a one-character common prefix.
|
|
|
167
|
|
|
168 Also we delay the addition of grouping parenthesis as long as possible
|
|
|
169 until we're sure we need them, and try to remove one-character sequences
|
|
|
170 so we can use character sets rather than grouping parenthesis."
|
|
2550
|
171 (let* ((open-group (cond ((stringp paren) paren) (paren "\\(?:") (t "")))
|
|
2548
|
172 (close-group (if paren "\\)" ""))
|
|
|
173 (open-charset (if lax "" open-group))
|
|
|
174 (close-charset (if lax "" close-group)))
|
|
|
175 (cond
|
|
|
176 ;;
|
|
|
177 ;; If there are no strings, just return the empty string.
|
|
|
178 ((= (length strings) 0)
|
|
|
179 "")
|
|
|
180 ;;
|
|
|
181 ;; If there is only one string, just return it.
|
|
|
182 ((= (length strings) 1)
|
|
|
183 (if (= (length (car strings)) 1)
|
|
|
184 (concat open-charset (regexp-quote (car strings)) close-charset)
|
|
|
185 (concat open-group (regexp-quote (car strings)) close-group)))
|
|
|
186 ;;
|
|
|
187 ;; If there is an empty string, remove it and recurse on the rest.
|
|
|
188 ((= (length (car strings)) 0)
|
|
|
189 (concat open-charset
|
|
2550
|
190 (regexp-opt-group (cdr strings) t t) "?"
|
|
2548
|
191 close-charset))
|
|
|
192 ;;
|
|
|
193 ;; If all are one-character strings, just return a character set.
|
|
|
194 ((= (length strings) (apply '+ (mapcar 'length strings)))
|
|
|
195 (concat open-charset
|
|
|
196 (regexp-opt-charset strings)
|
|
|
197 close-charset))
|
|
|
198 ;;
|
|
|
199 ;; We have a list of different length strings.
|
|
|
200 (t
|
|
|
201 (let ((prefix (try-completion "" (mapcar 'list strings)))
|
|
|
202 (letters (let ((completion-regexp-list '("^.$")))
|
|
|
203 (all-completions "" (mapcar 'list strings)))))
|
|
|
204 (cond
|
|
|
205 ;;
|
|
|
206 ;; If there is a common prefix, remove it and recurse on the suffixes.
|
|
|
207 ((> (length prefix) 0)
|
|
|
208 (let* ((length (length prefix))
|
|
|
209 (suffixes (mapcar (lambda (s) (substring s length)) strings)))
|
|
|
210 (concat open-group
|
|
2550
|
211 (regexp-quote prefix) (regexp-opt-group suffixes t t)
|
|
2548
|
212 close-group)))
|
|
|
213 ;;
|
|
|
214 ;; If there are several one-character strings, remove them and recurse
|
|
|
215 ;; on the rest (first so the final regexp finds the longest match).
|
|
|
216 ((> (length letters) 1)
|
|
|
217 (let ((rest (let ((completion-regexp-list '("^..+$")))
|
|
|
218 (all-completions "" (mapcar 'list strings)))))
|
|
|
219 (concat open-group
|
|
2550
|
220 (regexp-opt-group rest) "\\|" (regexp-opt-charset letters)
|
|
2548
|
221 close-group)))
|
|
|
222 ;;
|
|
|
223 ;; Otherwise, divide the list into those that start with a particular
|
|
|
224 ;; letter and those that do not, and recurse on them.
|
|
|
225 (t
|
|
|
226 (let* ((char (substring (car strings) 0 1))
|
|
|
227 (half1 (all-completions char (mapcar 'list strings)))
|
|
|
228 (half2 (nthcdr (length half1) strings)))
|
|
|
229 (concat open-group
|
|
2550
|
230 (regexp-opt-group half1) "\\|" (regexp-opt-group half2)
|
|
2548
|
231 close-group)))))))))
|
|
|
232
|
|
|
233 (defun regexp-opt-charset (chars)
|
|
|
234 ;;
|
|
|
235 ;; Return a regexp to match a character in CHARS.
|
|
|
236 ;;
|
|
|
237 ;; The basic idea is to find character ranges. Also we take care in the
|
|
|
238 ;; position of character set meta characters in the character set regexp.
|
|
|
239 ;;
|
|
|
240 (let* ((charwidth 256) ; Yeah, right.
|
|
|
241 ;; XEmacs: use bit-vectors instead of bool-vectors
|
|
|
242 (charmap (make-bit-vector charwidth 0))
|
|
|
243 (charset "")
|
|
|
244 (bracket "") (dash "") (caret ""))
|
|
|
245 ;;
|
|
|
246 ;; Make a character map but extract character set meta characters.
|
|
|
247 (dolist (char (mapcar 'string-to-char chars))
|
|
|
248 (case char
|
|
|
249 (?\]
|
|
|
250 (setq bracket "]"))
|
|
|
251 (?^
|
|
|
252 (setq caret "^"))
|
|
|
253 (?-
|
|
|
254 (setq dash "-"))
|
|
|
255 (otherwise
|
|
|
256 ;; XEmacs: 1
|
|
|
257 (aset charmap char 1))))
|
|
|
258 ;;
|
|
|
259 ;; Make a character set from the map using ranges where applicable.
|
|
|
260 (dotimes (char charwidth)
|
|
|
261 (let ((start char))
|
|
|
262 (while (and (< char charwidth)
|
|
|
263 ;; XEmacs: (not (zerop ...))
|
|
|
264 (not (zerop (aref charmap char))))
|
|
|
265 (incf char))
|
|
|
266 (cond ((> char (+ start 3))
|
|
|
267 (setq charset (format "%s%c-%c" charset start (1- char))))
|
|
|
268 ((> char start)
|
|
|
269 (setq charset (format "%s%c" charset (setq char start)))))))
|
|
|
270 ;;
|
|
|
271 ;; Make sure a caret is not first and a dash is first or last.
|
|
|
272 (if (and (string-equal charset "") (string-equal bracket ""))
|
|
|
273 (concat "[" dash caret "]")
|
|
|
274 (concat "[" bracket charset caret dash "]"))))
|
|
|
275
|
|
|
276 (provide 'regexp-opt)
|
|
|
277
|
|
|
278 ;;; regexp-opt.el ends here
|
