Function: regexp-opt-group

regexp-opt-group is a byte-compiled function defined in regexp-opt.el.gz.

Signature

(regexp-opt-group STRINGS &optional PAREN LAX)

Documentation

Return a regexp to match a string in the sorted list 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. Merges keywords to avoid backtracking in Emacs's regexp matcher.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/regexp-opt.el.gz
;;; Workhorse functions.

(defun regexp-opt-group (strings &optional paren lax)
  "Return a regexp to match a string in the sorted list 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.
Merges keywords to avoid backtracking in Emacs's regexp matcher."
  ;; 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 ((stringp paren) paren) (paren "\\(?:") (t "")))
	 (close-group (if paren "\\)" ""))
	 (open-charset (if lax "" open-group))
	 (close-charset (if lax "" close-group)))
    (cond
     ;;
     ;; If there are no strings, just return the empty string.
     ((= (length strings) 0)
      "")
     ;;
     ;; If there is only one string, just return it.
     ((= (length strings) 1)
      (if (= (length (car strings)) 1)
	  (concat open-charset (regexp-quote (car strings)) close-charset)
	(concat open-group (regexp-quote (car strings)) 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) "?"
	      close-charset))
     ;;
     ;; If there are several one-char strings, use charsets
     ((and (= (length (car strings)) 1)
	   (let ((strs (cdr strings)))
	     (while (and strs (/= (length (car strs)) 1))
	       (pop strs))
	     strs))
      (let (letters rest)
	;; Collect one-char strings
	(dolist (s strings)
	  (if (= (length s) 1) (push (string-to-char s) letters) (push s rest)))

	(if rest
	    ;; several one-char strings: take them and recurse
	    ;; on the rest (first so as to match the longest).
	    (concat open-group
		    (regexp-opt-group (nreverse rest))
		    "\\|" (regexp-opt-charset letters)
		    close-group)
	  ;; all are one-char strings: just return a character set.
	  (concat open-charset
		  (regexp-opt-charset letters)
		  close-charset))))
     ;;
     ;; We have a list of different length strings.
     (t
      (let ((prefix (try-completion "" strings)))
	(if (> (length prefix) 0)
	    ;; common prefix: take it and recurse on the suffixes.
	    (let* ((n (length prefix))
		   (suffixes (mapcar (lambda (s) (substring s n)) strings)))
	      (concat open-group
		      (regexp-quote prefix)
		      (regexp-opt-group suffixes t t)
		      close-group))

	  (let* ((sgnirts (mapcar #'reverse strings))
		 (xiffus (try-completion "" sgnirts)))
	    (if (> (length xiffus) 0)
		;; common suffix: take it and recurse on the prefixes.
		(let* ((n (- (length xiffus)))
		       (prefixes
			;; Sorting is necessary in cases such as ("ad" "d").
			(sort (mapcar (lambda (s) (substring s 0 n)) strings)
                              :in-place t)))
		  (concat open-group
			  (regexp-opt-group prefixes t t)
			  (regexp-quote (nreverse xiffus))
			  close-group))

	      ;; Otherwise, divide the list into those that start with a
	      ;; particular letter and those that do not, and recurse on them.
	      (let* ((char (substring-no-properties (car strings) 0 1))
		     (half1 (all-completions char strings))
		     (half2 (nthcdr (length half1) strings)))
		(concat open-group
			(regexp-opt-group half1)
			"\\|" (regexp-opt-group half2)
			close-group))))))))))