console/oplevel
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
cqc
2024-07-08 23:00:09 -05:00
parent 0193c3e7f0
commit c065a0423b
1 changed files with 41 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

66
ogui.ml
View File

@ -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.epr "process_key4 %s f ()@." name;
exec actions
f () >>= fun () -> exec actions
| [] -> Lwt.return_unit
in
F.epr "process_key5@.";
exec actions >>= fun () -> Lwt.return_unit
| Event.Continue _ | Event.Rejected -> Lwt.return_unit)
>>= fun () ->
F.epr "process_key5@.";
Lwt.return res
>>= fun () -> 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