diff options
| -rw-r--r-- | pearl.el | 38 | ||||
| -rw-r--r-- | tests/test-pearl-adhoc.el | 16 |
2 files changed, 44 insertions, 10 deletions
@@ -3359,6 +3359,19 @@ out of constraining this dimension." "Return CANDIDATES with `pearl--filter-none' prepended as the first option." (cons pearl--filter-none candidates)) +(defun pearl--completion-table-keep-order (candidates) + "Return a completion table over CANDIDATES that preserves input order. +The framework-side sort (vertico-sort-function, prescient, ivy, etc.) +re-sorts alphabetically by default, which clobbers `pearl--filter-none' +as the topmost option whenever a real candidate sorts ahead of \"[\". +Setting the table's `display-sort-function' to `identity' is the standard +Emacs hook for \"these are pre-sorted, leave them alone\"." + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (display-sort-function . identity) + (cycle-sort-function . identity)) + (complete-with-action action candidates string pred)))) + (defun pearl--read-filter-interactively () "Build a filter plist by completing over the chosen team's fetched dimensions. Picks a team first (scoping the rest), then offers open-only, state, project, @@ -3369,8 +3382,9 @@ choice; selecting it drops that dimension. The assignee prompt offers `me' (let* ((teams (pearl--all-teams)) (team-name (completing-read "Team: " - (pearl--with-none - (mapcar (lambda (tm) (cdr (assoc 'name tm))) teams)) + (pearl--completion-table-keep-order + (pearl--with-none + (mapcar (lambda (tm) (cdr (assoc 'name tm))) teams))) nil t)) (team-id (and (not (pearl--filter-none-value-p team-name)) (pearl--get-team-id-by-name team-name))) @@ -3378,16 +3392,18 @@ choice; selecting it drops that dimension. The assignee prompt offers `me' (state (and team-id (let ((s (completing-read "State: " - (pearl--with-none - (mapcar (lambda (st) (cdr (assoc 'name st))) - (pearl--team-states team-id))) + (pearl--completion-table-keep-order + (pearl--with-none + (mapcar (lambda (st) (cdr (assoc 'name st))) + (pearl--team-states team-id)))) nil t))) (unless (pearl--filter-none-value-p s) s)))) (project (and team-id (let ((p (completing-read "Project: " - (pearl--with-none - (pearl--team-collection-names 'projects team-id)) + (pearl--completion-table-keep-order + (pearl--with-none + (pearl--team-collection-names 'projects team-id))) nil t))) ;; The :project filter compiles to project.id.eq, so ;; resolve the picked name to its id before passing. @@ -3400,13 +3416,15 @@ choice; selecting it drops that dimension. The assignee prompt offers `me' (cl-remove pearl--filter-none (completing-read-multiple "Labels (comma-separated): " - (pearl--with-none - (pearl--team-collection-names 'labels team-id)) + (pearl--completion-table-keep-order + (pearl--with-none + (pearl--team-collection-names 'labels team-id))) nil t) :test #'string=))) (assignee (let ((choice (completing-read "Assignee: " - (list pearl--filter-none "me" "member") + (pearl--completion-table-keep-order + (list pearl--filter-none "me" "member")) nil t))) (pcase choice ("me" :me) diff --git a/tests/test-pearl-adhoc.el b/tests/test-pearl-adhoc.el index d8c7231..2bcc575 100644 --- a/tests/test-pearl-adhoc.el +++ b/tests/test-pearl-adhoc.el @@ -57,6 +57,22 @@ completing-read candidate list." (let ((wrapped (pearl--with-none '()))) (should (equal (list pearl--filter-none) wrapped)))) +(ert-deftest test-pearl-completion-table-keep-order-metadata-pins-identity () + "Action `metadata' returns an alist with `display-sort-function' bound to +`identity', the standard Emacs hook saying \"these are pre-sorted; don't re-sort.\"" + (let* ((tbl (pearl--completion-table-keep-order '("a" "b" "c"))) + (meta (funcall tbl "" nil 'metadata))) + (should (eq 'metadata (car meta))) + (should (eq #'identity (alist-get 'display-sort-function (cdr meta)))) + (should (eq #'identity (alist-get 'cycle-sort-function (cdr meta)))))) + +(ert-deftest test-pearl-completion-table-keep-order-delegates-all-completions () + "Non-metadata actions delegate to `complete-with-action' over the original +candidate list, so completion still works the way the framework expects." + (let ((tbl (pearl--completion-table-keep-order '("alpha" "beta" "gamma")))) + (should (equal '("alpha") (all-completions "a" tbl))) + (should (equal '("beta") (all-completions "b" tbl))))) + ;;; --assemble-filter (ert-deftest test-pearl-assemble-filter-only-set-keys () |