Fix lambda term work with lwt3 and lwt4

src/jbuild

@@ -4,13 +4,19 @@
  ((name lambda_term)
   (public_name lambda-term)
   (wrapped false)
-  (libraries (lwt lwt.unix lwt_react zed))
+  (libraries
+   (lwt lwt_react zed
+    (select lTerm_sequence.ml from
+     (lwt.unix -> lTerm_sequence_lwt3.ml)
+     (lwt-unix -> lTerm_sequence_lwt4.ml))
+    (select lTerm_sequence.mli from
+     (lwt.unix -> lTerm_sequence_lwt3.mli)
+     (lwt-unix -> lTerm_sequence_lwt4.mli))))
   (flags (:standard -safe-string))
   (synopsis "Cross-platform library for terminal manipulation")
   (c_names (lTerm_term_stubs lTerm_unix_stubs lTerm_windows_stubs))
   (c_flags         (:standard (:include c_flags)))
-  (c_library_flags (:standard (:include c_library_flags)))
-  ))
+  (c_library_flags (:standard (:include c_library_flags)))))
 
 (ocamllex (lTerm_inputrc lTerm_resource_lexer))
 

src/lTerm.ml

@@ -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_sequence.add_r send_resize Lwt_main.enter_iter_hooks)
     | 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_sequence.add_r send_resize Lwt_main.enter_iter_hooks)
 
 (* +-----------------------------------------------------------------+
    | Creation                                                        |

src/lTerm_buttons_impl.ml

@@ -28,7 +28,7 @@ class button ?(brackets=("< "," >")) initial_label =
 
   method! can_focus = true
 
-  val click_callbacks = Lwt_sequence.create ()
+  val click_callbacks = LTerm_sequence.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_sequence.create ()
 
   method on_state_change ?switch f =
     register switch state_change_callbacks f

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_sequence.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_sequence.create ()
   method on_scrollbar_change ?switch (f : unit -> unit) =
     LTerm_widget_callbacks.register switch scrollbar_change_callbacks f
 

src/lTerm_sequence_lwt3.ml

@@ -0,0 +1,2 @@
+[@@@ocaml.warning "-3"]
+include Lwt_sequence

src/lTerm_sequence_lwt3.mli

@@ -0,0 +1,2 @@
+[@@@ocaml.warning "-3"]
+include module type of Lwt_sequence with type 'a t = 'a Lwt_sequence.t

src/lTerm_sequence_lwt4.ml

@@ -0,0 +1,242 @@
+(* 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.
+ *)
+
+exception Empty
+
+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 get node =
+  node.node_data
+
+let set node data =
+  node.node_data <- data
+
+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 is_empty seq = seq.next == seq
+
+let length seq =
+  let rec loop curr len =
+    if curr == seq then
+      len
+    else
+      let node = node_of_seq curr in loop node.node_next (len + 1)
+  in
+  loop seq.next 0
+
+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 add_r data seq =
+  let node = { node_prev = seq.prev; node_next = seq; node_data = data; node_active = true } in
+  seq.prev.next <- seq_of_node node;
+  seq.prev <- seq_of_node node;
+  node
+
+let take_l seq =
+  if is_empty seq then
+    raise Empty
+  else begin
+    let node = node_of_seq seq.next in
+    remove node;
+    node.node_data
+  end
+
+let take_r seq =
+  if is_empty seq then
+    raise Empty
+  else begin
+    let node = node_of_seq seq.prev in
+    remove node;
+    node.node_data
+  end
+
+let take_opt_l seq =
+  if is_empty seq then
+    None
+  else begin
+    let node = node_of_seq seq.next in
+    remove node;
+    Some node.node_data
+  end
+
+let take_opt_r seq =
+  if is_empty seq then
+    None
+  else begin
+    let node = node_of_seq seq.prev in
+    remove node;
+    Some node.node_data
+  end
+
+let transfer_l s1 s2 =
+  s2.next.prev <- s1.prev;
+  s1.prev.next <- s2.next;
+  s2.next <- s1.next;
+  s1.next.prev <- s2;
+  s1.prev <- s1;
+  s1.next <- s1
+
+let transfer_r s1 s2 =
+  s2.prev.next <- s1.next;
+  s1.next.prev <- s2.prev;
+  s2.prev <- s1.prev;
+  s1.prev.next <- s2;
+  s1.prev <- s1;
+  s1.next <- s1
+
+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 iter_r 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_prev
+    end
+  in
+  loop seq.prev
+
+let iter_node_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;
+      loop node.node_next
+    end
+  in
+  loop seq.next
+
+let iter_node_r 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;
+      loop node.node_prev
+    end
+  in
+  loop seq.prev
+
+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
+
+let fold_r 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_prev (f node.node_data acc)
+      else
+        loop node.node_prev acc
+  in
+  loop seq.prev acc
+
+let find_node_l f seq =
+  let rec loop curr =
+    if curr != seq then
+      let node = node_of_seq curr in
+      if node.node_active then
+        if f node.node_data then
+          node
+        else
+          loop node.node_next
+      else
+        loop node.node_next
+    else
+      raise Not_found
+  in
+  loop seq.next
+
+let find_node_r f seq =
+  let rec loop curr =
+    if curr != seq then
+      let node = node_of_seq curr in
+      if node.node_active then
+        if f node.node_data then
+          node
+        else
+          loop node.node_prev
+      else
+        loop node.node_prev
+    else
+      raise Not_found
+  in
+  loop seq.prev
+
+let find_node_opt_l f seq =
+  try Some (find_node_l f seq) with Not_found -> None
+
+let find_node_opt_r f seq =
+  try Some (find_node_r f seq) with Not_found -> None