From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Michael Heerdegen Newsgroups: gmane.emacs.devel Subject: Add a function for building sort predicates Date: Thu, 01 Feb 2024 18:06:55 +0100 Message-ID: <87msskw1u8.fsf@web.de> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="36530"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) To: Emacs Development Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Thu Feb 01 18:07:40 2024 Return-path: Envelope-to: ged-emacs-devel@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 1rVaXL-0009G0-NR for ged-emacs-devel@m.gmane-mx.org; Thu, 01 Feb 2024 18:07:39 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rVaWd-0003ZD-4c; Thu, 01 Feb 2024 12:06:56 -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 1rVaWK-0003YA-08 for emacs-devel@gnu.org; Thu, 01 Feb 2024 12:06:36 -0500 Original-Received: from mout.web.de ([217.72.192.78]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rVaWH-0000xt-DE for emacs-devel@gnu.org; Thu, 01 Feb 2024 12:06:35 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=web.de; s=s29768273; t=1706807191; x=1707411991; i=michael_heerdegen@web.de; bh=hIGceyYPZZhFxEdDz+uUiBkXZN6/sER9lKOLHQjmdjY=; h=X-UI-Sender-Class:From:To:Subject:Date; b=VRrZVwWAiZlO7FfWbPtuVpt5ezOlaRwVl7v2d2ulTuIsM8pBIa4TaJ2XVnpTG8L/ efdhBKWX1LVsyiKWPvgo5LPz+eisH3WojKcmuftAlej7vQ/KAjwPVfyXLePmVv8si pKSToKW5fqbyuuJbNRkUcRCH6HZU4aAAh016TfViqoMg3M1Jkqd0Mc0d6VGN+89Xr 0o6p2Keh7KBJsWs7CrMZgN0t7Z6DPBEkJB7OxTxIHRbzQF2RnR65Lo8uyMCs2QwGT q8Z49ziDpx5y/LROn4V8p8rBJE1oDNfRJeZGeMqF6nM8BWAWTpIVBzfl8jkISpeXB I3yxm4YKH0KWmitj+Q== X-UI-Sender-Class: 814a7b36-bfc1-4dae-8640-3722d8ec6cd6 Original-Received: from drachen.dragon ([178.6.28.230]) by smtp.web.de (mrweb105 [213.165.67.124]) with ESMTPSA (Nemesis) id 1MSIEs-1rc93X0ohs-00T28p; Thu, 01 Feb 2024 18:06:31 +0100 X-Provags-ID: V03:K1:bl8bxDSK4r3ZVxyroJXLIKODxesboeq1G8Lm4zA93X+QtJOe9JC 2UrodymnRZVS6s5X1EPpzIoJ5BewI/jvp6gWodzKplAGZI/ccga0GBp4+IdbY1SrG58z/iJ uNmvnP83hAQ53K1VQjrNSqA0Qse16uulrApKO/i2d51lWs6C025ViOYiVUCEqmJC9goldk3 93UGYpKWshlzVDi16JhoQ== UI-OutboundReport: notjunk:1;M01:P0:7Q/ILIyINs4=;cG6RRFx67+12Hl7n6yjagpNH0pn jL4ykxe+wMjiiGrQVSaXbfQIL4F4RUsJOGwV4yfg4MyzX8v3dSPfVlFKqGrjdm4P1GbB4FZbT DaGevnAxmoD1fvRDePBRG+C1cGbdPqMuLS3FPl2IlhznU3aiZTs8gb7nV8ThrKI1O8jZpu/Vi I5WkaRc7kBdL6pWrtv3KANYxpgKnbVR7e/2hp0Wi4+liTwIPlCYb1KBRTuPl9qAOwpcrSMlMd P+ROoxxJ1KD6U/06F+HT9MOFImmlRdVlRWzfNslUmC1wBkmUboAd8TwUEZDpniM/4HFQaUNCw QE6Z/tlltbiBy3sBFERuw431EvwoVUVmqs3aPkI0DC0M1rKaXPzOSRXFgB8E2HcLDH6MYY+vN 4l2gfzmgcLgtfQURIovPwtE9GBnACwn20QVRR3lyITIaOIDED7tx4kV3LshCxcGr7Rq/l27Rd h0bAfBShglh2U/7c9UwEg9cJZyw0GEU3XR2tDq/ksi05BXIW2WErdg0j/RfIdO/yCdIrM7eni 6CPoif9sdMno2hhIGLlcWGvLzpyi/bhldK+FBdlu9yyz88N5tfkKCBqF1Q6MDCllMWGjcA9DC 6OGUdoBtW8MBdWpa3gkpq89rRdYlMprn8fLcAxnJQ+v5A55rPDUbCO2+qoZx87VZOaWAWmYRT zE2MVIqu5Ry6C4m91SjrnYWW+JUaTVDVRsPfzF+h1cP/Dj9unRHSo5RwhjPEBLlCEaCPPLLJg YVDV8JitKSTI51KKnqTSVaCMZ0OH0xnJkGOIk0TtM9o1UtBqyPyXPlTCUVV03PWFQrQonC2L Received-SPF: pass client-ip=217.72.192.78; envelope-from=michael_heerdegen@web.de; helo=mout.web.de X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H3=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_NONE=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: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:315705 Archived-At: Hello, I looked at how "package.el" defines the sort predicates for the used tabulated list view - for example, `package-menu--status-predicate': #+begin_src emacs-lisp (defun package-menu--status-predicate (A B) "Predicate to sort \"*Packages*\" buffer by the status column. This is used for `tabulated-list-format' in `package-menu-mode'." (let ((sA (aref (cadr A) 2)) (sB (aref (cadr B) 2))) (cond ((string= sA sB) (package-menu--name-predicate A B)) ((string= sA "new") t) ((string= sB "new") nil) ((string-prefix-p "avail" sA) (if (string-prefix-p "avail" sB) (package-menu--name-predicate A B) t)) ((string-prefix-p "avail" sB) nil) ((string= sA "installed") t) ((string= sB "installed") nil) ((string= sA "dependency") t) ((string= sB "dependency") nil) ((string= sA "source") t) ((string= sB "source") nil) ((string= sA "unsigned") t) ... (t (string< sA sB))))) #+end_src This is hard to read and maintain, 0% user configurable, and it's not easy to add additional "layers", like, "sort packages with equal states first by archive name, and only then by name". I want to suggest to add a function for defining sort predicates for cases like these (especially having tabulated-list-mode in mind, but not only - sorting is a common task). Here is what I would imagine: #+begin_src emacs-lisp ;; -*- lexical-binding: t -*- (defun make-sort-pred (rules) "Return a sort predicate according to the sort RULES. The returned predicate will accept two arguments A and B. When called, it will try RULES in order to decide whether A < B and return non-nil in that case and nil when B <= A. When no rule can decide whether A < B, the predicate will also return nil. RULES is a list of sort specifications using one of the formats explained below. The allowed formats of the specification lists in RULES are: -- (KEYFUN PRED) This is like (lambda (a b) (funcall PRED (funcall KEYFUN a) (funcall KEYFUN b))) -- (KEYFUN EQUAL-TEST . KEYLIST) This spec allows to specify the order of keys explicitly when the number of possible keys is small by specifying an accordingly ordered KEYLIST directly. A test using this rule form will first call KEYFUN with the arguments A and B to get K-A and K-B. Then, using the equality test EQUAL-TEST, it is tested to which of the elements in KEYLIST K-A and K-B are equal. It is decided whether A < B using the natural order of the KEYLIST elements. Keys not found in KEYLIST are treated it as if coming after all of its elements. Elements for that KEYFUN yields `equal' values are considered indistinguishable. -- (KEYFUN EQUAL-TEST GET-KEYLIST) This works exactly like the above spec - the only difference is that GET-KEYLIST is either a symbol whose `symbol-value' will be consulted, or a function accepting zero arguments to obtain the KEYLIST to use, at run-time. In the latter case the function should be accordingly cheap when called and avoid unnecessary consing. Example 1: Sort a list like this: ((\"c\" 2) (\"a\" 3) (\"b\" 1) (\"b\" 3) (\"c\" 3) (\"c\" 1) (\"a\" 2) (\"b\" 2)) first by the first element, then by the second: (sort \\='((\"c\" 2) (\"a\" 3) (\"b\" 1) (\"b\" 3) (\"c\" 3) (\"c\" 1) (\"a\" 2) (\"b\" 2)) (make-sort-pred `((,#'car ,#'string<) (,#'cadr ,#'<)))) Example 2: Create a sort predicate suitable for sorting the list of packages for M-x list-packages. We want to have all \"new\" packages listed first, then all obsolete packages, according to the following list: (defvar my-package-menu--status-sorting-order \\='(\"new\" \"obsolete\" \"held\" \"external\" ...)) Package in the same category should be sorted by archive in a certain order, and last by name: (defalias \\='my-package-menu--status-predicate (make-sort-pred `((,(lambda (x) (aref (cadr x) 2)) ,#'string= my-package-menu--status-sorting-order) (,(lambda (x) (package-desc-archive (car x))) ,#'equal \"gnu\" \"nongnu\" \"melpa\" nil) (,#'identity ,#'package-menu--name-predicate))))" (let ((result (make-symbol "result"))) (cl-flet ((compare-with (test a b) (cond ((funcall test a b) (throw result t)) ((funcall test b a) (throw result nil))))) (let ((rules ;; translate RULES to test functions (mapcar (pcase-lambda (`(,keyfun . ,rule)) (if (cdr rule) (let* ((test (car rule)) (testfun (lambda (x y) (funcall test y (funcall keyfun x)))) (keys (cdr rule)) (ckeys (car keys))) (cl-flet ((keys (cond ((cdr keys) (lambda () keys)) ((symbolp ckeys) (lambda () (symbol-value ckeys))) (t (lambda () (funcall ckeys)))))) (lambda (a b) (cl-block nil (let ((keys (keys))) (while keys (let ((key (pop keys))) (cond ((funcall testfun a key) (if (funcall testfun b key) (cl-return) (throw result t))) ((funcall testfun b key) (throw result nil)))))))))) (lambda (a b) (compare-with (car rule) (funcall keyfun a) (funcall keyfun b))))) rules))) (lambda (a b) (catch result ;; any rule throws 'result' when a