From 1961a9779b482cf9cbdb3365137c2e74423067c6 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Mon, 7 Feb 2022 16:00:56 +0100
Subject: Text editor using quill
---
editor.opam | 25 +++++++
editor/dune | 17 +++++
editor/editor.html | 149 +++++++++++++++++++++++++++++++++++++++
editor/editor.ml | 203 +++++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 394 insertions(+)
create mode 100755 editor.opam
create mode 100755 editor/dune
create mode 100755 editor/editor.html
create mode 100755 editor/editor.ml
diff --git a/editor.opam b/editor.opam
new file mode 100755
index 0000000..c50744b
--- /dev/null
+++ b/editor.opam
@@ -0,0 +1,25 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Text editor"
+maintainer: ["Sébastien Dailly"]
+authors: ["Sébastien Dailly"]
+depends: [
+ "dune" {>= "2.7"}
+ "ocaml" {>= "4.10.0"}
+ "brr" {>= "0.0.1"}
+ "odoc" {with-doc}
+]
+build: [
+ ["dune" "subst"] {dev}
+ [
+ "dune"
+ "build"
+ "-p"
+ name
+ "-j"
+ jobs
+ "@install"
+ "@runtest" {with-test}
+ "@doc" {with-doc}
+ ]
+]
diff --git a/editor/dune b/editor/dune
new file mode 100755
index 0000000..c87962c
--- /dev/null
+++ b/editor/dune
@@ -0,0 +1,17 @@
+(executable
+ (name editor)
+ (libraries
+ brr
+ brr.note
+ elements
+ blog
+ )
+ (modes js)
+ (preprocess (pps js_of_ocaml-ppx))
+ (link_flags (:standard -no-check-prims))
+ )
+
+(rule
+ (targets editor.js)
+ (deps editor.bc.js)
+ (action (copy %{deps} %{targets})))
diff --git a/editor/editor.html b/editor/editor.html
new file mode 100755
index 0000000..525d8fc
--- /dev/null
+++ b/editor/editor.html
@@ -0,0 +1,149 @@
+
+<!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">
+
+
+ <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 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">
+
+
+
+ <title>Chimrod – Editor</title>
+
+<link rel="stylesheet" href="quill/quill.snow.css" />
+
+<style>
+ .standalone-container {
+ margin: 50px auto;
+ max-width: 100%;
+ }
+ #text-container {
+ height: 350px;
+ }
+</style>
+</head>
+<body class="light-theme">
+ <aside>
+ <div>
+ <a href="//localhost:8000">
+ <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>
+ </ul>
+ </nav>
+
+ <ul class="social">
+ </ul>
+ </div>
+
+ </aside>
+ <main>
+
+ <nav>
+ <a href="//localhost:8000">Accueil</a>
+
+
+ <a href="//localhost:8000/feeds/all.atom.xml">Atom</a>
+
+ </nav>
+
+<article class="single">
+ <header>
+
+ <h1 id="editor">Editor</h1>
+ </header>
+ <div>
+<div class="standalone-container">
+ <div id="text-container"></div>
+</div>
+
+
+
+<script src="quill/quill.min.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);
+ });
+ </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/editor.ml b/editor/editor.ml
new file mode 100755
index 0000000..aeb96c1
--- /dev/null
+++ b/editor/editor.ml
@@ -0,0 +1,203 @@
+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")
+let save_contents
+ : Quill.t -> unit
+ = fun editor ->
+ let storage = Brr_io.Storage.local G.window in
+ let contents = Quill.get_contents editor in
+ Brr_io.Storage.set_item
+ storage
+ storage_key
+ (Json.encode @@ Jv.Id.of_jv @@ contents)
+ |> Console.log_if_error ~use:()
+
+let load_contents
+ : Quill.t -> unit
+ = fun editor ->
+ let storage = Brr_io.Storage.local G.window in
+ Brr_io.Storage.get_item
+ storage
+ storage_key
+ |> Option.iter (fun contents ->
+
+
+ Json.decode contents
+ |> Result.map (fun json ->
+ Quill.set_contents editor json
+ )
+ |> Console.log_if_error ~use:()
+ )
+
+
+
+let page_main 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");
+
+ (* Create the editor with the configuration *)
+ Quill.quill ~options (Jv.Id.of_jv id)
+ |> Result.iter (fun editor ->
+
+ load_contents editor;
+
+
+ let () = Quill.on_text_change editor (fun delta old source ->
+ let _ = delta
+ and _ = old
+ and _ = source
+ in
+ ()
+ )
+ in
+
+ (* Attach an event on focus out *)
+ let out_event = Brr_note.Evr.on_el
+ (Ev.focusout)
+ (fun _ -> save_contents editor)
+ (Jv.Id.of_jv id) in
+
+ (* Prevent the event to be garbage collected *)
+ E.log out_event (fun _ -> ())
+ |> Option.iter Logr.hold
+ )
+ end
+
+let () =
+
+ let open Jv in
+ let editor = obj
+ [| "attach", (repr page_main)
+ |] in
+
+ set global "editor" editor
--
cgit v1.2.3