Add cape-wrap-super and cape-capf-super for consistency

3 files changed, 91 insertions, 84 deletions

diff --git a/CHANGELOG.org b/CHANGELOG.org
index 8eb108d..fae6145 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -5,6 +5,8 @@
 * Development
 
 - Add =cape-wrap-debug= and =cape-capf-debug= to add debug messages to a Capf.
+- Add =cape-wrap-super= and =cape-capf-super= for better consistency with the other
+  Capf combinators.
 
 * Version 0.17 (2023-08-14)
 
diff --git a/README.org b/README.org
index 5a0b283..a8d0695 100644
--- a/README.org
+++ b/README.org
@@ -65,7 +65,7 @@ Furthermore the =cape-*= functions are Capfs which you can add to the
 since each of the Capfs adds a small runtime cost. Note that the Capfs which
 occur earlier in the list take precedence, such that the first Capf returning a
 result will win and the later Capfs may not get a chance to run. In order to
-merge Capfs you can try the experimental function =cape-super-capf=.
+merge Capfs you can try the experimental function =cape-capf-super=.
 
 One must distinguish the buffer-local and the global value of the
 =completion-at-point-functions= variable. The buffer-local value of the list takes
@@ -175,7 +175,7 @@ It is possible to merge multiple Company backends and use them as a single Capf
 using the ~company--multi-backend-adapter~ function from Company. The adapter
 transforms multiple Company backends into a single Company backend, which can
 then be used as a Capf via ~cape-company-to-capf~. Capfs can be merged directly
