Bindings to prosemirror

author: Sébastien Dailly <sebastien@chimrod.com> 2021-01-31 04:21:01 +0100
committer: Sébastien Dailly <sebastien@dailly.me> 2022-02-07 16:43:33 +0100
commit: d17d17261faccb3eb42e91f88ca035e5b1730c66 (patch)
tree: 28424d286bda347aee77528ece79907026b2e35b
parent: 1961a9779b482cf9cbdb3365137c2e74423067c6 (diff)
12 files changed, 1144 insertions, 145 deletions
diff --git a/editor/dune b/editor/dune
index c87962c..cb571b5 100755
--- a/editor/dune
+++ b/editor/dune
@@ -4,6 +4,8 @@
    brr
    brr.note
    elements
+   j
+   prosemirror
    blog
    )
  (modes js)
diff --git a/editor/editor.html b/editor/editor.html
index 525d8fc..9048e02 100755
--- a/editor/editor.html
+++ b/editor/editor.html
@@ -20,6 +20,7 @@
   <link rel="stylesheet" type="text/css" href="/theme/font-awesome/css/fontawesome.css">
   <link rel="stylesheet" type="text/css" href="/theme/font-awesome/css/brands.css">
   <link rel="stylesheet" type="text/css" href="/theme/font-awesome/css/solid.css">
+  <link rel="stylesheet" type="text/css" href="./editor.css">
 
     <link href="//localhost:8000/custom.css" rel="stylesheet">
 
@@ -43,16 +44,12 @@
 
   <title>Chimrod &ndash; Editor</title>
 
-<link rel="stylesheet" href="quill/quill.snow.css" />
-
 <style>
-  .standalone-container {
-    margin: 50px auto;
-    max-width: 100%;
-  }
   #text-container {
     height: 350px;
   }
+  .ProseMirror { height: 330px; overflow-y: auto; box-sizing: border-box; -moz-box-sizing: border-box }
+  textarea { width: 100%; height: 400px; border: 1px solid silver; box-sizing: border-box; padding: 3px 10px; border: none; outline: none }
 </style>
 </head>
 <body class="light-theme">
@@ -97,24 +94,34 @@
 <article class="single">
   <header>
     
-    <h1 id="editor">Editor</h1>
+    <h1 id="title">Editor</h1>
   </header>
   <div>
-<div class="standalone-container">
-  <div id="text-container"></div>
+<div id="text_editor" class="editor" style="margin-bottom: 23px; height: 350px;"></div>
+<div style="display: none" id="content">
+ <textarea>
+  <h3>Hello ProseMirror</h3>
+  <p>This is editable text. You can focus it and start typing.</p>
+  <p>To apply styling, you can select a piece of text and manipulate
+  its styling from the menu. The basic schema</p>
+  </textarea>
 </div>
 
+
   
   
-<script src="quill/quill.min.js"></script>
+<script src="prosemirror.js"></script>
 
   <noscript>Sorry, you need to enable JavaScript to see this page.</noscript>
     <script id="script" type="text/javascript" defer="defer" src="editor.js"></script>
   <script>
     var script = document.getElementById('script');
     script.addEventListener('load', function() {
-      var app = document.getElementById('text-container');
-      editor.attach(app);
+      var quill = document.getElementById('text-container');
+      editor.attach_quill(quill);
+      var prose = document.getElementById('text_editor');
+      var content = document.getElementById('content');
+      editor.attach_prosemirror(prose, content);
     });
   </script>
 
diff --git a/editor/editor.ml b/editor/editor.ml
index aeb96c1..be15718 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -1,132 +1,11 @@
+open Js_of_ocaml
 open Brr
 open Note
 
-module Prop
-  : sig
 
