diff options
| author | Stefan Monnier | 2019-12-14 12:40:29 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2019-12-14 12:40:29 -0500 |
| commit | 0eff1a0191fc489debfcce1b695937112608718a (patch) | |
| tree | 6fda44f5af89ba809144a0b36877e619515f1792 | |
| parent | 3f36cab333a01bec3850d27ac0b2383570edb14e (diff) | |
| download | emacs-0eff1a0191fc489debfcce1b695937112608718a.tar.gz emacs-0eff1a0191fc489debfcce1b695937112608718a.zip | |
* lisp/minibuffer.el (completion-pcm--find-all-completions): Simplify a bit
| -rw-r--r-- | lisp/minibuffer.el | 126 |
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))))) |