Update of /cvsroot/emacs-jabber/emacs-jabber
In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv18162
Modified Files:
jabber-presence.el
Log Message:
Revision: ma...@fr...--2005/emacs-jabber--cvs-head--0--patch-462
Creator: Magnus Henoch <ma...@fr...>
Optimization: batch roster update from presence packets
Index: jabber-presence.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-presence.el,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -d -r1.42 -r1.43
--- jabber-presence.el 13 Jan 2008 18:13:15 -0000 1.42
+++ jabber-presence.el 2 Mar 2008 04:19:48 -0000 1.43
@@ -113,6 +113,16 @@
(when (eq closure-data 'initial)
(run-hook-with-args 'jabber-post-connect-hooks jc)))
+(defvar jabber-pending-presence-updates nil
+ "List of presence updates waiting to be displayed in roster.
+Each element is (JC . JID-SYMBOL).")
+
+(defvar jabber-pending-presence-timer nil
+ "Timer for running `jabber-handle-pending-presence-updates'.")
+
+(defvar jabber-pending-presence-timeout 0.5
+ "Wait this long before doing presence packet batch processing.")
+
(add-to-list 'jabber-presence-chain 'jabber-process-presence)
(defun jabber-process-presence (jc xml-data)
"process incoming presence tags"
@@ -205,7 +215,12 @@
(put buddy 'resources (cons (cons resource resource-plist) (get buddy 'resources))))
(jabber-prioritize-resources buddy))
- (jabber-roster-update jc nil (list buddy) nil)
+ (push (cons jc buddy) jabber-pending-presence-updates)
+ (unless jabber-pending-presence-timer
+ (run-with-idle-timer
+ jabber-pending-presence-timeout
+ nil
+ 'jabber-handle-pending-presence-updates))
(dolist (hook '(jabber-presence-hooks jabber-alert-presence-hooks))
(run-hook-with-args hook
@@ -219,6 +234,20 @@
newstatus
(plist-get resource-plist 'status)))))))))))
+(defun jabber-handle-pending-presence-updates ()
+ (let (updates-by-account x)
+ (while (setq x (pop jabber-pending-presence-updates))
+ (let* ((jc (car x))
+ (jid (cdr x))
+ (entry (assq (car x) updates-by-account)))
+ (if entry
+ (push jid (cdr entry))
+ (push (list jc jid) updates-by-account))))
+
+ (dolist (account-jids updates-by-account)
+ (jabber-roster-update (car account-jids) nil (cdr account-jids) nil)))
+ (setf jabber-pending-presence-timer nil))
+
(defun jabber-process-subscription-request (jc from presence-status)
"process an incoming subscription request"
(with-current-buffer (jabber-chat-create-buffer jc from)
|
