From 2fc4e793b12341df6264e22c0b8bd0f6dd2bd27d Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Thu, 29 Apr 2021 15:20:11 +0200
Subject: Added pop-up and events in editor

---
 editor/actions.ml | 93 ++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 65 insertions(+), 28 deletions(-)

(limited to 'editor/actions.ml')

diff --git a/editor/actions.ml b/editor/actions.ml
index 3b17dae..f7633e1 100755
--- a/editor/actions.ml
+++ b/editor/actions.ml
@@ -1,9 +1,12 @@
 open StdLabels
+open Js_of_ocaml
 open Brr
 open Brr_note
 
 type button_actions =
-  { delete : El.t * (unit Note.event)
+  { delete : unit Note.event
+  ; redirect : Jstr.t option Note.event
+  ; add: unit Note.event
   }
 
 let populate_menu () =
@@ -11,7 +14,6 @@ let populate_menu () =
   | None -> None
   | Some element ->
     let () = Blog.Sidebar.clean element in
-    let uri = Brr.Window.location Brr.G.window in
 
     let delete_button = El.button
         ~at:At.[ class' (Jstr.v "action-button") ]
@@ -20,46 +22,79 @@ let populate_menu () =
             ~at:At.[ class' (Jstr.v "fa")
                    ; class' (Jstr.v "fa-2x")
                    ; class' (Jstr.v "fa-trash")
-                   ]
-        ] in
+                   ] ]
+
+    and home_button = El.button
+        ~at:At.[ class' (Jstr.v "action-button") ]
+        [ El.i
+            []
+            ~at:At.[ class' (Jstr.v "fa")
+                   ; class' (Jstr.v "fa-2x")
+                   ; class' (Jstr.v "fa-home")
+                   ] ]
+
+    and add_button = El.button
+        ~at:At.[ class' (Jstr.v "action-button") ]
+        [ El.i
+            []
+            ~at:At.[ class' (Jstr.v "fa")
+                   ; class' (Jstr.v "fa-2x")
+                   ; class' (Jstr.v "fa-plus")
+                   ] ]
+
+    in
 
     let delete_event =
       Evr.on_el
         Ev.click
         Evr.unit
-        delete_button in
+        delete_button
+    and add_event =
+      Evr.on_el
+        Ev.click
+        Evr.unit
+        add_button in
 
+    let stored_pages = Storage.get_ids () in
     let pages =
+      List.map
+        stored_pages
+        ~f:(fun id ->
 
-      List.map (Storage.get_ids ())
-        ~f:(fun name ->
-            let target =
-              Jstr.( (Brr.Uri.path uri)
-                     + (Jstr.v "?page=")
-                     + name) in
+            let name_opt = (Storage.load (Some id))##.title in
+            let name = Js.Opt.get
+                name_opt
+                (fun () -> id) in
+
+            let target = Jstr.v "#" in
             El.li
               [ El.a
                   ~at:[At.href target]
                   [ El.txt name ] ]
           ) in
 
+    (* Wait for a click on an existing page in order to sent the associated
+       event.
+
+       We compose the resulting event with both :
+       - the home button
+       - the list for all the pages presents in the sidebar *)
+    let redirect_event = Note.E.select
+        (( Evr.on_el
+             Ev.click
+             (fun _ -> None)
+             home_button
+         ) :: (
+           List.map2 stored_pages pages
+             ~f:(fun name el ->
+                 Evr.on_el
+                   Ev.click
+                   (fun _ -> Some name)
+                   el ))) in
+
     let childs =
-      [ El.button
-          ~at:At.[class' (Jstr.v "action-button")]
-          [ El.i
-              []
-              ~at:At.[ class' (Jstr.v "fa")
-                     ; class' (Jstr.v "fa-2x")
-                     ; class' (Jstr.v "fa-home") ]
-          ]
-      ; El.button
-          ~at:At.[class' (Jstr.v "action-button")]
-          [ El.i
-              []
-              ~at:At.[ class' (Jstr.v "fa")
-                     ; class' (Jstr.v "fa-2x")
-                     ; class' (Jstr.v "fa-plus") ]
-          ]
+      [ home_button
+      ; add_button
       ; El.button
           ~at:At.[class' (Jstr.v "action-button")]
           [ El.i
@@ -84,5 +119,7 @@ let populate_menu () =
 
     let () = El.append_children element childs in
     Some
-      { delete = (delete_button, delete_event)
+      { delete = delete_event
+      ; redirect = redirect_event
+      ; add = add_event
       }
-- 
cgit v1.2.3