Function: completion-pcm--merge-completions
completion-pcm--merge-completions is a byte-compiled function defined
in minibuffer.el.gz.
Signature
(completion-pcm--merge-completions STRS PATTERN)
Documentation
Extract the commonality in STRS, with the help of PATTERN.
PATTERN can contain strings and symbols chosen among star, any, point,
and prefix. They all match anything (aka ".*") but are merged differently:
any only grows from the left (when matching "a1b" and "a2b" it gets
completed to just "a").
prefix only grows from the right (when matching "a1b" and "a2b" it gets
completed to just "b").
star grows from both ends and is reified into a "*" (when matching "a1b"
and "a2b" it gets completed to "a*b").
point is like star except that it gets reified as the position of point
instead of being reified as a "*" character.
The underlying idea is that we should return a string which still matches
the same set of elements.
Source Code
;; Defined in /usr/src/emacs/lisp/minibuffer.el.gz
(defun completion-pcm--merge-completions (strs pattern)
"Extract the commonality in STRS, with the help of PATTERN.
PATTERN can contain strings and symbols chosen among `star', `any', `point',
and `prefix'. They all match anything (aka \".*\") but are merged differently:
`any' only grows from the left (when matching \"a1b\" and \"a2b\" it gets
completed to just \"a\").
`prefix' only grows from the right (when matching \"a1b\" and \"a2b\" it gets
completed to just \"b\").
`star' grows from both ends and is reified into a \"*\" (when matching \"a1b\"
and \"a2b\" it gets completed to \"a*b\").
`point' is like `star' except that it gets reified as the position of point
instead of being reified as a \"*\" character.
The underlying idea is that we should return a string which still matches
the same set of elements."
;; When completing while ignoring case, we want to try and avoid
;; completing "fo" to "foO" when completing against "FOO" (bug#4219).
;; So we try and make sure that the string we return is all made up
;; of text from the completions rather than part from the
;; completions and part from the input.
;; FIXME: This reduces the problems of inconsistent capitalization
;; but it doesn't fully fix it: we may still end up completing
;; "fo-ba" to "foo-BAR" or "FOO-bar" when completing against
;; '("foo-barr" "FOO-BARD").
(cond
((null (cdr strs)) (list (car strs)))
(t
(let ((segmented (completion-pcm--pattern->segments (append pattern '(any))))
(ccs ())) ;Chopped completions.
;; First chop each string into the parts corresponding to each
;; non-constant element of `pattern', using regexp-matching.
(let ((re (concat (completion-pcm--segments->regex segmented t) "\\'"))
(case-fold-search completion-ignore-case))
(dolist (str strs)
(unless (string-match re str)
(error "Internal error: %s doesn't match %s" str re))
(let ((chopped ())
(last 0)
(i 1)
next)
(while (setq next (match-end i))
(push (substring str last next) chopped)
(setq last next)
(setq i (1+ i)))
(push (nreverse chopped) ccs))))
;; Then for each of those non-constant elements, extract the
;; commonality between them.
(let ((res ()))
(dolist (elem segmented)
(let ((fixed (car elem))
(wildcards (cdr elem)))
(let ((comps ()))
(dolist (cc (prog1 ccs (setq ccs nil)))
(push (car cc) comps)
(push (cdr cc) ccs))
;; Might improve the likelihood to avoid choosing
;; different capitalizations in different parts.
;; In practice, it doesn't seem to make any difference.
(setq ccs (nreverse ccs))
;; FIXED is a prefix of all of COMPS. Try to grow that prefix.
(let* ((prefix (try-completion fixed comps))
(unique (or (and (eq prefix t) (setq prefix fixed))
(and (stringp prefix)
;; If PREFIX is equal to all of COMPS,
;; then PREFIX is a unique completion.
(seq-every-p
;; PREFIX is still a prefix of all of
;; COMPS, so if COMP is the same length,
;; they're equal.
(lambda (comp)
(= (length prefix) (length comp)))
comps)))))
;; If there's only one completion, `elem' is not useful
;; any more: it can only match the empty string.
;; FIXME: in some cases, it may be necessary to turn an
;; `any' into a `star' because the surrounding context has
;; changed such that string->pattern wouldn't add an `any'
;; here any more.
(if unique
;; If the common prefix is unique, it also is a common
;; suffix, so we should add it for `prefix' elements.
(push prefix res)
;; `prefix' only wants to include the fixed part before the
;; wildcard, not the result of growing that fixed part.
(when (seq-some (lambda (elem) (eq elem 'prefix)) wildcards)
(setq prefix (substring prefix 0 (length fixed))))
(push prefix res)
;; Push all the wildcards in this stretch, to preserve `point' and
;; `star' wildcards before ELEM.
(dolist (wildcard wildcards)
(push wildcard res))
;; Extract common suffix additionally to common prefix.
;; Don't do it for `any' since it could lead to a merged
;; completion that doesn't itself match the candidates.
(when (and (seq-some (lambda (elem) (memq elem '(star point prefix))) wildcards)
;; If prefix is one of the completions, there's no
;; suffix left to find.
(not (assoc-string prefix comps t)))
(let ((suffix
(completion--common-suffix
(if (zerop (length prefix)) comps
;; Ignore the chars in the common prefix, so we
;; don't merge '("abc" "abbc") as "ab*bc".
(let ((skip (length prefix)))
(mapcar (lambda (str) (substring str skip))
comps))))))
(cl-assert (stringp suffix))
(unless (equal suffix "")
(push suffix res)))))))))
;; We return it in reverse order.
res)))))