~~~ save ~~~ (C-x C-s)

ogui.ml

@@ -6,16 +6,6 @@ module Str = Re.Str
 module Lwd = struct
   open Lwt_react
 
-  (*module S = struct
-      include Lwt_react.S
-
-      include Lwt_react.S.Make (struct
-        type 'a t
-
-        let equal = Stdlib.( == )
-      end)
-    end*)
-
   type 'a var = 'a React.signal * (?step:React.step -> 'a -> unit)
   type 'a t = 'a React.signal
 
@@ -33,11 +23,11 @@ module Lwd = struct
     S.l2 ~eq f a b
 
   let map_s ?(eq = eq) ~(f : 'a -> 'b Lwt.t) (a : 'a t) : 'b t Lwt.t =
-    S.l1_s f a
+    S.l1_s ~eq f a
 
   let map2_s ?(eq = eq) ~(f : 'a -> 'b -> 'c Lwt.t) (a : 'a t)
       (b : 'b t) : 'c t Lwt.t =
-    S.l2_s f a b
+    S.l2_s ~eq f a b
 
   let bind ?(eq = eq) (a : 'a t) ~(f : 'a -> 'b t) : 'b t =
     S.bind ~eq a f
@@ -299,6 +289,29 @@ module TextBuffer = struct
   let length { path; tree; _ } =
     Store.S.Tree.get (Lwd.peek tree) (Lwd.peek path) >>= fun text ->
     Lwt.return (String.length text)
+
+  let save { path; tree; repo } =
+    Store.S.Tree.get (Lwd.peek tree) (Lwd.peek path)
+    >>= fun contents ->
+    repo >>= fun r ->
+    Store.S.set
+      ~info:
+        Store.S.Info.(
+          fun () ->
+            v ~author:"me" ~message:"TextBuffer.save"
+              (Unix.time () |> Int64.of_float))
+      r (Lwd.peek path) contents
+    >>= fun r ->
+    (match r with
+    | Ok () -> ()
+    | Error (`Conflict s) ->
+        F.epr "TextBuffer.save Error `Conflict %s@." s
+    | Error (`Too_many_retries n) ->
+        F.epr "TextBuffer.save Error `Too_many_retries %d@." n
+    | Error (`Test_was n) ->
+        F.epr "TextBuffer.save Error `Test_was %s@."
+          "<not implemented>");
+    Lwt.return_unit
 end
 
 module Event = struct
@@ -737,7 +750,6 @@ module Ui = struct
   let process_key t (resolver : action list Event.result)
       (state : Event.key_action) (key : Event.key)
       (mods : Event.key_mod list) : action list Event.result Lwt.t =
-    F.epr "process_key1@.";
     let res =
       match resolver with
       | Event.Rejected | Event.Accepted _ ->
@@ -748,24 +760,17 @@ module Ui = struct
           ]
       | Event.Continue r -> r
     in
-    F.epr "process_key2@.";
     let res = Event.resolve (Key (state, key, mods)) res in
-    F.epr "process_key3@.";
     (match res with
     | Event.Accepted actions ->
         let rec exec : action list -> unit Lwt.t = function
           | Custom (name, f) :: actions ->
-              f () >>= fun () ->
+              f () >>= fun () -> exec actions
-              F.epr "process_key4 %s f ()@." name;
-              exec actions
           | [] -> Lwt.return_unit
         in
-        F.epr "process_key5@.";
         exec actions >>= fun () -> Lwt.return_unit
     | Event.Continue _ | Event.Rejected -> Lwt.return_unit)
-    >>= fun () ->
+    >>= fun () -> Lwt.return res
-    F.epr "process_key5@.";
-    Lwt.return res
 
   let update_bindings ui
       (f : action list Event.t -> action list Event.t) =
@@ -804,7 +809,9 @@ module Ui = struct
                   (* junk the `Char that is sent with a `Key that has no mods *)
                   Lwt_stream.peek events
                   >>= function
-                  | Some (`Char _) -> Lwt_stream.junk events
+                  | Some (`Char _) ->
+                      F.epr "process_events: junking next event@.";
+                      Lwt_stream.junk events
                   | _ -> Lwt.return_unit)
               | Accepted _ | Continue _ | Rejected -> Lwt.return_unit)
               >>= fun () -> proc res
@@ -1155,6 +1162,17 @@ module TextEdit = struct
                    fun () ->
                      Lwd.set t.mark None;
                      Lwt.return_unit );
+             ]
+        |> adds
+             [
+               [
+                 Key (Press, X, [ Control ]);
+                 Key (Press, S, [ Control ]);
+               ];
+             ]
+             (* Save *)
+             [
+               Custom ("save_buffer", fun () -> TextBuffer.save t.text);
              ]);
 
     Ui.chrcallback_ref :=
@@ -1293,8 +1311,6 @@ module Layout = struct
                        ui;
                      Lwt.return_unit );
              ]);
-    (* let teln = List.length telist in *)
-    (* let ratio n = `Ratio (1. /. float (teln - (n + 1))) in *)
     Lwd.map_s
       ~f:(fun (_, tl) ->
         Lwt_list.mapi_s