From: Stefan Monnier Date: Sat, 14 Dec 2019 17:40:29 +0000 (-0500) Subject: * lisp/minibuffer.el (completion-pcm--find-all-completions): Simplify a bit X-Git-Tag: emacs-27.0.90~352 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0eff1a0191fc489debfcce1b695937112608718a;p=emacs.git * lisp/minibuffer.el (completion-pcm--find-all-completions): Simplify a bit --- diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 8af8aca30ec..f8888111caf 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3214,69 +3214,69 @@ filter out additional entries (because TABLE might not obey PRED)." (null (ignore-errors (try-completion prefix table pred)))) ;; The prefix has no completions at all, so we should try and fix ;; that first. - (let ((substring (substring prefix 0 -1))) - (pcase-let ((`(,subpat ,suball ,subprefix ,_subsuffix) - (completion-pcm--find-all-completions - substring table pred (length substring) filter))) - (let ((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))))) + (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)))))