stuff

glfw_types.ml

@@ -1,7 +1,7 @@
 open GLFW
 module F = Fmt
 
-let pp_key : GLFW.key F.t =
+let pp_key : key F.t =
  fun ppf k ->
   F.pf ppf
     GLFW.(

ogui.ml

@@ -730,8 +730,8 @@ module TextLayout = struct
                   else [])
                @
                if
-                 ce >= s
+                 ce > s
-                 && ce < e (* if cursor end is in this section *)
+                 && ce <= e (* if cursor end is in this section *)
                then [ { sec with byte_range = (ce, e) } ]
                else [])
              []
@@ -741,7 +741,10 @@ module TextLayout = struct
   let with_cursor (cur : cursor)
       ?(cursor_format = default_cursor_formatter) layout_job :
       layout_job =
+    let c =
       with_range (cur.index, cur.index + 1) ~cursor_format layout_job
+    in
+    c
 
   let with_mark (mark : int option) (cur : int)
       ?(cursor_format = default_mark_formatter) layout_job :
@@ -1333,15 +1336,14 @@ module Painter = struct
   open Gg
 
   let paint_galley (t : Gv.t) (g : TextLayout.galley) : box2 Lwt.t =
+    TextBuffer.contents g.job.text >>= fun contents ->
+    let contents_len = String.length contents in
     (*F.epr
         "Painter.galley (String.length g.job.text)=%d (Array.length \
          g.rows)=%d @."
-         (Lwt_main.run (TextBuffer.length g.job.text))
+        contents_len (Array.length g.rows);
-         (Array.length g.rows);
       F.epr "g.job=%a@." TextLayout.pp_layout_job g.job;
       F.epr "g.rows=%a@." F.(braces (array TextLayout.pp_row)) g.rows; *)
-    TextBuffer.contents g.job.text >>= fun contents ->
-    let contents_len = String.length contents in
     g.rows
     |> Array.fold_left
          (fun (br : box2) (row : TextLayout.row) ->
@@ -1357,6 +1359,9 @@ module Painter = struct
            in
            assert (List.length sections > 0);
 
+           (*F.epr "paint_galley sections:%a@."
+             F.(list TextLayout.pp_layout_section)
+             sections; *)
            ignore
              (List.fold_left
                 (fun x (sec : TextLayout.layout_section) ->
@@ -1370,7 +1375,6 @@ module Painter = struct
                            (min (snd sec.byte_range)
                               row.text_row.end_index)) )
                   in
-
                   let font_name, font_size =
                     match sec.format.font_id with
                     | Default -> ("mono", 18.)
@@ -1382,15 +1386,28 @@ module Painter = struct
                   Text.set_align t ~align:Align.(left lor top);
                   let metrics = Gv.Text.metrics t in
                   let bounds =
+                    if start == row.text_row.end_index then
+                      (* hack to display cursor at end of row *)
+                      Gv.Text.bounds t ~x ~y:0. " "
+                    else
                       Gv.Text.bounds t ~x ~y:0. ~start ~end_ contents
                   in
+
                   Path.begin_ t;
                   Path.rect t ~x ~y:(Box2.miny row.rect)
                     ~w:bounds.advance ~h:metrics.line_height;
                   set_fill_color t ~color:sec.format.background;
+                  set_stroke_color t
+                    ~color:(Gv.Color.rgbf ~r:0.9 ~g:0.2 ~b:0.2);
+                  set_stroke_width t ~width:2.0;
                   fill t;
 
+                  (* stroke t; *)
                   set_fill_color t ~color:sec.format.color;
+                  (*F.epr "paint_galley row=%d:%d %d:%d %S@."
+                    row.text_row.start_index row.text_row.end_index
+                    start end_
+                    (String.sub contents start (end_ - start)); *)
                   Text.text_w t ~x ~y:(Box2.miny row.rect) ~start
                     ~end_ contents)
                 (Box2.minx row.rect) sections);

store.ml

@@ -21,4 +21,8 @@ let init_default upstream_url : Sync.db Lwt.t =
   S.Repo.v (Irmin_git.Conf.init "../rootstore") >>= fun repo ->
   S.of_branch repo "lablgtk" >>= fun t ->
   S.remote upstream_url >>= fun upstream ->
-  Sync.pull_exn t upstream `Set >>= fun _ -> Lwt.return t
+  (try Sync.pull_exn t upstream `Set >>= fun _ -> Lwt.return_unit
+   with Invalid_argument a ->
+     F.epr "Sync.pull_exn raised Invalid_argument(%s)" a;
+     Lwt.return_unit)
+  >>= fun () -> Lwt.return t