-    type ('a, 'b) prop
-
-    val prop
-      : string -> ('a, 'b) prop
-
-    val get
-      : 'a -> ('a, 'b) prop -> 'b option
-
-    val set
-      : 'a -> ('a, 'b) prop -> 'b -> unit
-  end
-
-= struct
-
-  type ('a, 'b) prop = Jv.prop'
-
-  let prop
-    : string -> ('a, 'b) prop
-    = Jstr.of_string
-
-  let get
-    : 'a -> ('a, 'b) prop -> 'b option
-    = fun obj prop ->
-      Jv.get' (Jv.Id.to_jv obj) prop
-      |> Jv.to_option Jv.Id.of_jv
-
-  let set
-    : 'a -> ('a, 'b) prop -> 'b -> unit
-    = fun obj prop value ->
-      Jv.set'
-        (Jv.Id.to_jv obj)
-        prop
-        (Jv.Id.to_jv value)
-
-end
-
-module Quill = struct
-
-  type t = Jv.t
-
-  type options
-
-  let bounds
-    : (options, El.t) Prop.prop
-    = Prop.prop "bounds"
-
-  let debug
-    : (options, Jstr.t) Prop.prop
-    = Prop.prop "debug"
-
-  let placeholder
-    : (options, Jstr.t) Prop.prop
-    = Prop.prop "placeholder"
-
-  let readonly
-    : (options, Jstr.t) Prop.prop
-    = Prop.prop "readonly"
-
-  let theme
-    : (options, Jstr.t) Prop.prop
-    = Prop.prop "theme"
-
-  let scrollingContainer
-    : (options, El.t) Prop.prop
-    = Prop.prop "scrollingContainer"
-
-  let options
-    : unit -> options
-    =  Jv.Id.of_jv @@ Jv.obj' [||]
-
-  (* Constructor.
-
-     [quill element] will create the editor inside the given element
-
-  *)
-  let quill
-    : ?options:options -> El.t -> (t, Jv.Error.t) Result.t
-    = fun ?options element ->
-      let quill = Jv.get Jv.global "Quill" in
-
-      let options = Jv.of_option ~none:Jv.undefined Jv.Id.to_jv options in
-
-      match Jv.new' quill Jv.Id.[| to_jv element; options |] with
-      | exception Jv.Error e -> Error e
-      | v -> Ok v
-
-
-  type delta = Jv.t
-
-  (* Operations is an array *)
-  type operations = Jv.t
-
-  let ops
-    : (delta, operations) Prop.prop
-    = Prop.prop "ops"
-
-
-  (** Return the editor content *)
-  let get_contents
-    : t -> delta
-    = fun t ->
-      Jv.call t "getContents" [||]
-
-  let set_contents
-    : t -> delta -> unit
-    = fun t contents ->
-      ignore @@ Jv.call t "setContents" [|contents|]
-
-  (** [extract_content index length] return the content starting from index, with length elements *)
-  let extract_contents
-    : t -> int -> int -> delta
-    = fun t index length ->
-      Jv.call t "getContents" [|Jv.of_int index; Jv.of_int length|]
-
-  let on_text_change
-    : t -> (string -> string -> string -> unit) -> unit
-    = fun t callback ->
-      ignore @@ Jv.call t "on" [|Jv.Id.to_jv @@ Jstr.v "text-change" ; Jv.repr callback|]
-
-
-end
 
 let storage_key = (Jstr.v "content")
+(** Save the text into the local storage *)
 let save_contents
   : Quill.t -> unit
   = fun editor ->
@@ -135,9 +14,12 @@ let save_contents
     Brr_io.Storage.set_item
       storage
       storage_key
-      (Json.encode @@ Jv.Id.of_jv @@ contents)
+      (Json.encode @@ Quill.delta_to_json @@ contents)
     |> Console.log_if_error ~use:()
 
+
+
+(** Load the content from the cache storage *)
 let load_contents
   : Quill.t -> unit
   = fun editor ->
@@ -146,24 +28,21 @@ let load_contents
       storage
       storage_key
     |> Option.iter (fun contents ->
-
-
         Json.decode contents
         |> Result.map (fun json ->
-            Quill.set_contents editor json
+            Quill.delta_of_json json
+            |> Quill.set_contents editor
           )
         |> Console.log_if_error ~use:()
       )
 
-
-
-let page_main id =
+let quill id =
   begin match (Jv.is_none id) with
     | true -> Console.(error [str "No element with id '%s' found"; id])
     | false ->
       let options = Quill.options () in
-      Prop.set options Quill.placeholder (Jstr.v "Nouvelle note…");
-      Prop.set options Quill.theme (Jstr.v "snow");
+      J.set options Quill.placeholder (Jstr.v "Nouvelle note…");
+      J.set options Quill.theme (Jstr.v "snow");
 
       (* Create the editor with the configuration *)
       Quill.quill ~options (Jv.Id.of_jv id)
@@ -193,11 +72,129 @@ let page_main id =
         )
   end
 
