From 8adce03c05d26d5410b776dfffe5cba07f6666ef Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Tue, 23 Jan 2024 11:35:20 +0100
Subject: [PATCH] ; Narrow character name completions by Unicode category

* lisp/international/mule-cmds.el (mule--ucs-names-sort-by-code)
(mule--ucs-names-affixation): Add documentation string.
(mule--ucs-categories-annotation, mule--ucs-names-narrow): New funcs.
(read-char-by-name): Provide 'narrow-completions-function' metadata.
---
 lisp/international/mule-cmds.el | 81 +++++++++++++++++++++++++++++----
 1 file changed, 73 insertions(+), 8 deletions(-)

diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 083af430e6f..ee88a8b1835 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -3163,16 +3163,74 @@ on encoding."
         (setq ucs-names names))))
 
 (defun mule--ucs-names-sort-by-code (names)
+  "Sort Unicode character NAMES by character codes."
   (let ((codes-and-names
          (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names)))
     (mapcar #'cdr (sort codes-and-names #'car-less-than-car))))
 
 (defun mule--ucs-names-affixation (names)
+  "Return Unicode character NAMES with completion affixations."
   (mapcar (lambda (name)
             (let ((char (gethash name ucs-names)))
               (list name (concat (if char (list char) " ") "\t") "")))
           names))
 
+(defun mule--ucs-categories-annotation (cat-name)
+  "Return completion annotation for Unicode category name CAT-NAME."
+  (when-let ((desc (char-code-property-description
+                    'general-category
+                    (intern cat-name))))
+    (concat " " (propertize desc 'face 'completions-annotations))))
+
+(defun mule--ucs-names-narrow ()
+  "Return completion predicate that filters character names by category.
+
+This function reads the names of one or more character
+categories, and returns a predicate function that returns non-nil
+only for characters with those categories.  If the current prefix
+argument is negative, then the predicate that this function
+returns excludes categories that you specify instead."
+  (let* ((names
+          (let* ((beg (minibuffer-prompt-end))
+                 (end (point-max))
+                 (input (buffer-substring beg end))
+                 (all (completion-all-completions
+                       input
+                       minibuffer-completion-table
+                       minibuffer-completion-predicate
+                       (- (point) beg)
+                       (completion--field-metadata beg)))
+                 (last (last all)))
+            (when (consp last) (setcdr last nil))
+            all))
+         (all-cats (delete-dups
+                    (seq-keep
+                     (lambda (name)
+                       (when-let ((char (gethash name ucs-names)))
+                         (get-char-code-property char 'general-category)))
+                     names)))
+         (enable-recursive-minibuffers t)
+         (cat-names
+          (or (completing-read-multiple
+               "Restrict to category: "
+               (completion-table-with-metadata
+                all-cats
+                '((annotation-function . mule--ucs-categories-annotation)))
+               nil t)
+              (user-error "Specify one or more character categories")))
+         (cats (mapcar #'intern cat-names))
+         (desc (format "in categor%s %s" (ngettext "y" "ies" (length cats))
+                       (mapconcat #'identity cat-names ","))))
+    (if (< (prefix-numeric-value current-prefix-arg) 0)
+        (cons
+         (lambda (_name char)
+           (not (memq (get-char-code-property char 'general-category) cats)))
+         (concat "not " desc))
+      (cons
+       (lambda (_name char)
+         (memq (get-char-code-property char 'general-category) cats))
+       desc))))
+
 (defun mule--ucs-names-group (name transform)
   (if transform
       name
@@ -3242,14 +3300,21 @@ single characters to be treated as standing for themselves."
 		     #'mule--ucs-names-sort-by-code))
          (group-fun (when completions-group #'mule--ucs-names-group))
 	 (input
-	  (completing-read
-	   prompt
-           (completion-table-with-metadata
-            (ucs-names)
-            `((display-sort-function . ,sort-fun)
-	      (affixation-function . ,#'mule--ucs-names-affixation)
-	      (group-function . ,group-fun)
-	      (category . unicode-name)))))
+          (minibuffer-with-setup-hook
+              (lambda ()
+                (setq-local minibuffer-completions-sort-orders
+                            (cons '(?c "code" "Sort by character code"
+                                       mule--ucs-names-sort-by-code
+                                       "sorted by character code")
+                                  minibuffer-completions-sort-orders)))
+	    (completing-read
+	     prompt (completion-table-with-metadata
+                     (ucs-names)
+                     `((display-sort-function . ,sort-fun)
+                       (affixation-function . ,#'mule--ucs-names-affixation)
+                       (narrow-completions-function . ,#'mule--ucs-names-narrow)
+	               (group-function . ,group-fun)
+	               (category . unicode-name))))))
 	 (char
           (cond
            ((char-from-name input t))
-- 
2.39.5