133 |
(require 'cl)) |
(require 'cl)) |
134 |
|
|
135 |
(defun regexp-opt-group (strings &optional paren lax) |
(defun regexp-opt-group (strings &optional paren lax) |
136 |
"Return a regexp to match a string in STRINGS. |
;; Return a regexp to match a string in the sorted list STRINGS. |
137 |
If PAREN non-nil, output regexp parentheses around returned regexp. |
;; If PAREN non-nil, output regexp parentheses around returned regexp. |
138 |
If LAX non-nil, don't output parentheses if it doesn't require them. |
;; If LAX non-nil, don't output parentheses if it doesn't require them. |
139 |
Merges keywords to avoid backtracking in Emacs' regexp matcher. |
;; Merges keywords to avoid backtracking in Emacs' regexp matcher. |
140 |
|
|
141 |
The basic idea is to find the shortest common prefix or suffix, remove it |
;; The basic idea is to find the shortest common prefix or suffix, remove it |
142 |
and recurse. If there is no prefix, we divide the list into two so that |
;; and recurse. If there is no prefix, we divide the list into two so that |
143 |
\(at least) one half will have at least a one-character common prefix. |
;; \(at least) one half will have at least a one-character common prefix. |
144 |
|
|
145 |
Also we delay the addition of grouping parenthesis as long as possible |
;; Also we delay the addition of grouping parenthesis as long as possible |
146 |
until we're sure we need them, and try to remove one-character sequences |
;; until we're sure we need them, and try to remove one-character sequences |
147 |
so we can use character sets rather than grouping parenthesis." |
;; so we can use character sets rather than grouping parenthesis. |
148 |
(let* ((open-group (cond ((stringp paren) paren) (paren "\\(?:") (t ""))) |
(let* ((open-group (cond ((stringp paren) paren) (paren "\\(?:") (t ""))) |
149 |
(close-group (if paren "\\)" "")) |
(close-group (if paren "\\)" "")) |
150 |
(open-charset (if lax "" open-group)) |
(open-charset (if lax "" open-group)) |
192 |
;; |
;; |
193 |
;; We have a list of different length strings. |
;; We have a list of different length strings. |
194 |
(t |
(t |
195 |
(let ((prefix (try-completion "" (mapcar 'list strings)))) |
(let ((prefix (try-completion "" strings))) |
196 |
(if (> (length prefix) 0) |
(if (> (length prefix) 0) |
197 |
;; common prefix: take it and recurse on the suffixes. |
;; common prefix: take it and recurse on the suffixes. |
198 |
(let* ((n (length prefix)) |
(let* ((n (length prefix)) |
205 |
(let* ((sgnirts (mapcar (lambda (s) |
(let* ((sgnirts (mapcar (lambda (s) |
206 |
(concat (nreverse (string-to-list s)))) |
(concat (nreverse (string-to-list s)))) |
207 |
strings)) |
strings)) |
208 |
(xiffus (try-completion "" (mapcar 'list sgnirts)))) |
(xiffus (try-completion "" sgnirts))) |
209 |
(if (> (length xiffus) 0) |
(if (> (length xiffus) 0) |
210 |
;; common suffix: take it and recurse on the prefixes. |
;; common suffix: take it and recurse on the prefixes. |
211 |
(let* ((n (- (length xiffus))) |
(let* ((n (- (length xiffus))) |
218 |
(regexp-quote |
(regexp-quote |
219 |
(concat (nreverse (string-to-list xiffus)))) |
(concat (nreverse (string-to-list xiffus)))) |
220 |
close-group)) |
close-group)) |
221 |
|
|
222 |
;; Otherwise, divide the list into those that start with a |
;; Otherwise, divide the list into those that start with a |
223 |
;; particular letter and those that do not, and recurse on them. |
;; particular letter and those that do not, and recurse on them. |
224 |
(let* ((char (char-to-string (string-to-char (car strings)))) |
(let* ((char (char-to-string (string-to-char (car strings)))) |
225 |
(half1 (all-completions char (mapcar 'list strings))) |
(half1 (all-completions char strings)) |
226 |
(half2 (nthcdr (length half1) strings))) |
(half2 (nthcdr (length half1) strings))) |
227 |
(concat open-group |
(concat open-group |
228 |
(regexp-opt-group half1) |
(regexp-opt-group half1) |