-with ~cape-super-capf~.
+with ~cape-capf-super~.
 
 #+begin_src emacs-lisp
 (require 'company)
@@ -191,34 +191,34 @@ with ~cape-super-capf~.
 
 /Throw multiple Capfs under the Cape and get a Super-Capf!/
 
-Cape supports merging multiple Capfs using the function ~cape-super-capf~. This
+Cape supports merging multiple Capfs using the function ~cape-capf-super~. This
 feature is *EXPERIMENTAL* and should only be used carefully in special scenarios.
 Due to some technical details, only a subset of Capfs can be merged. Merge Capfs
 one by one and make sure that you get the desired outcome on each step.
 
-Note that ~cape-super-capf~ is not needed if you want to use multiple Capfs which
+Note that ~cape-capf-super~ is not needed if you want to use multiple Capfs which
 are tried one after the other, for example you can use ~cape-file~ together with
 programming mode Capfs by adding ~cape-file~ to the ~completion-at-point-functions~
 list. File completion will then be available in comments and string literals,
-but not in normal code. ~cape-super-capf~ is only necessary if you want to combine
+but not in normal code. ~cape-capf-super~ is only necessary if you want to combine
 multiple Capfs, such that the candidates from multiple sources appear /together/
 in the completion list at the same time.
 
 Capf merging works only for completion functions which are sufficiently
 well-behaved and completion functions which do not define completion boundaries.
-~cape-super-capf~ has the same restrictions as ~completion-table-merge~ and
-~completion-table-in-turn~. As a simple rule of thumb, ~cape-super-capf~ works only
+~cape-capf-super~ has the same restrictions as ~completion-table-merge~ and
+~completion-table-in-turn~. As a simple rule of thumb, ~cape-capf-super~ works only
 for static completion functions like ~cape-dabbrev~, ~cape-keyword~, ~cape-dict~,
 etc., but not for multi-step completions like ~cape-file~.
 
 #+begin_src emacs-lisp
 ;; Merge the dabbrev, dict and keyword capfs, display candidates together.
 (setq-local completion-at-point-functions
-            (list (cape-super-capf #'cape-dabbrev #'cape-dict #'cape-keyword)))
+            (list (cape-capf-super #'cape-dabbrev #'cape-dict #'cape-keyword)))
 
 ;; Alternative: Define named Capf instead of using the anonymous Capf directly
-(defalias 'cape-dabbrev-dict-keyword
-  (cape-super-capf #'cape-dabbrev #'cape-dict #'cape-keyword))
+(defun cape-dabbrev-dict-keyword ()
+  (cape-wrap-super #'cape-dabbrev #'cape-dict #'cape-keyword))
 (setq-local completion-at-point-functions (list #'cape-dabbrev-dict-keyword))
 #+end_src
 
@@ -230,7 +230,7 @@ allows you to merge multiple Company backends.
 /The Capf-Buster ensures that you always get a fresh set of candidates!/
 
 If a Capf caches the candidates for too long we can use a cache busting
-Capf-transformer. For example the Capf merging function ~cape-super-capf~ creates
+Capf-transformer. For example the Capf merging function ~cape-capf-super~ creates
 a Capf, which caches the candidates for the whole lifetime of the Capf.
 Therefore you may want to combine a merged Capf with a cache buster under some
 circumstances. It is noteworthy that the ~company-capf~ backend from Company
@@ -261,6 +261,7 @@ the Capf transformers with =defalias= to a function symbol.
 - ~cape-wrap-properties~, ~cape-capf-properties~: Add completion properties to a Capf.
 - ~cape-wrap-predicate~, ~cape-capf-predicate~: Add candidate predicate to a Capf.
 - ~cape-wrap-prefix-length~, ~cape-capf-prefix-length~: Enforce a minimal prefix length.
+- ~cape-wrap-super~, ~cape-capf-super~: Merge multiple Capfs into a Super-Capf.
 - ~cape-wrap-inside-comment~, ~cape-capf-inside-comment~: Ensure that Capf triggers only inside comment.
 - ~cape-wrap-inside-string~, ~cape-capf-inside-string~: Ensure that Capf triggers only inside a string literal.
 
diff --git a/cape.el b/cape.el
index 94fd91e..0d706f5 100644
--- a/cape.el
+++ b/cape.el
@@ -717,79 +717,6 @@ If INTERACTIVE is nil the function acts like a Capf."
 
 ;;;; Capf combinators
 
-;;;###autoload
-(defun cape-super-capf (&rest capfs)
-  "Merge CAPFS and return new Capf which includes all candidates.
-The function `cape-super-capf' is experimental."
-  (lambda ()
-    (when-let (results (delq nil (mapcar #'funcall capfs)))
-      (pcase-let* ((`((,beg ,end . ,_)) results)
-                   (cand-ht (make-hash-table :test #'equal))
-                   (tables nil)
-                   (prefix-len nil))
-        (cl-loop for (beg2 end2 . rest) in results do
-                 (when (and (= beg beg2) (= end end2))
-                   (push rest tables)
-                   (let ((plen (plist-get (cdr rest) :company-prefix-length)))
-                     (cond
-                      ((eq plen t)
-                       (setq prefix-len t))
-                      ((and (not prefix-len) (integerp plen))
-                       (setq prefix-len plen))
-                      ((and (integerp prefix-len) (integerp plen))
-                       (setq prefix-len (max prefix-len plen)))))))
-        (setq tables (nreverse tables))
-        `(,beg ,end
-          ,(lambda (str pred action)
-             (pcase action
-               (`(boundaries . ,_) nil)
-               ('metadata
-                '(metadata (category . cape-super)
-                           (display-sort-function . identity)
-                           (cycle-sort-function . identity)))
-               ('t ;; all-completions
-                (let ((ht (make-hash-table :test #'equal))
-                      (candidates nil))
-                  (cl-loop for (table . plist) in tables do
-                           (let* ((pr (if-let (pr (plist-get plist :predicate))
-                                          (if pred
-                                              (lambda (x) (and (funcall pr x) (funcall pred x)))
-                                            pr)
-                                        pred))
-                                  (md (completion-metadata "" table pr))
-                                  (sort (or (completion-metadata-get md 'display-sort-function)
-                                            #'identity))
-                                  (cands (funcall sort (all-completions str table pr))))
-                             (cl-loop for cell on cands
-                                      for cand = (car cell) do
-                                      (if (eq (gethash cand ht t) t)
-                                          (puthash cand plist ht)
-                                        (setcar cell nil)))
-                             (setq candidates (nconc candidates cands))))
-                  (setq cand-ht ht)
-                  (delq nil candidates)))
-               (_ ;; try-completion and test-completion
-                (completion--some
-                 (pcase-lambda (`(,table . ,plist))
-                   (complete-with-action
-                    action table str
-                    (if-let (pr (plist-get plist :predicate))
-                        (if pred
-                            (lambda (x) (and (funcall pr x) (funcall pred x)))
-                          pr)
-                      pred)))
-                 tables))))
-          :exclusive no
-          :company-prefix-length ,prefix-len
-          ,@(mapcan
-             (lambda (prop)
-               (list prop (lambda (cand &rest args)
-                            (when-let (fun (plist-get (gethash cand cand-ht) prop))
-                              (apply fun cand args)))))
-             '(:company-docsig :company-location :company-kind
-               :company-doc-buffer :company-deprecated
-               :annotation-function :exit-function)))))))
-
 (defun cape--company-call (&rest app)
   "Apply APP and handle future return values."
   ;; Backends are non-interruptible. Disable interrupts!
@@ -907,6 +834,81 @@ changed.  The function `cape-company-to-capf' is experimental."
     (if interactive (cape-interactive capf) (funcall capf))))
 
 ;;;###autoload
+(defalias 'cape-super-capf #'cape-capf-super)
+
+;;;###autoload
+(defun cape-wrap-super (&rest capfs)
+  "Call CAPFS and return merged completion result.
+The functions `cape-wrap-super' and `cape-capf-super' are experimental."
+  (when-let ((results (delq nil (mapcar #'funcall capfs))))
+    (pcase-let* ((`((,beg ,end . ,_)) results)
+                 (cand-ht (make-hash-table :test #'equal))
+                 (tables nil)
+                 (prefix-len nil))
+      (cl-loop for (beg2 end2 . rest) in results do
+               (when (and (= beg beg2) (= end end2))
+                 (push rest tables)
+                 (let ((plen (plist-get (cdr rest) :company-prefix-length)))
+                   (cond
+                    ((eq plen t)
+                     (setq prefix-len t))
+                    ((and (not prefix-len) (integerp plen))
+                     (setq prefix-len plen))
+                    ((and (integerp prefix-len) (integerp plen))
+                     (setq prefix-len (max prefix-len plen)))))))
+      (setq tables (nreverse tables))
+      `(,beg ,end
+        ,(lambda (str pred action)
+           (pcase action
+             (`(boundaries . ,_) nil)
+             ('metadata
+              '(metadata (category . cape-super)
+                         (display-sort-function . identity)
+                         (cycle-sort-function . identity)))
+             ('t ;; all-completions
+              (let ((ht (make-hash-table :test #'equal))
+                    (candidates nil))
+                (cl-loop for (table . plist) in tables do
+                         (let* ((pr (if-let (pr (plist-get plist :predicate))
+                                        (if pred
+                                            (lambda (x) (and (funcall pr x) (funcall pred x)))
+                                          pr)
+                                      pred))
+                                (md (completion-metadata "" table pr))
+                                (sort (or (completion-metadata-get md 'display-sort-function)
+                                          #'identity))
+                                (cands (funcall sort (all-completions str table pr))))
+                           (cl-loop for cell on cands
+                                    for cand = (car cell) do
+                                    (if (eq (gethash cand ht t) t)
+                                        (puthash cand plist ht)
+                                      (setcar cell nil)))
+                           (push cands candidates)))
+                (setq cand-ht ht)
+                (delq nil (apply #'nconc (nreverse candidates)))))
+             (_ ;; try-completion and test-completion
+              (completion--some
+               (pcase-lambda (`(,table . ,plist))
+                 (complete-with-action
+                  action table str
+                  (if-let (pr (plist-get plist :predicate))
+                      (if pred
+                          (lambda (x) (and (funcall pr x) (funcall pred x)))
+                        pr)
+                    pred)))
+               tables))))
+        :exclusive no
+        :company-prefix-length ,prefix-len
+        ,@(mapcan
+           (lambda (prop)
+             (list prop (lambda (cand &rest args)
+                          (when-let (fun (plist-get (gethash cand cand-ht) prop))
+                            (apply fun cand args)))))
+           '(:company-docsig :company-location :company-kind
+             :company-doc-buffer :company-deprecated
+             :annotation-function :exit-function))))))
+
+;;;###autoload
 (defun cape-wrap-debug (capf &optional name)
   "Call CAPF and return a completion table which prints trace messages.
 If CAPF is an anonymous lambda, pass the Capf NAME explicitly for
@@ -1116,6 +1118,8 @@ This function can be used as an advice around an existing Capf."
 (cape--capf-wrapper inside-comment)
 ;;;###autoload (autoload 'cape-capf-inside-string "cape")
 (cape--capf-wrapper inside-string)
+;;;###autoload (autoload 'cape-capf-super "cape")
+(cape--capf-wrapper super)
 ;;;###autoload (autoload 'cape-capf-noninterruptible "cape")
 (cape--capf-wrapper noninterruptible)
 ;;;###autoload (autoload 'cape-capf-nonexclusive "cape")