Function: completion-pcm--find-all-completions

completion-pcm--find-all-completions is a byte-compiled function defined in minibuffer.el.gz.

Signature

(completion-pcm--find-all-completions STRING TABLE PRED POINT &optional FILTER)

Documentation

Find all completions for STRING at POINT in TABLE, satisfying PRED.

POINT is a position inside STRING. FILTER is a function applied to the return value, that can be used, e.g. to filter out additional entries (because TABLE might not obey PRED).

Source Code

;; Defined in /usr/src/emacs/lisp/minibuffer.el.gz
(defun completion-pcm--find-all-completions (string table pred point
                                                    &optional filter)
  "Find all completions for STRING at POINT in TABLE, satisfying PRED.
POINT is a position inside STRING.
FILTER is a function applied to the return value, that can be used, e.g. to
filter out additional entries (because TABLE might not obey PRED)."
  (unless filter (setq filter 'identity))
  (let* ((beforepoint (substring string 0 point))
         (afterpoint (substring string point))
         (bounds (completion-boundaries beforepoint table pred afterpoint))
         (prefix (substring beforepoint 0 (car bounds)))
         (suffix (substring afterpoint (cdr bounds)))
         firsterror)
    (setq string (substring string (car bounds) (+ point (cdr bounds))))
    (let* ((relpoint (- point (car bounds)))
           (pattern (completion-pcm--optimize-pattern
                     (completion-pcm--string->pattern string relpoint)))
           (all (condition-case-unless-debug err
                    (funcall filter
                             (completion-pcm--all-completions
                              prefix pattern table pred))
                  (error (setq firsterror err) nil))))
      (when (and (null all)
                 (> (car bounds) 0)
                 (null (ignore-errors (try-completion prefix table pred))))
        ;; The prefix has no completions at all, so we should try and fix
        ;; that first.
        (pcase-let* ((substring (substring prefix 0 -1))
                     (`(,subpat ,suball ,subprefix ,_subsuffix)
                      (completion-pcm--find-all-completions
                       substring table pred (length substring) filter))
                     (sep (aref prefix (1- (length prefix))))
                     ;; Text that goes between the new submatches and the
                     ;; completion substring.
                     (between nil))
          ;; Eliminate submatches that don't end with the separator.
          (dolist (submatch (prog1 suball (setq suball ())))
            (when (eq sep (aref submatch (1- (length submatch))))
              (push submatch suball)))
          (when suball
            ;; Update the boundaries and corresponding pattern.
            ;; We assume that all submatches result in the same boundaries
            ;; since we wouldn't know how to merge them otherwise anyway.
            ;; FIXME: COMPLETE REWRITE!!!
            (let* ((newbeforepoint
                    (concat subprefix (car suball)
                            (substring string 0 relpoint)))
                   (leftbound (+ (length subprefix) (length (car suball))))
                   (newbounds (completion-boundaries
                               newbeforepoint table pred afterpoint)))
              (unless (or (and (eq (cdr bounds) (cdr newbounds))
                               (eq (car newbounds) leftbound))
                          ;; Refuse new boundaries if they step over
                          ;; the submatch.
                          (< (car newbounds) leftbound))
                ;; The new completed prefix does change the boundaries
                ;; of the completed substring.
                (setq suffix (substring afterpoint (cdr newbounds)))
                (setq string
                      (concat (substring newbeforepoint (car newbounds))
                              (substring afterpoint 0 (cdr newbounds))))
                (setq between (substring newbeforepoint leftbound
                                         (car newbounds)))
                (setq pattern (completion-pcm--optimize-pattern
                               (completion-pcm--string->pattern
                                string
                                (- (length newbeforepoint)
                                   (car newbounds))))))
              (dolist (submatch suball)
                (setq all (nconc
                           (mapcar
                            (lambda (s) (concat submatch between s))
                            (funcall filter
                                     (completion-pcm--all-completions
                                      (concat subprefix submatch between)
                                      pattern table pred)))
                           all)))
              ;; FIXME: This can come in handy for try-completion,
              ;; but isn't right for all-completions, since it lists
              ;; invalid completions.
              ;; (unless all
              ;;   ;; Even though we found expansions in the prefix, none
              ;;   ;; leads to a valid completion.
              ;;   ;; Let's keep the expansions, tho.
              ;;   (dolist (submatch suball)
              ;;     (push (concat submatch between newsubstring) all)))
              ))
          (setq pattern (append subpat (list 'any (string sep))
                                (if between (list between)) pattern))
          (setq prefix subprefix)))
      (if (and (null all) firsterror)
          (signal (car firsterror) (cdr firsterror))
        (list pattern all prefix suffix)))))