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