branch: elpa/jabber
commit 1c33b8cb42874f75ed5bb6f31bd6f33792c5c950
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
roster: Remove sort machinery orphaned by popup rework
---
lisp/jabber-roster.el | 83 ---------------------------------------------
tests/jabber-test-roster.el | 81 ++-----------------------------------------
2 files changed, 3 insertions(+), 161 deletions(-)
diff --git a/lisp/jabber-roster.el b/lisp/jabber-roster.el
index 3a38600ac6..9eca35cb6e 100644
--- a/lisp/jabber-roster.el
+++ b/lisp/jabber-roster.el
@@ -39,24 +39,6 @@
(defgroup jabber-roster nil "Roster options."
:group 'jabber)
-(defcustom jabber-roster-sort-functions
- '(jabber-roster-sort-by-status jabber-roster-sort-by-displayname)
- "Sort roster according to these criteria.
-
-These functions should take two roster items A and B, and return:
-<0 if A < B
-0 if A = B
->0 if A > B."
- :type 'hook
- :options '(jabber-roster-sort-by-status
- jabber-roster-sort-by-displayname
- jabber-roster-sort-by-group))
-
-(defcustom jabber-sort-order '("chat" "" "away" "dnd" "xa")
- "Sort by status in this order. Anything not in list goes last.
-Offline is represented as nil."
- :type '(repeat (restricted-sexp :match-alternatives (stringp nil))))
-
(defcustom jabber-remove-newlines t
"Remove newlines in status messages?
Newlines in status messages mess up the roster display. However,
@@ -604,14 +586,6 @@ entry is offered to clear the scope."
;;; Roster data management
-(defun jabber-roster--accounts-for-jid (jid)
- "Return list of connections that have JID in their roster."
- (let ((sym (jabber-jid-symbol jid)))
- (cl-remove-if-not
- (lambda (jc)
- (memq sym (plist-get (fsm-get-state-data jc) :roster)))
- jabber-connections)))
-
(defun jabber-roster-prepare-roster (jc)
"Make a hash based roster.
JC is the Jabber connection."
@@ -637,63 +611,6 @@ JC is the Jabber connection."
(plist-put state-data :roster-hash
hash)))
-(defun jabber-sort-roster (jc)
- "Sort roster according to online status.
-JC is the Jabber connection."
- (let ((state-data (fsm-get-state-data jc)))
- (dolist (group (plist-get state-data :roster-groups))
- (let ((group-name (car group)))
- (puthash group-name
- (sort
- (gethash group-name
- (plist-get state-data :roster-hash))
- #'jabber-roster-sort-items)
- (plist-get state-data :roster-hash))))))
-
-(defun jabber-roster-sort-items (a b)
- "Sort roster items A and B according to `jabber-roster-sort-functions'.
-Return t if A is less than B."
- (cl-dolist (fn jabber-roster-sort-functions)
- (let ((comparison (funcall fn a b)))
- (cond
- ((< comparison 0)
- (cl-return t))
- ((> comparison 0)
- (cl-return nil))))))
-
-(defun jabber-roster-sort-by-status (a b)
- "Sort roster items A and B by online status.
-See `jabber-sort-order' for order used."
- (cl-flet ((order (item) (length (member (get item 'show)
jabber-sort-order))))
- (let ((a-order (order a))
- (b-order (order b)))
- (cond
- ((< a-order b-order)
- 1)
- ((> a-order b-order)
- -1)
- (t
- 0)))))
-
-(defun jabber-roster-sort-by-displayname (a b)
- "Sort roster items A and B by displayed name."
- (let ((a-name (jabber-jid-displayname a))
- (b-name (jabber-jid-displayname b)))
- (cond
- ((string-lessp a-name b-name) -1)
- ((string= a-name b-name) 0)
- (t 1))))
-
-(defun jabber-roster-sort-by-group (a b)
- "Sort roster items A and B by group membership."
- (cl-flet ((first-group (item) (or (car (get item 'groups)) "")))
- (let ((a-group (first-group a))
- (b-group (first-group b)))
- (cond
- ((string-lessp a-group b-group) -1)
- ((string= a-group b-group) 0)
- (t 1)))))
-
(defun jabber-fix-status (status)
"Make STATUS strings more readable."
(when status
diff --git a/tests/jabber-test-roster.el b/tests/jabber-test-roster.el
index 46511666d6..da30a00eea 100644
--- a/tests/jabber-test-roster.el
+++ b/tests/jabber-test-roster.el
@@ -2,7 +2,7 @@
;;; Commentary:
-;; Roster display and contact sorting.
+;; Roster display.
;;; Code:
@@ -17,82 +17,7 @@
(require 'jabber-roster)
-;;; Group 1: jabber-roster-sort-by-status
-
-(ert-deftest jabber-test-roster-sort-by-status-online-vs-away ()
- "Online user sorts before away user."
- (let ((jabber-sort-order '("chat" "" "away" "dnd" "xa"))
- (a (make-symbol "[email protected]"))
- (b (make-symbol "[email protected]")))
- (put a 'show "")
- (put b 'show "away")
- (should (< (jabber-roster-sort-by-status a b) 0))))
-
-(ert-deftest jabber-test-roster-sort-by-status-same ()
- "Same status returns 0."
- (let ((jabber-sort-order '("chat" "" "away" "dnd" "xa"))
- (a (make-symbol "[email protected]"))
- (b (make-symbol "[email protected]")))
- (put a 'show "away")
- (put b 'show "away")
- (should (= (jabber-roster-sort-by-status a b) 0))))
-
-(ert-deftest jabber-test-roster-sort-by-status-offline-last ()
- "Offline (nil show) sorts after online."
- (let ((jabber-sort-order '("chat" "" "away" "dnd" "xa"))
- (a (make-symbol "[email protected]"))
- (b (make-symbol "[email protected]")))
- (put a 'show nil)
- (put b 'show "")
- (should (> (jabber-roster-sort-by-status a b) 0))))
-
-;;; Group 2: jabber-roster-sort-by-displayname
-
-(ert-deftest jabber-test-roster-sort-by-displayname-order ()
- "Alphabetical ordering by display name."
- (let ((jabber-jid-obarray (make-vector 127 0))
- (a (intern "[email protected]" (make-vector 127 0)))
- (b (intern "[email protected]" (make-vector 127 0))))
- (put a 'name "Alice")
- (put b 'name "Bob")
- (should (< (jabber-roster-sort-by-displayname a b) 0))))
-
-(ert-deftest jabber-test-roster-sort-by-displayname-equal ()
- "Same name returns 0."
- (let ((jabber-jid-obarray (make-vector 127 0))
- (a (intern "[email protected]" (make-vector 127 0)))
- (b (intern "[email protected]" (make-vector 127 0))))
- (put a 'name "Alice")
- (put b 'name "Alice")
- (should (= (jabber-roster-sort-by-displayname a b) 0))))
-
-;;; Group 3: jabber-roster-sort-by-group
-
-(ert-deftest jabber-test-roster-sort-by-group-different ()
- "Different groups sort alphabetically."
- (let ((a (make-symbol "[email protected]"))
- (b (make-symbol "[email protected]")))
- (put a 'groups '("Friends"))
- (put b 'groups '("Work"))
- (should (< (jabber-roster-sort-by-group a b) 0))))
-
-(ert-deftest jabber-test-roster-sort-by-group-same ()
- "Same group returns 0."
- (let ((a (make-symbol "[email protected]"))
- (b (make-symbol "[email protected]")))
- (put a 'groups '("Friends"))
- (put b 'groups '("Friends"))
- (should (= (jabber-roster-sort-by-group a b) 0))))
-
-(ert-deftest jabber-test-roster-sort-by-group-no-group ()
- "No group falls back to empty string."
- (let ((a (make-symbol "[email protected]"))
- (b (make-symbol "[email protected]")))
- (put a 'groups nil)
- (put b 'groups '("Work"))
- (should (< (jabber-roster-sort-by-group a b) 0))))
-
-;;; Group 4: jabber-fix-status
+;;; Group 1: jabber-fix-status
(ert-deftest jabber-test-roster-fix-status-trailing-newlines ()
"Trailing newlines are removed."
@@ -113,7 +38,7 @@
"Nil input returns nil."
(should (null (jabber-fix-status nil))))
-;;; Group 5: Face definitions
+;;; Group 2: Face definitions
(ert-deftest jabber-test-roster-faces-use-inherit ()
"Modernized roster faces use :inherit."
