branch: elpa/jabber
commit 9c6a6911cb1a1675cceb0167253f92fabea7c7d5
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
util: Sort JID completion candidates by availability
---
lisp/jabber-util.el | 31 +++++++++++++++++++++++++--
tests/jabber-test-util.el | 53 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 82 insertions(+), 2 deletions(-)
diff --git a/lisp/jabber-util.el b/lisp/jabber-util.el
index 9a9f8c7fd9..d2f98d3196 100644
--- a/lisp/jabber-util.el
+++ b/lisp/jabber-util.el
@@ -237,12 +237,37 @@ is either a JID or display name depending on
`jabber-jid-completion-display'."
(cons (if (and use-names name) name jid) item)))
roster-items)))
+(defconst jabber--presence-sort-order '("chat" "" "away" "dnd" "xa")
+ "Presence shows from most to least available, for contact sorting.
+Offline contacts (nil show) sort last.")
+
+(defun jabber--presence-rank (sym)
+ "Return sort rank of roster symbol SYM; lower is more available."
+ (let ((tail (and sym (member (get sym 'show) jabber--presence-sort-order))))
+ (if tail
+ (- (length jabber--presence-sort-order) (length tail))
+ (length jabber--presence-sort-order))))
+
+(defun jabber--jid-candidate-lessp (a b table)
+ "Order completion candidates A and B by availability, then name.
+TABLE maps candidate strings to roster symbols."
+ (let ((rank-a (jabber--presence-rank (cdr (assoc-string a table t))))
+ (rank-b (jabber--presence-rank (cdr (assoc-string b table t)))))
+ (if (= rank-a rank-b)
+ (string-lessp (downcase a) (downcase b))
+ (< rank-a rank-b))))
+
(defun jabber--jid-completion-with-metadata (table)
"Wrap TABLE as a completion table matching both JIDs and names.
Candidates follow `jabber-jid-completion-display'; the other form
-is shown as an annotation. Both are matchable regardless of mode."
+is shown as an annotation. Both are matchable regardless of mode.
+Candidates display sorted by availability, then name."
(let ((alt-to-candidate (make-hash-table :test 'equal))
- (use-names (eq jabber-jid-completion-display 'name)))
+ (use-names (eq jabber-jid-completion-display 'name))
+ (sort-candidates
+ (lambda (candidates)
+ (sort (copy-sequence candidates)
+ (lambda (a b) (jabber--jid-candidate-lessp a b table))))))
;; Build reverse lookup: alternate form -> candidate string.
(dolist (entry table)
(let* ((candidate (car entry))
@@ -256,6 +281,8 @@ is shown as an annotation. Both are matchable regardless
of mode."
(cond
((eq action 'metadata)
`(metadata
+ (display-sort-function . ,sort-candidates)
+ (cycle-sort-function . ,sort-candidates)
(annotation-function
. ,(lambda (candidate)
(when-let* ((sym (cdr (assoc-string candidate table t))))
diff --git a/tests/jabber-test-util.el b/tests/jabber-test-util.el
index 6189839090..f75df5f379 100644
--- a/tests/jabber-test-util.el
+++ b/tests/jabber-test-util.el
@@ -298,5 +298,58 @@
(should-not (jabber-roster-contact-p nil "[email protected]"))
(should-not (jabber-roster-contact-p jc nil))))
+;;; Group: JID completion sorting
+
+(defun jabber-test-util--contact (jid show &optional name)
+ "Return an uninterned roster symbol JID with SHOW and NAME set."
+ (let ((sym (make-symbol jid)))
+ (put sym 'show show)
+ (when name (put sym 'name name))
+ sym))
+
+(ert-deftest jabber-test-util-presence-rank-orders-shows ()
+ "Available shows rank ahead of away shows, offline ranks last."
+ (let ((online (jabber-test-util--contact "[email protected]" ""))
+ (chatty (jabber-test-util--contact "[email protected]" "chat"))
+ (away (jabber-test-util--contact "[email protected]" "away"))
+ (offline (jabber-test-util--contact "[email protected]" nil)))
+ (should (< (jabber--presence-rank chatty)
+ (jabber--presence-rank online)))
+ (should (< (jabber--presence-rank online)
+ (jabber--presence-rank away)))
+ (should (< (jabber--presence-rank away)
+ (jabber--presence-rank offline)))))
+
+(ert-deftest jabber-test-util-jid-candidate-lessp-availability-first ()
+ "An online contact sorts before an offline one regardless of name."
+ (let* ((online (jabber-test-util--contact "[email protected]" ""))
+ (offline (jabber-test-util--contact "[email protected]" nil))
+ (table (list (cons "[email protected]" online)
+ (cons "[email protected]" offline))))
+ (should (jabber--jid-candidate-lessp "[email protected]" "[email protected]" table))
+ (should-not (jabber--jid-candidate-lessp "[email protected]" "[email protected]"
table))))
+
+(ert-deftest jabber-test-util-jid-candidate-lessp-name-tiebreak ()
+ "Same availability falls back to case-insensitive name order."
+ (let* ((a (jabber-test-util--contact "[email protected]" ""))
+ (b (jabber-test-util--contact "[email protected]" ""))
+ (table (list (cons "[email protected]" a)
+ (cons "[email protected]" b))))
+ (should (jabber--jid-candidate-lessp "[email protected]" "[email protected]" table))
+ (should-not (jabber--jid-candidate-lessp "[email protected]" "[email protected]"
table))))
+
+(ert-deftest jabber-test-util-completion-metadata-sorts-by-availability ()
+ "The completion table's display sort puts available contacts first."
+ (let* ((jabber-jid-completion-display 'jid)
+ (table (list (cons "[email protected]" (jabber-test-util--contact
"[email protected]" nil))
+ (cons "[email protected]" (jabber-test-util--contact
"[email protected]" "away"))
+ (cons "[email protected]" (jabber-test-util--contact
"[email protected]" ""))))
+ (collection (jabber--jid-completion-with-metadata table))
+ (metadata (funcall collection "" nil 'metadata))
+ (sorter (cdr (assq 'display-sort-function (cdr metadata)))))
+ (should (functionp sorter))
+ (should (equal '("[email protected]" "[email protected]" "[email protected]")
+ (funcall sorter '("[email protected]" "[email protected]"
"[email protected]"))))))
+
(provide 'jabber-test-util)
;;; jabber-test-util.el ends here
