Menu
▾
▴
[SCM] emacs-jabber branch, roster-optimisation, updated. 3d32b14025e9eebd69f8dcdb2288d1a2e1431dba
|
From: Magnus H. <leg...@us...> - 2015-04-16 10:48:35
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "emacs-jabber".
The branch, roster-optimisation has been updated
via 3d32b14025e9eebd69f8dcdb2288d1a2e1431dba (commit)
via 8e3e41e386283d8269fe6615dfce1db60c332d1e (commit)
from 9bf8d47f8caa8c346beb45501293650347836794 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 3d32b14025e9eebd69f8dcdb2288d1a2e1431dba
Author: Magnus Henoch <mag...@gm...>
Date: Thu Apr 16 11:28:14 2015 +0100
Display names of loaded files in load-all test
This makes it easier to find which file causes an error when loaded.
diff --git a/tests/load-all.el b/tests/load-all.el
index 77006d9..6e29abd 100644
--- a/tests/load-all.el
+++ b/tests/load-all.el
@@ -3,6 +3,7 @@
(let* ((default-directory (expand-file-name (getenv "top_builddir")))
(elc-files (file-expand-wildcards "*.elc" t)))
(dolist (f elc-files)
+ (princ (format "Loading %s...\n" f))
(load f nil t)))
;; arch-tag: 509c4808-2e92-11dd-9c8c-000a95c2fcd0
commit 8e3e41e386283d8269fe6615dfce1db60c332d1e
Author: Magnus Henoch <mag...@gm...>
Date: Thu Apr 16 11:03:48 2015 +0100
Fix roster item sorting when several items change
When several roster items change at once, the sort order would sometimes
become messed up. Avoid that by treating items being changed specially
while sorting.
Also add several test cases.
diff --git a/jabber-roster.el b/jabber-roster.el
index 9c16241..3a5205a 100644
--- a/jabber-roster.el
+++ b/jabber-roster.el
@@ -856,51 +856,64 @@ three being lists of JID symbols."
(remhash buddy buddy-ewoc-node-hash)))
;; Hm, what is the ewoc data exactly? It's a list, (GROUP BUDDY).
;; BUDDY is a symbol, so it already contains all relevant data.
- (dolist (buddy changed-items)
- (let* ((inhibit-read-only t)
- (entry (gethash buddy buddy-ewoc-node-hash))
- (current-groups (or (get buddy 'groups)
- (list jabber-roster-default-group-name)))
- new-entry)
- (dolist (node entry)
- (if (not (member (caar (ewoc-data node)) current-groups))
- ;; If the contact has been removed from a roster group,
- ;; just remove from display under that roster group.
- (funcall delete-roster-item node)
- ;; Check if the sort order has changed.
- (cond
- ;; Should the item move up?
- ((let ((previous (ewoc-prev ewoc node))
- insert-before)
- (while (let ((previous-buddy (and previous (cadr (ewoc-data previous)))))
- (when (and previous-buddy
- (jabber-roster-sort-items buddy previous-buddy))
- (setq insert-before previous)
- (setq previous (ewoc-prev ewoc previous))
- t)))
- (when insert-before
- (let ((data (ewoc-data node)))
- (ewoc-delete ewoc node)
- (push (ewoc-enter-before ewoc insert-before data) new-entry)))))
- ;; Should the item move down?
- ((let ((next (ewoc-next ewoc node))
- insert-after)
- (while (let ((next-buddy (and next (cadr (ewoc-data next)))))
- (when (and next-buddy
- (jabber-roster-sort-items next-buddy buddy))
- (setq insert-after next)
- (setq next (ewoc-next ewoc next))
- t)))
- (when insert-after
- (let ((data (ewoc-data node)))
- (ewoc-delete ewoc node)
- (push (ewoc-enter-after ewoc insert-after data) new-entry)))))
- ;; Or should it be updated in place?
- (t
- (ewoc-invalidate ewoc node)
- (push node new-entry)))))
- ;; Update hash table with new ewoc node list.
- (puthash buddy new-entry buddy-ewoc-node-hash)))))))
+ (setq changed-items (sort changed-items #'jabber-roster-sort-items))
+ (let (buddy)
+ (while (setq buddy (pop changed-items))
+ (let* ((inhibit-read-only t)
+ (entry (gethash buddy buddy-ewoc-node-hash))
+ (current-groups (or (get buddy 'groups)
+ (list jabber-roster-default-group-name)))
+ new-entry)
+ (dolist (node entry)
+ (if (not (member (caar (ewoc-data node)) current-groups))
+ ;; If the contact has been removed from a roster group,
+ ;; just remove from display under that roster group.
+ (funcall delete-roster-item node)
+ ;; Check if the sort order has changed.
+ (cond
+ ;; Should the item move up?
+ ((let ((previous (ewoc-prev ewoc node))
+ insert-before)
+ (while (let ((previous-buddy (and previous (cadr (ewoc-data previous)))))
+ (when (and previous-buddy
+ ;; If we're reordering several items at a time,
+ ;; the comparison won't be accurate, since
+ ;; the ewoc position represents the previous
+ ;; state, but the symbol plist represents the
+ ;; current state. Let's always sort upwards
+ ;; for now.
+ (if (memq previous-buddy changed-items)
+ t
+ (jabber-roster-sort-items buddy previous-buddy)))
+ (setq insert-before previous)
+ (setq previous (ewoc-prev ewoc previous))
+ t)))
+ (when insert-before
+ (let ((data (ewoc-data node)))
+ (ewoc-delete ewoc node)
+ (push (ewoc-enter-before ewoc insert-before data) new-entry)))))
+ ;; Should the item move down?
+ ((let ((next (ewoc-next ewoc node))
+ insert-after)
+ (while (let ((next-buddy (and next (cadr (ewoc-data next)))))
+ (when (and next-buddy
+ ;; Ditto but vice versa.
+ (if (memq next-buddy changed-items)
+ nil
+ (jabber-roster-sort-items next-buddy buddy)))
+ (setq insert-after next)
+ (setq next (ewoc-next ewoc next))
+ t)))
+ (when insert-after
+ (let ((data (ewoc-data node)))
+ (ewoc-delete ewoc node)
+ (push (ewoc-enter-after ewoc insert-after data) new-entry)))))
+ ;; Or should it be updated in place?
+ (t
+ (ewoc-invalidate ewoc node)
+ (push node new-entry)))))
+ ;; Update hash table with new ewoc node list.
+ (puthash buddy new-entry buddy-ewoc-node-hash))))))))
(defalias 'jabber-presence-update-roster 'ignore)
;;jabber-presence-update-roster is not needed anymore.
diff --git a/tests/roster-display.el b/tests/roster-display.el
index c16f7c8..8eb9efe 100644
--- a/tests/roster-display.el
+++ b/tests/roster-display.el
@@ -25,6 +25,13 @@
(defvar rd-roster-string nil)
+(defun rd-clear-roster ()
+ (let ((state-data (fsm-get-state-data (car jabber-connections))))
+ ;; First unintern everything:
+ (jabber-clear-roster)
+ (plist-put state-data :roster nil)
+ (plist-put state-data :roster-hash nil)))
+
(defun rd-check-roster-buffer (&optional _jc)
;; The presence stanza causes an asynchronous :roster-update message
;; to be sent. Let's wait for that.
@@ -462,3 +469,117 @@
" * ju...@ca... Online \n"
"__________________________________\n"
"\n"))
+
+(rd-clear-roster)
+
+;; This test case was found through a Quickcheck property.
+(dolist (input '((iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "c...@ex...")) (group () "d") )))
+ (iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "d...@ex...")) (group () "d") )))
+ (iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "e...@ex...")) (group () "d") )))
+ (presence ((from . "e...@ex..."))
+ (show () "dnd"))
+ (presence ((from . "d...@ex...")))))
+ (jabber-process-input (car jabber-connections) input))
+
+(rd-check-roster-buffer)
+
+(rd-compare
+ "Something wrong with ordering"
+ (concat
+ "Jabber roster\n"
+ "__________________________________\n"
+ "\n"
+ " - Online -\n"
+ "ro...@mo...\n"
+ "__________________________________\n"
+ "\n"
+ "d\n"
+ " * d...@ex... Online \n"
+ " * e...@ex... Do not Disturb \n"
+ " c...@ex... Offline \n"
+ "__________________________________\n"
+ "\n"
+ ))
+
+(rd-clear-roster)
+
+;; More Quickcheck test cases.
+(dolist (input '((iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "b...@ex...")) (group () "b") )))
+ (iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "c...@ex...")) (group () "b") )))
+ (iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "a...@ex...")) )))
+ (presence ((from . "b...@ex...")) (show () "away"))
+ (presence ((from . "c...@ex...") (type . "unavailable")))
+ (presence ((from . "a...@ex...")) (show () "dnd"))
+ (iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "a...@ex...")) (group () "b") )))))
+ (jabber-process-input (car jabber-connections) input))
+
+(rd-check-roster-buffer)
+
+(rd-compare
+ "More ordering issues"
+ (concat
+ "Jabber roster\n"
+ "__________________________________\n"
+ "\n"
+ " - Online -\n"
+ "ro...@mo...\n"
+ "__________________________________\n"
+ "\n"
+ "b\n"
+ " * b...@ex... Away \n"
+ " * a...@ex... Do not Disturb \n"
+ " c...@ex... Offline \n"
+ "__________________________________\n"
+ "\n"
+ ))
+
+(rd-clear-roster)
+
+(dolist (input '((iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "c...@ex...")) (group () "b"))))
+ (presence ((from . "c...@ex...")) (show () "away"))
+ (iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "e...@ex...")) (group () "b"))))
+ (presence ((from . "e...@ex...")))
+ (iq ((type . "set"))
+ (query ((xmlns . "jabber:iq:roster"))
+ (item ((jid . "a...@ex...")) (group () "b"))))
+ (presence ((from . "c...@ex...") (type . "unavailable")))
+ ))
+ (jabber-process-input (car jabber-connections) input))
+
+(rd-check-roster-buffer)
+
+(rd-compare
+ "Yet another ordering issue"
+ (concat
+ "Jabber roster\n"
+ "__________________________________\n"
+ "\n"
+ " - Online -\n"
+ "ro...@mo...\n"
+ "__________________________________\n"
+ "\n"
+ "b\n"
+ " * e...@ex... Online \n"
+ " a...@ex... Offline \n"
+ " c...@ex... Offline \n"
+ "__________________________________\n"
+ "\n"
+ ))
-----------------------------------------------------------------------
Summary of changes:
jabber-roster.el | 103 ++++++++++++++++++++++-----------------
tests/load-all.el | 1 +
tests/roster-display.el | 121 +++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 180 insertions(+), 45 deletions(-)
hooks/post-receive
--
emacs-jabber
|
