aboutsummaryrefslogtreecommitdiff
path: root/editor
diff options
context:
space:
mode:
Diffstat (limited to 'editor')
-rwxr-xr-xeditor/actions/editor_actions.ml316
-rwxr-xr-xeditor/actions/editor_actions.mli17
-rwxr-xr-xeditor/editor.ml52
3 files changed, 229 insertions, 156 deletions
diff --git a/editor/actions/editor_actions.ml b/editor/actions/editor_actions.ml
index 70b078b..0053890 100755
--- a/editor/actions/editor_actions.ml
+++ b/editor/actions/editor_actions.ml
@@ -1,157 +1,197 @@
open StdLabels
-open Js_of_ocaml
open Brr
open Brr_note
-let populate_menu
- : unit -> State.event Note.event option
+module Js = Js_of_ocaml.Js
+
+(** This is the attribute attached to each link in which containing the node id
+ pointed by the link. *)
+let note_id_attribute = Jstr.v "data-note-id"
+
+type t =
+ { ev : State.event Note.event
+ ; childs : El.t list
+ ; ul : El.t
+ ; mutable completed : bool
+ }
+
+let build
+ : unit -> t
= fun () ->
- match Blog.Sidebar.get () with
- | None -> None
- | Some element ->
- let () = Blog.Sidebar.clean element in
+ let delete_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-trash") ] ]
+
+ 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") ] ]
+
+ and export_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-download") ]
+ ]
+
+ and load_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-upload") ]
+ ]
+ in
+
+ (* We are waiting for event inside another event ( form validation inside
+ popup creation.
+
+ Note.E.join is used here in order to get only te popup validation. *)
+ let delete_event =
+ Note.E.join (
+ Evr.on_el
+ Ev.click
+ (fun _ -> Delete_page.create ())
+ delete_button)
- let delete_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-trash") ] ]
+ (* Event on popup creation *)
+ and add_event =
+ Note.E.join (
+ Evr.on_el
+ Ev.click
+ (fun _ -> Add_page.create ())
+ add_button)
- 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 export_event =
+ Evr.on_el
+ Ev.click
+ (fun _ -> Export.create ())
+ export_button
- 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") ] ]
+ and import_event =
+ Note.E.join (
+ Evr.on_el
+ Ev.click
+ (fun _ -> Import.create ())
+ load_button)
+ in
- and export_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-download") ]
- ]
- and load_button = El.button
+ let redirect_handler =
+ (module Load_page.M : State.Event with type t = Load_page.M.t ) in
+
+ let ul = El.ul [] 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
+
+ We use the bubble property in order to listen only the [ul] element and
+ not the each entry in the list. This way, there is no recursive loop
+ between the redirect_handler and the dynamic generation of elements
+ inside the [ul] node. *)
+ let redirect_event =
+ Note.E.select
+ [ Evr.on_el
+ Ev.click
+ (fun _ -> State.E (None, redirect_handler))
+ home_button
+ ; Evr.on_el
+ Ev.click
+ (fun ev ->
+ let el = Jv.Id.of_jv @@ Jv.Id.to_jv @@ Ev.target ev in
+ let name = El.at note_id_attribute el in
+ State.E (name, redirect_handler))
+ ul ] in
+
+ let childs =
+ [ home_button
+ ; add_button
+ ; export_button
+ ; load_button
+ ; delete_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-upload") ]
+ ; class' (Jstr.v "fa-cog") ]
]
- in
-
- (* We are waiting for event inside another event ( form validation inside
- popup creation.
-
- Note.E.join is used here in order to get only te popup validation. *)
- let delete_event =
- Note.E.join (
- Evr.on_el
- Ev.click
- (fun _ -> Delete_page.create ())
- delete_button)
-
- (* Event on popup creation *)
- and add_event =
- Note.E.join (
- Evr.on_el
- Ev.click
- (fun _ -> Add_page.create ())
- add_button)
-
- and export_event =
- Evr.on_el
- Ev.click
- (fun _ -> Export.create ())
- export_button
-
- and import_event =
- Note.E.join (
- Evr.on_el
- Ev.click
- (fun _ -> Import.create ())
- load_button)
- in
-
-
- let stored_pages = State.Storage.get_ids () in
- let pages =
- List.map
- stored_pages
- ~f:(fun id ->
-
- let name_opt = (State.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_handler =
- (module Load_page.M : State.Event with type t = Load_page.M.t ) in
-
- let redirect_event = Note.E.select
- (( Evr.on_el
- Ev.click
- (fun _ -> State.E (None, redirect_handler))
- home_button
- ) :: (
- List.map2 stored_pages pages
- ~f:(fun name el ->
- Evr.on_el
- Ev.click
- (fun _ -> State.E ((Some name), redirect_handler))
- el ))) in
-
- let childs =
- [ home_button
- ; add_button
- ; export_button
- ; load_button
- ; delete_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-cog") ]
- ]
- ; El.hr ()
- ; El.ul
- pages
+ ; El.hr ()
+ ; ul
+ ] in
+
+ let result_event =
+ Note.E.select
+ [ delete_event
+ ; redirect_event
+ ; add_event
+ ; export_event
+ ; import_event
] in
- let () = El.append_children element childs in
-
- Some (
- Note.E.select
- [ delete_event
- ; redirect_event
- ; add_event
- ; export_event
- ; import_event
- ])
+ { ev = result_event
+ ; childs
+ ; ul
+ ; completed = false
+ }
+
+let get_event
+ : t -> State.event Note.event
+ = fun {ev; _} -> ev
+
+(** Collect all the notes in the cache and return them into links. *)
+let get_notes _ =
+ List.map
+ (State.Storage.get_ids ())
+ ~f:(fun id ->
+ let name_opt = (State.Storage.load (Some id))##.title in
+ let name = Js.Opt.get name_opt (fun () -> id) in
+ El.li
+ [ El.a
+ ~at:[ At.href (Jstr.v "#")
+ ; At.v note_id_attribute id
+ ]
+ [ El.txt name ] ])
+
+let complete
+ : t -> State.t Note.event -> El.t list
+ = fun ({ childs; ul ; completed ; _ } as t) change ->
+
+ let () =
+ if completed then
+ raise (Failure "The action panel is already registered") in
+
+ let note_list =
+ Note.E.map get_notes
+ change
+ in
+ t.completed <- true;
+
+ (* Register all the notes at the creation time *)
+ El.set_children ul (get_notes ());
+
+ (* Then register updates *)
+ Elr.set_children ul ~on:note_list;
+
+ childs
diff --git a/editor/actions/editor_actions.mli b/editor/actions/editor_actions.mli
new file mode 100755
index 0000000..48d5676
--- /dev/null
+++ b/editor/actions/editor_actions.mli
@@ -0,0 +1,17 @@
+type t
+
+(** Create the elements to be declareds inside the panel *)
+val build
+ : unit -> t
+
+(* Get the events triggered by the actions buttons *)
+val get_event
+ : t -> State.event Note.event
+
+(* Finalize the creation, register the handler to state update, and return the dom elements.
+
+ Raise an error if already completed.
+
+*)
+val complete
+ : t -> State.t Note.event -> Brr.El.t list
diff --git a/editor/editor.ml b/editor/editor.ml
index 51ff3e4..f27c60c 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -58,20 +58,17 @@ let build_view
view, last_backup
module Store = struct
- type t = unit
+ type t = El.t
let update
: t -> State.t -> State.t
- = fun () state ->
- let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
- let content = Option.map
- (fun el -> El.prop (El.Prop.value) el)
- title_element in
+ = fun title_element state ->
+ let title = El.prop (El.Prop.value) title_element in
let new_date = (new%js Js.date_now)##getTime in
let content_obj = object%js
val content = Js.some @@ Jv.Id.to_jv (state.view##.state##toJSON ())
- val title = Js.Opt.option content
+ val title = Js.some title
val date = Js.some new_date
end in
let save = State.Storage.save
@@ -119,10 +116,12 @@ end
let app id content =
+ let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
(* Check the pre-requisite *)
- let events_opt = Actions.populate_menu () in
- match (Jv.is_none id), (Jv.is_none content), events_opt with
- | false, false, Some btn_events ->
+ match title_element, (Jv.is_none id), (Jv.is_none content), Blog.Sidebar.get () with
+ | Some title, false, false, Some sidebar ->
+
+ let () = Blog.Sidebar.clean sidebar in
let pm = PM.v () in
let editor:El.t = Jv.Id.of_jv id in
@@ -132,24 +131,41 @@ let app id content =
let init_state = State.init pm view last_backup page_id in
+ let side_elements = Editor_actions.build () in
+ let btn_events = Editor_actions.get_event side_elements in
let app_state = State.run
~eq:State.eq
init_state
(Note.E.select
- [ Brr_note.Evr.on_el Ev.focusout (fun _ ->
- (State.E
- ( ()
- , (module Store:State.Event with type t = Store.t)))) editor
+ [ Brr_note.Evr.on_el Ev.focusout
+ (fun _ ->
+ State.E
+ ( title
+ , (module Store:State.Event with type t = Store.t)))
+ editor
+ ; Brr_note.Evr.on_el Ev.focusout
+ (fun _ ->
+ State.E
+ ( title
+ , (module Store:State.Event with type t = Store.t)))
+ title
; btn_events
]) in
- let () =
- Note.S.log app_state (fun _ -> ())
- |> Note.Logr.hold in
+ let change_event =
+ Note.S.changes app_state in
+
+ let childs = Editor_actions.complete side_elements change_event in
+ let () = El.append_children sidebar childs in
+ let _ =
+ Note.E.log change_event
+ (fun _ -> ())
+ |> Option.iter Note.Logr.hold
+ in
()
- | _, _, _ ->
+ | _ ->
Console.(error [str "No element with id '%s' '%s' found"; id ; content])
let () =
generated by cgit v1.2.3 (git 2.46.0) at 2025-10-31 23:46:17 +0000