xemacs-base / regexp-opt.el

Diff from to


 ;; Maintainer: FSF
 ;; Keywords: strings, regexps, extensions
-;; Modified by Karl M. Hegbloom Sep. 1997 to support the new regexp syntax
-;; with shy groups. (benchmarks pending)
 ;; This file is part of XEmacs.
 ;; XEmacs is free software; you can redistribute it and/or modify
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
+;;; Synched up with: GNU Emacs 21.3 + paren-in-char-set fix from CVS
+;;;                  revision 1.25.  Some implementation differences in
+;;;                  regexp-opt-group and regexp-opt-charset but the APIs
+;;;                  are compatible and should return compatible (if not
+;;;                  exactly the same) regexps.
 ;;; Commentary:
-;; The "opt" in "regexp-opt" stands for "optim\\(al\\|i\\(se\\|ze\\)\\)".
+;; The "opt" in "regexp-opt" stands for "optim\\(?:al\\|i\\(?:se\\|ze\\)\\)".
 ;; This package generates a regexp from a given list of strings (which matches
 ;; one of those strings) so that the regexp generated by:
 ;; 		    "save-current-buffer" "save-match-data"
 ;; 		    "catch" "throw" "unwind-protect" "condition-case")))
 ;;   (concat "(" (regexp-opt strings t) "\\>"))
-;;  => "(\\(?: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\\)\\)\\>"
-;; (let ((strings '("cond" "if" "when" "unless" "while"
-;; 		    "let" "let*" "progn" "prog1" "prog2"
-;; 		    "save-restriction" "save-excursion" "save-window-excursion"
-;; 		    "save-current-buffer" "save-match-data"
-;; 		    "catch" "throw" "unwind-protect" "condition-case")))
-;;   (concat "(" (regexp-opt strings t t) "\\>"))
-;;                                     ^
-;;  => "(\\(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\\)\\)\\>"
+;;  => "(\\(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\\)\\)\\>"
 ;; Searching using the above example `regexp-opt' regexp takes approximately
 ;; two-thirds of the time taken using the equivalent `mapconcat' regexp.
 ;; your code for such changes to have effect in your code.
 ;; Originally written for font-lock.el, from an idea from Stig's hl319.el, with
