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 ((re (completion-pcm--pattern->regex pattern 'group))
          (ccs ()))                     ;Chopped completions.

      ;; First chop each string into the parts corresponding to each
      ;; non-constant element of `pattern', using regexp-matching.
      (let ((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)))
            ;; Add the text corresponding to the implicit trailing `any'.
            (push (substring str last) chopped)
            (push (nreverse chopped) ccs))))

      ;; Then for each of those non-constant elements, extract the
      ;; commonality between them.
      (let ((res ())
            (fixed ""))
        ;; Make the implicit trailing `any' explicit.
        (dolist (elem (append pattern '(any)))
          (if (stringp elem)
              (setq fixed (concat fixed 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))
              (let* ((prefix (try-completion fixed comps))
                     (unique (or (and (eq prefix t) (setq prefix fixed))
                                 (and (stringp prefix)
                                      (eq t (try-completion prefix comps))))))
                (unless (or (eq elem 'prefix)
                            (equal prefix ""))
                  (push prefix res))
                ;; 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.
                (unless unique
                  (push elem 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 (memq elem '(star point prefix))
                             ;; 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)))))
                (setq fixed "")))))
        ;; We return it in reverse order.
        res)))))