From 76b43f3c56f37dc632a46a385971f249a6e61b50 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 4 Jan 2024 19:20:30 +0200 Subject: [PATCH] Support display-sort-function in completion-category-overrides (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add 'display-sort-function' to the table of 'completion-category-overrides'. * lisp/calendar/calendar.el (calendar-read-date): Add metadata category 'calendar-month' for completing-read reading a month name. * lisp/minibuffer.el (completion-category-defaults): Add 'display-sort-function' with identity for the category 'calendar-month'. (completion-category-overrides): Add customization for completion sorting with 'display-sort-function' and a choice like in 'completions-sort'. (completion-metadata-override-get): New function. (minibuffer-completion-help): Use 'completion-metadata-override-get' instead of 'completion-metadata-get' to get sort-fun from 'display-sort-function'. (cherry picked from commit dc99be8e633fa0d8594b72f41584a53590939fde) --- doc/lispref/minibuf.texi | 6 ++++++ etc/NEWS | 6 ++++++ lisp/calendar/calendar.el | 6 +++++- lisp/minibuffer.el | 30 +++++++++++++++++++++++++++--- 4 files changed, 44 insertions(+), 4 deletions(-) diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 2bd600fbd3c..3ca1a8ca75d 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1985,6 +1985,12 @@ The value should be a list of completion styles (symbols). The value should be a value for @code{completion-cycle-threshold} (@pxref{Completion Options,,, emacs, The GNU Emacs Manual}) for this category. + +@item display-sort-function +The possible values are: @code{nil} that means to use either the sorting +function from metadata or if it's nil then fall back to @code{completions-sort}; +@code{identity} that means to not use any sorting to keep the original order; +and other values are the same as in @code{completions-sort}. @end table @noindent diff --git a/etc/NEWS b/etc/NEWS index 5693158e8e8..d3fc7a12ecb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -750,6 +750,12 @@ This command lets you change the separator that strings. 'completing-read-multiple' binds 'C-x ,' to 'crm-change-separator' in the minibuffer. ++++ +*** 'completion-category-overrides' supports 'display-sort-function'. +You can now customize the sorting order for any category in +'completion-category-overrides' that will override the sorting order +defined in the metadata or in 'completions-sort'. + ** Pcomplete --- diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index a25684f7b5d..e01d5d792a6 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -2339,7 +2339,11 @@ returned is (month year)." (month (cdr (assoc-string (completing-read (format-prompt "Month name" defmon) - (append month-array nil) + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (category . calendar-month)) + (complete-with-action + action (append month-array nil) string pred))) nil t nil nil defmon) (calendar-make-alist month-array 1) t))) (defday (calendar-extract-day default-date)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1ea69674cc8..2c2ea236082 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1138,12 +1138,14 @@ styles for specific categories, such as files, buffers, etc." (project-file (styles . (substring))) (xref-location (styles . (substring))) (info-menu (styles . (basic substring))) - (symbol-help (styles . (basic shorthand substring)))) + (symbol-help (styles . (basic shorthand substring))) + (calendar-month (display-sort-function . identity))) "Default settings for specific completion categories. Each entry has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `display-sort-function': the sorting function. Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1151,10 +1153,16 @@ Also see `completion-category-overrides'.") (defcustom completion-category-overrides nil "List of category-specific user overrides for completion styles. + Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `display-sort-function': where `nil' means to use either the sorting +function from metadata or if it's nil then fall back to `completions-sort'; +`identity' means to not use any sorting to keep the original order; +and other values are the same as in `completions-sort'. + Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1174,12 +1182,28 @@ overrides the default specified in `completion-category-defaults'." ,completion--styles-type) (cons :tag "Completion Cycling" (const :tag "Select one value from the menu." cycle) - ,completion--cycling-threshold-type)))) + ,completion--cycling-threshold-type) + (cons :tag "Completion Sorting" + (const :tag "Select one value from the menu." + display-sort-function) + (choice (const :tag "Use default" nil) + (const :tag "No sorting" identity) + (const :tag "Alphabetical sorting" + minibuffer-sort-alphabetically) + (const :tag "Historical sorting" + minibuffer-sort-by-history) + (function :tag "Custom function")))))) (defun completion--category-override (category tag) (or (assq tag (cdr (assq category completion-category-overrides))) (assq tag (cdr (assq category completion-category-defaults))))) +(defun completion-metadata-override-get (metadata prop) + (if-let ((cat (completion-metadata-get metadata 'category)) + (over (completion--category-override cat prop))) + (cdr over) + (completion-metadata-get metadata prop))) + (defun completion--styles (metadata) (let* ((cat (completion-metadata-get metadata 'category)) (over (completion--category-override cat 'styles))) @@ -2653,7 +2677,7 @@ current order instead." (aff-fun (or (completion-metadata-get all-md 'affixation-function) (plist-get completion-extra-properties :affixation-function))) - (sort-fun (completion-metadata-get all-md 'display-sort-function)) + (sort-fun (completion-metadata-override-get all-md 'display-sort-function)) (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new -- 2.39.5