From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#68214: Completion sorting customization by category Date: Tue, 02 Jan 2024 19:07:48 +0200 Organization: LINKOV.NET Message-ID: <86a5pnzst1.fsf@mail.linkov.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="16518"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/30.0.50 (x86_64-pc-linux-gnu) To: 68214@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Jan 02 18:10:22 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rKiHV-00040f-Gb for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 02 Jan 2024 18:10:21 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rKiHC-0000S7-Dz; Tue, 02 Jan 2024 12:10:02 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rKiHA-0000Rp-Uf for bug-gnu-emacs@gnu.org; Tue, 02 Jan 2024 12:10:00 -0500 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rKiHA-0004Wr-J5 for bug-gnu-emacs@gnu.org; Tue, 02 Jan 2024 12:10:00 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rKiHC-0005iA-R0 for bug-gnu-emacs@gnu.org; Tue, 02 Jan 2024 12:10:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 02 Jan 2024 17:10:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 68214 X-GNU-PR-Package: emacs X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.170421537321907 (code B ref -1); Tue, 02 Jan 2024 17:10:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 2 Jan 2024 17:09:33 +0000 Original-Received: from localhost ([127.0.0.1]:51146 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rKiGj-0005hG-1L for submit@debbugs.gnu.org; Tue, 02 Jan 2024 12:09:33 -0500 Original-Received: from lists.gnu.org ([2001:470:142::17]:33976) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rKiGd-0005h0-Lk for submit@debbugs.gnu.org; Tue, 02 Jan 2024 12:09:31 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rKiGV-0000QZ-Ho for bug-gnu-emacs@gnu.org; Tue, 02 Jan 2024 12:09:19 -0500 Original-Received: from relay3-d.mail.gandi.net ([2001:4b98:dc4:8::223]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rKiGS-0004RU-P0 for bug-gnu-emacs@gnu.org; Tue, 02 Jan 2024 12:09:19 -0500 Original-Received: by mail.gandi.net (Postfix) with ESMTPSA id 5687A60005 for ; Tue, 2 Jan 2024 17:09:12 +0000 (UTC) X-GND-Sasl: juri@linkov.net Received-SPF: pass client-ip=2001:4b98:dc4:8::223; envelope-from=juri@linkov.net; helo=relay3-d.mail.gandi.net X-Spam_score_int: -25 X-Spam_score: -2.6 X-Spam_bar: -- X-Spam_report: (-2.6 / 5.0 requ) BAYES_00=-1.9, RCVD_IN_DNSWL_LOW=-0.7, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:277248 Archived-At: --=-=-= Content-Type: text/plain 0. emacs -Q 1. M-x calendar RET 2. 'g d' (calendar-goto-date) 3. type any year and RET 4. on the prompt "Month name: " type TAB Month names are sorted alphabetically that makes no sense: April August December February January July June March May November October September What is worse is that currently it's impossible to customize this sorting order. This was discussed recently in https://lists.gnu.org/archive/html/emacs-devel/2023-11/msg01233.html Here is a patch that allows such customization (setopt completion-category-overrides '((calendar-month (display-sort-function . identity)))) that will sort month names chronologically: January February March April May June July August September October November December --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=completion-sort.patch 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 @@ calendar-read-date (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 fa2dcb4f698..67870ad8054 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1106,6 +1111,13 @@ completion--cycling-threshold-type (const :tag "Always cycle" t) (integer :tag "Threshold"))) +(defconst completion--sorting-type + '(choice (const :tag "Undefined" nil) + (const :tag "Keep unsorted" identity) + (const :tag "Alphabetical sorting" alphabetical) + (const :tag "Historical sorting" historical) + (function :tag "Custom function"))) + (defcustom completion-styles ;; First, use `basic' because prefix completion has been the standard ;; for "ever" and works well in most cases, so using it first @@ -1171,7 +1183,11 @@ completion-category-overrides ,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) + ,completion--sorting-type)))) (defun completion--category-override (category tag) (or (assq tag (cdr (assq category completion-category-overrides))) @@ -1334,10 +1350,7 @@ completions-sort If the completion-specific metadata provides a `display-sort-function', that function overrides the value of this variable." - :type '(choice (const :tag "No sorting" nil) - (const :tag "Alphabetical sorting" alphabetical) - (const :tag "Historical sorting" historical) - (function :tag "Custom function")) + :type completion--sorting-type :version "30.1") (defcustom completions-group nil @@ -1618,6 +1631,12 @@ completion--metadata (if (eq (car bounds) base) md-at-point (completion-metadata (substring string 0 base) table pred)))) +(defun completion--display-sort-function (metadata) + (let* ((cat (completion-metadata-get metadata 'category)) + (over (completion--category-override cat 'display-sort-function))) + (if over (cdr over) + (completion-metadata-get metadata 'display-sort-function)))) + (defun minibuffer--sort-by-key (elems keyfun) "Return ELEMS sorted by increasing value of their KEYFUN. KEYFUN takes an element of ELEMS and should return a numerical value." @@ -2522,7 +2541,7 @@ minibuffer-completion-help (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--display-sort-function all-md)) (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new --=-=-=--