Update for lwt 4.0.0

examples/editor.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open Lwt
 
 let main () =

examples/read_yes_no.ml

@@ -11,7 +11,7 @@ open Lwt
 
 let rec read_char term =
   LTerm.read_event term >>= function
-    | LTerm_event.Key { LTerm_key.code = LTerm_key.Char ch; LTerm_key.control = true ; _ } when ch = CamomileLibraryDyn.Camomile.UChar.of_char 'c' ->
+    | LTerm_event.Key { LTerm_key.code = LTerm_key.Char ch; LTerm_key.control = true ; _ } when ch = CamomileLibraryDefault.Camomile.UChar.of_char 'c' ->
         (* Exit on Ctrl+C *)
         Lwt.fail (Failure "interrupted")
     | LTerm_event.Key { LTerm_key.code = LTerm_key.Char ch ; _ } ->

examples/shell.ml

@@ -9,7 +9,7 @@
 
 (* A mini shell *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open React
 open Lwt
 open LTerm_style

lambda-term.opam

@@ -11,6 +11,7 @@ build: [
 ]
 depends: [
   "lwt"   {>= "2.7.0"}
+  "lwt_log"
   "react"
   "zed"   {>= "1.2"}
   "camomile" {>= "0.8.6"}

print_sequences.ml

@@ -34,10 +34,10 @@ let () =
   };
   (* Read and print key sequences. *)
   print_endline "press 'q' to quit";
-  let buf = String.create 128 in
+  let buf = Bytes.create 128 in
   let rec loop () =
-    let n = Unix.read Unix.stdin buf 0 (String.length buf) in
-    let s = String.sub buf 0 n in
+    let n = Unix.read Unix.stdin buf 0 (Bytes.length buf) in
+    let s = Bytes.to_string (Bytes.sub buf 0 n) in
     print_endline (String.escaped s);
     if s <> "q" then loop ()
   in

src/jbuild

@@ -4,7 +4,7 @@
  ((name lambda_term)
   (public_name lambda-term)
   (wrapped false)
-  (libraries (lwt lwt.unix lwt_react zed))
+  (libraries (lwt lwt.unix lwt_react zed lwt_log))
   (flags (:standard -safe-string))
   (synopsis "Cross-platform library for terminal manipulation")
   (c_names (lTerm_term_stubs lTerm_unix_stubs lTerm_windows_stubs))

src/lTerm.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open Lwt_react
 open LTerm_geom
 
@@ -112,12 +112,12 @@ let () =
   match LTerm_unix.sigwinch with
     | None ->
         (* Check for size when something happen. *)
-        ignore (Lwt_sequence.add_r send_resize Lwt_main.enter_iter_hooks)
+        ignore (LTerm_dlist.add_l send_resize (LTerm_dlist.create ()))
     | Some signum ->
         try
           ignore (Lwt_unix.on_signal signum (fun _ -> send_resize ()))
         with Not_found ->
-          ignore (Lwt_sequence.add_r send_resize Lwt_main.enter_iter_hooks)
+          ignore (LTerm_dlist.add_l send_resize (LTerm_dlist.create ()))
 
 (* +-----------------------------------------------------------------+
    | Creation                                                        |

src/lTerm_buttons_impl.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open LTerm_geom
 open LTerm_key
 open LTerm_mouse
@@ -28,7 +28,7 @@ class button ?(brackets=("< "," >")) initial_label =
 
   method! can_focus = true
 
-  val click_callbacks = Lwt_sequence.create ()
+  val click_callbacks = LTerm_widget_callbacks.create ()
 
   method on_click ?switch f =
     register switch click_callbacks f
@@ -121,7 +121,7 @@ end
 
 class ['a] radiogroup  = object
 
-  val state_change_callbacks = Lwt_sequence.create ()
+  val state_change_callbacks = LTerm_widget_callbacks.create ()
 
   method on_state_change ?switch f =
     register switch state_change_callbacks f

src/lTerm_dlist.ml

@@ -0,0 +1,84 @@
+(* OCaml promise library
+ * http://www.ocsigen.org/lwt
+ * Copyright (C) 2009 Jérémie Dimino
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as
+ * published by the Free Software Foundation, with linking exceptions;
+ * either version 2.1 of the License, or (at your option) any later
+ * version. See COPYING file for details.
+ *
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ * 02111-1307, USA.
+ *)
+
+type 'a t = {
+  mutable prev : 'a t;
+  mutable next : 'a t;
+}
+
+type 'a node = {
+  mutable node_prev : 'a t;
+  mutable node_next : 'a t;
+  mutable node_data : 'a;
+  mutable node_active : bool;
+}
+
+external seq_of_node : 'a node -> 'a t = "%identity"
+external node_of_seq : 'a t -> 'a node = "%identity"
+
+(* +-----------------------------------------------------------------+
+   | Operations on nodes                                             |
+   +-----------------------------------------------------------------+ *)
+
+let remove node =
+  if node.node_active then begin
+    node.node_active <- false;
+    let seq = seq_of_node node in
+    seq.prev.next <- seq.next;
+    seq.next.prev <- seq.prev
+  end
+
+(* +-----------------------------------------------------------------+
+   | Operations on sequences                                         |
+   +-----------------------------------------------------------------+ *)
+
+let create () =
+  let rec seq = { prev = seq; next = seq } in
+  seq
+
+let add_l data seq =
+  let node = { node_prev = seq; node_next = seq.next; node_data = data; node_active = true } in
+  seq.next.prev <- seq_of_node node;
+  seq.next <- seq_of_node node;
+  node
+
+let iter_l f seq =
+  let rec loop curr =
+    if curr != seq then begin
+      let node = node_of_seq curr in
+      if node.node_active then f node.node_data;
+      loop node.node_next
+    end
+  in
+  loop seq.next
+
+let fold_l f seq acc =
+  let rec loop curr acc =
+    if curr == seq then
+      acc
+    else
+      let node = node_of_seq curr in
+      if node.node_active then
+        loop node.node_next (f node.node_data acc)
+      else
+        loop node.node_next acc
+  in
+  loop seq.next acc

src/lTerm_draw.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open LTerm_geom
 
 let unsafe_get matrix line column =

src/lTerm_edit.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open Zed_edit
 open LTerm_key
 open LTerm_geom

src/lTerm_history.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 
 let return, (>>=) = Lwt.return, Lwt.(>>=)
 

src/lTerm_inputrc.mll

@@ -8,7 +8,7 @@
  *)
 
 {
-  open CamomileLibraryDyn.Camomile
+  open CamomileLibraryDefault.Camomile
   open LTerm_key
 
   let return, (>>=) = Lwt.return, Lwt.(>>=)

src/lTerm_key.ml

@@ -14,7 +14,7 @@ module String = struct
   include String
 end
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 
 type code =
   | Char of UChar.t

src/lTerm_read_line.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open Lwt_react
 open LTerm_geom
 open LTerm_style

src/lTerm_scroll_impl.ml

@@ -20,7 +20,7 @@ let map_range range1 range2 offset1 =
 class adjustment = object(self)
 
   (* callbacks *)
-  val offset_change_callbacks = Lwt_sequence.create ()
+  val offset_change_callbacks = LTerm_widget_callbacks.create ()
   method on_offset_change ?switch (f : int -> unit) =
     LTerm_widget_callbacks.register switch offset_change_callbacks f
 
@@ -46,7 +46,7 @@ end
 class scrollable_adjustment = object(self)
   inherit adjustment as adj
 
-  val scrollbar_change_callbacks = Lwt_sequence.create ()
+  val scrollbar_change_callbacks = LTerm_widget_callbacks.create ()
   method on_scrollbar_change ?switch (f : unit -> unit) =
     LTerm_widget_callbacks.register switch scrollbar_change_callbacks f
 

src/lTerm_text.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open LTerm_style
 
 type t = (UChar.t * LTerm_style.t) array

src/lTerm_unix.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open LTerm_key
 
 let return, (>>=), (>|=) = Lwt.return, Lwt.(>>=), Lwt.(>|=)

src/lTerm_unix.mli

@@ -9,7 +9,7 @@
 
 (** Unix specific functions *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 
 val sigwinch : int option
   (** The number of the signal used to indicate that the terminal size

src/lTerm_widget.ml

@@ -7,7 +7,7 @@
  * This file is a part of Lambda-Term.
  *)
 
-open CamomileLibraryDyn.Camomile
+open CamomileLibraryDefault.Camomile
 open LTerm_geom
 open LTerm_draw
 

src/lTerm_widget_base_impl.ml

@@ -66,7 +66,7 @@ end = object(self)
   method allocation = allocation
   method set_allocation rect = allocation <- rect
 
-  val event_filters = Lwt_sequence.create ()
+  val event_filters = LTerm_widget_callbacks.create ()
 
   method send_event ev =
     if not (exec_filters event_filters ev) then

src/lTerm_widget_callbacks.ml

@@ -14,16 +14,19 @@ let section = Lwt_log.Section.make "lambda-term(widget_callbacks)"
    +-----------------------------------------------------------------+ *)
 
 type switch = { mutable switch_state : (unit -> unit) list option }
+type 'a callbacks = 'a LTerm_dlist.t
+
+let create () = LTerm_dlist.create ()
 
 let register switch_opt seq f =
   match switch_opt with
     | None ->
-        ignore (Lwt_sequence.add_l f seq)
+        ignore (LTerm_dlist.add_l f seq)
     | Some switch ->
         match switch.switch_state with
           | Some l ->
-              let node = Lwt_sequence.add_l f seq in
-              switch.switch_state <- Some ((fun () -> Lwt_sequence.remove node) :: l)
+              let node = LTerm_dlist.add_l f seq in
+              switch.switch_state <- Some ((fun () -> LTerm_dlist.remove node) :: l)
           | None ->
               ()
 
@@ -36,7 +39,7 @@ let stop switch =
         ()
 
 let exec_callbacks seq x =
-  Lwt_sequence.iter_l
+  LTerm_dlist.iter_l
     (fun f ->
        try
          f x
@@ -45,7 +48,7 @@ let exec_callbacks seq x =
     seq
 
 let exec_filters seq x =
-  Lwt_sequence.fold_l
+  LTerm_dlist.fold_l
     (fun f acc ->
        if acc then
          true

src/lTerm_widget_callbacks.mli

@@ -10,14 +10,18 @@
 type switch
   (** Switches are used to stop signals. *)
 
-val register : switch option -> 'a Lwt_sequence.t -> 'a -> unit
+type 'a callbacks
+
+val create : unit -> 'a callbacks
+
+val register : switch option -> 'a callbacks -> 'a -> unit
   (** *)
 
 val stop : switch -> unit
   (** *)
 
-val exec_callbacks : ('a -> unit) Lwt_sequence.t -> 'a -> unit
+val exec_callbacks : ('a -> unit) callbacks -> 'a -> unit
   (** [apply_callbacks callbacks x] *)
 
-val exec_filters : ('a -> bool) Lwt_sequence.t -> 'a -> bool
+val exec_filters : ('a -> bool) callbacks -> 'a -> bool