aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-12-14 12:40:29 -0500
committerStefan Monnier2019-12-14 12:40:29 -0500
commit0eff1a0191fc489debfcce1b695937112608718a (patch)
tree6fda44f5af89ba809144a0b36877e619515f1792
parent3f36cab333a01bec3850d27ac0b2383570edb14e (diff)
downloademacs-0eff1a0191fc489debfcce1b695937112608718a.tar.gz
emacs-0eff1a0191fc489debfcce1b695937112608718a.zip
* lisp/minibuffer.el (completion-pcm--find-all-completions): Simplify a bit
-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)."
3214 (null (ignore-errors (try-completion prefix table pred)))) 3214 (null (ignore-errors (try-completion prefix table pred))))
3215 ;; The prefix has no completions at all, so we should try and fix 3215 ;; The prefix has no completions at all, so we should try and fix
3216 ;; that first. 3216 ;; that first.
3217 (let ((substring (substring prefix 0 -1))) 3217 (pcase-let* ((substring (substring prefix 0 -1))
3218 (pcase-let ((`(,subpat ,suball ,subprefix ,_subsuffix) 3218 (`(,subpat ,suball ,subprefix ,_subsuffix)
3219 (completion-pcm--find-all-completions 3219 (completion-pcm--find-all-completions
3220 substring table pred (length substring) filter))) 3220 substring table pred (length substring) filter))
3221 (let ((sep (aref prefix (1- (length prefix)))) 3221 (sep (aref prefix (1- (length prefix))))
3222 ;; Text that goes between the new submatches and the 3222 ;; Text that goes between the new submatches and the
3223 ;; completion substring. 3223 ;; completion substring.
3224 (between nil)) 3224 (between nil))
3225 ;; Eliminate submatches that don't end with the separator. 3225 ;; Eliminate submatches that don't end with the separator.
3226 (dolist (submatch (prog1 suball (setq suball ()))) 3226 (dolist (submatch (prog1 suball (setq suball ())))
3227 (when (eq sep (aref submatch (1- (length submatch)))) 3227 (when (eq sep (aref submatch (1- (length submatch))))
3228 (push submatch suball))) 3228 (push submatch suball)))
3229 (when suball 3229 (when suball
3230 ;; Update the boundaries and corresponding pattern. 3230 ;; Update the boundaries and corresponding pattern.
3231 ;; We assume that all submatches result in the same boundaries 3231 ;; We assume that all submatches result in the same boundaries
3232 ;; since we wouldn't know how to merge them otherwise anyway. 3232 ;; since we wouldn't know how to merge them otherwise anyway.
3233 ;; FIXME: COMPLETE REWRITE!!! 3233 ;; FIXME: COMPLETE REWRITE!!!
3234 (let* ((newbeforepoint 3234 (let* ((newbeforepoint
3235 (concat subprefix (car suball) 3235 (concat subprefix (car suball)
3236 (substring string 0 relpoint))) 3236 (substring string 0 relpoint)))
3237 (leftbound (+ (length subprefix) (length (car suball)))) 3237 (leftbound (+ (length subprefix) (length (car suball))))
3238 (newbounds (completion-boundaries 3238 (newbounds (completion-boundaries
3239 newbeforepoint table pred afterpoint))) 3239 newbeforepoint table pred afterpoint)))
3240 (unless (or (and (eq (cdr bounds) (cdr newbounds)) 3240 (unless (or (and (eq (cdr bounds) (cdr newbounds))
3241 (eq (car newbounds) leftbound)) 3241 (eq (car newbounds) leftbound))
3242 ;; Refuse new boundaries if they step over 3242 ;; Refuse new boundaries if they step over
3243 ;; the submatch. 3243 ;; the submatch.
3244 (< (car newbounds) leftbound)) 3244 (< (car newbounds) leftbound))
3245 ;; The new completed prefix does change the boundaries 3245 ;; The new completed prefix does change the boundaries
3246 ;; of the completed substring. 3246 ;; of the completed substring.
3247 (setq suffix (substring afterpoint (cdr newbounds))) 3247 (setq suffix (substring afterpoint (cdr newbounds)))
3248 (setq string 3248 (setq string
3249 (concat (substring newbeforepoint (car newbounds)) 3249 (concat (substring newbeforepoint (car newbounds))
3250 (substring afterpoint 0 (cdr newbounds)))) 3250 (substring afterpoint 0 (cdr newbounds))))
3251 (setq between (substring newbeforepoint leftbound 3251 (setq between (substring newbeforepoint leftbound
3252 (car newbounds))) 3252 (car newbounds)))
3253 (setq pattern (completion-pcm--optimize-pattern 3253 (setq pattern (completion-pcm--optimize-pattern
3254 (completion-pcm--string->pattern 3254 (completion-pcm--string->pattern
3255 string 3255 string
3256 (- (length newbeforepoint) 3256 (- (length newbeforepoint)
3257 (car newbounds)))))) 3257 (car newbounds))))))
3258 (dolist (submatch suball) 3258 (dolist (submatch suball)
3259 (setq all (nconc 3259 (setq all (nconc
3260 (mapcar 3260 (mapcar
3261 (lambda (s) (concat submatch between s)) 3261 (lambda (s) (concat submatch between s))
3262 (funcall filter 3262 (funcall filter
3263 (completion-pcm--all-completions 3263 (completion-pcm--all-completions
3264 (concat subprefix submatch between) 3264 (concat subprefix submatch between)
3265 pattern table pred))) 3265 pattern table pred)))
3266 all))) 3266 all)))
3267 ;; FIXME: This can come in handy for try-completion, 3267 ;; FIXME: This can come in handy for try-completion,
3268 ;; but isn't right for all-completions, since it lists 3268 ;; but isn't right for all-completions, since it lists
3269 ;; invalid completions. 3269 ;; invalid completions.
3270 ;; (unless all 3270 ;; (unless all
3271 ;; ;; Even though we found expansions in the prefix, none 3271 ;; ;; Even though we found expansions in the prefix, none
3272 ;; ;; leads to a valid completion. 3272 ;; ;; leads to a valid completion.
3273 ;; ;; Let's keep the expansions, tho. 3273 ;; ;; Let's keep the expansions, tho.
3274 ;; (dolist (submatch suball) 3274 ;; (dolist (submatch suball)
3275 ;; (push (concat submatch between newsubstring) all))) 3275 ;; (push (concat submatch between newsubstring) all)))
3276 )) 3276 ))
3277 (setq pattern (append subpat (list 'any (string sep)) 3277 (setq pattern (append subpat (list 'any (string sep))
3278 (if between (list between)) pattern)) 3278 (if between (list between)) pattern))
3279 (setq prefix subprefix))))) 3279 (setq prefix subprefix)))
3280 (if (and (null all) firsterror) 3280 (if (and (null all) firsterror)
3281 (signal (car firsterror) (cdr firsterror)) 3281 (signal (car firsterror) (cdr firsterror))
3282 (list pattern all prefix suffix))))) 3282 (list pattern all prefix suffix)))))