Mercurial > emacs
annotate lisp/emacs-lisp/regexp-opt.el @ 54283:d0c3cadb7e21
(help-at-pt-timer-delay): Minor doc fix (remove stray space).
author | Luc Teirlinck <teirllm@auburn.edu> |
---|---|
date | Fri, 05 Mar 2004 04:42:46 +0000 |
parents | 695cf19ef79e |
children | da163770bb89 375f2633d815 |
rev | line source |
---|---|
38412
253f761ad37b
Some fixes to follow coding conventions in files maintained by FSF.
Pavel Janík <Pavel@Janik.cz>
parents:
33209
diff
changeset
|
1 ;;; regexp-opt.el --- generate efficient regexps to match strings |
18014 | 2 |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
3 ;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc. |
18014 | 4 |
25278 | 5 ;; Author: Simon Marshall <simon@gnu.org> |
27589 | 6 ;; Maintainer: FSF |
28420 | 7 ;; Keywords: strings, regexps, extensions |
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. |
2fec7f622b82
emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents:
18014
diff
changeset
|
51 |
18014 | 52 ;; Since this package was written to produce efficient regexps, not regexps |
53 ;; efficiently, it is probably not a good idea to in-line too many calls in | |
54 ;; your code, unless you use the following trick with `eval-when-compile': | |
55 ;; | |
56 ;; (defvar definition-regexp | |
57 ;; (eval-when-compile | |
58 ;; (concat "^(" | |
59 ;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias" | |
60 ;; "defvar" "defconst") t) | |
61 ;; "\\>"))) | |
62 ;; | |
63 ;; The `byte-compile' code will be as if you had defined the variable thus: | |
64 ;; | |
65 ;; (defvar definition-regexp | |
66 ;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>") | |
67 ;; | |
18149
2fec7f622b82
emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents:
18014
diff
changeset
|
68 ;; 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
|
69 ;; `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
|
70 ;; 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
|
71 ;; 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
|
72 ;; 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
|
73 ;; 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
|
74 |
2fec7f622b82
emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents:
18014
diff
changeset
|
75 ;; 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
|
76 ;; 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
|
77 ;; Stefan Monnier. |
6f591e2d9c0d
(regexp-opt-try-suffix): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
25278
diff
changeset
|
78 ;; 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
|
79 ;; or any other information to improve things are welcome. |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
80 ;; |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
81 ;; One possible improvement would be to compile '("aa" "ab" "ba" "bb") |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
82 ;; into "[ab][ab]" rather than "a[ab]\\|b[ab]". I'm not sure it's worth |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
83 ;; it but if someone knows how to do it without going through too many |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
84 ;; contortions, I'm all ears. |
18014 | 85 |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
86 ;;; Code: |
18014 | 87 |
88 ;;;###autoload | |
89 (defun regexp-opt (strings &optional paren) | |
90 "Return a regexp to match a string in STRINGS. | |
19782 | 91 Each string should be unique in STRINGS and should not contain any regexps, |
92 quoted or not. If optional PAREN is non-nil, ensure that the returned regexp | |
93 is enclosed by at least one regexp grouping construct. | |
18014 | 94 The returned regexp is typically more efficient than the equivalent regexp: |
95 | |
32304
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
96 (let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\"))) |
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
97 (concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close)) |
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
98 |
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
99 If PAREN is `words', then the resulting regexp is additionally surrounded |
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
100 by \\=\\< and \\>." |
18014 | 101 (save-match-data |
102 ;; Recurse on the sorted list. | |
32304
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
103 (let* ((max-lisp-eval-depth (* 1024 1024)) |
42625
ad0233037e24
(regexp-opt): Bind max-specpdl-size.
Richard M. Stallman <rms@gnu.org>
parents:
41754
diff
changeset
|
104 (max-specpdl-size (* 1024 1024)) |
32304
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
105 (completion-ignore-case nil) |
41754
e78fbcf9b878
(regexp-opt): Bind completion-regexp-list to nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41617
diff
changeset
|
106 (completion-regexp-list nil) |
32304
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
107 (words (eq paren 'words)) |
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
108 (open (cond ((stringp paren) paren) (paren "\\("))) |
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
109 (sorted-strings (sort (copy-sequence strings) 'string-lessp)) |
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
110 (re (regexp-opt-group sorted-strings open))) |
e8fca08bb4cc
(regexp-opt): Add \< and \> if PAREN=`words'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32041
diff
changeset
|
111 (if words (concat "\\<" re "\\>") re)))) |
18014 | 112 |
50713
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
113 (defconst regexp-opt-not-groupie*-re |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
114 (let* ((harmless-ch "[^\\\\[]") |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
115 (esc-pair-not-lp "\\\\[^(]") |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
116 (class-harmless-ch "[^][]") |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
117 (class-lb-harmless "[^]:]") |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
118 (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?") |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
119 (class-lb (concat "\\[\\(" class-lb-harmless |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
120 "\\|" class-lb-colon-maybe-charclass "\\)")) |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
121 (class |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
122 (concat "\\[^?]?" |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
123 "\\(" class-harmless-ch |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
124 "\\|" class-lb "\\)*" |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
125 "\\[?]")) ; special handling for bare [ at end of re |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
126 (shy-lp "\\\\(\\?:")) |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
127 (concat "\\(" harmless-ch "\\|" esc-pair-not-lp |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
128 "\\|" class "\\|" shy-lp "\\)*")) |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
129 "Matches any part of a regular expression EXCEPT for non-shy \"\\\\(\"s") |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
130 |
18014 | 131 ;;;###autoload |
132 (defun regexp-opt-depth (regexp) | |
133 "Return the depth of REGEXP. | |
134 This means the number of regexp grouping constructs (parenthesised expressions) | |
135 in REGEXP." | |
136 (save-match-data | |
137 ;; Hack to signal an error if REGEXP does not have balanced parentheses. | |
138 (string-match regexp "") | |
139 ;; Count the number of open parentheses in REGEXP. | |
140 (let ((count 0) start) | |
50713
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
141 (while |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
142 (progn |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
143 (string-match regexp-opt-not-groupie*-re regexp start) |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
144 (setq start ( + (match-end 0) 2)) ; +2 for "\\(" after match-end. |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
145 (<= start (length regexp))) |
645707022f8f
(regexp-opt-depth): Don't count a "//(" which appears inside a character set.
Juanma Barranquero <lekktu@gmail.com>
parents:
49598
diff
changeset
|
146 (setq count (1+ count))) |
18014 | 147 count))) |
148 | |
149 ;;; Workhorse functions. | |
150 | |
151 (eval-when-compile | |
152 (require 'cl)) | |
153 | |
154 (defun regexp-opt-group (strings &optional paren lax) | |
49352
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
155 ;; Return a regexp to match a string in the sorted list STRINGS. |
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
156 ;; If PAREN non-nil, output regexp parentheses around returned regexp. |
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
157 ;; If LAX non-nil, don't output parentheses if it doesn't require them. |
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
158 ;; Merges keywords to avoid backtracking in Emacs' regexp matcher. |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
159 |
49352
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
160 ;; The basic idea is to find the shortest common prefix or suffix, remove it |
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
161 ;; and recurse. If there is no prefix, we divide the list into two so that |
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
162 ;; \(at least) one half will have at least a one-character common prefix. |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
163 |
49352
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
164 ;; Also we delay the addition of grouping parenthesis as long as possible |
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
165 ;; until we're sure we need them, and try to remove one-character sequences |
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
166 ;; so we can use character sets rather than grouping parenthesis. |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
167 (let* ((open-group (cond ((stringp paren) paren) (paren "\\(?:") (t ""))) |
18014 | 168 (close-group (if paren "\\)" "")) |
169 (open-charset (if lax "" open-group)) | |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
170 (close-charset (if lax "" close-group))) |
18014 | 171 (cond |
25938
6f591e2d9c0d
(regexp-opt-try-suffix): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
25278
diff
changeset
|
172 ;; |
6f591e2d9c0d
(regexp-opt-try-suffix): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
25278
diff
changeset
|
173 ;; 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
|
174 ((= (length strings) 0) |
6f591e2d9c0d
(regexp-opt-try-suffix): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
25278
diff
changeset
|
175 "") |
6f591e2d9c0d
(regexp-opt-try-suffix): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
25278
diff
changeset
|
176 ;; |
18014 | 177 ;; If there is only one string, just return it. |
178 ((= (length strings) 1) | |
179 (if (= (length (car strings)) 1) | |
180 (concat open-charset (regexp-quote (car strings)) close-charset) | |
181 (concat open-group (regexp-quote (car strings)) close-group))) | |
182 ;; | |
183 ;; If there is an empty string, remove it and recurse on the rest. | |
184 ((= (length (car strings)) 0) | |
185 (concat open-charset | |
186 (regexp-opt-group (cdr strings) t t) "?" | |
187 close-charset)) | |
188 ;; | |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
189 ;; If there are several one-char strings, use charsets |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
190 ((and (= (length (car strings)) 1) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
191 (let ((strs (cdr strings))) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
192 (while (and strs (/= (length (car strs)) 1)) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
193 (pop strs)) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
194 strs)) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
195 (let (letters rest) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
196 ;; Collect one-char strings |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
197 (dolist (s strings) |
30719
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
198 (if (= (length s) 1) (push (string-to-char s) letters) (push s rest))) |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
199 |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
200 (if rest |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
201 ;; several one-char strings: take them and recurse |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
202 ;; on the rest (first so as to match the longest). |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
203 (concat open-group |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
204 (regexp-opt-group (nreverse rest)) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
205 "\\|" (regexp-opt-charset letters) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
206 close-group) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
207 ;; all are one-char strings: just return a character set. |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
208 (concat open-charset |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
209 (regexp-opt-charset letters) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
210 close-charset)))) |
18014 | 211 ;; |
212 ;; We have a list of different length strings. | |
213 (t | |
45905
20781c152651
(regexp-opt-group): Don't cons uselessly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
42625
diff
changeset
|
214 (let ((prefix (try-completion "" strings))) |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
215 (if (> (length prefix) 0) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
216 ;; common prefix: take it and recurse on the suffixes. |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
217 (let* ((n (length prefix)) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
218 (suffixes (mapcar (lambda (s) (substring s n)) strings))) |
32041
a055173cadf8
(regexp-opt-group): Put more parenthesis.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30719
diff
changeset
|
219 (concat open-group |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
220 (regexp-quote prefix) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
221 (regexp-opt-group suffixes t t) |
32041
a055173cadf8
(regexp-opt-group): Put more parenthesis.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30719
diff
changeset
|
222 close-group)) |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
223 |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
224 (let* ((sgnirts (mapcar (lambda (s) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
225 (concat (nreverse (string-to-list s)))) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
226 strings)) |
45905
20781c152651
(regexp-opt-group): Don't cons uselessly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
42625
diff
changeset
|
227 (xiffus (try-completion "" sgnirts))) |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
228 (if (> (length xiffus) 0) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
229 ;; common suffix: take it and recurse on the prefixes. |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
230 (let* ((n (- (length xiffus))) |
33209
f94f82069336
(regexp-opt-group): Sort the strings when extracting a suffix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32304
diff
changeset
|
231 (prefixes |
f94f82069336
(regexp-opt-group): Sort the strings when extracting a suffix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32304
diff
changeset
|
232 ;; Sorting is necessary in cases such as ("ad" "d"). |
f94f82069336
(regexp-opt-group): Sort the strings when extracting a suffix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32304
diff
changeset
|
233 (sort (mapcar (lambda (s) (substring s 0 n)) strings) |
f94f82069336
(regexp-opt-group): Sort the strings when extracting a suffix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32304
diff
changeset
|
234 'string-lessp))) |
32041
a055173cadf8
(regexp-opt-group): Put more parenthesis.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30719
diff
changeset
|
235 (concat open-group |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
236 (regexp-opt-group prefixes t t) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
237 (regexp-quote |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
238 (concat (nreverse (string-to-list xiffus)))) |
32041
a055173cadf8
(regexp-opt-group): Put more parenthesis.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
30719
diff
changeset
|
239 close-group)) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49352
diff
changeset
|
240 |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
241 ;; Otherwise, divide the list into those that start with a |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
242 ;; particular letter and those that do not, and recurse on them. |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
243 (let* ((char (char-to-string (string-to-char (car strings)))) |
45905
20781c152651
(regexp-opt-group): Don't cons uselessly.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
42625
diff
changeset
|
244 (half1 (all-completions char strings)) |
49352
8bfc6a0f6b3e
(regexp-opt-group): Undo last change. Fix the docstring instead.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49335
diff
changeset
|
245 (half2 (nthcdr (length half1) strings))) |
28067
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
246 (concat open-group |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
247 (regexp-opt-group half1) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
248 "\\|" (regexp-opt-group half2) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
249 close-group)))))))))) |
e09db52da018
Update copyright and leading comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27589
diff
changeset
|
250 |
18014 | 251 |
252 (defun regexp-opt-charset (chars) | |
253 ;; | |
254 ;; Return a regexp to match a character in CHARS. | |
255 ;; | |
256 ;; The basic idea is to find character ranges. Also we take care in the | |
257 ;; position of character set meta characters in the character set regexp. | |
258 ;; | |
30719
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
259 (let* ((charmap (make-char-table 'case-table)) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
260 (start -1) (end -2) |
18014 | 261 (charset "") |
262 (bracket "") (dash "") (caret "")) | |
263 ;; | |
264 ;; Make a character map but extract character set meta characters. | |
30719
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
265 (dolist (char chars) |
18149
2fec7f622b82
emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents:
18014
diff
changeset
|
266 (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
|
267 (?\] |
2fec7f622b82
emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents:
18014
diff
changeset
|
268 (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
|
269 (?^ |
2fec7f622b82
emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents:
18014
diff
changeset
|
270 (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
|
271 (?- |
2fec7f622b82
emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents:
18014
diff
changeset
|
272 (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
|
273 (otherwise |
2fec7f622b82
emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents:
18014
diff
changeset
|
274 (aset charmap char t)))) |
18014 | 275 ;; |
276 ;; Make a character set from the map using ranges where applicable. | |
30719
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
277 (map-char-table |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
278 (lambda (c v) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
279 (when v |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
280 (if (= (1- c) end) (setq end c) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
281 (if (> end (+ start 2)) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
282 (setq charset (format "%s%c-%c" charset start end)) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
283 (while (>= end start) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
284 (setq charset (format "%s%c" charset start)) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
285 (incf start))) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
286 (setq start c end c)))) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
287 charmap) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
288 (when (>= end start) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
289 (if (> end (+ start 2)) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
290 (setq charset (format "%s%c-%c" charset start end)) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
291 (while (>= end start) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
292 (setq charset (format "%s%c" charset start)) |
fd7db1cf7adf
(make-bool-vector): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28864
diff
changeset
|
293 (incf start)))) |
18014 | 294 ;; |
295 ;; Make sure a caret is not first and a dash is first or last. | |
296 (if (and (string-equal charset "") (string-equal bracket "")) | |
297 (concat "[" dash caret "]") | |
298 (concat "[" bracket charset caret dash "]")))) | |
299 | |
300 (provide 'regexp-opt) | |
301 | |
52401 | 302 ;;; arch-tag: 6c5a66f4-29af-4fd6-8c3b-4b554d5b4370 |
18014 | 303 ;;; regexp-opt.el ends here |