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

loads and displays teh git tree

Browse Source
This commit is contained in:
cqc
2023-01-13 05:39:51 -06:00
parent dfef26fcf5
commit 18daf83c1c
3 changed files with 6432 additions and 6222 deletions
Download Patch File Download Diff File Expand all files Collapse all files

70
human.ml
View File

@ -453,19 +453,13 @@ module Nav = struct
let test_pull () : t Lwt.t =
(* test_populate ()*)
Firebug.console##log (Js.string "Nav.test_pull()\n");
S.Repo.v (Config.init "") >>= fun repo ->
Firebug.console##log (Js.string "Nav.test_pull(2)\n");
S.of_branch repo "current" >>= fun t ->
Firebug.console##log (Js.string "Nav.test_pull(3)\n");
Git_console_http.connect Mimic.empty >>= fun ctx ->
Firebug.console##log (Js.string "Nav.test_pull(4)\n");
let upstream =
S.remote ~ctx "https://localhost:8080/console/rootstore.git"
in
Firebug.console##log (Js.string "Nav.test_pull(5)\n");
Sync.fetch_exn t upstream >>= fun _ -> S.tree t
(* irmin/src/irmin/sync.ml: calls S.Remote.Backend.fetch *)
end
module Input = struct
@ -2779,7 +2773,7 @@ module Nottui_widgets = struct
Ui.may_handle (Lwd_table.get row) (fun line -> f row line))
let cursor_move cursor
(f : line Lwd_table.row -> line Lwd_table.row option) =
(f : 'a Lwd_table.row -> 'a Lwd_table.row option) =
match Lwd.peek cursor with
| Some cursor_row -> (
match f cursor_row with
@ -2859,7 +2853,7 @@ module Nottui_widgets = struct
table
|> Lwd.join
|> Lwd.map2
~f:(fun (focus, _) ->
~f:(fun focus ->
Ui.keyboard_area ~focus (fun k ->
Log.debug (fun m ->
m "edit_area handler %a" Ui.pp_key k);
@ -2911,7 +2905,65 @@ module Nottui_widgets = struct
else `Unhandled))
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
| _ -> `Unhandled))
(Lwd.pair (Focus.status focus) (focused_row_of_table table))
(Focus.status focus)
let tree_nav ?(focus = Focus.make ()) tree path : Ui.t Lwd.t Lwt.t =
let table = Lwd_table.make () in
(*
Option.iter
(fun cursor ->
Option.iter (fun first -> Focus.request first.focus)
@@ Lwd_table.get cursor)
(Lwd.peek cursor); *)
let cursor_move cursor
(f : 'a Lwd_table.row -> 'a Lwd_table.row option) =
match Lwd.peek cursor with
| Some cursor_row -> (
match f cursor_row with
| Some new_row ->
Lwd.set cursor (Some new_row);
`Handled
| None -> `Unhandled)
| None -> `Unhandled
in
(* Build view of tree *)
let open Lwt.Infix in
Nav.S.Tree.list tree path >>= fun treelist ->
List.iter (fun te -> Lwd_table.append' table te) treelist;
let cursor = Lwd.var @@ Lwd_table.first table in
Lwt.return
(Lwd_table.map_reduce
(fun _ (s, _) -> Lwd.pure (string s))
(Lwd_utils.lift_monoid Ui.pack_y)
table
|> Lwd.join
|> Lwd.map2
~f:(fun focus ->
Ui.keyboard_area ~focus (fun k ->
Log.debug (fun m ->
m "edit_area handler %a" Ui.pp_key k);
match k with
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' ->
cursor_move cursor (fun c -> Lwd_table.next c)
| `Arrow `Down, _ ->
cursor_move cursor (fun c -> Lwd_table.next c)
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' ->
cursor_move cursor (fun c -> Lwd_table.prev c)
| `Arrow `Up, _ ->
cursor_move cursor (fun c -> Lwd_table.prev c)
| `Uchar u, [ `Meta ] when eq_uc_c u '<' ->
cursor_move cursor (fun _ ->
Lwd_table.first table)
| `Uchar u, [ `Meta ] when eq_uc_c u '>' ->
cursor_move cursor (fun _ ->
Lwd_table.last table)
| `Enter, [] -> `Handled
| `Backspace, [] -> `Unhandled
| `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
| _ -> `Unhandled))
(Focus.status focus))
(** Tab view, where exactly one element of [l] is shown at a time. *)
let tabs (tabs : (string * (unit -> Ui.t Lwd.t)) list) : Ui.t Lwd.t