-;; thanks for ideas also to Michael Ernst, Bob Glickstein and Dan Nicolaescu.
-;; Please don't tell me that it doesn't produce optimal regexps; I know that
-;; already.  For example, the above explanation for the meaning of "opt" would
-;; be more efficient as "optim\\(al\\|i[sz]e\\)", but this requires complex
-;; forward looking.  But (ideas or) code to improve things (are) is welcome.
+;; thanks for ideas also to Michael Ernst, Bob Glickstein, Dan Nicolaescu and
+;; Stefan Monnier.
+;; No doubt `regexp-opt' doesn't always produce optimal regexps, so code, ideas
+;; or any other information to improve things are welcome.
+;; One possible improvement would be to compile '("aa" "ab" "ba" "bb")
+;; into "[ab][ab]" rather than "a[ab]\\|b[ab]".  I'm not sure it's worth
+;; it but if someone knows how to do it without going through too many
+;; contortions, I'm all ears.
 ;;; Code:
-(defun regexp-opt (strings &optional paren non-shy)
+(defun regexp-opt (strings &optional paren)
   "Return a regexp to match a string in STRINGS.
 Each string should be unique in STRINGS and should not contain any regexps,
 quoted or not.  If optional PAREN is non-nil, ensure that the returned regexp
-is enclosed by at least one regexp match grouping construct.  If optional
-NON-SHY is non nil, the inner groupings will use \"\\\\( \\\\)\" grouping,
-rather than the default \"\\\\(?: \\\\)\" 'shy', or non-match-capturing groups.
+is enclosed by at least one regexp grouping construct.
 The returned regexp is typically more efficient than the equivalent regexp:
- (let ((open-paren (if PAREN \"\\\\(\" \"\")) (close-paren (if PAREN \"\\\\)\" \"\")))
-   (concat open-paren (mapconcat 'regexp-quote STRINGS \"\\\\|\") close-paren))
-but typically contains more regexp grouping constructs.
-Use `regexp-opt-depth' to count them.
+ (let ((open (if PAREN \"\\\\(\" \"\")) (close (if PAREN \"\\\\)\" \"\")))
+   (concat open (mapconcat 'regexp-quote STRINGS \"\\\\|\") close))
 If PAREN is `words', then the resulting regexp is additionally surrounded
 by \\=\\< and \\>."
     (let* ((max-lisp-eval-depth (* 1024 1024))
 	   (completion-ignore-case nil)
 	   (words (eq paren 'words))
+	   (open (cond ((stringp paren) paren) (paren "\\(")))
 	   (sorted-strings (sort (copy-sequence strings) 'string-lessp))
-	   (re (regexp-opt-group sorted-strings paren nil non-shy)))
+	   (re (regexp-opt-group sorted-strings open)))
       (if words (concat "\\<" re "\\>") re))))
+(defconst regexp-opt-not-groupie*-re
+  (let* ((harmless-ch "[^\\\\[]")
+         (esc-pair-not-lp "\\\\[^(]")
+         (class-harmless-ch "[^][]")
+         (class-lb-harmless "[^]:]")
+         (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?")
+         (class-lb (concat "\\[\\(" class-lb-harmless
+                           "\\|" class-lb-colon-maybe-charclass "\\)"))
+         (class
+          (concat "\\[^?]?"
+                  "\\(" class-harmless-ch
+                  "\\|" class-lb "\\)*"
+                  "\\[?]"))         ; special handling for bare [ at end of re
+         (shy-lp "\\\\(\\?:"))
+    (concat "\\(" harmless-ch "\\|" esc-pair-not-lp
+            "\\|" class "\\|" shy-lp "\\)*"))
+  "Matches any part of a regular expression EXCEPT for non-shy \"\\\\(\"s")
-(defun regexp-opt-depth (regexp &optional count-shy-groups-too)
+(defun regexp-opt-depth (regexp)
   "Return the depth of REGEXP.
-This means the number of regexp grouping constructs (parenthesised
-expressions) in REGEXP, not counting the \"\\\\(?: \\\\)\"
-non-match-capturing groups unless COUNT-SHY-GROUPS-TOO is non-nil.
-See `regexp-opt'."
+This means the number of regexp grouping constructs (parenthesised expressions)
+in REGEXP."
     ;; Hack to signal an error if REGEXP does not have balanced parentheses.
     (string-match regexp "")
     ;; Count the number of open parentheses in REGEXP.
-    (let ((max (1- (length regexp)))
-          (count 0) start)
-      (while (string-match "\\\\(" regexp start)
-        (setq start (match-end 0))
-        (when (or count-shy-groups-too
-                  (not (string= (substring regexp start (min (+ start 2) max)) "?:")))
-          (setq count (1+ count))))
+    (let ((count 0) start)
+      (while
+          (progn
+            (string-match regexp-opt-not-groupie*-re regexp start)
+            (setq start ( + (match-end 0) 2))  ; +2 for "\\(" after match-end.
+            (<= start (length regexp)))
+        (setq count (1+ count)))
 ;;; Workhorse functions.
   (require 'cl))
-(unless (fboundp 'make-bool-vector)
-  (defalias 'make-bool-vector 'make-vector))
-(defun regexp-opt-group (strings &optional paren lax non-shy)
+(defun regexp-opt-group (strings &optional paren lax)
   "Return a regexp to match a string in STRINGS.
 If PAREN non-nil, output regexp parentheses around returned regexp.
 If LAX non-nil, don't output parentheses if it doesn't require them.
-If NON-SHY non-nil, don't use \\(?: \\) shy groups, use match capturing ones.
 Merges keywords to avoid backtracking in Emacs' regexp matcher.
-The basic idea is to find the shortest common prefix, remove it
+The basic idea is to find the shortest common prefix or suffix, remove it
 and recurse.  If there is no prefix, we divide the list into two so that
 \(at least) one half will have at least a one-character common prefix.
 Also we delay the addition of grouping parenthesis as long as possible
 until we're sure we need them, and try to remove one-character sequences
 so we can use character sets rather than grouping parenthesis."
-  (let* ((open-group (cond
-                       ((and paren non-shy) "\\(")
-                       (paren "\\(?:")
-                       (t "")))
+  (let* ((open-group (cond ((stringp paren) paren) (paren "\\(?:") (t "")))
 	 (close-group (if paren "\\)" ""))
 	 (open-charset (if lax "" open-group))
 	 (close-charset (if lax "" close-group)))
      ;; If there is an empty string, remove it and recurse on the rest.
      ((= (length (car strings)) 0)
       (concat open-charset
-	      (regexp-opt-group (cdr strings) t t non-shy) "?"
+	      (regexp-opt-group (cdr strings) t t) "?"
      ;; If all are one-character strings, just return a character set.
 	  (let* ((length (length prefix))
 		 (suffixes (mapcar (lambda (s) (substring s length)) strings)))
 	    (concat open-group
-		    (regexp-quote prefix) (regexp-opt-group suffixes t t non-shy)
+		    (regexp-quote prefix) (regexp-opt-group suffixes t t)
 	 ;; If there are several one-character strings, remove them and recurse
 	  (let ((rest (let ((completion-regexp-list '("^..+$")))
 			(all-completions "" (mapcar 'list strings)))))
 	    (concat open-group
-		    (regexp-opt-group rest nil nil non-shy) "\\|" (regexp-opt-charset letters)
+		    (regexp-opt-group rest) "\\|" (regexp-opt-charset letters)
 	 ;; Otherwise, divide the list into those that start with a particular
 		 (half1 (all-completions char (mapcar 'list strings)))
 		 (half2 (nthcdr (length half1) strings)))
 	    (concat open-group
-		    (regexp-opt-group half1 nil nil non-shy) "\\|" (regexp-opt-group half2 nil nil non-shy)
+		    (regexp-opt-group half1) "\\|" (regexp-opt-group half2)
 (defun regexp-opt-charset (chars)