mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-21 18:23:59 +00:00
Code Issues Releases Activity

* lisp/minibuffer.el (completion-pcm--find-all-completions): Simplify a bit

Browse Source
This commit is contained in:
Stefan Monnier 2019-12-14 12:40:29 -05:00
parent 3f36cab333
commit 0eff1a0191
1 changed files with 63 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
lisp/minibuffer.el
View File

@ -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)))))