Update of /cvsroot/emacs-jabber/emacs-jabber
In directory sc8-pr-cvs17.sourceforge.net:/tmp/cvs-serv6055
Modified Files:
jabber-core.el jabber-presence.el
Log Message:
Revision: ma...@fr...--2005/emacs-jabber--cvs-head--0--patch-466
Creator: Magnus Henoch <ma...@fr...>
Move roster update batch processing to jabber-connection FSM
Index: jabber-core.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-core.el,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -d -r1.84 -r1.85
--- jabber-core.el 28 Feb 2008 22:11:26 -0000 1.84
+++ jabber-core.el 4 Mar 2008 07:23:27 -0000 1.85
@@ -665,6 +665,9 @@
#'jabber-report-success "Roster retrieval")
(list (plist-put state-data :ever-session-established t) nil))
+(defvar jabber-pending-presence-timeout 0.5
+ "Wait this long before doing presence packet batch processing.")
+
(define-state jabber-connection :session-established
(fsm state-data event callback)
(case (or (car-safe event) event)
@@ -672,7 +675,7 @@
(let ((process (cadr event))
(string (car (cddr event))))
(jabber-pre-filter process string fsm)
- (list :session-established state-data)))
+ (list :session-established state-data :keep)))
(:sentinel
(jabber-fsm-handle-sentinel state-data event))
@@ -682,14 +685,39 @@
(jabber-process-stream-error (cadr event) state-data)
(progn
(jabber-process-input fsm (cadr event))
- (list :session-established state-data))))
+ (list :session-established state-data :keep))))
+
+ (:roster-update
+ ;; Batch up roster updates
+ (let* ((jid-symbol-to-update (cdr event))
+ (pending-updates (plist-get state-data :roster-pending-updates)))
+ ;; If there are pending updates, there is a timer running
+ ;; already; just add the new symbol and wait.
+ (if pending-updates
+ (progn
+ (unless (memq jid-symbol-to-update pending-updates)
+ (nconc pending-updates (list jid-symbol-to-update))
+ (list :session-established state-data :keep)))
+ ;; Otherwise, we need to create the list and start the timer.
+ (setq state-data
+ (plist-put state-data
+ :roster-pending-updates
+ (list jid-symbol-to-update)))
+ (list :session-established state-data jabber-pending-presence-timeout))))
+
+ (:timeout
+ ;; Update roster
+ (let ((pending-updates (plist-get state-data :roster-pending-updates)))
+ (setq state-data (plist-put state-data :roster-pending-updates nil))
+ (jabber-roster-update fsm nil pending-updates nil)
+ (list :session-established state-data)))
(:send-if-connected
;; This is the only state in which we respond to such messages.
;; This is to make sure we don't send anything inappropriate
;; during authentication etc.
(jabber-send-sexp fsm (cdr event))
- (list :session-established state-data))
+ (list :session-established state-data :keep))
(:do-disconnect
(jabber-send-string fsm "</stream:stream>")
Index: jabber-presence.el
===================================================================
RCS file: /cvsroot/emacs-jabber/emacs-jabber/jabber-presence.el,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -d -r1.45 -r1.46
--- jabber-presence.el 2 Mar 2008 16:36:38 -0000 1.45
+++ jabber-presence.el 4 Mar 2008 07:23:27 -0000 1.46
@@ -113,16 +113,6 @@
(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"
@@ -215,13 +205,7 @@
(put buddy 'resources (cons (cons resource resource-plist) (get buddy 'resources))))
(jabber-prioritize-resources buddy))
- (push (cons jc buddy) jabber-pending-presence-updates)
- (unless jabber-pending-presence-timer
- (setq jabber-pending-presence-timer
- (run-with-idle-timer
- jabber-pending-presence-timeout
- nil
- 'jabber-handle-pending-presence-updates)))
+ (fsm-send jc (cons :roster-update buddy))
(dolist (hook '(jabber-presence-hooks jabber-alert-presence-hooks))
(run-hook-with-args hook
@@ -235,20 +219,6 @@
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)
|
