summaryrefslogtreecommitdiff
path: root/lisp/minibuffer.el
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2019-12-14 12:40:29 -0500
committerStefan Monnier <monnier@iro.umontreal.ca>2019-12-14 12:40:29 -0500
commit0eff1a0191fc489debfcce1b695937112608718a (patch)
tree6fda44f5af89ba809144a0b36877e619515f1792 /lisp/minibuffer.el
parent3f36cab333a01bec3850d27ac0b2383570edb14e (diff)
downloademacs-0eff1a0191fc489debfcce1b695937112608718a.tar.gz
* lisp/minibuffer.el (completion-pcm--find-all-completions): Simplify a bit
Diffstat (limited to 'lisp/minibuffer.el')
-rw-r--r--lisp/minibuffer.el126
1 files changed, 63 insertions, 63 deletions
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)))))