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