+let create_new_state pm pm_model pm_state mySchema content =
+  let module PM = Prosemirror in
+
+  let doc = PM.Model.(
+      DOMParser.parse
+        (DOMParser.from_schema pm_model mySchema)
+        (Jv.Id.of_jv content)) in
+
+  let props = PM.State.creation_prop () in
+  props##.doc := Js.some doc;
+  props##.plugins := Js.some (PM.example_setup pm mySchema);
+
+  PM.State.create
+    pm_state
+    props
+
+let storage_key = (Jstr.v "editor")
+let prosemirror id content =
+  begin match (Jv.is_none id), (Jv.is_none content) with
+    | false, false ->
+
+      let module PM = Prosemirror in
+      let pm = PM.v () in
+
+      let ( let+ ) o f = Option.iter f o
+      and ( and+ ) a b =
+        match a, b with
+        | Some a, Some b -> Some (a, b)
+        | _ -> None
+
+      in
+
+      let+ pm_state = J.get pm PM.state
+      and+ pm_view  = J.get pm PM.view
+      and+ pm_model = J.get pm PM.model
+      and+ schema_basic = J.get pm PM.schema_basic
+      and+ schema_list = J.get pm PM.schema_list
+
+      in
+
+      let _ = schema_basic
+      and _ = schema_list in
+
+      let mySchema = Js_of_ocaml.Js.Unsafe.eval_string {|new PM.model.Schema({
+    nodes: PM.schema_list.addListNodes(PM.schema_basic.schema.spec.nodes, "paragraph block*", "block"),
+    marks: PM.schema_basic.schema.spec.marks
+  })|} in
+
+
+      (* Create the initial state *)
+      let storage = Brr_io.Storage.local G.window in
+      let opt_data = Brr_io.Storage.get_item storage storage_key in
+      let state = match opt_data with
+        | None -> create_new_state pm pm_model pm_state mySchema content
+        | Some contents ->
+          (* Try to load from the storage *)
+          begin match Json.decode contents with
+            | Error _ -> create_new_state pm pm_model pm_state mySchema content
+            | Ok json ->
+              Console.(log [Jstr.v "Loading json"]);
+
+              let history = PM.History.(history pm (history_prop ()) ) in
+              Console.(log [history]);
+              let _ = history in
+
+              let obj = PM.State.configuration_prop () in
+              obj##.plugins := Js.some (PM.example_setup pm mySchema);
+              obj##.schema := mySchema;
+              PM.State.fromJSON pm_state obj json
+          end
+      in
+
+      let props = PM.View.direct_editor_props () in
+      props##.dispatchTransaction := (Js.wrap_meth_callback (fun view transaction ->
+          Console.(log [ Jstr.v "Document size went from"
+                       ; transaction##.before##.content##.size ]);
+          let state = view##.state##apply transaction in
+          view##updateState state
+        ));
+      props##.state := state;
+
+
+      let view = PM.View.editor_view
+          pm_view
+          (Jv.Id.of_jv id)
+          props in
+
+
+      view##setProps props;
+
+      (* Attach an event on focus out *)
+      let _out_event = Brr_note.Evr.on_el
+          (Ev.focusout)
+          (fun _ ->
+             let contents = view##.state##toJSON () in
+
+             let storage = Brr_io.Storage.local G.window in
+             Brr_io.Storage.set_item
+               storage
+               storage_key
+               (Json.encode @@ contents)
+             |> Console.log_if_error ~use:()
+
+
+
+          )
+          (Jv.Id.of_jv id) in
+      ()
+
+    | _, _-> Console.(error [str "No element with id '%s' '%s' found"; id ; content])
+
+
+
+  end
+
+
+
 let () =
 
   let open Jv in
   let editor = obj
