diff options
| -rw-r--r-- | editor/editor.css | 52 | ||||
| -rwxr-xr-x | editor/editor.ml | 164 | ||||
| -rwxr-xr-x | editor/index.html | 130 | ||||
| -rwxr-xr-x | editor/plugins.ml | 134 | ||||
| -rwxr-xr-x | editor/prosemirror/bindings.ml | 194 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.ml | 117 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.mli | 65 | ||||
| -rwxr-xr-x | editor/tooltip.ml | 149 |
8 files changed, 666 insertions, 339 deletions
diff --git a/editor/editor.css b/editor/editor.css index fb58773..c8c2aeb 100644 --- a/editor/editor.css +++ b/editor/editor.css @@ -325,38 +325,70 @@ li.ProseMirror-selectednode:after { .ProseMirror p { margin-bottom: 1em } -.editor em::before, .editor em::after { +.editor [contenteditable="true"] em::before, .editor [contenteditable="true"] em::after { content: "//" } -.editor blockquote p::before { +.editor [contenteditable="true"] blockquote p::before { content: "> " } -.editor strong::before, .editor strong::after { - content: "**" +.editor [contenteditable="true"] strong::before, .editor [contenteditable="true"] strong::after { + content: "**"; + display: inline-block; + pointer-events: none; } -.editor h1::before { +.editor [contenteditable="true"] h1::before { content: "# " } -.editor h2::before { +.editor [contenteditable="true"] h2::before { content: "## " } -.editor h3::before { +.editor [contenteditable="true"] h3::before { content: "### " } -.editor h4::before { +.editor [contenteditable="true"] h4::before { content: "#### " } -.editor h5::before { +.editor [contenteditable="true"] h5::before { content: "##### " } -.editor h6::before { +.editor [contenteditable="true"] h6::before { content: "###### " } + +#title { + font-size:2.4em; + font-weight:300; + line-height:1.1; + font-family:Source Sans Pro,Roboto,Open Sans,Liberation Sans,DejaVu Sans,Verdana,Helvetica,Arial,sans-serif; + width:100%; + +} + +.editor a[href] { + position: relative; +} +.tooltip, .editor a[href]:hover::after { + position: absolute; + border: 1px #3b4252 solid; + border-radius: 10px; + background-color: #2e3440; + padding: 12px; + color: #eceff4; + font-size: 14px; + z-index: 99; + pointer-events: none; +} + +.editor a[href]:hover::after { + content: attr(href); + left: 0; + top: 24px; +} diff --git a/editor/editor.ml b/editor/editor.ml index d32288c..5aecef0 100755 --- a/editor/editor.ml +++ b/editor/editor.ml @@ -2,72 +2,6 @@ open Js_of_ocaml open Brr module PM = Prosemirror -let change_level - : PM.t -> PM.Model.resolved_pos Js.t -> int -> (int -> bool) -> PM.State.command - = 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" - , (object%js - val level = current_level + incr - end :> < > Js.t )) - | true -> - ( PM.O.get state##.schema##.nodes "paragraph" - , object%js end) 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" -> change_level pm res 1 (fun _ -> false) state dispatch - | _ -> 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 default_plugins pm schema = - - let props = PM.Example.options schema in - props##.menuBar := Js.some Js._true; - props##.floatingMenu := Js.some Js._true; - 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 - - Js.some setup - let create_new_state pm mySchema content = let module PM = Prosemirror in @@ -78,13 +12,45 @@ let create_new_state pm mySchema content = let props = PM.State.creation_prop () in props##.doc := Js.some doc; - props##.plugins := default_plugins pm mySchema; + props##.plugins := Plugins.default pm mySchema; PM.State.create pm props let storage_key = (Jstr.v "editor") + +let storage = Brr_io.Storage.local G.window + +(** Read the state from the local storage, or load the content from the given + element *) +let load_storage + : PM.t -> PM.Model.schema Js.t -> Jv.t -> PM.State.editor_state Js.t + = fun pm schema content -> + let opt_data = Brr_io.Storage.get_item storage storage_key in + match opt_data with + | None -> create_new_state pm schema content + | Some contents -> + (* Try to load from the storage *) + match Json.decode contents with + | Error _ -> create_new_state pm schema content + | Ok json -> + let obj = PM.State.configuration_prop () in + obj##.plugins := Plugins.default pm schema; + obj##.schema := Js.some schema; + PM.State.fromJSON pm obj json + +let save_storage + : PM.View.editor_view Js.t -> unit + = fun view -> + 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:() + let prosemirror id content = begin match (Jv.is_none id), (Jv.is_none content) with | false, false -> @@ -100,61 +66,57 @@ let prosemirror id content = (Some (Jstr.v "block"))) (Some (PM.SchemaBasic.schema pm)##.spec##.marks) None in - let mySchema = PM.Model.schema pm specs 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 mySchema content - | Some contents -> - (* Try to load from the storage *) - begin match Json.decode contents with - | Error _ -> create_new_state pm mySchema content - | Ok json -> - Console.(log [Jstr.v "Loading json"]); - - let history = PM.History.(history pm (history_prop ()) ) in - let _ = history in - - let obj = PM.State.configuration_prop () in - obj##.plugins := default_plugins pm mySchema; - obj##.schema := Js.some mySchema; - PM.State.fromJSON pm obj json - end - in + let state = load_storage pm mySchema content in let props = PM.View.direct_editor_props () in props##.state := state; + (* Each time the state is update, handle the copy *) + props##.dispatchTransaction := Js.wrap_meth_callback @@ (fun view tr -> + let state = view##.state##apply tr in + view##updateState state + ); let view = PM.View.editor_view pm (Jv.Id.of_jv id) props in - - view##setProps props; - (* Attach an event on focus out *) - let _out_event = Brr_note.Evr.on_el + let _ = 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:() +(* + let props = view##.props in + props##.editable := Js.wrap_callback (fun _ -> Js._false); + view##update props; +*) + save_storage view + ) + (Jv.Id.of_jv id) in +(* + let default_editable = view##.props##.editable in + let _ = Brr_note.Evr.on_el + (Ev.dblclick) + (fun e -> + let target = Ev.target e in + let (el:El.t) = Jv.Id.(of_jv @@ to_jv target) in + if (view##.editable == Js._false && (El.tag_name el <> Jstr.v "a")) then ( + let props = view##.props in + props##.editable := default_editable; + view##update props; + Console.(log [el]); + El.set_has_focus true (Jv.Id.of_jv id); + ) ) (Jv.Id.of_jv id) in +*) () | _, _-> Console.(error [str "No element with id '%s' '%s' found"; id ; content]) diff --git a/editor/index.html b/editor/index.html index 9f7189b..ed1f9fe 100755 --- a/editor/index.html +++ b/editor/index.html @@ -1,18 +1,11 @@ - <!DOCTYPE html> <html lang="fr_fr"> <head> <meta charset="utf-8" /> <meta http-equiv="X-UA-Compatible" content="IE=edge" /> - <meta name="HandheldFriendly" content="True" /> - <meta name="viewport" content="width=device-width, initial-scale=1.0" /> - <meta name="robots" content="noindex, nofollow" /> - <link href="https://fonts.googleapis.com/css2?family=Source+Code+Pro:ital,wght@0,400;0,700;1,400&family=Source+Sans+Pro:ital,wght@0,300;0,400;0,700;1,400&display=swap" rel="stylesheet"> <link rel="stylesheet" type="text/css" href="/theme/stylesheet/style.min.css"> - - <link id="pygments-light-theme" rel="stylesheet" type="text/css" href="//localhost:8000/theme/pygments/monokai.min.css"> @@ -21,26 +14,7 @@ <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"> - - <link href="//localhost:8000/feeds/all.atom.xml" type="application/atom+xml" rel="alternate" title="Chimrod Atom"> - - - - - - <meta name="author" content="Chimrod" /> - <meta name="description" content="" /> -<meta property="og:site_name" content="Chimrod"/> -<meta property="og:type" content="blog"/> -<meta property="og:title" content="Chimrod"/> -<meta property="og:description" content=""/> -<meta property="og:locale" content="en_US"/> -<meta property="og:url" content="//localhost:8000"/> -<meta property="og:image" content="/images/profile.png"> - - + <link href="//localhost:8000/custom.css" rel="stylesheet"> <title>Chimrod – Editor</title> @@ -55,24 +29,18 @@ <body class="light-theme"> <aside> <div> - <a href="//localhost:8000"> + <a href="/"> <img src="/profile.png" alt="Chimrod" title="Chimrod"> </a> <h1> <a href="//localhost:8000">Chimrod</a> </h1> - - - <nav> <ul class="list"> - - - - <li> - <a target="_self" href="http://git.chimrod.com" >git</a> - </li> + <li> + <a target="_self" href="http://git.chimrod.com" >git</a> + </li> </ul> </nav> @@ -82,73 +50,39 @@ </aside> <main> - - <nav> - <a href="//localhost:8000">Accueil</a> - - - <a href="//localhost:8000/feeds/all.atom.xml">Atom</a> - - </nav> - -<article class="single"> - <header> + <article class="single"> + <header> + <input type="text" id="title" value="Titre" /> + </header> + <div> + <div id="text_editor" class="editor" style="margin-bottom: 23px; height: 350px;"></div> - <h1 id="title">Editor</h1> - </header> - <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="/resources/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 prose = document.getElementById('text_editor'); - var content = document.getElementById('content'); - editor.attach_prosemirror(prose, content); - }); - </script> - - - - <footer class="info"> </footer> - </div> -</article> + <div style="display: none" id="content"> + <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> + </div> + + <script src="/resources/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 prose = document.getElementById('text_editor'); + var content = document.getElementById('content'); + editor.attach_prosemirror(prose, content); + }); + </script> + <footer class="info"> </footer> + </div> + </article> <footer> <p>© </p> <p> </p> </footer> </main> - - - - -<script type="application/ld+json"> -{ - "@context" : "http://schema.org", - "@type" : "Blog", - "name": " Chimrod ", - "url" : "//localhost:8000", - "image": "./profile.png", - "description": "" -} -</script> - - </body> </html> diff --git a/editor/plugins.ml b/editor/plugins.ml new file mode 100755 index 0000000..6173c4f --- /dev/null +++ b/editor/plugins.ml @@ -0,0 +1,134 @@ +open Js_of_ocaml +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_type 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; + 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.tooltip_plugin pm) in + let _ = setup##push (Tooltip.bold_plugin pm) in + + + Js.some setup diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml index cb5a47c..4b95b73 100755 --- a/editor/prosemirror/bindings.ml +++ b/editor/prosemirror/bindings.ml @@ -92,7 +92,15 @@ module Model = struct end - type mark + class type mark = object ('this) + + method eq: + 'this t -> bool t meth + + method isInSet: + mark t js_array t -> mark t opt meth + + end type node_spec @@ -100,6 +108,8 @@ module Model = struct type slice + type depth = int opt + class type resolved_pos = object ('this) method pos: @@ -115,10 +125,13 @@ module Model = struct node t readonly_prop method node: - int -> node t meth + depth -> node t meth method index: - int -> int meth + depth -> int meth + + method after: + depth -> int meth method nodeAfter: node t opt readonly_prop @@ -142,7 +155,7 @@ module Model = struct and mark_spec = object ('this) method toDOM: - (node t -> domOutputSpec t) callback writeonly_prop + (node t -> domOutputSpec t) callback prop method inclusive: bool t prop @@ -185,6 +198,9 @@ module Model = struct method node: Jstr.t -> < .. > t opt -> fragment t opt -> mark t js_array t opt -> node t meth + method mark_type: + mark_type t -> < .. > t opt -> mark t meth + end and node_type = object ('this) @@ -204,7 +220,7 @@ module Model = struct content_match t readonly_prop method hasRequiredAttrs: - unit -> bool meth + unit -> bool t meth method create_withFragment: < .. > t -> fragment t opt -> mark t opt -> node t meth @@ -226,6 +242,9 @@ module Model = struct method spec: mark_spec t readonly_prop + method isInSet: + mark t js_array t -> mark t opt meth + end (** Common signature between fragment and node *) @@ -245,7 +264,7 @@ module Model = struct (** Get the child node at the given index, if it exists. *) method eq: - 'this t -> bool meth + 'this t -> bool t meth (** Compare this element to another one. *) method cut: @@ -309,7 +328,7 @@ module Model = struct mark t js_array t readonly_prop method sameMarkupd: - node t -> bool meth + node t -> bool t meth method text: Jstr.t opt prop @@ -359,39 +378,97 @@ module Transform = struct method step: step t -> 'this t meth + method addMark: + from:int -> to_:int -> Model.mark t -> 'this t meth + + method delete: + from:int -> to_:int -> 'this t meth + method insert: - int -> Model.node t -> 'this t meth + pos:int -> Model.node t -> 'this t meth method replaceRangeWith: - int -> int -> Model.node t -> 'this t meth + from:int -> to_:int -> Model.node t -> 'this t meth method setBlockType: - int -> int -> Model.node_type t -> < .. > t -> 'this t meth + from:int -> to_:int -> Model.node_type t -> < .. > t -> 'this t meth end end -(** - The class is defined outside of the module View for prevent recursive - declaration. +module Classes = struct -*) -class type _editor_props = object ('this) -end + (** View *) + class type editor_props = object ('this) + method editable: + (editor_state t -> bool t) callback prop + end -module State = struct + and direct_editor_props = object ('this) - class type plugin = object ('this) + inherit editor_props - method props : _editor_props t readonly_prop + method state: + editor_state t writeonly_prop + (** The call back is called with this = instance of editor_view *) + method dispatchTransaction: + (editor_view t, transaction t -> unit) meth_callback writeonly_prop end - class type selection = object ('this) + and editor_view = object ('this) + + method state: + editor_state t readonly_prop + + method dom: + Brr.El.t readonly_prop prop + + method editable: + bool t readonly_prop + + method props: + direct_editor_props t readonly_prop + + method update: + direct_editor_props t -> unit meth + + method setProps: + direct_editor_props t -> unit meth + + method updateState: + editor_state t -> unit meth + + method posAtCoords: + < left: float prop ; top: float prop > t -> < pos: int prop; inside: int prop> t meth + + method coordsAtPos: + int -> int opt -> < left: float prop; right: float prop; top: float prop; bottom: float prop > t meth + + method dispatch: + transaction t -> unit meth + + end + + (** State *) + + and plugin = object ('this) + + method props : editor_props t opt prop + + method view: + (editor_view t -> < .. > t) callback opt prop + + method filterTransaction: + (transaction t -> editor_state t -> bool t) opt prop + + end + + and selection = object ('this) method from: int readonly_prop @@ -399,6 +476,12 @@ module State = struct method _to: int readonly_prop + method empty: + bool t readonly_prop + + method eq: + 'this t -> bool t meth + method content: unit -> Model.slice t meth @@ -474,13 +557,15 @@ module State = struct method before: Model.node t readonly_prop + method insertText: + Jstr.t -> from:int opt -> to_:int opt -> 'this t meth + method scrollIntoView : unit -> 'this t meth - end - class type configuration_prop = object ('this) + and configuration_prop = object ('this) method schema: Model.schema t opt prop @@ -490,7 +575,7 @@ module State = struct end - class type creation_prop = object ('this) + and creation_prop = object ('this) inherit configuration_prop @@ -505,7 +590,7 @@ module State = struct end - class type editor_state = object ('this) + and editor_state = object ('this) method doc : Model.node t readonly_prop @@ -538,45 +623,37 @@ module State = struct end -module View = struct - - class type editor_props = _editor_props - - class type direct_editor_props = object ('this) - - inherit editor_props +module State = struct - method state: - State.editor_state t writeonly_prop + class type plugin = Classes.plugin + class type selection = Classes.selection + class type text_selection = Classes.text_selection + class type node_selection = Classes.node_selection + class type transaction = Classes.transaction + class type configuration_prop = Classes.configuration_prop + class type creation_prop = Classes.creation_prop + class type editor_state = Classes.editor_state - (** The call back is called with this = instance of editor_view *) - method dispatchTransaction: - (editor_view t, State.transaction t -> unit) meth_callback writeonly_prop + type dispatch = (Classes.transaction t -> unit) +end - end +module View = struct - and editor_view = object ('this) + class type editor_props = Classes.editor_props - method state: - State.editor_state t readonly_prop + class type direct_editor_props = Classes.direct_editor_props - method dom: - Brr.El.t readonly_prop prop + class type editor_view = Classes.editor_view - method editable: - bool readonly_prop prop +end - method update: - direct_editor_props t -> unit meth +module History = struct - method setProps: - direct_editor_props t -> unit meth + class type history_prop = object ('this) - method updateState: - State.editor_state t -> unit meth + method depth: int opt prop - method dispatch: - State.transaction t -> unit meth + method newGroupDelay: int opt prop end @@ -633,18 +710,6 @@ module SchemaBasic = struct end -module History = struct - - class type history_prop = object ('this) - - method depth: int opt prop - - method newGroupDelay: int opt prop - - end - -end - module Example = struct class type options = object ('this) @@ -662,4 +727,5 @@ module Example = struct bool t opt prop end + end diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml index e2758c7..e37cc3b 100755 --- a/editor/prosemirror/prosemirror.ml +++ b/editor/prosemirror/prosemirror.ml @@ -3,6 +3,8 @@ open Brr type t = Jv.t +type t' = t + let v : unit -> t = fun () -> @@ -112,10 +114,6 @@ module State = struct include Bindings.State - type dispatch = (transaction Js.t -> unit) - - type command = editor_state Js.t -> dispatch Js.opt -> bool Js.t - let configuration_prop : unit -> configuration_prop Js_of_ocaml.Js.t = fun () -> Js_of_ocaml.Js.Unsafe.obj [||] @@ -181,6 +179,10 @@ module State = struct Jv.call (Jv.get state "TextSelection") "create" Jv.Id.[|to_jv doc; Jv.of_int number|] |> Jv.Id.of_jv + let cursor + : selection Js.t -> Model.resolved_pos Js.t Js.opt + = fun selection -> + Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$cursor") end (* Editor view *) @@ -199,46 +201,37 @@ module View = struct let editor_view : t -> El.t -> direct_editor_props Js.t -> editor_view Js.t = fun t node props -> - let view = Jv.get t "view" in - Jv.new' (Jv.get view "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|] - |> Jv.Id.of_jv -end - -module SchemaList = struct - - let add_list_nodes - : t -> Model.node_spec Bindings.ordered_map Js.t -> Jstr.t -> Jstr.t option -> Model.node_spec Bindings.ordered_map Js.t - = fun t nodes item_content list_group_opt -> - let schema_list = Jv.get t "schema_list" in - - let list_group = Jv.of_option ~none:Jv.null Jv.of_jstr list_group_opt in - - Jv.call schema_list "addListNodes" - [|Jv.Id.to_jv nodes - ; Jv.of_jstr item_content - ; list_group |] + Jv.new' (Jv.get (Jv.get t "view") "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|] |> Jv.Id.of_jv end -module SchemaBasic = struct +module Commands = struct - include Bindings.SchemaBasic + type t = State.editor_state Js.t -> State.dispatch Js.opt -> bool Js.t - let schema - : t -> Model.schema Js.t + let baseKeymap + : t' -> (string * t) array = fun t -> - Jv.get (Jv.get t "schema_basic") "schema" + Jv.get (Jv.get t "commands") "baseKeymap" |> Jv.Id.of_jv - let nodes - : t -> nodes Js.t - = fun t -> - Jv.get (Jv.get t "schema_basic") "nodes" + let set_block_type + : t' -> Model.node_type Js.t -> < .. > Js.t Js.opt -> t + = fun t node props -> + Jv.call (Jv.get t "commands") "setBlockType" Jv.Id.[| to_jv node ; to_jv props |] + |> Jv.Id.of_jv + + let toggle_mark + : t' -> Model.mark_type Js.t -> < .. > Js.t Js.opt -> t + = fun t mark props -> + Jv.call (Jv.get t "commands") "toggleMark" Jv.Id.[| to_jv mark ; to_jv props |] |> Jv.Id.of_jv + end + module History = struct include Bindings.History @@ -254,13 +247,13 @@ module History = struct |> Jv.Id.of_jv let undo - : t -> State.command + : t -> Commands.t = 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.command + : t -> Commands.t = fun t state fn -> Jv.call (Jv.get t "history") "redo" [|Jv.Id.to_jv state; Jv.repr fn|] |> Jv.Id.of_jv @@ -269,7 +262,7 @@ end module Keymap = struct let keymap - : t -> (string * State.command) array -> State.plugin Js.t + : t -> (string * Commands.t) 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|] @@ -277,21 +270,61 @@ module Keymap = struct end -module Commands = struct +module InputRule = struct - let baseKeymap - : t -> (string * State.command) array + type input_rule + + let create + : t -> Js.regExp Js.t -> fn:(State.editor_state Js.t -> Jstr.t Js.js_array Js.t -> from:int -> to_:int -> State.transaction Js.t Js.opt) Js.callback -> input_rule Js.t + = fun t match' ~fn -> + Jv.new' (Jv.get (Jv.get t "inputrules") "InputRule") [|Jv.Id.to_jv match' ; Jv.Id.to_jv fn|] + |> Jv.Id.of_jv + + let to_plugin + : t -> input_rule Js.t Js.js_array Js.t -> State.plugin Js.t + = fun t rules -> + let obj = Jv.obj [|("rules", Jv.Id.to_jv rules)|] in + Jv.call (Jv.get t "inputrules") "inputRules" [| obj |] + |> Jv.Id.of_jv + +end + +module SchemaBasic = struct + + include Bindings.SchemaBasic + + let schema + : t -> Model.schema Js.t = fun t -> - Jv.get (Jv.get t "commands") "baseKeymap" + Jv.get (Jv.get t "schema_basic") "schema" |> Jv.Id.of_jv - let set_block_type - : t -> Model.node_type Js.t -> < .. > Js.t -> State.command - = fun t node props -> - Jv.call (Jv.get t "commands") "setBlockType" Jv.Id.[| to_jv node ; to_jv props |] + let nodes + : t -> nodes Js.t + = fun t -> + Jv.get (Jv.get t "schema_basic") "nodes" + |> Jv.Id.of_jv + +end + +module SchemaList = struct + + let add_list_nodes + : t -> Model.node_spec Bindings.ordered_map Js.t -> Jstr.t -> Jstr.t option -> Model.node_spec Bindings.ordered_map Js.t + = fun t nodes item_content list_group_opt -> + let schema_list = Jv.get t "schema_list" in + + let list_group = Jv.of_option ~none:Jv.null Jv.of_jstr list_group_opt in + + Jv.call schema_list "addListNodes" + [|Jv.Id.to_jv nodes + ; Jv.of_jstr item_content + ; list_group |] |> Jv.Id.of_jv + end + (* Example Setup *) module Example = struct diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli index 7a723d3..eac895a 100755 --- a/editor/prosemirror/prosemirror.mli +++ b/editor/prosemirror/prosemirror.mli @@ -3,6 +3,8 @@ open Brr type t +type t' = t + val v : unit -> t @@ -57,13 +59,6 @@ module rec Model : sig end -and SchemaList : sig - - val add_list_nodes - : t -> Model.node_spec Bindings.ordered_map Js.t -> Jstr.t -> Jstr.t option -> Model.node_spec Bindings.ordered_map Js.t - -end - (* State *) and State : sig @@ -100,9 +95,8 @@ and State : sig val create_text_selection : t -> Model.node Js.t -> int -> text_selection Js.t - type dispatch = (transaction Js.t -> unit) - - type command = editor_state Js.t -> dispatch Js.opt -> bool Js.t + val cursor + : selection Js.t -> Model.resolved_pos Js.t Js.opt end @@ -126,16 +120,18 @@ and View : sig end -module SchemaBasic : sig +module Commands : sig - include module type of Bindings.SchemaBasic + type t = State.editor_state Js.t -> State.dispatch Js.opt -> bool Js.t - val schema - : t -> Model.schema Js.t + val baseKeymap + : t' -> (string * t) array - val nodes - : t -> nodes Js.t + val set_block_type + : t' -> Model.node_type Js.t -> < .. > Js.t Js.opt -> t + val toggle_mark + : t' -> Model.mark_type Js.t -> < .. > Js.t Js.opt -> t end @@ -150,26 +146,47 @@ module History : sig : t -> history_prop Js.t -> State.plugin Js.t val undo - : t -> State.command + : t -> Commands.t val redo - : t -> State.command + : t -> Commands.t end module Keymap : sig val keymap - : t -> (string * State.command) array -> State.plugin Js.t + : t -> (string * Commands.t) array -> State.plugin Js.t end -module Commands : sig +module InputRule : sig - val baseKeymap - : t -> (string * State.command) array + type input_rule - val set_block_type - : t -> Model.node_type Js.t -> < .. > Js.t -> State.command + (** Create a new input rule for the given regExp. *) + val create + : t -> Js.regExp Js.t -> fn:(State.editor_state Js.t -> Jstr.t Js.js_array Js.t -> from:int -> to_:int -> State.transaction Js.t Js.opt) Js.callback -> input_rule Js.t + + val to_plugin + : t -> input_rule Js.t Js.js_array Js.t -> State.plugin Js.t +end + +module SchemaBasic : sig + + include module type of Bindings.SchemaBasic + + val schema + : t -> Model.schema Js.t + + val nodes + : t -> nodes Js.t + +end + +module SchemaList : sig + + val add_list_nodes + : t -> Model.node_spec Bindings.ordered_map Js.t -> Jstr.t -> Jstr.t option -> Model.node_spec Bindings.ordered_map Js.t end diff --git a/editor/tooltip.ml b/editor/tooltip.ml new file mode 100755 index 0000000..06426d1 --- /dev/null +++ b/editor/tooltip.ml @@ -0,0 +1,149 @@ +open StdLabels +open Js_of_ocaml +open Brr + + +module PM = Prosemirror + +(** https://prosemirror.net/examples/tooltip/ *) + +(** Set the element position just above the selection *) +let set_position + : PM.View.editor_view Js.t -> El.t -> unit + = fun view el -> + El.set_inline_style El.Style.display (Jstr.v "") el; + let start = view##coordsAtPos (view##.state##.selection##.from) Js.null + and end' = view##coordsAtPos (view##.state##.selection##._to) Js.null in + let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in + + 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 + + let left = Float.max + ((start##.left +. end'##.left) /. 2.) + (start##.left +. 3.) 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 + +let tooltip + : 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 "tooltip")]) 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 -> + + Js.Opt.case state_opt + (fun () -> ()) + (fun previous_state -> + if ((view##.state##.doc##eq previous_state##.doc) = Js._true) + && ((previous_state##.selection##eq view##.state##.selection) = Js._true) + then + () + else ( + if (view##.state##.selection##.empty) = Js._true then + (* Hide the tooltip if the selection is empty *) + El.set_inline_style El.Style.display (Jstr.v "none") tooltip + else ( + (* otherwise, reposition it and update its content *) + set_position view tooltip; + El.set_prop + (El.Prop.jstr (Jstr.v "textContent")) + (Jstr.of_int + (view##.state##.selection##._to - view##.state##.selection##.from)) + tooltip))) + and destroy () = El.remove tooltip in + + object%js + val update = Js.wrap_callback update + val destroy= Js.wrap_callback destroy + end + +let tooltip_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 -> tooltip view) + end in + + Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |] + |> Jv.Id.of_jv + + +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 "tooltip")]) 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 -> + let state = view##.state in + let is_bold = match PM.O.get state##.schema##.marks "strong" with + | None -> None + | Some mark_type -> + let is_strong = Js.Opt.bind state##.storedMarks (fun t -> mark_type##isInSet t) in + Js.Opt.case is_strong + (fun () -> None) + (fun _ -> Some (Jstr.v "gras")) in + let is_em = match PM.O.get state##.schema##.marks "em" with + | None -> None + | Some mark_type -> + let is_strong = Js.Opt.bind state##.storedMarks (fun t -> mark_type##isInSet t) in + Js.Opt.case is_strong + (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 *) + set_position 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 |