From bf94695abeda0d7bb296ae4cd0f9a53782587d4a Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Mon, 7 Feb 2022 16:14:09 +0100
Subject: Update editor organisation
---
editor/actions.ml | 23 ++--
editor/app.ml | 118 ++++++++++++++++++++
editor/dune | 2 +
editor/editor.ml | 197 +++++----------------------------
editor/footnotes.ml | 248 ------------------------------------------
editor/forms/add_page.ml | 22 +++-
editor/forms/add_page.mli | 6 +-
editor/forms/delete_page.ml | 10 +-
editor/forms/dune | 1 +
editor/forms/events.ml | 17 ++-
editor/link_editor.ml | 127 ---------------------
editor/plugins.ml | 135 -----------------------
editor/plugins/dune | 9 ++
editor/plugins/footnotes.ml | 248 ++++++++++++++++++++++++++++++++++++++++++
editor/plugins/link_editor.ml | 127 +++++++++++++++++++++
editor/plugins/plugins.ml | 137 +++++++++++++++++++++++
editor/plugins/popin.ml | 83 ++++++++++++++
editor/plugins/tooltip.ml | 89 +++++++++++++++
editor/popin.ml | 83 --------------
editor/state/dune | 9 ++
editor/state/state.ml | 70 ++++++++++++
editor/state/state.mli | 24 ++++
editor/state/storage.ml | 137 +++++++++++++++++++++++
editor/state/storage.mli | 36 ++++++
editor/storage.ml | 137 -----------------------
editor/storage.mli | 36 ------
editor/tooltip.ml | 89 ---------------
27 files changed, 1176 insertions(+), 1044 deletions(-)
create mode 100755 editor/app.ml
delete mode 100755 editor/footnotes.ml
delete mode 100755 editor/link_editor.ml
delete mode 100755 editor/plugins.ml
create mode 100755 editor/plugins/dune
create mode 100755 editor/plugins/footnotes.ml
create mode 100755 editor/plugins/link_editor.ml
create mode 100755 editor/plugins/plugins.ml
create mode 100755 editor/plugins/popin.ml
create mode 100755 editor/plugins/tooltip.ml
delete mode 100755 editor/popin.ml
create mode 100755 editor/state/dune
create mode 100755 editor/state/state.ml
create mode 100755 editor/state/state.mli
create mode 100755 editor/state/storage.ml
create mode 100755 editor/state/storage.mli
delete mode 100755 editor/storage.ml
delete mode 100755 editor/storage.mli
delete mode 100755 editor/tooltip.ml
diff --git a/editor/actions.ml b/editor/actions.ml
index f7633e1..0f107f9 100755
--- a/editor/actions.ml
+++ b/editor/actions.ml
@@ -17,30 +17,24 @@ let populate_menu () =
let delete_button = El.button
~at:At.[ class' (Jstr.v "action-button") ]
- [ El.i
- []
+ [ El.i []
~at:At.[ class' (Jstr.v "fa")
; class' (Jstr.v "fa-2x")
- ; class' (Jstr.v "fa-trash")
- ] ]
+ ; class' (Jstr.v "fa-trash") ] ]
and home_button = El.button
~at:At.[ class' (Jstr.v "action-button") ]
- [ El.i
- []
+ [ El.i []
~at:At.[ class' (Jstr.v "fa")
; class' (Jstr.v "fa-2x")
- ; class' (Jstr.v "fa-home")
- ] ]
+ ; class' (Jstr.v "fa-home") ] ]
and add_button = El.button
~at:At.[ class' (Jstr.v "action-button") ]
- [ El.i
- []
+ [ El.i []
~at:At.[ class' (Jstr.v "fa")
; class' (Jstr.v "fa-2x")
- ; class' (Jstr.v "fa-plus")
- ] ]
+ ; class' (Jstr.v "fa-plus") ] ]
in
@@ -49,19 +43,20 @@ let populate_menu () =
Ev.click
Evr.unit
delete_button
+
and add_event =
Evr.on_el
Ev.click
Evr.unit
add_button in
- let stored_pages = Storage.get_ids () in
+ let stored_pages = State.Storage.get_ids () in
let pages =
List.map
stored_pages
~f:(fun id ->
- let name_opt = (Storage.load (Some id))##.title in
+ let name_opt = (State.Storage.load (Some id))##.title in
let name = Js.Opt.get
name_opt
(fun () -> id) in
diff --git a/editor/app.ml b/editor/app.ml
new file mode 100755
index 0000000..aee396a
--- /dev/null
+++ b/editor/app.ml
@@ -0,0 +1,118 @@
+open Brr
+module PM = Prosemirror
+module Js = Js_of_ocaml.Js
+
+type events =
+ | DeleteEvent
+ | StoreEvent
+ | LoadEvent of Jstr.t option
+ | AddEvent
+ | CloseEvent of Forms.Events.kind option
+ | GEvent of Forms.Events.event
+
+let key_of_title
+ : Jstr.t -> Jstr.t
+ = fun title ->
+ title
+
+(** [update] is the event loop.
+
+ The function take a new event, and apply it to the current state. *)
+
+let update
+ : 'a option Note.E.send -> (events, State.t) Application.t
+ = fun close_sender event state ->
+ match event with
+
+ | GEvent (Event (t, (module Handler))) ->
+ Handler.on_close t state
+
+ | AddEvent ->
+ let title = Jstr.v "Nouvelle page" in
+ let popup = Ui.popup
+ ~title
+ ~form:(Some (Forms.Add_page.create ()))
+ close_sender in
+ { state with window = popup::state.window}
+
+ | DeleteEvent ->
+ begin match state.page_id with
+ | None -> state
+ | Some page_id ->
+ let title = Jstr.v "Confirmation" in
+ let popup = Ui.popup
+ ~title
+ ~form:(Some (Forms.Delete_page.create page_id))
+ close_sender in
+ { state with window = popup::state.window}
+ end
+
+ | CloseEvent res ->
+
+ let state = match state.window with
+ | [] -> { state with window = [] }
+ | el::tl -> El.remove el
+ ; { state with window = tl } in
+
+ (* The actions is confirmed by the user. Handle the form result *)
+ begin match res with
+ (* Delete the current page, then load the home page *)
+ | Some (Forms.Delete_page.DeletePage id) ->
+ State.Storage.delete (fun () -> Some id);
+ let json = State.Storage.load None in
+ State.load_page None state json
+ (* Add a new page *)
+ | Some (Forms.Add_page.AddPage {title}) ->
+ let page_id = key_of_title title in
+ let new_date = (new%js Js.date_now)##getTime in
+ let content_obj = object%js
+ val content = Js.null
+ val title = Js.some title
+ val date = Js.some new_date
+ end in
+ State.load_page (Some page_id) state content_obj
+
+ | _ -> state
+ end
+
+ | StoreEvent ->
+
+ 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
+
+ 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 date = Js.some new_date
+ end in
+ let save = State.Storage.save
+ content_obj
+ state.page_id
+ ~check:(fun previous_state ->
+ Js.Opt.case previous_state##.date
+ (fun () -> true)
+ (fun date ->
+ (* I do not figure how the previous date could be older
+ than the last backup. It could be either :
+
+ - equal (if we are the only one to update it)
+ - more recent (if the content has been updated elsewhere)
+
+ but older shoud be a bug. *)
+ date <= state.last_backup)) in
+ begin match save with
+ | Ok true -> { state with last_backup = new_date }
+ | other ->
+ (* TODO In case of error, notify the user *)
+ Console.(log [other]);
+ state
+ end
+
+ | LoadEvent page_id ->
+ let json = State.Storage.load page_id in
+ State.load_page page_id state json
+
+
diff --git a/editor/dune b/editor/dune
index c8dfe3c..295c39f 100755
--- a/editor/dune
+++ b/editor/dune
@@ -8,6 +8,8 @@
prosemirror
blog
application
+ state
+ plugins
forms
)
(modes js)
diff --git a/editor/editor.ml b/editor/editor.ml
index d3a9624..1a34dfc 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -2,56 +2,6 @@ open Brr
module PM = Prosemirror
module Js = Js_of_ocaml.Js
-(** This is the state for the application *)
-type state =
- { editable : bool
- ; view : PM.View.editor_view Js.t
- ; last_backup: float
- ; page_id: Jstr.t option
-
- ; window : El.t list
- }
-
-type events =
- | DeleteEvent
- | StoreEvent
- | LoadEvent of Jstr.t option
- | AddEvent
- | CloseEvent of Forms.Events.kind option
-
-let set_title
- : Storage.content Js.t -> unit
- = fun content ->
- let title =
- Js.Opt.get
- content##.title
- (fun () -> Jstr.empty) in
- let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
- Option.iter
- (fun el -> El.set_prop (El.Prop.value) title el)
- title_element
-
-let key_of_title
- : Jstr.t -> Jstr.t
- = fun title ->
- title
-
-let state_of_storage
- : PM.t -> Storage.content Js.t -> PM.Model.schema Js.t -> PM.State.editor_state Js.t
- = fun pm content schema ->
- Js.Opt.case
- content##.content
- (fun () ->
- let obj = PM.State.creation_prop () in
- obj##.plugins := Plugins.default pm schema;
- obj##.schema := Js.some schema;
- PM.State.create pm obj)
- (fun page_content ->
- let obj = PM.State.configuration_prop () in
- obj##.plugins := Plugins.default pm schema;
- obj##.schema := Js.some schema;
- PM.State.fromJSON pm obj page_content)
-
(** Create a new editor view
[build_view element state] will create the editor and attach it to [element].
@@ -68,7 +18,7 @@ let build_view
This could be improved, instead of creating a new schema, just fetch
the node and marks from the plungin *)
let custom_schema =
- Footnotes.footnote_schema
+ Plugins.Footnotes.footnote_schema
pm
(PM.SchemaBasic.schema pm) in
@@ -83,7 +33,7 @@ let build_view
(Some custom_schema##.spec##.marks)
None in
let full_schema = PM.Model.schema pm specs in
- let stored_content = Storage.load page_id in
+ let stored_content = State.Storage.load page_id in
(* This variable contains the last update time, either because it is
stored, or because it is the date where we create the first page. *)
@@ -92,11 +42,11 @@ let build_view
(fun () -> (new%js Js.date_now)##getTime) in
let props = PM.View.direct_editor_props () in
- props##.state := state_of_storage pm stored_content full_schema;
+ props##.state := State.state_of_storage pm stored_content full_schema;
(* Add the custom nodes *)
props##.nodeViews := PM.O.init
- [| ( "footnote", (Footnotes.footnote_view pm))
+ [| ( "footnote", (Plugins.Footnotes.footnote_view pm))
|];
let view = PM.View.editor_view
@@ -105,114 +55,21 @@ let build_view
props in
view, last_backup
-let load_page
- : PM.t -> Jstr.t option -> state -> Storage.content Js.t -> state
- = fun pm page_id state json ->
- let editor_state = state_of_storage pm json state.view##.state##.schema in
- let () = state.view##updateState editor_state
- and () = set_title json in
- { state with page_id }
(** [update] is the event loop.
The function take a new event, and apply it to the current state. *)
let update
- : PM.t -> 'a option Note.E.send -> (events, state) Application.t
- = fun pm close_sender event state ->
- match event with
-
- | AddEvent ->
- let title = Jstr.v "Nouvelle page" in
- let popup = Ui.popup
- ~title
- ~form:(Some (Forms.Add_page.create ()))
- close_sender in
- { state with window = popup::state.window}
-
- | DeleteEvent ->
- begin match state.page_id with
- | None -> state
- | Some page_id ->
- let title = Jstr.v "Confirmation" in
- let popup = Ui.popup
- ~title
- ~form:(Some (Forms.Delete_page.create page_id))
- close_sender in
- { state with window = popup::state.window}
- end
-
- | CloseEvent res ->
-
- let state = match state.window with
- | [] -> { state with window = [] }
- | el::tl -> El.remove el
- ; { state with window = tl } in
-
- (* The actions is confirmed by the user. Handle the form result *)
- begin match res with
- (* Delete the current page, then load the home page *)
- | Some (Forms.Delete_page.DeletePage id) ->
- Storage.delete (fun () -> Some id);
- let json = Storage.load None in
- load_page pm None state json
- (* Add a new page *)
- | Some (Forms.Add_page.AddPage {title}) ->
- let page_id = key_of_title title in
- Console.(log [title]);
- let new_date = (new%js Js.date_now)##getTime in
- let content_obj = object%js
- val content = Js.null
- val title = Js.some title
- val date = Js.some new_date
- end in
- load_page pm (Some page_id) state content_obj
-
- | _ -> state
- end
-
- | StoreEvent ->
-
- 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
-
- 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 date = Js.some new_date
- end in
- let save = Storage.save
- content_obj
- state.page_id
- ~check:(fun previous_state ->
- Js.Opt.case previous_state##.date
- (fun () -> true)
- (fun date ->
- (* I do not figure how the previous date could be older
- than the last backup. It could be either :
-
- - equal (if we are the only one to update it)
- - more recent (if the content has been updated elsewhere)
-
- but older shoud be a bug. *)
- date <= state.last_backup)) in
- begin match save with
- | Ok true -> { state with last_backup = new_date }
- | _ ->
- (* TODO In case of error, notify the user *)
- state
- end
-
- | LoadEvent page_id ->
- let json = Storage.load page_id in
- load_page pm page_id state json
-
+ : 'a option Note.E.send -> (App.events, State.t) Application.t
+ = App.update
let app id content =
+ (* This event is used in the pop process. The sender is given to the
+ subroutine in order to track the window closing *)
+ let event, sender = Note.E.create () in
+
(* Check the pre-requisite *)
let events_opt = Actions.populate_menu () in
match (Jv.is_none id), (Jv.is_none content), events_opt with
@@ -221,34 +78,32 @@ let app id content =
let pm = PM.v () in
let editor:El.t = Jv.Id.of_jv id in
(* Load the cache for the given page *)
- let page_id = Storage.page_id () in
+ let page_id = State.Storage.page_id () in
let view, last_backup = build_view pm page_id editor in
- (* This event is used in the pop process. The sender is given to the
- subroutine in order to track the window closing *)
- let event, sender = Note.E.create () in
- let _ = sender in
let init_state =
- { editable = true
- ; view
- ; last_backup
- ; page_id
-
- ; window = []
- }
+ State.{ editable = true
+ ; view
+ ; last_backup
+ ; page_id
+
+ ; window = []
+ ; pm
+ }
in
let app_state = Application.run
- (update pm sender)
+ ~eq:State.eq
+ (App.update sender)
init_state
(Note.E.select
- [ Note.E.map (fun () -> DeleteEvent) btn_events.Actions.delete
- ; Brr_note.Evr.on_el Ev.focusout (fun _ -> StoreEvent) editor
- ; Note.E.map (fun v -> LoadEvent v) btn_events.Actions.redirect
- ; Note.E.map (fun () -> AddEvent) btn_events.Actions.add
- ; Note.E.map (fun v -> CloseEvent v) event
+ [ Brr_note.Evr.on_el Ev.focusout (fun _ -> App.StoreEvent) editor
+ ; Note.E.map (fun () -> App.DeleteEvent) btn_events.Actions.delete
+ ; Note.E.map (fun () -> App.AddEvent) btn_events.Actions.add
+ ; Note.E.map (fun v -> App.LoadEvent v) btn_events.Actions.redirect
+ ; Note.E.map (fun v -> App.CloseEvent v) event
]) in
let () =
diff --git a/editor/footnotes.ml b/editor/footnotes.ml
deleted file mode 100755
index 794171f..0000000
--- a/editor/footnotes.ml
+++ /dev/null
@@ -1,248 +0,0 @@
-open Brr
-open Js_of_ocaml
-module PM = Prosemirror
-
-let footNoteSpec = object%js
-
- val mutable group = Jstr.v "inline"
- val mutable content = Jstr.v "inline*" (* The star is very important ! *)
- val mutable inline = Js._true
- val mutable draggable = Js._true
- (* This makes the view treat the node as a leaf, even though it
- technically has content *)
- val mutable atom = Js._true
-
- val toDOM
- : (PM.Model.node Js.t -> PM.Model.domOutputSpec Js.t) Js.callback
- = Js.wrap_callback (fun _ ->
- let open PM.Model.Dom_output_spec in
- v "footnote"
- [ hole ])
-
- val parseDOM
- : PM.Model.parse_rule Js.t Js.js_array Js.t Js.opt
- = Js.some @@ Js.array
- [|PM.Model.ParseRule.tag (Jstr.v "footnote")|]
-
-end
-
-let footnote_schema pm defaultSchema =
-
- let nodes = defaultSchema##.spec##.nodes
- and marks = defaultSchema##.spec##.marks in
-
- let specs = PM.Model.schema_spec
- (nodes##addToEnd (Jstr.v "footnote") (Js.Unsafe.coerce footNoteSpec))
- (Some marks)
- None in
-
- PM.Model.schema pm
- specs
-
-let build_menu pm schema =
- let menu = PM.Example.buildMenuItems pm schema in
-
- let itemSpec = PM.Menu.menuItemSpec () in
- itemSpec##.title := Js.some @@ Jstr.v "Insert footnote";
- itemSpec##.label := Js.some @@ Jstr.v "Footnote";
- itemSpec##.select := Js.wrap_meth_callback (fun _ (state:PM.State.editor_state Js.t) ->
- match PM.O.get schema##.nodes "footnote" with
- | None -> Js._false
- | Some footnote_node ->
- let res = Js.Opt.test @@ PM.Transform.insertPoint
- pm
- state##.doc
- ~pos:state##.selection##.from
- footnote_node
- in
- Js.bool res);
-
- itemSpec##.run :=
- Js.wrap_meth_callback (fun _this state dispatch _ _ ->
- match PM.O.get schema##.nodes "footnote" with
- | None -> ()
- | Some footnote_node ->
-
- let from' = PM.State.selection_from state##.selection
- and to' = PM.State.selection_to state##.selection in
-
- let content =
- if state##.selection##.empty != Js._true
- && from'##sameParent to' = Js._true
- && from'##.parent##.inlineContent = Js._true then (
- from'##.parent##.content##cut
- (from'##.parentOffset)
- (Js.some @@ to'##.parentOffset)
- ) else (
- PM.Model.empty_fragment pm
- ) in
- let new_node = footnote_node##create_withFragmentContent
- Js.null
- (Js.some content)
- Js.null
- in
- dispatch @@
- state##.tr##replaceSelectionWith
- new_node
- Js.null
- );
-
- let item = PM.Menu.menu_item pm itemSpec in
- let _ = menu##.insertMenu##.content##push item in
- menu
-
-let fromOutside
- : bool PM.State.meta_data Js.t
- = PM.State.create_str_meta_data (Jstr.v "fromOutside")
-
-let footnote_view
- : PM.t -> PM.Model.node Js.t -> PM.View.editor_view Js.t -> (unit -> int) -> < .. > Js.t
- = fun pm init_node outerView get_pos ->
-
- (* These are used when the footnote is selected *)
- let innerView
- : PM.View.editor_view Js.t Js.opt ref
- = ref Js.null in
-
- let dispatchInner
- : PM.View.editor_view Js.t -> PM.State.transaction Js.t -> unit
- = fun view tr ->
- let res = view##.state##applyTransaction tr in
- view##updateState res##.state;
-
- let meta = Js.Optdef.get (tr##getMeta fromOutside) (fun () -> false) in
- if (not meta) then (
- let outerTr = outerView##.state##.tr
- and offsetMap = PM.Transform.offset pm ((get_pos()) + 1) in
- res##.transactions##forEach
- (Js.wrap_callback @@
- fun (elem:PM.State.transaction Js.t) _ _ ->
- elem##.steps##forEach
- (Js.wrap_callback @@ fun (step:PM.Transform.step Js.t) _ _ ->
- let _ = outerTr##step (step##map offsetMap) in
- ()
- ));
- if (outerTr##.docChanged = Js._true) then (
- outerView##dispatch outerTr)
- );
- in
- object%js (_self)
-
- val mutable node: PM.Model.node Js.t = init_node
-
- (* The node's representation in the editor (empty, for now) *)
- val dom = El.v (Jstr.v "footnote") []
-
- method _open =
- (* Append a tooltip to the outer node *)
- let tooltip = El.div []
- ~at:At.([class' (Jstr.v "popin")]) in
- El.append_children _self##.dom
- [ tooltip ];
-
- let dispatch_fn
- : PM.State.transaction Js.t -> unit
- = fun tr -> outerView##dispatch tr in
-
- let state_properties = Js.Unsafe.coerce (object%js
- val doc = Js.some _self##.node;
- val plugins = Js.some @@ Js.array @@ [|
- PM.Keymap.keymap pm
- [| ( "Mod-z"
- , (fun _ _ -> PM.History.undo pm outerView##.state (Js.some dispatch_fn)))
- ; ( "Mod-y"
- , (fun _ _ -> PM.History.redo pm outerView##.state (Js.some dispatch_fn)))
- |]
- |];
- end) in
-
- let view_properties = PM.View.direct_editor_props () in
- view_properties##.state := PM.State.create pm state_properties;
- (* This is the magic part *)
- view_properties##.dispatchTransaction :=
- (Js.wrap_meth_callback dispatchInner);
- view_properties##.handleDOMEvents := PM.O.init
- [| ( "mousedown"
- , Js.wrap_callback (fun _ _ ->
- (* Kludge to prevent issues due to the fact that the
- whole footnote is node-selected (and thus DOM-selected)
- when the parent editor is focused. *)
- if (outerView##hasFocus () = Js._true) then (
- Js.Opt.iter !innerView (fun view -> view##focus ())
- );
- Js._false ))|];
-
- innerView := Js.some
- (PM.View.editor_view pm
- tooltip
- view_properties);
-
- method close =
- Js.Opt.iter (!innerView)
- (fun view ->
- view##destroy;
- innerView := Js.null;
- El.set_prop
- (El.Prop.jstr (Jstr.v "textContent"))
- (Jstr.empty)
- _self##.dom
- )
-
- method update
- : PM.Model.node Js.t -> bool Js.t
- = fun node ->
- if (node##sameMarkup _self##.node = Js._false) then (
- Js._false
- ) else (
- _self##.node := node;
- Js.Opt.iter !innerView (fun view ->
- let state = view##.state in
- Js.Opt.iter (node##.content##findDiffStart state##.doc##.content) (fun start ->
- let res_opt = (node##.content##findDiffEnd state##.doc##.content) in
- Js.Opt.iter res_opt (fun end_diff ->
- let overlap = start - (min end_diff##.a end_diff##.b) in
- let endA, endB =
- if overlap > 0 then
- ( end_diff##.a + overlap
- , end_diff##.b + overlap )
- else
- ( end_diff##.a
- , end_diff##.b )
- in
- let tr =
- state##.tr
- ##(replace
- ~from:start
- ~to_:endB
- (Js.some @@ node##slice ~from:start ~to_:(Js.some endA)))
- ##(setMeta fromOutside true) in
- view##dispatch tr)));
- Js._true
- )
-
- method destroy =
- Js.Opt.iter !innerView (fun _ -> _self##close)
-
- method stopEvent e =
- Js.Opt.case !innerView
- (fun () -> Js._false)
- (fun view ->
- let dom = view##.dom in
- Jv.call (Jv.Id.to_jv dom) "contains" [| e##.target|]
- |> Jv.Id.of_jv)
-
- method ignoreMutation =
- Js._true
-
- method selectNode =
- El.set_class (Jstr.v "ProseMirror-selectednode") true _self##.dom;
- if not (Js.Opt.test !innerView) then (
- _self##_open
- )
-
- method deselectNode =
- El.set_class (Jstr.v "ProseMirror-selectednode") false _self##.dom;
- if (Js.Opt.test !innerView) then
- _self##close
-
- end
diff --git a/editor/forms/add_page.ml b/editor/forms/add_page.ml
index 597e9d3..ac45824 100755
--- a/editor/forms/add_page.ml
+++ b/editor/forms/add_page.ml
@@ -1,9 +1,12 @@
open Brr
open Brr_note
open Note
+module Js = Js_of_ocaml.Js
+
+type t = { title : Jstr.t }
type Events.kind +=
- | AddPage of { title : Jstr.t }
+ | AddPage of t [@@unboxed]
let create
: unit -> Events.t
@@ -34,3 +37,20 @@ let create
[ input ]
]
] )
+
+let key_of_title
+ : Jstr.t -> Jstr.t
+ = fun title ->
+ title
+
+let on_close
+ : t -> State.t -> State.t
+ = fun {title} state ->
+ let page_id = key_of_title title in
+ let new_date = (new%js Js.date_now)##getTime in
+ let content_obj = object%js
+ val content = Js.null
+ val title = Js.some title
+ val date = Js.some new_date
+ end in
+ State.load_page (Some page_id) state content_obj
diff --git a/editor/forms/add_page.mli b/editor/forms/add_page.mli
index 97b1d6c..6be1611 100755
--- a/editor/forms/add_page.mli
+++ b/editor/forms/add_page.mli
@@ -1,5 +1,9 @@
+type t = { title : Jstr.t }
type Events.kind +=
- | AddPage of { title : Jstr.t }
+ | AddPage of t [@@unboxed]
val create
: unit -> Events.t
+
+val on_close
+ : t -> State.t -> State.t
diff --git a/editor/forms/delete_page.ml b/editor/forms/delete_page.ml
index 701162c..3328dd7 100755
--- a/editor/forms/delete_page.ml
+++ b/editor/forms/delete_page.ml
@@ -1,8 +1,10 @@
open Brr
open Note
+type t = Jstr.t
+
type Events.kind +=
- | DeletePage of Jstr.t [@@unboxed]
+ | DeletePage of t [@@unboxed]
let create
: Jstr.t -> Events.t
@@ -23,3 +25,9 @@ let create
, El.txt message
)
+let on_close
+ : t -> State.t -> State.t
+ = fun id state ->
+ State.Storage.delete (fun () -> Some id);
+ let json = State.Storage.load None in
+ State.load_page None state json
diff --git a/editor/forms/dune b/editor/forms/dune
index 9876654..124ce01 100755
--- a/editor/forms/dune
+++ b/editor/forms/dune
@@ -7,6 +7,7 @@
js_lib
blog
application
+ state
)
(preprocess (pps js_of_ocaml-ppx))
)
diff --git a/editor/forms/events.ml b/editor/forms/events.ml
index 339e15d..f7f5711 100755
--- a/editor/forms/events.ml
+++ b/editor/forms/events.ml
@@ -1,5 +1,20 @@
-(** This type is designed to be extended for each form *)
+(** This type is designed to be extended for each form.
+
+ Each of them hold the values inside the form.
+
+*)
type kind = ..
+(** The signal has to be log in order to be completely working *)
type t = kind Note.signal * Brr.El.t
+module type Handler = sig
+
+ type t
+
+ val on_close: t -> State.t -> State.t
+
+end
+
+type event = Event : 'a * (module Handler with type t = 'a) -> event
+
diff --git a/editor/link_editor.ml b/editor/link_editor.ml
deleted file mode 100755
index 9bfdfd4..0000000
--- a/editor/link_editor.ml
+++ /dev/null
@@ -1,127 +0,0 @@
-open Brr
-
-module Js = Js_of_ocaml.Js
-module PM = Prosemirror
-
-let link_edit
- : PM.View.editor_view Js.t -> < .. > Js.t
- = fun view ->
-
- let popin = El.div []
- ~at:At.([class' (Jstr.v "popin")]) in
-
- El.set_inline_style El.Style.display (Jstr.v "none") popin;
-
- let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
- let () = El.append_children parent [popin] in
-
- let hide
- : unit -> unit
- = fun () ->
- El.set_inline_style El.Style.display (Jstr.v "none") popin
- in
-
- let update
- : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
- = fun view _state_opt ->
-
- let state = view##.state in
- Js.Opt.case (state##.doc##nodeAt (view##.state##.selection##._to))
- (fun () -> hide ())
- (fun node ->
- (* Check if we are editing a link *)
- match PM.O.get state##.schema##.marks "link" with
- | None -> ()
- | Some link_type ->
- let is_present = link_type##isInSet node##.marks in
- Js.Opt.case
- is_present
- (fun () -> hide ())
- (fun mark ->
- (* Get the node's bounding position and display the popin *)
- let position = state##.doc##resolve
- (view##.state##.selection##._to) in
- let start = position##start Js.null
- and end' = position##_end Js.null in
-
- Popin.set_position
- ~start
- ~end'
- view popin;
-
- (* Extract the value from the attribute *)
- let attrs = mark##.attrs in
- let href_opt = PM.O.get attrs "href" in
- let href_value = Option.value
- ~default:Jstr.empty
- href_opt
- in
-
- (* Create the popin content *)
- let a = El.a
- ~at:At.[ href href_value ]
- [ El.txt href_value ] in
-
- let entry = Popin.build_field a
- (fun new_value ->
- (* The function is called when the user validate
- the change in the popi. We create a new
- transaction in the document by replacing the
- mark with the new one. *)
- if not (Jstr.equal new_value href_value) then (
-
- (* Create a new attribute object for the mark in
- order to keep history safe *)
- let attrs' = PM.O.init
- [| "href", new_value |] in
-
- Option.iter
- (fun v -> PM.O.set attrs' "title" v)
- (PM.O.get attrs "title");
-
- let mark' = state##.schema##mark_fromType
- link_type
- (Js.some attrs') in
- (* Create a transaction which update the
- mark with the new value *)
- view##dispatch
- state
- ##.tr
- ##(removeMark
- ~from:start
- ~to_:end'
- mark)
- ##(addMark
- ~from:start
- ~to_:end'
- mark')
- );
- true
-
- ) in
-
-
- El.set_children popin
- [ entry.field
- ; entry.button ];
-
- ))
-
- and destroy () = El.remove popin in
-
- object%js
- val update = Js.wrap_callback update
- val destroy= Js.wrap_callback destroy
- end
-
-let plugin
- : PM.t -> PM.State.plugin Js.t
- = fun t ->
- let state = Jv.get (Jv.Id.to_jv t) "state" in
-
- let params = object%js
- val view = (fun view -> link_edit view)
- end in
-
- Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
- |> Jv.Id.of_jv
diff --git a/editor/plugins.ml b/editor/plugins.ml
deleted file mode 100755
index 91dedeb..0000000
--- a/editor/plugins.ml
+++ /dev/null
@@ -1,135 +0,0 @@
-module Js = Js_of_ocaml.Js
-module PM = Prosemirror
-
-(** Commands *)
-
-let change_level
- : PM.t -> PM.Model.resolved_pos Js.t -> int -> (int -> bool) -> PM.Commands.t
- = fun pm res incr pred state dispatch ->
- let parent = res##.parent in
- let attributes = parent##.attrs in
-
- let current_level = if Jv.is_none attributes##.level then
- 0
- else
- attributes##.level in
- let t, props = match pred current_level with
- | false ->
- ( PM.O.get state##.schema##.nodes "heading"
- , Js.some (object%js
- val level = current_level + incr
- end))
- | true ->
- ( PM.O.get state##.schema##.nodes "paragraph"
- , Js.null) in
- match t with
- | None -> Js._false
- | Some t ->
- PM.Commands.set_block_type pm t props state dispatch
-
-(** Increase the title level by one when pressing # at the begining of a line *)
-let handle_sharp pm state dispatch =
-
- let res = PM.State.selection_to (state##.selection) in
- match Js.Opt.to_option res##.nodeBefore with
- | Some _ -> Js._false
- | None -> (* Line start *)
- begin match Jstr.to_string res##.parent##._type##.name with
- | "heading" ->
- change_level pm res 1 (fun x -> x > 5) state dispatch
- | "paragraph" ->
- begin match PM.O.get state##.schema##.nodes "heading" with
- | None -> Js._false
- | Some t ->
- let props = Js.some (object%js
- val level = 1
- end) in
- PM.Commands.set_block_type pm t props state dispatch
- end
- | _ -> Js._false
- end
-
-let handle_backspace pm state dispatch =
-
- let res = PM.State.selection_to (state##.selection) in
- match Js.Opt.to_option res##.nodeBefore with
- | Some _ -> Js._false
- | None -> (* Line start *)
- begin match Jstr.to_string res##.parent##._type##.name with
- | "heading" -> change_level pm res (-1) (fun x -> x <= 1) state dispatch
- | _ -> Js._false
- end
-
-
-let toggle_mark
- : Js.regExp Js.t -> PM.t -> string -> PM.InputRule.input_rule Js.t
- = fun regExp pm mark_type_name ->
- PM.InputRule.create pm
- regExp
- ~fn:(Js.wrap_callback @@ fun (state:PM.State.editor_state Js.t) _ ~from ~to_ ->
- match PM.O.get state##.schema##.marks mark_type_name with
- | None -> Js.null
- | Some mark_type ->
-
- let m = state##.schema##mark_fromType mark_type Js.null in
-
- (* Delete the markup code *)
- let tr = (state##.tr)##delete ~from ~to_ in
-
- (* Check if the mark is active at the position *)
- let present = Js.Opt.bind
- (PM.State.cursor (tr##.selection))
- (fun resolved ->
- Js.Opt.map
- (mark_type##isInSet (resolved##marks ()))
- (fun _ -> resolved)
- ) in
- Js.Opt.case present
- (fun () ->
- let tr = tr##addStoredMark m in
- Js.some @@ tr)
- (fun _resolved ->
- let tr = tr##removeStoredMark_mark m in
- Js.some tr))
-
-let input_rule pm =
-
- let bold =
- toggle_mark
- (new%js Js.regExp (Js.string "\\*\\*$"))
- pm
- "strong"
- and em =
- toggle_mark
- (new%js Js.regExp (Js.string "//$"))
- pm
- "em" in
-
- PM.InputRule.to_plugin pm
- (Js.array [| bold; em |])
-
-let default pm schema =
-
- (** Load the history plugin *)
- let _ = PM.History.(history pm (history_prop ()) ) in
-
- let props = PM.Example.options schema in
- props##.menuBar := Js.some Js._true;
- props##.floatingMenu := Js.some Js._true;
- props##.menuContent := (Footnotes.build_menu pm schema)##.fullMenu;
- let setup = PM.Example.example_setup pm props in
-
- let keymaps =
- PM.Keymap.keymap pm
- [| "Backspace", (handle_backspace pm)
- ; "#", (handle_sharp pm)
- |] in
-
- (* Add the custom keymaps in the list *)
- let _ = setup##unshift keymaps in
- let _ = setup##push (input_rule pm) in
- let _ = setup##push (Tooltip.bold_plugin pm) in
- let _ = setup##push (Link_editor.plugin pm) in
-
-
- Js.some setup
diff --git a/editor/plugins/dune b/editor/plugins/dune
new file mode 100755
index 0000000..046dc5a
--- /dev/null
+++ b/editor/plugins/dune
@@ -0,0 +1,9 @@
+(library
+ (name plugins)
+ (libraries
+ brr
+ prosemirror
+ js_lib
+ )
+ (preprocess (pps js_of_ocaml-ppx))
+ )
diff --git a/editor/plugins/footnotes.ml b/editor/plugins/footnotes.ml
new file mode 100755
index 0000000..794171f
--- /dev/null
+++ b/editor/plugins/footnotes.ml
@@ -0,0 +1,248 @@
+open Brr
+open Js_of_ocaml
+module PM = Prosemirror
+
+let footNoteSpec = object%js
+
+ val mutable group = Jstr.v "inline"
+ val mutable content = Jstr.v "inline*" (* The star is very important ! *)
+ val mutable inline = Js._true
+ val mutable draggable = Js._true
+ (* This makes the view treat the node as a leaf, even though it
+ technically has content *)
+ val mutable atom = Js._true
+
+ val toDOM
+ : (PM.Model.node Js.t -> PM.Model.domOutputSpec Js.t) Js.callback
+ = Js.wrap_callback (fun _ ->
+ let open PM.Model.Dom_output_spec in
+ v "footnote"
+ [ hole ])
+
+ val parseDOM
+ : PM.Model.parse_rule Js.t Js.js_array Js.t Js.opt
+ = Js.some @@ Js.array
+ [|PM.Model.ParseRule.tag (Jstr.v "footnote")|]
+
+end
+
+let footnote_schema pm defaultSchema =
+
+ let nodes = defaultSchema##.spec##.nodes
+ and marks = defaultSchema##.spec##.marks in
+
+ let specs = PM.Model.schema_spec
+ (nodes##addToEnd (Jstr.v "footnote") (Js.Unsafe.coerce footNoteSpec))
+ (Some marks)
+ None in
+
+ PM.Model.schema pm
+ specs
+
+let build_menu pm schema =
+ let menu = PM.Example.buildMenuItems pm schema in
+
+ let itemSpec = PM.Menu.menuItemSpec () in
+ itemSpec##.title := Js.some @@ Jstr.v "Insert footnote";
+ itemSpec##.label := Js.some @@ Jstr.v "Footnote";
+ itemSpec##.select := Js.wrap_meth_callback (fun _ (state:PM.State.editor_state Js.t) ->
+ match PM.O.get schema##.nodes "footnote" with
+ | None -> Js._false
+ | Some footnote_node ->
+ let res = Js.Opt.test @@ PM.Transform.insertPoint
+ pm
+ state##.doc
+ ~pos:state##.selection##.from
+ footnote_node
+ in
+ Js.bool res);
+
+ itemSpec##.run :=
+ Js.wrap_meth_callback (fun _this state dispatch _ _ ->
+ match PM.O.get schema##.nodes "footnote" with
+ | None -> ()
+ | Some footnote_node ->
+
+ let from' = PM.State.selection_from state##.selection
+ and to' = PM.State.selection_to state##.selection in
+
+ let content =
+ if state##.selection##.empty != Js._true
+ && from'##sameParent to' = Js._true
+ && from'##.parent##.inlineContent = Js._true then (
+ from'##.parent##.content##cut
+ (from'##.parentOffset)
+ (Js.some @@ to'##.parentOffset)
+ ) else (
+ PM.Model.empty_fragment pm
+ ) in
+ let new_node = footnote_node##create_withFragmentContent
+ Js.null
+ (Js.some content)
+ Js.null
+ in
+ dispatch @@
+ state##.tr##replaceSelectionWith
+ new_node
+ Js.null
+ );
+
+ let item = PM.Menu.menu_item pm itemSpec in
+ let _ = menu##.insertMenu##.content##push item in
+ menu
+
+let fromOutside
+ : bool PM.State.meta_data Js.t
+ = PM.State.create_str_meta_data (Jstr.v "fromOutside")
+
+let footnote_view
+ : PM.t -> PM.Model.node Js.t -> PM.View.editor_view Js.t -> (unit -> int) -> < .. > Js.t
+ = fun pm init_node outerView get_pos ->
+
+ (* These are used when the footnote is selected *)
+ let innerView
+ : PM.View.editor_view Js.t Js.opt ref
+ = ref Js.null in
+
+ let dispatchInner
+ : PM.View.editor_view Js.t -> PM.State.transaction Js.t -> unit
+ = fun view tr ->
+ let res = view##.state##applyTransaction tr in
+ view##updateState res##.state;
+
+ let meta = Js.Optdef.get (tr##getMeta fromOutside) (fun () -> false) in
+ if (not meta) then (
+ let outerTr = outerView##.state##.tr
+ and offsetMap = PM.Transform.offset pm ((get_pos()) + 1) in
+ res##.transactions##forEach
+ (Js.wrap_callback @@
+ fun (elem:PM.State.transaction Js.t) _ _ ->
+ elem##.steps##forEach
+ (Js.wrap_callback @@ fun (step:PM.Transform.step Js.t) _ _ ->
+ let _ = outerTr##step (step##map offsetMap) in
+ ()
+ ));
+ if (outerTr##.docChanged = Js._true) then (
+ outerView##dispatch outerTr)
+ );
+ in
+ object%js (_self)
+
+ val mutable node: PM.Model.node Js.t = init_node
+
+ (* The node's representation in the editor (empty, for now) *)
+ val dom = El.v (Jstr.v "footnote") []
+
+ method _open =
+ (* Append a tooltip to the outer node *)
+ let tooltip = El.div []
+ ~at:At.([class' (Jstr.v "popin")]) in
+ El.append_children _self##.dom
+ [ tooltip ];
+
+ let dispatch_fn
+ : PM.State.transaction Js.t -> unit
+ = fun tr -> outerView##dispatch tr in
+
+ let state_properties = Js.Unsafe.coerce (object%js
+ val doc = Js.some _self##.node;
+ val plugins = Js.some @@ Js.array @@ [|
+ PM.Keymap.keymap pm
+ [| ( "Mod-z"
+ , (fun _ _ -> PM.History.undo pm outerView##.state (Js.some dispatch_fn)))
+ ; ( "Mod-y"
+ , (fun _ _ -> PM.History.redo pm outerView##.state (Js.some dispatch_fn)))
+ |]
+ |];
+ end) in
+
+ let view_properties = PM.View.direct_editor_props () in
+ view_properties##.state := PM.State.create pm state_properties;
+ (* This is the magic part *)
+ view_properties##.dispatchTransaction :=
+ (Js.wrap_meth_callback dispatchInner);
+ view_properties##.handleDOMEvents := PM.O.init
+ [| ( "mousedown"
+ , Js.wrap_callback (fun _ _ ->
+ (* Kludge to prevent issues due to the fact that the
+ whole footnote is node-selected (and thus DOM-selected)
+ when the parent editor is focused. *)
+ if (outerView##hasFocus () = Js._true) then (
+ Js.Opt.iter !innerView (fun view -> view##focus ())
+ );
+ Js._false ))|];
+
+ innerView := Js.some
+ (PM.View.editor_view pm
+ tooltip
+ view_properties);
+
+ method close =
+ Js.Opt.iter (!innerView)
+ (fun view ->
+ view##destroy;
+ innerView := Js.null;
+ El.set_prop
+ (El.Prop.jstr (Jstr.v "textContent"))
+ (Jstr.empty)
+ _self##.dom
+ )
+
+ method update
+ : PM.Model.node Js.t -> bool Js.t
+ = fun node ->
+ if (node##sameMarkup _self##.node = Js._false) then (
+ Js._false
+ ) else (
+ _self##.node := node;
+ Js.Opt.iter !innerView (fun view ->
+ let state = view##.state in
+ Js.Opt.iter (node##.content##findDiffStart state##.doc##.content) (fun start ->
+ let res_opt = (node##.content##findDiffEnd state##.doc##.content) in
+ Js.Opt.iter res_opt (fun end_diff ->
+ let overlap = start - (min end_diff##.a end_diff##.b) in
+ let endA, endB =
+ if overlap > 0 then
+ ( end_diff##.a + overlap
+ , end_diff##.b + overlap )
+ else
+ ( end_diff##.a
+ , end_diff##.b )
+ in
+ let tr =
+ state##.tr
+ ##(replace
+ ~from:start
+ ~to_:endB
+ (Js.some @@ node##slice ~from:start ~to_:(Js.some endA)))
+ ##(setMeta fromOutside true) in
+ view##dispatch tr)));
+ Js._true
+ )
+
+ method destroy =
+ Js.Opt.iter !innerView (fun _ -> _self##close)
+
+ method stopEvent e =
+ Js.Opt.case !innerView
+ (fun () -> Js._false)
+ (fun view ->
+ let dom = view##.dom in
+ Jv.call (Jv.Id.to_jv dom) "contains" [| e##.target|]
+ |> Jv.Id.of_jv)
+
+ method ignoreMutation =
+ Js._true
+
+ method selectNode =
+ El.set_class (Jstr.v "ProseMirror-selectednode") true _self##.dom;
+ if not (Js.Opt.test !innerView) then (
+ _self##_open
+ )
+
+ method deselectNode =
+ El.set_class (Jstr.v "ProseMirror-selectednode") false _self##.dom;
+ if (Js.Opt.test !innerView) then
+ _self##close
+
+ end
diff --git a/editor/plugins/link_editor.ml b/editor/plugins/link_editor.ml
new file mode 100755
index 0000000..9bfdfd4
--- /dev/null
+++ b/editor/plugins/link_editor.ml
@@ -0,0 +1,127 @@
+open Brr
+
+module Js = Js_of_ocaml.Js
+module PM = Prosemirror
+
+let link_edit
+ : PM.View.editor_view Js.t -> < .. > Js.t
+ = fun view ->
+
+ let popin = El.div []
+ ~at:At.([class' (Jstr.v "popin")]) in
+
+ El.set_inline_style El.Style.display (Jstr.v "none") popin;
+
+ let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
+ let () = El.append_children parent [popin] in
+
+ let hide
+ : unit -> unit
+ = fun () ->
+ El.set_inline_style El.Style.display (Jstr.v "none") popin
+ in
+
+ let update
+ : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
+ = fun view _state_opt ->
+
+ let state = view##.state in
+ Js.Opt.case (state##.doc##nodeAt (view##.state##.selection##._to))
+ (fun () -> hide ())
+ (fun node ->
+ (* Check if we are editing a link *)
+ match PM.O.get state##.schema##.marks "link" with
+ | None -> ()
+ | Some link_type ->
+ let is_present = link_type##isInSet node##.marks in
+ Js.Opt.case
+ is_present
+ (fun () -> hide ())
+ (fun mark ->
+ (* Get the node's bounding position and display the popin *)
+ let position = state##.doc##resolve
+ (view##.state##.selection##._to) in
+ let start = position##start Js.null
+ and end' = position##_end Js.null in
+
+ Popin.set_position
+ ~start
+ ~end'
+ view popin;
+
+ (* Extract the value from the attribute *)
+ let attrs = mark##.attrs in
+ let href_opt = PM.O.get attrs "href" in
+ let href_value = Option.value
+ ~default:Jstr.empty
+ href_opt
+ in
+
+ (* Create the popin content *)
+ let a = El.a
+ ~at:At.[ href href_value ]
+ [ El.txt href_value ] in
+
+ let entry = Popin.build_field a
+ (fun new_value ->
+ (* The function is called when the user validate
+ the change in the popi. We create a new
+ transaction in the document by replacing the
+ mark with the new one. *)
+ if not (Jstr.equal new_value href_value) then (
+
+ (* Create a new attribute object for the mark in
+ order to keep history safe *)
+ let attrs' = PM.O.init
+ [| "href", new_value |] in
+
+ Option.iter
+ (fun v -> PM.O.set attrs' "title" v)
+ (PM.O.get attrs "title");
+
+ let mark' = state##.schema##mark_fromType
+ link_type
+ (Js.some attrs') in
+ (* Create a transaction which update the
+ mark with the new value *)
+ view##dispatch
+ state
+ ##.tr
+ ##(removeMark
+ ~from:start
+ ~to_:end'
+ mark)
+ ##(addMark
+ ~from:start
+ ~to_:end'
+ mark')
+ );
+ true
+
+ ) in
+
+
+ El.set_children popin
+ [ entry.field
+ ; entry.button ];
+
+ ))
+
+ and destroy () = El.remove popin in
+
+ object%js
+ val update = Js.wrap_callback update
+ val destroy= Js.wrap_callback destroy
+ end
+
+let plugin
+ : PM.t -> PM.State.plugin Js.t
+ = fun t ->
+ let state = Jv.get (Jv.Id.to_jv t) "state" in
+
+ let params = object%js
+ val view = (fun view -> link_edit view)
+ end in
+
+ Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
+ |> Jv.Id.of_jv
diff --git a/editor/plugins/plugins.ml b/editor/plugins/plugins.ml
new file mode 100755
index 0000000..3a92df8
--- /dev/null
+++ b/editor/plugins/plugins.ml
@@ -0,0 +1,137 @@
+module Js = Js_of_ocaml.Js
+module PM = Prosemirror
+
+module Footnotes = Footnotes
+
+(** Commands *)
+
+let change_level
+ : PM.t -> PM.Model.resolved_pos Js.t -> int -> (int -> bool) -> PM.Commands.t
+ = fun pm res incr pred state dispatch ->
+ let parent = res##.parent in
+ let attributes = parent##.attrs in
+
+ let current_level = if Jv.is_none attributes##.level then
+ 0
+ else
+ attributes##.level in
+ let t, props = match pred current_level with
+ | false ->
+ ( PM.O.get state##.schema##.nodes "heading"
+ , Js.some (object%js
+ val level = current_level + incr
+ end))
+ | true ->
+ ( PM.O.get state##.schema##.nodes "paragraph"
+ , Js.null) in
+ match t with
+ | None -> Js._false
+ | Some t ->
+ PM.Commands.set_block_type pm t props state dispatch
+
+(** Increase the title level by one when pressing # at the begining of a line *)
+let handle_sharp pm state dispatch =
+
+ let res = PM.State.selection_to (state##.selection) in
+ match Js.Opt.to_option res##.nodeBefore with
+ | Some _ -> Js._false
+ | None -> (* Line start *)
+ begin match Jstr.to_string res##.parent##._type##.name with
+ | "heading" ->
+ change_level pm res 1 (fun x -> x > 5) state dispatch
+ | "paragraph" ->
+ begin match PM.O.get state##.schema##.nodes "heading" with
+ | None -> Js._false
+ | Some t ->
+ let props = Js.some (object%js
+ val level = 1
+ end) in
+ PM.Commands.set_block_type pm t props state dispatch
+ end
+ | _ -> Js._false
+ end
+
+let handle_backspace pm state dispatch =
+
+ let res = PM.State.selection_to (state##.selection) in
+ match Js.Opt.to_option res##.nodeBefore with
+ | Some _ -> Js._false
+ | None -> (* Line start *)
+ begin match Jstr.to_string res##.parent##._type##.name with
+ | "heading" -> change_level pm res (-1) (fun x -> x <= 1) state dispatch
+ | _ -> Js._false
+ end
+
+
+let toggle_mark
+ : Js.regExp Js.t -> PM.t -> string -> PM.InputRule.input_rule Js.t
+ = fun regExp pm mark_type_name ->
+ PM.InputRule.create pm
+ regExp
+ ~fn:(Js.wrap_callback @@ fun (state:PM.State.editor_state Js.t) _ ~from ~to_ ->
+ match PM.O.get state##.schema##.marks mark_type_name with
+ | None -> Js.null
+ | Some mark_type ->
+
+ let m = state##.schema##mark_fromType mark_type Js.null in
+
+ (* Delete the markup code *)
+ let tr = (state##.tr)##delete ~from ~to_ in
+
+ (* Check if the mark is active at the position *)
+ let present = Js.Opt.bind
+ (PM.State.cursor (tr##.selection))
+ (fun resolved ->
+ Js.Opt.map
+ (mark_type##isInSet (resolved##marks ()))
+ (fun _ -> resolved)
+ ) in
+ Js.Opt.case present
+ (fun () ->
+ let tr = tr##addStoredMark m in
+ Js.some @@ tr)
+ (fun _resolved ->
+ let tr = tr##removeStoredMark_mark m in
+ Js.some tr))
+
+let input_rule pm =
+
+ let bold =
+ toggle_mark
+ (new%js Js.regExp (Js.string "\\*\\*$"))
+ pm
+ "strong"
+ and em =
+ toggle_mark
+ (new%js Js.regExp (Js.string "//$"))
+ pm
+ "em" in
+
+ PM.InputRule.to_plugin pm
+ (Js.array [| bold; em |])
+
+let default pm schema =
+
+ (** Load the history plugin *)
+ let _ = PM.History.(history pm (history_prop ()) ) in
+
+ let props = PM.Example.options schema in
+ props##.menuBar := Js.some Js._true;
+ props##.floatingMenu := Js.some Js._true;
+ props##.menuContent := (Footnotes.build_menu pm schema)##.fullMenu;
+ let setup = PM.Example.example_setup pm props in
+
+ let keymaps =
+ PM.Keymap.keymap pm
+ [| "Backspace", (handle_backspace pm)
+ ; "#", (handle_sharp pm)
+ |] in
+
+ (* Add the custom keymaps in the list *)
+ let _ = setup##unshift keymaps in
+ let _ = setup##push (input_rule pm) in
+ let _ = setup##push (Tooltip.bold_plugin pm) in
+ let _ = setup##push (Link_editor.plugin pm) in
+
+
+ Js.some setup
diff --git a/editor/plugins/popin.ml b/editor/plugins/popin.ml
new file mode 100755
index 0000000..63dcad1
--- /dev/null
+++ b/editor/plugins/popin.ml
@@ -0,0 +1,83 @@
+open Brr
+module Js = Js_of_ocaml.Js
+module PM = Prosemirror
+
+type binded_field =
+ { field: El.t
+ ; button: El.t
+ }
+
+(** Set the element position just above the selection *)
+let set_position
+ : start:int -> end':int -> PM.View.editor_view Js.t -> El.t -> unit
+ = fun ~start ~end' view el ->
+ El.set_inline_style El.Style.display (Jstr.v "") el;
+
+ (* These are in screen coordinates *)
+ let start = view##coordsAtPos start Js.null
+ and end' = view##coordsAtPos end' Js.null in
+ let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in
+
+ (* The box in which the tooltip is positioned, to use as base *)
+ let box = Jv.(Id.of_jv @@ call (Jv.Id.to_jv offsetParent) "getBoundingClientRect" [||]) in
+ let box_left = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "left") in
+ let box_bottom = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "bottom") in
+
+ (* Find a center-ish x position from the selection endpoints (when
+ crossing lines, end may be more to the left) *)
+ let left = (start##.left +. end'##.left) /. 2. in
+
+ El.set_inline_style (Jstr.v "left")
+ Jstr.( (of_float ( left -. box_left )) + (v "px") )
+ el;
+ El.set_inline_style (Jstr.v "bottom")
+ Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") )
+ el
+
+(** Build a button which allow to activate or desactivate the given Element.
+
+ The function f is called when the user validate the input.
+
+*)
+let build_field
+ : El.t -> (Jstr.t -> bool) -> binded_field
+ = fun field f ->
+
+ let button_content =
+ [ El.i []
+ ~at:At.[ class' (Jstr.v "fas")
+ ; class' (Jstr.v "fa-pen") ]
+ ] in
+
+ let button = El.button
+ button_content
+ in
+
+ Ev.listen Ev.click
+ (fun _ ->
+ match El.at (Jstr.v "contenteditable") field with
+ | Some value when (Jstr.equal value (Jstr.v "true")) ->
+ let new_value = El.prop
+ (El.Prop.jstr (Jstr.v "textContent"))
+ field in
+ begin match f new_value with
+ | true ->
+ El.set_at (Jstr.v "contenteditable") None field;
+ El.set_children button button_content
+ | false -> ()
+ end
+ | _ ->
+ El.set_at (Jstr.v "contenteditable")
+ (Some (Jstr.v "true")) field;
+ El.set_children button
+ [ El.i
+ ~at:At.[ class' (Jstr.v "fas")
+ ; class' (Jstr.v "fa-check") ]
+ []
+ ]
+ )
+ (El.as_target button);
+
+ { field
+ ; button = button
+ }
diff --git a/editor/plugins/tooltip.ml b/editor/plugins/tooltip.ml
new file mode 100755
index 0000000..05d56d4
--- /dev/null
+++ b/editor/plugins/tooltip.ml
@@ -0,0 +1,89 @@
+open StdLabels
+open Brr
+
+module Js = Js_of_ocaml.Js
+module PM = Prosemirror
+
+(** https://prosemirror.net/examples/tooltip/ *)
+
+
+let boldtip
+ : PM.View.editor_view Js.t -> < .. > Js.t
+ = fun view ->
+ (* Create the element which will be displayed over the editor *)
+ let tooltip = El.div []
+ ~at:At.([ class' (Jstr.v "popin")
+ ]) in
+ El.set_inline_style El.Style.display (Jstr.v "none") tooltip;
+
+ let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
+ let () = El.append_children parent [tooltip] in
+
+ let update
+ : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
+ = fun view state_opt ->
+
+ (* Compare the previous and actual state. If the stored marks are the
+ same, just return *)
+ let state = view##.state in
+ let previous_stored_marks =
+ Js.Opt.bind state_opt (fun state -> state##.storedMarks)
+ |> Js.Opt.to_option
+ and current_stored_marks = state##.storedMarks in
+
+ let same = match previous_stored_marks, Js.Opt.to_option current_stored_marks with
+ | Some arr1, Some arr2 ->
+ Js_lib.Array.compare arr1 arr2 ~f:(fun v1 v2 -> v1##eq v2)
+ | None, None -> Js._true
+ | _, _ -> Js._false in
+
+ if same <> Js._true then
+
+ let is_bold = Option.bind (PM.O.get state##.schema##.marks "strong")
+ (fun mark_type ->
+ let is_strong =
+ Js.Opt.bind current_stored_marks
+ (fun t -> mark_type##isInSet t) in
+ Js.Opt.case is_strong
+ (fun () -> None)
+ (fun _ -> Some (Jstr.v "gras"))) in
+ let is_em = Option.bind (PM.O.get state##.schema##.marks "em")
+ (fun mark_type ->
+ let is_em =
+ Js.Opt.bind current_stored_marks
+ (fun t -> mark_type##isInSet t) in
+ Js.Opt.case is_em
+ (fun () -> None)
+ (fun _ -> Some (Jstr.(v "emphase")))) in
+
+ let marks = List.filter_map [is_bold; is_em] ~f:(fun x -> x) in
+ match marks with
+ | [] -> El.set_inline_style El.Style.display (Jstr.v "none") tooltip
+ | _ ->
+ (* The mark is present, add in the content *)
+ let start = view##.state##.selection##.from
+ and end' = view##.state##.selection##._to in
+ Popin.set_position ~start ~end' view tooltip;
+ El.set_prop
+ (El.Prop.jstr (Jstr.v "textContent"))
+ (Jstr.concat marks ~sep:(Jstr.v ", "))
+ tooltip
+
+ and destroy () = El.remove tooltip in
+
+ object%js
+ val update = Js.wrap_callback update
+ val destroy= Js.wrap_callback destroy
+ end
+
+let bold_plugin
+ : PM.t -> PM.State.plugin Js.t
+ = fun t ->
+ let state = Jv.get (Jv.Id.to_jv t) "state" in
+
+ let params = object%js
+ val view = (fun view -> boldtip view)
+ end in
+
+ Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
+ |> Jv.Id.of_jv
diff --git a/editor/popin.ml b/editor/popin.ml
deleted file mode 100755
index 63dcad1..0000000
--- a/editor/popin.ml
+++ /dev/null
@@ -1,83 +0,0 @@
-open Brr
-module Js = Js_of_ocaml.Js
-module PM = Prosemirror
-
-type binded_field =
- { field: El.t
- ; button: El.t
- }
-
-(** Set the element position just above the selection *)
-let set_position
- : start:int -> end':int -> PM.View.editor_view Js.t -> El.t -> unit
- = fun ~start ~end' view el ->
- El.set_inline_style El.Style.display (Jstr.v "") el;
-
- (* These are in screen coordinates *)
- let start = view##coordsAtPos start Js.null
- and end' = view##coordsAtPos end' Js.null in
- let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in
-
- (* The box in which the tooltip is positioned, to use as base *)
- let box = Jv.(Id.of_jv @@ call (Jv.Id.to_jv offsetParent) "getBoundingClientRect" [||]) in
- let box_left = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "left") in
- let box_bottom = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "bottom") in
-
- (* Find a center-ish x position from the selection endpoints (when
- crossing lines, end may be more to the left) *)
- let left = (start##.left +. end'##.left) /. 2. in
-
- El.set_inline_style (Jstr.v "left")
- Jstr.( (of_float ( left -. box_left )) + (v "px") )
- el;
- El.set_inline_style (Jstr.v "bottom")
- Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") )
- el
-
-(** Build a button which allow to activate or desactivate the given Element.
-
- The function f is called when the user validate the input.
-
-*)
-let build_field
- : El.t -> (Jstr.t -> bool) -> binded_field
- = fun field f ->
-
- let button_content =
- [ El.i []
- ~at:At.[ class' (Jstr.v "fas")
- ; class' (Jstr.v "fa-pen") ]
- ] in
-
- let button = El.button
- button_content
- in
-
- Ev.listen Ev.click
- (fun _ ->
- match El.at (Jstr.v "contenteditable") field with
- | Some value when (Jstr.equal value (Jstr.v "true")) ->
- let new_value = El.prop
- (El.Prop.jstr (Jstr.v "textContent"))
- field in
- begin match f new_value with
- | true ->
- El.set_at (Jstr.v "contenteditable") None field;
- El.set_children button button_content
- | false -> ()
- end
- | _ ->
- El.set_at (Jstr.v "contenteditable")
- (Some (Jstr.v "true")) field;
- El.set_children button
- [ El.i
- ~at:At.[ class' (Jstr.v "fas")
- ; class' (Jstr.v "fa-check") ]
- []
- ]
- )
- (El.as_target button);
-
- { field
- ; button = button
- }
diff --git a/editor/state/dune b/editor/state/dune
new file mode 100755
index 0000000..dd405a1
--- /dev/null
+++ b/editor/state/dune
@@ -0,0 +1,9 @@
+(library
+ (name state)
+ (libraries
+ brr
+ prosemirror
+ plugins
+ )
+ (preprocess (pps js_of_ocaml-ppx))
+ )
diff --git a/editor/state/state.ml b/editor/state/state.ml
new file mode 100755
index 0000000..48b4d58
--- /dev/null
+++ b/editor/state/state.ml
@@ -0,0 +1,70 @@
+open Brr
+module PM = Prosemirror
+module Js = Js_of_ocaml.Js
+
+module Storage = Storage
+
+(** This is the state for the application *)
+type t =
+ { editable : bool
+ ; view : PM.View.editor_view Js.t
+ ; last_backup: float
+ ; page_id: Jstr.t option
+
+ ; window : Brr.El.t list
+ ; pm : PM.t
+ }
+
+(** Compare two states together.
+
+ The prosemirror elemens are ignored
+
+*)
+let eq s1 s2 =
+ Stdlib.(==)
+ ( s1.editable
+ , s1.last_backup
+ , s1.page_id
+ , s1.window )
+
+ ( s2.editable
+ , s2.last_backup
+ , s2.page_id
+ , s2.window )
+
+let set_title
+ : Storage.content Js.t -> unit
+ = fun content ->
+ let title =
+ Js.Opt.get
+ content##.title
+ (fun () -> Jstr.empty) in
+ let title_element = Document.find_el_by_id G.document (Jstr.v "title") in
+ Option.iter
+ (fun el -> El.set_prop (El.Prop.value) title el)
+ title_element
+
+let state_of_storage
+ : PM.t -> Storage.content Js.t -> PM.Model.schema Js.t -> PM.State.editor_state Js.t
+ = fun pm content schema ->
+ Js.Opt.case
+ content##.content
+ (fun () ->
+ let obj = PM.State.creation_prop () in
+ obj##.plugins := Plugins.default pm schema;
+ obj##.schema := Js.some schema;
+ PM.State.create pm obj)
+ (fun page_content ->
+ let obj = PM.State.configuration_prop () in
+ obj##.plugins := Plugins.default pm schema;
+ obj##.schema := Js.some schema;
+ PM.State.fromJSON pm obj page_content)
+
+let load_page
+ : Jstr.t option -> t -> Storage.content Js.t -> t
+ = fun page_id state json ->
+ let editor_state = state_of_storage state.pm json state.view##.state##.schema in
+ let () = state.view##updateState editor_state
+ and () = set_title json in
+ { state with page_id }
+
diff --git a/editor/state/state.mli b/editor/state/state.mli
new file mode 100755
index 0000000..e370015
--- /dev/null
+++ b/editor/state/state.mli
@@ -0,0 +1,24 @@
+module Js = Js_of_ocaml.Js
+
+module Storage = Storage
+
+type t =
+ { editable : bool
+ ; view : Prosemirror.View.editor_view Js.t
+ ; last_backup: float
+ ; page_id: Jstr.t option
+
+ ; window : Brr.El.t list
+ ; pm : Prosemirror.t
+ }
+
+val eq: t -> t -> bool
+
+val set_title
+ : Storage.content Js.t -> unit
+
+val state_of_storage
+ : Prosemirror.t -> Storage.content Js.t -> Prosemirror.Model.schema Js.t -> Prosemirror.State.editor_state Js.t
+
+val load_page
+ : Jstr.t option -> t -> Storage.content Js.t -> t
diff --git a/editor/state/storage.ml b/editor/state/storage.ml
new file mode 100755
index 0000000..f893c2d
--- /dev/null
+++ b/editor/state/storage.ml
@@ -0,0 +1,137 @@
+open Brr
+module Js = Js_of_ocaml.Js
+
+let storage_key = (Jstr.v "editor")
+
+let storage = Brr_io.Storage.local G.window
+
+class type content = object
+
+ method title
+ : Jstr.t Js.opt Js.readonly_prop
+
+ method content
+ : Jv.t Js.opt Js.readonly_prop
+
+ method date
+ : float Js.opt Js.readonly_prop
+
+end
+
+let page_id
+ : unit -> Jstr.t option
+ = fun () ->
+ let uri = Brr.Window.location Brr.G.window in
+ let query = Brr.Uri.query uri in
+ let params = Brr.Uri.Params.of_jstr query in
+ Brr.Uri.Params.find (Jstr.v "page") params
+
+(** [load' pm schema content key] will load the content stored in the local
+ storage for the [key].
+*)
+let load'
+ : Jstr.t -> content Js.t
+ = fun key ->
+
+ let opt_data = Brr_io.Storage.get_item storage key in
+ match opt_data with
+ | None ->
+ object%js
+ val title = Js.null
+ val content = Js.null
+ val date = Js.null
+ end
+ | Some contents ->
+
+ (* Try to load from the storage *)
+ match Json.decode contents with
+ | Error _ ->
+ object%js
+ val title = Js.null
+ val content = Js.null
+ val date = Js.null
+ end
+
+ | Ok json ->
+ Jv.Id.of_jv json
+
+(** Save the view *)
+let save'
+ : check:(content Js.t -> bool) -> content Js.t -> Jstr.t -> (bool, Jv.Error.t) result
+ = fun ~check object_content key ->
+
+ (* First load the content from the storage *)
+ match check (load' key) with
+ | false -> Ok false
+ | true ->
+ let storage = Brr_io.Storage.local G.window in
+ let operation = Brr_io.Storage.set_item
+ storage
+ key
+ (Json.encode @@ Jv.Id.to_jv @@ object_content) in
+ Result.map (fun () -> true) operation
+
+
+(** [load pm schema content f] will try load the content stored in the local
+ storage. The right key is given by the result of the function [f]
+*)
+let load
+ : Jstr.t option -> content Js.t
+ = fun key ->
+ match key with
+ | None -> load' storage_key
+ | Some value ->
+ let key = Jstr.concat
+ ~sep:(Jstr.v "_")
+ [storage_key ; value] in
+ load' key
+
+let save
+ : check:(content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result
+ = fun ~check object_content key ->
+ match key with
+ | None ->
+ save' ~check object_content storage_key
+ | Some value ->
+ let key = Jstr.concat
+ ~sep:(Jstr.v "_")
+ [storage_key ; value] in
+ save' ~check object_content key
+
+let delete
+ : (unit -> Jstr.t option) -> unit
+ = fun f ->
+ match f () with
+ | None -> ()
+ | Some value ->
+ let key = Jstr.concat
+ ~sep:(Jstr.v "_")
+ [storage_key ; value] in
+ let storage = Brr_io.Storage.local G.window in
+ Brr_io.Storage.remove_item storage key
+
+let get_ids
+ : unit -> Jstr.t list
+ = fun () ->
+ let open Brr_io in
+ let storage = Storage.local G.window in
+ let items = Storage.length storage in
+
+ let sub = Jstr.( storage_key + (v "_") ) in
+ let start = Jstr.length sub in
+
+ let rec add_element acc = function
+ | -1 -> acc
+ | nb ->
+ begin match Storage.key storage nb with
+ | Some key when (Jstr.starts_with ~sub key) ->
+
+ let key_name = Jstr.sub key
+ ~start in
+ add_element (key_name::acc) (nb -1)
+ | _ ->
+ add_element acc (nb -1)
+ end
+
+ in
+ add_element [] items
diff --git a/editor/state/storage.mli b/editor/state/storage.mli
new file mode 100755
index 0000000..5b7e0a0
--- /dev/null
+++ b/editor/state/storage.mli
@@ -0,0 +1,36 @@
+module Js = Js_of_ocaml.Js
+
+(** Provide a function for extracting the page id from the URL *)
+val page_id
+ : unit -> Jstr.t option
+
+class type content = object
+
+ method title
+ : Jstr.t Js.opt Js.readonly_prop
+
+ method content
+ : Jv.t Js.opt Js.readonly_prop
+
+ method date
+ : float Js.opt Js.readonly_prop
+
+end
+
+(** load f] will try to load the content associated with the given key.
+
+ The function [f] is called to identified which is the appropriate page id.
+*)
+val load
+ : Jstr.t option -> content Js.t
+
+val save
+ : check:(content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result
+
+(** Remove the page from the storage. *)
+val delete
+ : (unit -> Jstr.t option) -> unit
+
+(** Collect all the keys to the existing pages *)
+val get_ids
+ : unit -> Jstr.t list
diff --git a/editor/storage.ml b/editor/storage.ml
deleted file mode 100755
index f893c2d..0000000
--- a/editor/storage.ml
+++ /dev/null
@@ -1,137 +0,0 @@
-open Brr
-module Js = Js_of_ocaml.Js
-
-let storage_key = (Jstr.v "editor")
-
-let storage = Brr_io.Storage.local G.window
-
-class type content = object
-
- method title
- : Jstr.t Js.opt Js.readonly_prop
-
- method content
- : Jv.t Js.opt Js.readonly_prop
-
- method date
- : float Js.opt Js.readonly_prop
-
-end
-
-let page_id
- : unit -> Jstr.t option
- = fun () ->
- let uri = Brr.Window.location Brr.G.window in
- let query = Brr.Uri.query uri in
- let params = Brr.Uri.Params.of_jstr query in
- Brr.Uri.Params.find (Jstr.v "page") params
-
-(** [load' pm schema content key] will load the content stored in the local
- storage for the [key].
-*)
-let load'
- : Jstr.t -> content Js.t
- = fun key ->
-
- let opt_data = Brr_io.Storage.get_item storage key in
- match opt_data with
- | None ->
- object%js
- val title = Js.null
- val content = Js.null
- val date = Js.null
- end
- | Some contents ->
-
- (* Try to load from the storage *)
- match Json.decode contents with
- | Error _ ->
- object%js
- val title = Js.null
- val content = Js.null
- val date = Js.null
- end
-
- | Ok json ->
- Jv.Id.of_jv json
-
-(** Save the view *)
-let save'
- : check:(content Js.t -> bool) -> content Js.t -> Jstr.t -> (bool, Jv.Error.t) result
- = fun ~check object_content key ->
-
- (* First load the content from the storage *)
- match check (load' key) with
- | false -> Ok false
- | true ->
- let storage = Brr_io.Storage.local G.window in
- let operation = Brr_io.Storage.set_item
- storage
- key
- (Json.encode @@ Jv.Id.to_jv @@ object_content) in
- Result.map (fun () -> true) operation
-
-
-(** [load pm schema content f] will try load the content stored in the local
- storage. The right key is given by the result of the function [f]
-*)
-let load
- : Jstr.t option -> content Js.t
- = fun key ->
- match key with
- | None -> load' storage_key
- | Some value ->
- let key = Jstr.concat
- ~sep:(Jstr.v "_")
- [storage_key ; value] in
- load' key
-
-let save
- : check:(content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result
- = fun ~check object_content key ->
- match key with
- | None ->
- save' ~check object_content storage_key
- | Some value ->
- let key = Jstr.concat
- ~sep:(Jstr.v "_")
- [storage_key ; value] in
- save' ~check object_content key
-
-let delete
- : (unit -> Jstr.t option) -> unit
- = fun f ->
- match f () with
- | None -> ()
- | Some value ->
- let key = Jstr.concat
- ~sep:(Jstr.v "_")
- [storage_key ; value] in
- let storage = Brr_io.Storage.local G.window in
- Brr_io.Storage.remove_item storage key
-
-let get_ids
- : unit -> Jstr.t list
- = fun () ->
- let open Brr_io in
- let storage = Storage.local G.window in
- let items = Storage.length storage in
-
- let sub = Jstr.( storage_key + (v "_") ) in
- let start = Jstr.length sub in
-
- let rec add_element acc = function
- | -1 -> acc
- | nb ->
- begin match Storage.key storage nb with
- | Some key when (Jstr.starts_with ~sub key) ->
-
- let key_name = Jstr.sub key
- ~start in
- add_element (key_name::acc) (nb -1)
- | _ ->
- add_element acc (nb -1)
- end
-
- in
- add_element [] items
diff --git a/editor/storage.mli b/editor/storage.mli
deleted file mode 100755
index 5b7e0a0..0000000
--- a/editor/storage.mli
+++ /dev/null
@@ -1,36 +0,0 @@
-module Js = Js_of_ocaml.Js
-
-(** Provide a function for extracting the page id from the URL *)
-val page_id
- : unit -> Jstr.t option
-
-class type content = object
-
- method title
- : Jstr.t Js.opt Js.readonly_prop
-
- method content
- : Jv.t Js.opt Js.readonly_prop
-
- method date
- : float Js.opt Js.readonly_prop
-
-end
-
-(** load f] will try to load the content associated with the given key.
-
- The function [f] is called to identified which is the appropriate page id.
-*)
-val load
- : Jstr.t option -> content Js.t
-
-val save
- : check:(content Js.t -> bool) -> content Js.t -> Jstr.t option -> (bool, Jv.Error.t) result
-
-(** Remove the page from the storage. *)
-val delete
- : (unit -> Jstr.t option) -> unit
-
-(** Collect all the keys to the existing pages *)
-val get_ids
- : unit -> Jstr.t list
diff --git a/editor/tooltip.ml b/editor/tooltip.ml
deleted file mode 100755
index 05d56d4..0000000
--- a/editor/tooltip.ml
+++ /dev/null
@@ -1,89 +0,0 @@
-open StdLabels
-open Brr
-
-module Js = Js_of_ocaml.Js
-module PM = Prosemirror
-
-(** https://prosemirror.net/examples/tooltip/ *)
-
-
-let boldtip
- : PM.View.editor_view Js.t -> < .. > Js.t
- = fun view ->
- (* Create the element which will be displayed over the editor *)
- let tooltip = El.div []
- ~at:At.([ class' (Jstr.v "popin")
- ]) in
- El.set_inline_style El.Style.display (Jstr.v "none") tooltip;
-
- let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
- let () = El.append_children parent [tooltip] in
-
- let update
- : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
- = fun view state_opt ->
-
- (* Compare the previous and actual state. If the stored marks are the
- same, just return *)
- let state = view##.state in
- let previous_stored_marks =
- Js.Opt.bind state_opt (fun state -> state##.storedMarks)
- |> Js.Opt.to_option
- and current_stored_marks = state##.storedMarks in
-
- let same = match previous_stored_marks, Js.Opt.to_option current_stored_marks with
- | Some arr1, Some arr2 ->
- Js_lib.Array.compare arr1 arr2 ~f:(fun v1 v2 -> v1##eq v2)
- | None, None -> Js._true
- | _, _ -> Js._false in
-
- if same <> Js._true then
-
- let is_bold = Option.bind (PM.O.get state##.schema##.marks "strong")
- (fun mark_type ->
- let is_strong =
- Js.Opt.bind current_stored_marks
- (fun t -> mark_type##isInSet t) in
- Js.Opt.case is_strong
- (fun () -> None)
- (fun _ -> Some (Jstr.v "gras"))) in
- let is_em = Option.bind (PM.O.get state##.schema##.marks "em")
- (fun mark_type ->
- let is_em =
- Js.Opt.bind current_stored_marks
- (fun t -> mark_type##isInSet t) in
- Js.Opt.case is_em
- (fun () -> None)
- (fun _ -> Some (Jstr.(v "emphase")))) in
-
- let marks = List.filter_map [is_bold; is_em] ~f:(fun x -> x) in
- match marks with
- | [] -> El.set_inline_style El.Style.display (Jstr.v "none") tooltip
- | _ ->
- (* The mark is present, add in the content *)
- let start = view##.state##.selection##.from
- and end' = view##.state##.selection##._to in
- Popin.set_position ~start ~end' view tooltip;
- El.set_prop
- (El.Prop.jstr (Jstr.v "textContent"))
- (Jstr.concat marks ~sep:(Jstr.v ", "))
- tooltip
-
- and destroy () = El.remove tooltip in
-
- object%js
- val update = Js.wrap_callback update
- val destroy= Js.wrap_callback destroy
- end
-
-let bold_plugin
- : PM.t -> PM.State.plugin Js.t
- = fun t ->
- let state = Jv.get (Jv.Id.to_jv t) "state" in
-
- let params = object%js
- val view = (fun view -> boldtip view)
- end in
-
- Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
- |> Jv.Id.of_jv
--
cgit v1.2.3