-      [| "attach", (repr page_main)
+      [| "attach_quill", (repr quill)
+       ; "attach_prosemirror", (repr prosemirror)
       |] in
 
   set global "editor" editor
diff --git a/editor/j/dune b/editor/j/dune
new file mode 100755
index 0000000..56e6691
--- /dev/null
+++ b/editor/j/dune
@@ -0,0 +1,7 @@
+(library
+ (name j)
+ (libraries 
+   brr
+   js_of_ocaml
+   )
+ )
diff --git a/editor/j/j.ml b/editor/j/j.ml
new file mode 100755
index 0000000..96b22e0
--- /dev/null
+++ b/editor/j/j.ml
@@ -0,0 +1,47 @@
+type ('a, 'b) prop = Jv.prop'
+
+let prop
+  : string -> ('a, 'b) prop
+  = Jstr.of_string
+
+let get
+  : 'a -> ('a, 'b) prop -> 'b option
+  = fun obj prop ->
+    Jv.get' (Jv.Id.to_jv obj) prop
+    |> Jv.to_option Jv.Id.of_jv
+
+let set
+  : 'a -> ('a, 'b) prop -> 'b -> unit
+  = fun obj prop value ->
+    Jv.set'
+      (Jv.Id.to_jv obj)
+      prop
+      (Jv.Id.to_jv value)
+
+(* Objects *)
+
+type 'a constr = (Jstr.t * Jv.t)
+
+let c
+  : ('a, 'b) prop -> 'b -> 'a constr
+  = fun prop v ->
+    (prop, Jv.Id.to_jv v)
+
+let obj
+  : 'a constr Array.t -> 'a
+  = fun props ->
+    Jv.Id.of_jv @@ Jv.obj' props
+
+(* Arrays *)
+
+type 'a array = Jv.t
+
+let to_array
+  : 'a array -> 'a Array.t
+  = fun arr ->
+    Jv.to_array Jv.Id.of_jv arr
+
+let of_array
+  : 'a Array.t -> 'a array
+  = fun arr ->
+    Jv.of_array Jv.Id.to_jv arr
diff --git a/editor/j/j.mli b/editor/j/j.mli
new file mode 100755
index 0000000..796bb9d
--- /dev/null
+++ b/editor/j/j.mli
@@ -0,0 +1,32 @@
+(** The type properties *)
+type ('a, 'b) prop
+
+val prop
+  : string -> ('a, 'b) prop
+
+val get
+  : 'a -> ('a, 'b) prop -> 'b option
+
+val set
+  : 'a -> ('a, 'b) prop -> 'b -> unit
+
+
+(* Arrays *)
+
+type 'a array
+
+val to_array
+  : 'a array -> 'a Array.t
+
+val of_array
+  : 'a Array.t -> 'a array
+
+(* Object constructor *)
+
+type 'a constr
+
+val c
+  : ('a, 'b) prop -> 'b -> 'a constr
+
+val obj
+  : 'a constr Array.t -> 'a
diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml
new file mode 100755
index 0000000..d2ef2e6
--- /dev/null
+++ b/editor/prosemirror/bindings.ml
@@ -0,0 +1,376 @@
+open Js_of_ocaml.Js
+
+module Model = struct
+
+  type mark
+
+  type schema
+
+  type content_match
+
+  type node_spec
+
+  type slice
+
+  class type _node_props = object ('this)
+
+    method inlineContent:
+      bool readonly_prop
+    (** True if this node type has inline content. *)
+
+    method isBlock:
+      bool readonly_prop
+
+    method isText:
+      bool readonly_prop
+
+    method isInline:
+      bool readonly_prop
+
+    method isTextblock:
+      bool readonly_prop
+
+    method isLeaf:
+      bool readonly_prop
+
+    method isAtom:
+      bool readonly_prop
+
+  end
+
+  class type node_type = object ('this)
+
+    inherit _node_props
+
+    method name:
+      string readonly_prop
+
+    method schema:
+      schema t readonly_prop
+
+    method spec:
+      node_spec t readonly_prop
+
+    method contentMatch:
+      content_match t readonly_prop
+
+    method hasRequiredAttrs:
+      unit -> bool meth
+
+  end
+
+  class type mark_type = object ('this)
+  end
+
+  (** Common signature between fragment and node *)
+  class type _element = object ('this)
+
+    method childCount:
+      int readonly_prop
+    (** The number of children that the node has. *)
+
+    method child:
+      int -> node t meth
+    (**  Get the child node at the given index. Raise an error when the index
+         is out of range. *)
+
+    method maybeChild:
+      int -> node t opt meth
+    (** Get the child node at the given index, if it exists. *)
+
+    method eq:
+      'this t -> bool meth
+    (** Compare this element to another one. *)
+
+    method cut:
+      int -> int opt -> 'this meth
+    (** Cut out the element between the two given positions. *)
+
+    method toString:
+      unit -> Jstr.t meth
+    (** Return a debugging string that describes this element. *)
+
+    method forEach:
+      (node t -> int -> int) -> unit meth
+
+  end
+
+  and fragment = object ('this)
+
+    inherit _element
+
+    method size:
+      int readonly_prop
+    (** The size of the fragment, which is the total of the size of its
+        content nodes. *)
+
+    method append:
+      'this t -> 'this t meth
+
+    method lastChild:
+      node t opt readonly_prop
+
+    method firstChild:
+      node t opt readonly_prop
+
+  end
+
+  and node = object ('this)
+
+    inherit _element
+
+    inherit _node_props
+
+    method _type:
+      node_type t readonly_prop
+
+    method attrs:
+      < .. > t readonly_prop
+
+    method content:
+      fragment t readonly_prop
+
+    method marks:
+      mark t js_array t readonly_prop
+
+    method sameMarkupd:
+      node t -> bool meth
+  end
+
+end
+
+module Transform = struct
+
+  type step_result
+
+  class type step = object ('this)
+
+  end
+
+  class type replace_step = object ('this)
+
+    inherit step
+
+  end
+
+  class type replace_around_step = object ('this)
+
+    inherit step
+
+  end
+
+  class type add_mark_step = object ('this)
+
+    inherit step
+
+  end
+
+
+  class type transform = object ('this)
+
+    method doc:
+      Model.node t readonly_prop
+
+    method steps:
+      step t js_array t readonly_prop
+
+    method docs:
+      Model.node t js_array t readonly_prop
+
+    method step:
+      step t -> 'this t meth
+
+  end
+
+end
+
+(**
+
+   The class is defined outside of the module View for prevent recursive
+   declaration.
+
+*)
+class type _editor_props = object ('this)
+
+end
+
+
+module State = struct
+
+  class type plugin = object ('this)
+
+    method props : _editor_props t readonly_prop
+
+  end
+
+  class type selection = object ('this)
+
+    method content:
+      unit -> Model.slice t meth
+
+    method replace:
+      transaction t -> Model.slice t -> unit meth
+
+  end
+
+  and transaction = object ('this)
+
+    inherit Transform.transform
+
+    method time:
+      int readonly_prop
+
+    method setTime:
+      int -> 'this t meth
+
+    method storedMarks:
+      Model.mark t js_array t opt readonly_prop
+
+    method setStoredMarks:
+      Model.mark t js_array t opt -> 'this t meth
+
+    method addStoredMark:
+      Model.mark t -> 'this t meth
+
+    method removeStoredMark_mark:
+      Model.mark t -> 'this t meth
+
+    method removeStoredMark_marktype:
+      Model.mark_type t -> 'this t meth
+
+    method ensureMarks:
+      Model.mark t js_array t -> 'this t meth
+
+    method storedMarksSet:
+      bool readonly_prop
+
+    method selection:
+      selection t readonly_prop
+
+    method setSelection:
+      selection t -> 'this t meth
+
+    method deleteSelection:
+      'this t meth
+
+    method replaceSelection:
+      Model.slice t -> 'this t meth
+
+    method selectionSet:
+      bool readonly_prop
+
+    method before:
+      Model.node t readonly_prop
+
+  end
+
+  class type configuration_prop = object ('this)
+
+    method schema:
+      Model.schema t opt prop
+
+    method plugins:
+      plugin t js_array t opt prop
+
+  end
+
+  class type creation_prop = object ('this)
+
+    inherit configuration_prop
+
+    method doc:
+      Model.node t opt prop
+
+    method selection:
+      selection t opt prop
+
+    method storedMarks:
+      Model.mark t js_array t opt prop
+
+  end
+
+  class type editor_state = object ('this)
+
+    method doc :
+      Model.node t readonly_prop
+
+    method selection:
+      selection t readonly_prop
+
+    method storedMarks:
+      Model.mark t js_array t opt readonly_prop
+
+    method schema:
+      Model.schema t readonly_prop
+
+    method plugins:
+      plugin t js_array t readonly_prop
+
+    method apply:
+      transaction t -> 'this t meth
+
+    method tr:
+      transaction t readonly_prop
+
+    method reconfigure:
+      configuration_prop t meth
+
+    method toJSON:
+      unit -> Brr.Json.t meth
+
+  end
+
+end
+
+module View = struct
+
+  class type editor_props = _editor_props
+
+  class type direct_editor_props = object ('this)
+
+    inherit editor_props
+
+    method state:
+      State.editor_state t writeonly_prop
+
+    (** The call back is called with this = instance of editor_view *)
+    method dispatchTransaction:
+      (editor_view t, State.transaction t -> unit) meth_callback writeonly_prop
+
+  end
+
+  and editor_view = object ('this)
+
+    method state:
+      State.editor_state t readonly_prop
+
+    method dom:
+      Brr.El.t readonly_prop prop
+
+    method editable:
+      bool readonly_prop prop
+
+    method update:
+      direct_editor_props t -> unit meth
+
+    method setProps:
+      direct_editor_props t -> unit meth
+
+    method updateState:
+      State.editor_state t -> unit meth
+
+  end
+
+end
+
+module History = struct
+
+  class type history_prop = object ('this)
+
+    method depth: int opt prop
+
+    method newGroupDelay: int opt prop
+
+  end
+
+end
diff --git a/editor/prosemirror/dune b/editor/prosemirror/dune
new file mode 100755
index 0000000..4fff7b2
--- /dev/null
+++ b/editor/prosemirror/dune
@@ -0,0 +1,9 @@
+(library
+ (name prosemirror)
+ (libraries 
+   brr
+   js_of_ocaml
+   j
+   )
+ (preprocess (pps js_of_ocaml-ppx))
+ )
diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml
new file mode 100755
index 0000000..bf72227
--- /dev/null
+++ b/editor/prosemirror/prosemirror.ml
@@ -0,0 +1,206 @@
+open Js_of_ocaml
+open Brr
+
+type t = Jv.t
+
+let v
+  : unit -> t
+  = fun () ->
+    Jv.get Jv.global "PM"
+
+type pm_schema
+
+type pm_state = Jv.t
+
+type pm_view = Jv.t
+
+
+let state
+  : (t, pm_state) J.prop
+  = J.prop "state"
+
+let view
+  : (t, pm_view) J.prop
+  = J.prop "view"
+
+type schema
+
+let schema_basic
+  : (t, Jv.t) J.prop
+  = J.prop "schema_basic"
+
+(* Model *)
+
+type pm_model = Jv.t
+
+let model
+  : (t, pm_model) J.prop
+  = J.prop "model"
+
+module Model = struct
+
+  include Bindings.Model
+
+  module DOMParser = struct
+
+    type t = Jv.t
+
+    let from_schema
+      : pm_model -> schema Js.t -> t
+      = fun model schema ->
+        let parser = Jv.get model "DOMParser" in
+        Jv.call (Jv.Id.to_jv parser) "fromSchema" [|Jv.Id.to_jv schema|]
+
+    let parse
+      : t -> El.t -> node Js.t
+      = fun dom_parser el ->
+        Jv.call dom_parser "parse" [|Jv.Id.to_jv el|]
+        |> Jv.Id.of_jv
+
+  end
+
+  let empty_fragment
+    : t -> fragment Js.t
+    = fun t ->
+      let model = Jv.get t "model" in
+      let fragment = Jv.get model "Fragment" in
+      Jv.get fragment "empty"
+      |> Jv.Id.of_jv
+
+end
+
+type pm_transform = Jv.t
+
+let transform
+  : (t, pm_transform) J.prop
+  = J.prop "prosemirror-transform"
+
+
+module State = struct
+
+  include Bindings.State
+
+  let configuration_prop
+    : unit -> configuration_prop Js_of_ocaml.Js.t
+    = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]
+
+  let creation_prop
+    : unit -> creation_prop Js.t
+    = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]
+
+  let create
+    : pm_state -> creation_prop Js.t -> editor_state Js.t
+    = fun state props ->
+      let editor_state = Jv.get state "EditorState" in
+      Jv.call editor_state "create" [|Jv.Id.to_jv props|]
+      |> Jv.Id.of_jv
+
+  let fromJSON
+    : pm_state -> configuration_prop Js_of_ocaml.Js.t -> Brr.Json.t -> editor_state Js.t
+    = fun state config json ->
+      let editor_state = Jv.get state "EditorState" in
+      Jv.call editor_state "fromJSON" [|Jv.Id.to_jv config ; json |]
+      |> Jv.Id.of_jv
+end
+
+(* Editor view *)
+
+module View = struct
+
+  module EditorProps = struct
+    type t = Jv.t
+  end
+
+  include Bindings.View
+  let direct_editor_props
+    : unit -> direct_editor_props Js.t
+    = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]
+
+  let editor_view
+    : pm_view -> El.t -> direct_editor_props Js.t -> editor_view Js.t
+    = fun view node props ->
+      Jv.new' (Jv.get view "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|]
+      |> Jv.Id.of_jv
+end
+
+(* Schema list *)
+
+type schema_list = Jv.t
+
+let schema_list
+  : (t, schema_list) J.prop
+  = J.prop "schema_list"
+
+module SchemaList = struct
+
+  let js f = Jv.of_jstr @@ Jstr.v f
+
+  let js_opt = Jv.of_option
+      ~none:Jv.null
+      js
+
+  let add_list_nodes
+    : schema_list -> ?listGroup:string -> node:Model.node Js.t -> itemContent:string -> unit
+    = fun s ?listGroup ~node ~itemContent ->
+      Jv.call (Jv.Id.to_jv s) "addListNodes" [|Jv.Id.to_jv node; js itemContent ; js_opt listGroup|]
+      |> ignore
+
+end
+
+module History = struct
+
+  include Bindings.History
+
+  let history_prop
+    : unit -> history_prop Js.t
+    = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]
+
+  let history
+    : t -> history_prop Js.t -> State.plugin Js.t
+    = fun t props ->
+      Jv.call (Jv.get t "history") "history" [|Jv.Id.to_jv props|]
+      |> Jv.Id.of_jv
+
+  let undo
+    : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
+    = fun t state fn ->
+      Jv.call (Jv.get t "history") "undo" [|Jv.Id.to_jv state; Jv.repr fn|]
+      |> Jv.Id.of_jv
+
+  let redo
+    : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
+    = fun t state fn ->
+      Jv.call (Jv.get t "history") "redo" [|Jv.Id.to_jv state; Jv.repr fn|]
+      |> Jv.Id.of_jv
+end
+
+module Keymap = struct
+
+  let keymap
+    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array -> State.plugin Js.t
+    = fun t props ->
+      let props = Jv.obj @@ Array.map (fun (id, f) -> (id, Jv.repr f)) props in
+      Jv.call (Jv.get t "keymap") "keymap" [|props|]
+      |> Jv.Id.of_jv
+
+end
+
+module Commands = struct
+
+  let baseKeymap
+    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array
+    = fun t ->
+      Jv.get (Jv.get t "commands") "baseKeymap"
+      |> Jv.Id.of_jv
+
+end
+
+(* Example Setup *)
+
+let example_setup
+  : t -> Model.schema Js.t -> State.plugin Js.t Js.js_array Js.t
+  = fun t schema ->
+    let setup = Jv.get t "example_setup" in
+    let props = Jv.obj [|("schema", Jv.Id.to_jv schema)|] in
+    Jv.call setup "exampleSetup" [|props|]
+    |> Jv.Id.of_jv
diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli
new file mode 100755
index 0000000..1e0e889
--- /dev/null
+++ b/editor/prosemirror/prosemirror.mli
@@ -0,0 +1,145 @@
+open Js_of_ocaml
+open Brr
+
+type t
+
+val v
+  : unit -> t
+
+type schema_list
+
+type pm_schema
+
+type pm_state 
+
+type pm_view 
+
+type pm_model
+
+type pm_transform
+
+val state
+  : (t, pm_state) J.prop
+
+val view
+  : (t, pm_view) J.prop
+
+val model
+  : (t, pm_model) J.prop
+
+type schema
+
+val schema_basic
+  : (t, Jv.t) J.prop
+
+val schema_list
+  : (t, schema_list) J.prop
+
+
+val transform
+  : (t, pm_transform) J.prop
+
+
+module rec Model : sig
+
+  include module type of Bindings.Model
+
+
+  module DOMParser : sig
+    type t
+
+    val from_schema
+      : pm_model -> schema Js.t -> t
+
+    val parse
+      : t -> El.t -> node Js.t
+
+  end
+
+  val empty_fragment 
+    : t -> fragment Js.t
+
+end
+
+and SchemaList : sig
+
+  val add_list_nodes
+    : schema_list -> ?listGroup:string -> node:Model.node Js.t -> itemContent:string -> unit
+
+end
+
+(* State *)
+
+and State : sig
+
+  include module type of Bindings.State
+
+  val configuration_prop 
+    : unit -> configuration_prop Js.t 
+
+  val creation_prop 
+    : unit -> creation_prop Js.t 
+
+  val create
+    : pm_state -> creation_prop Js.t -> editor_state Js.t
+
+  val fromJSON 
+    : pm_state -> configuration_prop Js.t -> Brr.Json.t -> editor_state Js.t
+
+end
+
+(* Editor view *)
+
+and View : sig
+
+  module EditorProps : sig
+
+    type t
+
+  end
+
+  include module type of Bindings.View
+
+  val direct_editor_props 
+    : unit -> direct_editor_props Js.t
+
+  val editor_view
+    : pm_view -> El.t -> direct_editor_props Js.t -> editor_view Js.t
+
+end
+
+module History : sig
+
+  include module type of Bindings.History
+
+  val history_prop 
+    : unit -> history_prop Js.t
+
+  val history 
+    : t -> history_prop Js.t -> State.plugin Js.t
+
+  val undo 
+    : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
+
+  val redo
+    : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
+end
+
+module Keymap : sig
+
+  val keymap
+    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array -> State.plugin Js.t
+
+end
+
+module Commands : sig
+
+  val baseKeymap 
+    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array
+
+end
+
+(* Example Setup *)
+
+val example_setup
+  : t -> Model.schema Js.t -> State.plugin Js.t Js.js_array Js.t
diff --git a/editor/quill.ml b/editor/quill.ml
new file mode 100755
index 0000000..8069d90
--- /dev/null
+++ b/editor/quill.ml
@@ -0,0 +1,101 @@
+open Brr
+
+type t = Jv.t
+
+type options
+
+let bounds
+  : (options, El.t) J.prop
+  = J.prop "bounds"
+
+let debug
+  : (options, Jstr.t) J.prop
+  = J.prop "debug"
+
+let placeholder
+  : (options, Jstr.t) J.prop
+  = J.prop "placeholder"
+
+let readonly
+  : (options, Jstr.t) J.prop
+  = J.prop "readonly"
+
+let theme
+  : (options, Jstr.t) J.prop
+  = J.prop "theme"
+
+let scrollingContainer
+  : (options, El.t) J.prop
+  = J.prop "scrollingContainer"
+
+let options
+  : unit -> options
+  =  Jv.Id.of_jv @@ Jv.obj' [||]
+
+(** Constructor.
+
+    [quill element] will create the editor inside the given element
+
+*)
+let quill
+  : ?options:options -> El.t -> (t, Jv.Error.t) Result.t
+  = fun ?options element ->
+    let quill = Jv.get Jv.global "Quill" in
+
+    let options = Jv.of_option ~none:Jv.undefined Jv.Id.to_jv options in
+
+    match Jv.new' quill Jv.Id.[| to_jv element; options |] with
+    | exception Jv.Error e -> Error e
+    | v -> Ok v
+
+
+type delta = Jv.t
+
+let delta_to_json
+  : delta -> Brr.Json.t
+  = Jv.Id.to_jv
+
+let delta_of_json
+  : Brr.Json.t -> delta
+  = Jv.Id.of_jv
+
+(* Operations is an array *)
+type operations = Jv.t
+
+let ops
+  : (delta, operations) J.prop
+  = J.prop "ops"
+
+
+(** Return the editor content *)
+let get_contents
+  : t -> delta
+  = fun t ->
+    Jv.call t "getContents" [||]
+
+let set_contents
+  : t -> delta -> unit
+  = fun t contents ->
+    ignore @@ Jv.call t "setContents" [|contents|]
+
+(** [extract_content t index length] return the content starting from index,
+    with length elements *)
+let extract_contents
+  : t -> int -> int -> delta
+  = fun t index length ->
+    Jv.call t "getContents" [|Jv.of_int index; Jv.of_int length|]
+
+let on_text_change
+  : t -> (string -> string -> string -> unit) -> unit
+  = fun t callback ->
+    ignore @@ Jv.call t "on" [|Jv.Id.to_jv @@ Jstr.v "text-change" ; Jv.repr callback|]
+
+(* [update_contents t delta] replace the content with the commands given
+   by delta.
+*)
+let update_contents
+  : t -> delta -> delta
+  = fun t delta ->
+    Jv.call t "updateContents" [|delta|]
+
+
diff --git a/editor/quill.mli b/editor/quill.mli
new file mode 100755
index 0000000..7405102
--- /dev/null
+++ b/editor/quill.mli
@@ -0,0 +1,70 @@
+open Brr
+
+(** Constructor options *)
+type options
+
+val options
+  : unit -> options
+
+val bounds
+  : (options, El.t) J.prop
+
+val debug
+  : (options, Jstr.t) J.prop
+
+val placeholder
+  : (options, Jstr.t) J.prop
+
+val readonly
+  : (options, Jstr.t) J.prop
+
+val theme
+  : (options, Jstr.t) J.prop
+
+val scrollingContainer
+  : (options, El.t) J.prop
+
+type delta 
+
+val delta_to_json
+  : delta -> Json.t
+
+val delta_of_json
+  : Json.t -> delta
+
+type operations 
+
+val ops
+  : (delta, operations) J.prop
+
+type t 
+
+(** Constructor.
+
+    [quill element] will create the editor inside the given element
+
+*)
+val quill
+  : ?options:options -> El.t -> (t, Jv.Error.t) Result.t
+
+
+(** Return the editor content *)
+val get_contents
+  : t -> delta
+
+val set_contents
+  : t -> delta -> unit
+
+(** [extract_content t index length] return the content starting from index,
+    with length elements *)
+val extract_contents
+  : t -> int -> int -> delta
+
+val on_text_change
+  : t -> (string -> string -> string -> unit) -> unit
+
+(* [update_contents t delta] replace the content with the commands given
+   by delta.
+*)
+val update_contents
+  : t -> delta -> delta
author	Sébastien Dailly <sebastien@chimrod.com>	2021-01-31 04:21:01 +0100
committer	Sébastien Dailly <sebastien@dailly.me>	2022-02-07 16:43:33 +0100
commit	d17d17261faccb3eb42e91f88ca035e5b1730c66 (patch)
tree	28424d286bda347aee77528ece79907026b2e35b
parent	1961a9779b482cf9cbdb3365137c2e74423067c6 (diff)