annotate lisp/emacs-lisp/regexp-opt.el @ 23106:a0082bd79e91

(mail-hist-current-header-name): Fix test. (mail-hist-current-header-contents): Use mail-text-start.
author Karl Heuer <kwzh@gnu.org>
date Wed, 26 Aug 1998 20:26:12 +0000
parents 013cea3890cb
children d2cb43703bfb
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1 ;;; regexp-opt.el --- generate efficient regexps to match strings.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5 ;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 ;; Keywords: strings, regexps
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 ;; any later version.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
18 ;; GNU General Public License for more details.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
19
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23 ;; Boston, MA 02111-1307, USA.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
24
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 ;;; Commentary:
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
27 ;; The "opt" in "regexp-opt" stands for "optim\\(al\\|i\\(se\\|ze\\)\\)".
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
28 ;;
18149
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
29 ;; 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
30 ;; one of those strings) so that the regexp generated by:
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 ;;
18149
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
32 ;; (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
33 ;;
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
34 ;; 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
35 ;;
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
36 ;; (mapconcat 'regexp-quote strings "\\|")
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 ;; For example:
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 ;; (let ((strings '("cond" "if" "when" "unless" "while"
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41 ;; "let" "let*" "progn" "prog1" "prog2"
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
42 ;; "save-restriction" "save-excursion" "save-window-excursion"
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
43 ;; "save-current-buffer" "save-match-data"
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44 ;; "catch" "throw" "unwind-protect" "condition-case")))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 ;; (concat "(" (regexp-opt strings t) "\\>"))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 ;; => "(\\(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\\)\\)\\>"
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 ;;
18149
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
48 ;; 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
49 ;; 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
50
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 ;; Since this package was written to produce efficient regexps, not regexps
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52 ;; efficiently, it is probably not a good idea to in-line too many calls in
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
53 ;; your code, unless you use the following trick with `eval-when-compile':
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
54 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
55 ;; (defvar definition-regexp
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
56 ;; (eval-when-compile
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
57 ;; (concat "^("
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58 ;; (regexp-opt '("defun" "defsubst" "defmacro" "defalias"
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
59 ;; "defvar" "defconst") t)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
60 ;; "\\>")))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 ;; The `byte-compile' code will be as if you had defined the variable thus:
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
63 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
64 ;; (defvar definition-regexp
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
65 ;; "^(\\(def\\(alias\\|const\\|macro\\|subst\\|un\\|var\\)\\)\\>")
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 ;;
18149
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
67 ;; 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
68 ;; `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
69 ;; 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
70 ;; 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
71 ;; 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
72 ;; 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
73
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
74 ;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
75 ;; thanks for ideas also to Michael Ernst, Bob Glickstein and Dan Nicolaescu.
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 ;; Please don't tell me that it doesn't produce optimal regexps; I know that
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 ;; already. For example, the above explanation for the meaning of "opt" would
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 ;; be more efficient as "optim\\(al\\|i[sz]e\\)", but this requires complex
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 ;; forward looking. But (ideas or) code to improve things (are) is welcome.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
80
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
81 ;;; Code:
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 ;;;###autoload
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
84 (defun regexp-opt (strings &optional paren)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
85 "Return a regexp to match a string in STRINGS.
19782
013cea3890cb (regexp-opt): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 18465
diff changeset
86 Each string should be unique in STRINGS and should not contain any regexps,
013cea3890cb (regexp-opt): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 18465
diff changeset
87 quoted or not. If optional PAREN is non-nil, ensure that the returned regexp
013cea3890cb (regexp-opt): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 18465
diff changeset
88 is enclosed by at least one regexp grouping construct.
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 The returned regexp is typically more efficient than the equivalent regexp:
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90
18149
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
91 (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
92 (concat open-paren (mapconcat 'regexp-quote STRINGS \"\\\\|\") close-paren))
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93
18149
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
94 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
95 Use `regexp-opt-depth' to count them."
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 (save-match-data
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
97 ;; Recurse on the sorted list.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
98 (let ((max-lisp-eval-depth (* 1024 1024))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 (completion-ignore-case nil))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 (regexp-opt-group (sort (copy-sequence strings) 'string-lessp) paren))))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 ;;;###autoload
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 (defun regexp-opt-depth (regexp)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 "Return the depth of REGEXP.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 This means the number of regexp grouping constructs (parenthesised expressions)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 in REGEXP."
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 (save-match-data
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 ;; Hack to signal an error if REGEXP does not have balanced parentheses.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
109 (string-match regexp "")
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
110 ;; Count the number of open parentheses in REGEXP.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
111 (let ((count 0) start)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
112 (while (string-match "\\\\(" regexp start)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
113 (setq count (1+ count) start (match-end 0)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
114 count)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
115
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
116 ;;; Workhorse functions.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
117
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 (eval-when-compile
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 (require 'cl))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 (unless (fboundp 'make-bool-vector)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 (defalias 'make-bool-vector 'make-vector))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 (defun regexp-opt-group (strings &optional paren lax)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 ;; Return a regexp to match a string in STRINGS.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 ;; If PAREN non-nil, output regexp parentheses around returned regexp.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 ;; If LAX non-nil, don't output parentheses if it doesn't require them.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129 ;; Merges keywords to avoid backtracking in Emacs' regexp matcher.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 ;; The basic idea is to find the shortest common prefix, remove it and
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 ;; recurse. If there is no prefix, we divide the list into two so that (at
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 ;; least) one half will have at least a one-character common prefix.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 ;; Also we delay the addition of grouping parenthesis as long as possible
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 ;; until we're sure we need them, and try to remove one-character sequences
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 ;; so we can use character sets rather than grouping parenthesis.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139 (let* ((open-group (if paren "\\(" ""))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 (close-group (if paren "\\)" ""))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 (open-charset (if lax "" open-group))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142 (close-charset (if lax "" close-group)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 (cond
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
144 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
145 ;; If there is only one string, just return it.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 ((= (length strings) 1)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 (if (= (length (car strings)) 1)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 (concat open-charset (regexp-quote (car strings)) close-charset)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149 (concat open-group (regexp-quote (car strings)) close-group)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 ;; If there is an empty string, remove it and recurse on the rest.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
152 ((= (length (car strings)) 0)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
153 (concat open-charset
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
154 (regexp-opt-group (cdr strings) t t) "?"
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
155 close-charset))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
156 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
157 ;; If all are one-character strings, just return a character set.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
158 ((= (length strings) (apply '+ (mapcar 'length strings)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
159 (concat open-charset
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
160 (regexp-opt-charset strings)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
161 close-charset))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
162 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
163 ;; We have a list of different length strings.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164 (t
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
165 (let ((prefix (try-completion "" (mapcar 'list strings)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
166 (letters (let ((completion-regexp-list '("^.$")))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
167 (all-completions "" (mapcar 'list strings)))))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
168 (cond
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
169 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
170 ;; If there is a common prefix, remove it and recurse on the suffixes.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
171 ((> (length prefix) 0)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
172 (let* ((length (length prefix))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
173 (suffixes (mapcar (lambda (s) (substring s length)) strings)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
174 (concat open-group
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
175 (regexp-quote prefix) (regexp-opt-group suffixes t t)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
176 close-group)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
177 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
178 ;; 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
179 ;; on the rest (first so the final regexp finds the longest match).
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
180 ((> (length letters) 1)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 (let ((rest (let ((completion-regexp-list '("^..+$")))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
182 (all-completions "" (mapcar 'list strings)))))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
183 (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
184 (regexp-opt-group rest) "\\|" (regexp-opt-charset letters)
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
185 close-group)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
186 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
187 ;; Otherwise, divide the list into those that start with a particular
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
188 ;; letter and those that do not, and recurse on them.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
189 (t
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
190 (let* ((char (substring (car strings) 0 1))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
191 (half1 (all-completions char (mapcar 'list strings)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
192 (half2 (nthcdr (length half1) strings)))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
193 (concat open-group
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
194 (regexp-opt-group half1) "\\|" (regexp-opt-group half2)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
195 close-group)))))))))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
196
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
197 (defun regexp-opt-charset (chars)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
198 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
199 ;; Return a regexp to match a character in CHARS.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
200 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
201 ;; The basic idea is to find character ranges. Also we take care in the
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202 ;; position of character set meta characters in the character set regexp.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 (let* ((charwidth 256) ; Yeah, right.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 (charmap (make-bool-vector charwidth nil))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 (charset "")
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 (bracket "") (dash "") (caret ""))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 ;; 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
210 (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
211 (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
212 (?\]
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
213 (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
214 (?^
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
215 (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
216 (?-
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
217 (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
218 (otherwise
2fec7f622b82 emit charsets after strings so that the final regexp finds the longest match.
Simon Marshall <simon@gnu.org>
parents: 18014
diff changeset
219 (aset charmap char t))))
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221 ;; Make a character set from the map using ranges where applicable.
18465
4a6dd3081185 simplify.
Simon Marshall <simon@gnu.org>
parents: 18149
diff changeset
222 (dotimes (char charwidth)
4a6dd3081185 simplify.
Simon Marshall <simon@gnu.org>
parents: 18149
diff changeset
223 (let ((start char))
4a6dd3081185 simplify.
Simon Marshall <simon@gnu.org>
parents: 18149
diff changeset
224 (while (and (< char charwidth) (aref charmap char))
4a6dd3081185 simplify.
Simon Marshall <simon@gnu.org>
parents: 18149
diff changeset
225 (incf char))
4a6dd3081185 simplify.
Simon Marshall <simon@gnu.org>
parents: 18149
diff changeset
226 (cond ((> char (+ start 3))
4a6dd3081185 simplify.
Simon Marshall <simon@gnu.org>
parents: 18149
diff changeset
227 (setq charset (format "%s%c-%c" charset start (1- char))))
4a6dd3081185 simplify.
Simon Marshall <simon@gnu.org>
parents: 18149
diff changeset
228 ((> char start)
4a6dd3081185 simplify.
Simon Marshall <simon@gnu.org>
parents: 18149
diff changeset
229 (setq charset (format "%s%c" charset (setq char start)))))))
18014
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
230 ;;
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231 ;; Make sure a caret is not first and a dash is first or last.
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 (if (and (string-equal charset "") (string-equal bracket ""))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
233 (concat "[" dash caret "]")
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234 (concat "[" bracket charset caret dash "]"))))
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
236 (provide 'regexp-opt)
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237
9492b5c8485a Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
238 ;;; regexp-opt.el ends here