[elpa] externals/consult 2b5f1675be 1/2: consult--split-setup: Fix try completion

[ELPA Syncer]

branch: externals/consult
commit 2b5f1675becbeaff6548ea5d1e42cf34264fb7bb
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    consult--split-setup: Fix try completion
---
 consult-selectrum.el |  2 +-
 consult.el           | 47 ++++++++++++++++++++++++++---------------------
 2 files changed, 27 insertions(+), 22 deletions(-)

diff --git a/consult-selectrum.el b/consult-selectrum.el
index 15ca6c5f7d..3ff22276bd 100644
--- a/consult-selectrum.el
+++ b/consult-selectrum.el
@@ -71,7 +71,7 @@ and HIGHLIGHT."
   "Wrap candidates highlight/refinement ORIG function.
 The input is split by the SPLIT function."
   (lambda (str cands)
-    (funcall orig (cadr (funcall split str 0)) cands)))
+    (funcall orig (cadr (funcall split str)) cands)))
 
 (defun consult-selectrum--split-setup-adv (orig split)
   "Advice for `consult--split-setup' to be used by Selectrum.
diff --git a/consult.el b/consult.el
index fe6f252244..7e45e65453 100644
--- a/consult.el
+++ b/consult.el
@@ -1590,46 +1590,46 @@ to make it available for commands with narrowing."
 
 ;;;; Splitting completion style
 
-(defun consult--split-perl (str point &optional _plist)
+(defun consult--split-perl (str &optional _plist)
   "Split input STR in async input and filtering part.
 
-The function returns a list with four elements: The async string, the
-completion filter string, the new point position computed from POINT and a
-force flag. If the first character is a punctuation character it determines the
-separator. Examples: \"/async/filter\", \"#async#filter\"."
+The function returns a list with four elements: The async string,
+the completion filter string, the start position of the
+completion filter string and a force flag. If the first character
+is a punctuation character it determines the separator. Examples:
+\"/async/filter\", \"#async#filter\"."
   (if (string-match-p "^[[:punct:]]" str)
       (save-match-data
         (let ((q (regexp-quote (substring str 0 1))))
           (string-match (concat "^" q "\\([^" q "]*\\)\\(" q "\\)?") str)
           `(,(match-string 1 str)
             ,(substring str (match-end 0))
-            ,(max 0 (- point (match-end 0)))
+            ,(match-end 0)
             ;; Force update it two punctuation characters are entered.
             ,(match-end 2)
             ;; List of highlights
             (0 . ,(match-beginning 1))
             ,@(and (match-end 2) `((,(match-beginning 2) . ,(match-end 2)))))))
-    `(,str "" 0)))
+    `(,str "" ,(length str))))
 
-(defun consult--split-nil (str _point &optional _plist)
+(defun consult--split-nil (str &optional _plist)
   "Treat the complete input STR as async input."
-  `(,str "" 0))
+  `(,str "" ,(length str)))
 
-(defun consult--split-separator (str point plist)
+(defun consult--split-separator (str plist)
   "Split input STR in async input and filtering part at first separator.
-POINT is the point position.
 PLIST is the splitter configuration, including the separator."
   (let ((sep (regexp-quote (char-to-string (plist-get plist :separator)))))
     (save-match-data
       (if (string-match (format "^\\([^%s]+\\)\\(%s\\)?" sep sep) str)
           `(,(match-string 1 str)
             ,(substring str (match-end 0))
-            ,(max 0 (- point (match-end 0)))
+            ,(match-end 0)
             ;; Force update it space is entered.
             ,(match-end 2)
             ;; List of highlights
-            (0 . ,(match-end 1)))
-        `(,str "" 0)))))
+            ,@(and (match-end 2) `((,(match-beginning 2) . ,(match-end 2)))))
+        `(,str "" ,(length str))))))
 
 (defun consult--split-setup (split)
   "Setup splitting completion style with splitter function SPLIT."
@@ -1640,14 +1640,20 @@ PLIST is the splitter configuration, including the 
separator."
                 (let ((completion-styles styles)
                       (completion-category-defaults catdef)
                       (completion-category-overrides catovr)
-                      (parts (funcall split str point)))
-                  (completion-try-completion (cadr parts) table pred (caddr 
parts)))))
+                      (parts (funcall split str)))
+                  (pcase (completion-try-completion (cadr parts) table pred
+                                                    (max 0 (- point (caddr 
parts))))
+                    ('t t)
+                    (`(,newstr . ,newpt)
+                     (cons (concat (substring str 0 (caddr parts)) newstr)
+                           (+ (caddr parts) newpt)))))))
          (all (lambda (str table pred point)
                 (let ((completion-styles styles)
                       (completion-category-defaults catdef)
                       (completion-category-overrides catovr)
-                      (parts (funcall split str point)))
-                  (completion-all-completions (cadr parts) table pred (caddr 
parts))))))
+                      (parts (funcall split str)))
+                  (completion-all-completions (cadr parts) table pred
+                                              (max 0 (- point (caddr 
parts))))))))
     (setq-local completion-styles-alist (cons `(consult--split ,try ,all "")
                                               completion-styles-alist)
                 completion-styles '(consult--split)
@@ -1752,7 +1758,7 @@ SPLIT is the splitting function."
   (unless split
     (let* ((style (consult--async-split-style))
            (fn (plist-get style :function)))
-      (setq split (lambda (str pt) (funcall fn str pt style)))))
+      (setq split (lambda (str) (funcall fn str style)))))
   (lambda (action)
     (pcase action
       ('setup
@@ -1760,7 +1766,7 @@ SPLIT is the splitting function."
        (funcall async 'setup))
       ((pred stringp)
        (pcase-let* ((`(,async-str ,_ ,_ ,force . ,highlights)
-                     (funcall split action 0))
+                     (funcall split action))
                     (async-len (length async-str))
                     (input-len (length action))
                     (end (minibuffer-prompt-end)))
@@ -2006,7 +2012,6 @@ argument list :command and a highlighting function 
:highlight."
   (let ((map (make-sparse-keymap)))
     ;; Async keys overwriting some unusable defaults for the default completion
     (define-key map [remap minibuffer-complete-word] #'self-insert-command)
-    (define-key map [remap minibuffer-complete] #'minibuffer-completion-help)
     map)
   "Keymap added for commands with asynchronous candidates.")