bug#68214: Completion sorting customization by category

[Juri Linkov <juri@linkov.net>]

[-- Attachment #1: Type: text/plain, Size: 646 bytes --]

>>>> This function could be used to look up the other meta data
>>>> functions too, `display-sort-function`, `annotation-function`,
>>>> `affixation-function`, `group-function`, etc.
>>>
>>> All these meta data functions could be added later to
>>> completion-category-overrides after pushing the current patch.
>>
>> Makes sense, the `display-sort-function' is a good start. I suggest to
>> at least add the `cycle-sort-function' too. The cycle threshold can be
>> customized too.
>
> Looks like the cycle threshold is already supported,
> so I'll add the other meta data.

This looks like a complete patch, but it's not completely tested yet:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: completion-metadata-override-get.patch --]
[-- Type: text/x-diff, Size: 6375 bytes --]

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index b7aebae63a8..fbd9a03d921 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1180,6 +1185,10 @@ completion-category-overrides
            (cons :tag "Completion Cycling"
 		 (const :tag "Select one value from the menu." cycle)
                  ,completion--cycling-threshold-type)
+           (cons :tag "Cycle Sorting"
+                 (const :tag "Select one value from the menu."
+                        cycle-sort-function)
+                 (choice (function :tag "Custom function")))
            (cons :tag "Completion Sorting"
                  (const :tag "Select one value from the menu."
                         display-sort-function)
@@ -1189,7 +1198,19 @@ completion-category-overrides
                                 minibuffer-sort-alphabetically)
                          (const :tag "Historical sorting"
                                 minibuffer-sort-by-history)
-                         (function :tag "Custom function"))))))
+                         (function :tag "Custom function")))
+           (cons :tag "Completion Annotation"
+                 (const :tag "Select one value from the menu."
+                        annotation-function)
+                 (choice (function :tag "Custom function")))
+           (cons :tag "Completion Affixation"
+                 (const :tag "Select one value from the menu."
+                        affixation-function)
+                 (choice (function :tag "Custom function")))
+           (cons :tag "Completion Groups"
+                 (const :tag "Select one value from the menu."
+                        group-function)
+                 (choice (function :tag "Custom function"))))))
 
 (defun completion--category-override (category tag)
   (or (assq tag (cdr (assq category completion-category-overrides)))
@@ -1761,8 +1782,8 @@ completion-all-sorted-completions
                                            base-size md
                                            minibuffer-completion-table
                                            minibuffer-completion-predicate))
-             (sort-fun (completion-metadata-get all-md 'cycle-sort-function))
-             (group-fun (completion-metadata-get all-md 'group-function)))
+             (sort-fun (completion-metadata-override-get all-md 'cycle-sort-function))
+             (group-fun (completion-metadata-override-get all-md 'group-function)))
         (when last
           (setcdr last nil)
 
@@ -2540,14 +2561,14 @@ minibuffer-completion-help
                                            base-size md
                                            minibuffer-completion-table
                                            minibuffer-completion-predicate))
-             (ann-fun (or (completion-metadata-get all-md 'annotation-function)
+             (ann-fun (or (completion-metadata-override-get all-md 'annotation-function)
                           (plist-get completion-extra-properties
                                      :annotation-function)))
-             (aff-fun (or (completion-metadata-get all-md 'affixation-function)
+             (aff-fun (or (completion-metadata-override-get all-md 'affixation-function)
                           (plist-get completion-extra-properties
                                      :affixation-function)))
              (sort-fun (completion-metadata-override-get all-md 'display-sort-function))
-             (group-fun (completion-metadata-get all-md 'group-function))
+             (group-fun (completion-metadata-override-get all-md 'group-function))
              (mainbuf (current-buffer))
              ;; If the *Completions* buffer is shown in a new
              ;; window, mark it as softly-dedicated, so bury-buffer in
@@ -4466,9 +4487,9 @@ completion--flex-adjust-metadata
   "If `flex' is actually doing filtering, adjust sorting."
   (let ((flex-is-filtering-p completion-pcm--regexp)
         (existing-dsf
-         (completion-metadata-get metadata 'display-sort-function))
+         (completion-metadata-override-get metadata 'display-sort-function))
         (existing-csf
-         (completion-metadata-get metadata 'cycle-sort-function)))
+         (completion-metadata-override-get metadata 'cycle-sort-function)))
     (cl-flet
         ((compose-flex-sort-fn (existing-sort-fn)
            (lambda (completions)
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index d49714f3204..00f69e4ad72 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -789,12 +789,12 @@ icomplete--augment
 `group-function'.  Consecutive `equal' sections are avoided.
 COMP is the element in PROSPECTS or a transformation also given
 by `group-function''s second \"transformation\" protocol."
-  (let* ((aff-fun (or (completion-metadata-get md 'affixation-function)
+  (let* ((aff-fun (or (completion-metadata-override-get md 'affixation-function)
                       (plist-get completion-extra-properties :affixation-function)))
-         (ann-fun (or (completion-metadata-get md 'annotation-function)
+         (ann-fun (or (completion-metadata-override-get md 'annotation-function)
                       (plist-get completion-extra-properties :annotation-function)))
          (grp-fun (and completions-group
-                       (completion-metadata-get md 'group-function)))
+                       (completion-metadata-override-get md 'group-function)))
          (annotated
           (cond (aff-fun
            (funcall aff-fun prospects))
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index baadb4714b1..d1d6c5cac50 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -231,8 +231,8 @@ completion-preview--try-table
          (exit-fn (plist-get props :exit-function))
          (string (buffer-substring beg end))
          (md (completion-metadata string table pred))
-         (sort-fn (or (completion-metadata-get md 'cycle-sort-function)
-                      (completion-metadata-get md 'display-sort-function)
+         (sort-fn (or (completion-metadata-override-get md 'cycle-sort-function)
+                      (completion-metadata-override-get md 'display-sort-function)
                       completion-preview-sort-function))
          (all (let ((completion-lazy-hilit t))
                 (completion-all-completions string table pred