Allow eventloop callbacks to be modified; expose a compare function on the handle.

diff --git a/libs/stdext/eventloop.ml b/libs/stdext/eventloop.ml
index aa84b5f85df88edd9b7376748c94cec00e20e7ae..9c68fc818322358afa6d243e90683876bee062b8 100644 (file)
--- a/libs/stdext/eventloop.ml
+++ b/libs/stdext/eventloop.ml
@@ -98,6 +98,8 @@ type error = Unix.error * string * string
 
 type handle = Unix.file_descr
 
+let handle_compare = compare
+
 type conn_status =
        | Connecting
        | Listening
@@ -115,7 +117,7 @@ type conn_callbacks =
 
 and conn_state =
 {
-       callbacks : conn_callbacks;
+       mutable callbacks : conn_callbacks;
        mutable status : conn_status;
        mutable send_done_enabled : bool;
        mutable recv_enabled : bool;
@@ -213,6 +215,10 @@ let has_pending_send t handle =
        let conn_state = ConnMap.find handle t.conns in
        Buffer.length conn_state.send_buf > 0
 
+let set_callbacks t handle callbacks =
+       let conn_state = ConnMap.find handle t.conns in
+       conn_state.callbacks <- callbacks
+
 (* timers *)
 
 type timer = Timers.handle
@@ -311,9 +317,9 @@ let dispatch_write t fd cs =
        | Connected ->
                do_send t fd cs;
                if Buffer.length cs.send_buf = 0 then begin
+                       Unixext.Fdset.clear t.writers fd;
                        if cs.send_done_enabled then
-                               cs.callbacks.send_done_callback t fd;
-                       Unixext.Fdset.clear t.writers fd
+                               cs.callbacks.send_done_callback t fd
                end
 
 let dispatch_timers t current_time =

diff --git a/libs/stdext/eventloop.mli b/libs/stdext/eventloop.mli
index 46c5665151ac5b3e58da7faa2f713aa3743dfb14..0bf92562972e14e6b08d443baf9e6e14d28bc72f 100644 (file)
--- a/libs/stdext/eventloop.mli
+++ b/libs/stdext/eventloop.mli
@@ -33,6 +33,9 @@ type conn_callbacks =
        error_callback : t -> handle -> error -> unit;
 }
 
+(* this is to allow collections indexed by connection handles. *)
+val handle_compare : handle -> handle -> int
+
 (* by default, connections are disabled for the send_done callback, and enabled for all others. *)
 val register_conn : t -> Unix.file_descr -> ?enable_send_done:bool -> ?enable_recv:bool -> conn_callbacks -> handle
 val remove_conn : t -> handle -> unit
@@ -50,6 +53,8 @@ val disable_recv : t -> handle -> unit
 val send : t -> handle -> string -> unit
 val has_pending_send : t -> handle -> bool
 
+val set_callbacks : t -> handle -> conn_callbacks -> unit
+
 (* timers *)
 
 type timer