···11+# This is a basic workflow to help you get started with Actions
22+33+name: CI
44+55+# Controls when the action will run. Triggers the workflow on push or pull request
66+# events but only for the master branch
77+on:
88+ push:
99+ branches:
1010+ - "*"
1111+ pull_request:
1212+ branches:
1313+ - "*"
1414+1515+# A workflow run is made up of one or more jobs that can run sequentially or in parallel
1616+jobs:
1717+ # This workflow contains a single job called "build"
1818+ build:
1919+ strategy:
2020+ fail-fast: false
2121+ matrix:
2222+ os:
2323+ - ubuntu-latest
2424+ ocaml-compiler:
2525+ - 4.14.x
2626+ # The type of runner that the job will run on
2727+ runs-on: ${{ matrix.os }}
2828+2929+ # Steps represent a sequence of tasks that will be executed as part of the job
3030+ steps:
3131+ # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it
3232+ - uses: actions/checkout@v3
3333+3434+ - name: Set up OCaml ${{ matrix.ocaml-compiler }}
3535+ uses: ocaml/setup-ocaml@v2
3636+ with:
3737+ # Version of the OCaml compiler to initialise
3838+ ocaml-compiler: ${{ matrix.ocaml-compiler }}
3939+4040+ - name: Install dependencies
4141+ run: |
4242+ opam install . --deps-only --with-test
4343+4444+ - name: Build and test in release mode
4545+ run: opam install . --with-test
···11+(rule
22+ (deps
33+ (source_tree %{project_root}/node_modules))
44+ (target bundle-es6.js)
55+ (enabled_if
66+ (= %{profile} "with-bundle"))
77+ (action
88+ (run
99+ %{project_root}/node_modules/esbuild/bin/esbuild
1010+ %{dep:includes.js}
1111+ --bundle
1212+ --outfile=%{target})))
1313+1414+; warning: node modules are not managed by dune
1515+; to generate a new bundle one should run `npm install` before the first build
1616+1717+(rule
1818+ (deps
1919+ %{project_root}/package.json
2020+ %{project_root}/babel.config.js
2121+ (source_tree %{project_root}/node_modules))
2222+ (target bundle.js)
2323+ (mode promote)
2424+ (enabled_if
2525+ (= %{profile} "with-bundle"))
2626+ (action
2727+ (run
2828+ %{project_root}/node_modules/@babel/cli/bin/babel.js
2929+ %{dep:bundle-es6.js}
3030+ --config-file
3131+ %{project_root}/babel.config.js
3232+ -o
3333+ %{target})))
3434+3535+; The bundle is only re-generated if the profile is `with-bundle`
3636+; If you add new javascript dependency or update the package.json
3737+; you should run `dune build --profile=with-bundle`
+17
includes/includes.js
···11+import { EditorView, EditorState, basicSetup } from "@codemirror/basic-setup"
22+import * as tooltip from "@codemirror/tooltip"
33+import * as lint from "@codemirror/lint"
44+import * as autocomplete from "@codemirror/autocomplete"
55+import * as dark from "@codemirror/theme-one-dark"
66+import * as streamParser from "@codemirror/stream-parser"
77+import { oCaml } from "@codemirror/legacy-modes/mode/mllike"
88+99+joo_global_object.__CM__view = EditorView;
1010+joo_global_object.__CM__state = EditorState;
1111+joo_global_object.__CM__lint = lint;
1212+joo_global_object.__CM__autocomplete = autocomplete;
1313+joo_global_object.__CM__tooltip = tooltip;
1414+joo_global_object.__CM__basic_setup = basicSetup
1515+joo_global_object.__CM__dark = dark;
1616+joo_global_object.__CM__stream_parser = streamParser;
1717+joo_global_object.__CM__mllike = oCaml;
···11open Code_mirror
22-32module RegExp = RegExp
33+44let autocomplete = Jv.get Jv.global "__CM__autocomplete"
5566module Completion = struct
···8899 include (Jv.Id : Jv.CONV with type t := t)
10101111- let set_if_some_string t s v =
1212- Jv.Jstr.set_if_some t s (Option.map Jstr.v v)
1313-1414- let set_string t s v =
1515- Jv.Jstr.set t s (Jstr.v v)
1111+ let set_if_some_string t s v = Jv.Jstr.set_if_some t s (Option.map Jstr.v v)
1212+ let set_string t s v = Jv.Jstr.set t s (Jstr.v v)
16131714 let create ~label ?detail ?info ?apply ?type_ ?boost () =
1815 let o = Jv.obj [||] in
···2118 set_if_some_string o "info" info;
2219 Jv.set_if_some o "apply" apply;
2320 set_if_some_string o "type" type_;
2424- Jv.Int.set_if_some o "boost" boost;
2121+ Jv.Int.set_if_some o "boost" boost;
2522 o
2626-2723end
28242925module Context = struct
···32283329 include (Jv.Id : Jv.CONV with type t := t)
34303131+ let state t = Jv.get t "state" |> Editor.State.of_jv
3232+ let pos t = Jv.Int.get t "pos"
3333+ let explicit t = Jv.Bool.get t "explicit"
3434+3535 let token_before t types =
3636 let jv = Jv.call t "tokenBefore" [| Jv.of_list Jv.of_string types |] in
3737 if Jv.is_none jv then None else Some jv
···3939 let match_before t regex =
4040 let jv = Jv.call t "matchBefore" [| RegExp.to_jv regex |] in
4141 if Jv.is_none jv then None else Some jv
4242+4343+ let aborted t = Jv.Bool.get t "aborted"
4244end
43454446module Result = struct
···5759 o
5860end
59616060-type source = Context.t -> Result.t option Fut.t
6161-(** A completion source *)
6262+module Source = struct
6363+ type t = Jv.t
62646363-let source_to_jv (src : source) =
6464- let f ctx =
6565- let fut = Fut.map (fun v -> Ok v) @@ src (Context.of_jv ctx) in
6666- Fut.to_promise ~ok:(fun t -> Option.value ~default:Jv.null (Option.map Result.to_jv t)) fut
6767- in
6565+ include (Jv.Id : Jv.CONV with type t := t)
6666+6767+ let create (src : Context.t -> Result.t option Fut.t) =
6868+ let f ctx =
6969+ let fut = Fut.map (fun v -> Ok v) @@ src (Context.of_jv ctx) in
7070+ Fut.to_promise fut ~ok:(fun t ->
7171+ Option.value ~default:Jv.null (Option.map Result.to_jv t))
7272+ in
6873 Jv.repr f
7474+7575+ let from_list (l : Completion.t list) =
7676+ Jv.call autocomplete "completeFromList" [| Jv.of_jv_list l |] |> of_jv
7777+end
69787079type config = Jv.t
71807272-let config
7373- ?activate_on_typing
7474- ?override
7575- ?max_rendered_options
7676- ?default_key_map
7777- ?above_cursor
7878- ?option_class
7979- ?icons
8080- ?add_to_options
8181- () =
8181+let config ?activate_on_typing ?override ?max_rendered_options ?default_key_map
8282+ ?above_cursor ?option_class ?icons ?add_to_options () =
8283 let o = Jv.obj [||] in
8383- Jv.Bool.set_if_some o "activateOnTyping" activate_on_typing;
8484- Jv.set_if_some o "override" (Option.map (fun v -> Jv.of_list source_to_jv v) override);
8585- Jv.Int.set_if_some o "maxRenderedOptions" max_rendered_options;
8686- Jv.Bool.set_if_some o "defaultKeyMap" default_key_map;
8787- Jv.Bool.set_if_some o "aboveCursor" above_cursor;
8888- Jv.set_if_some o "optionClass" option_class;
8989- Jv.Bool.set_if_some o "icons" icons;
9090- Jv.set_if_some o "addToOptions" add_to_options;
9191- o
8484+ Jv.Bool.set_if_some o "activateOnTyping" activate_on_typing;
8585+ Jv.set_if_some o "override" (Option.map (fun v -> Jv.of_jv_list v) override);
8686+ Jv.Int.set_if_some o "maxRenderedOptions" max_rendered_options;
8787+ Jv.Bool.set_if_some o "defaultKeyMap" default_key_map;
8888+ Jv.Bool.set_if_some o "aboveCursor" above_cursor;
8989+ Jv.set_if_some o "optionClass" option_class;
9090+ Jv.Bool.set_if_some o "icons" icons;
9191+ Jv.set_if_some o "addToOptions" add_to_options;
9292+ o
92939394let create ?(config = Jv.null) () =
9494- Extension.of_jv @@
9595- Jv.call autocomplete "autocompletion" [| config |]
9595+ Extension.of_jv @@ Jv.call autocomplete "autocompletion" [| config |]
96969797(* type status = Active | Pending
98989999-let status state =
9999+ let status state =
100100101101-val status : Editor.State.t -> status option
102102-(** Gets the current completion status *)
101101+ val status : Editor.State.t -> status option
102102+ (** Gets the current completion status *)
103103104104-val current_completions : Editor.State.t -> Completion.t list
105105-(** Returns the current available completions *)
106106-107107-val selected_completion : Editor.State.t -> Completion.t option
108108-* Returh the currently selected completion if any *)
104104+ val current_completions : Editor.State.t -> Completion.t list
105105+ (** Returns the current available completions *)
109106107107+ val selected_completion : Editor.State.t -> Completion.t option
108108+ * Returh the currently selected completion if any *)
+80-14
src/autocomplete/autocomplete.mli
···11+open Code_mirror
22+33+(** Most of this documention originate from the code-mirror reference.
44+55+ {{:https://codemirror.net/6/docs/ref/#autocomplete} Visit the
66+ reference directly for additional information.} *)
77+18val autocomplete : Jv.t
29(** Global autocomplete value *)
310411module RegExp = RegExp
512613module Completion : sig
1414+ (** Represents individual completions. *)
1515+716 type t
1717+ (** Completion *)
818919 include Jv.CONV with type t := t
10201121 val create :
1222 label:string ->
1323 ?detail:string ->
1414- ?info:string ->
2424+ ?info:string ->
1525 ?apply:t ->
1626 ?type_:string ->
1727 ?boost:int ->
1818- unit -> t
2828+ unit ->
2929+ t
3030+ (** Creates a completion.
3131+3232+ @param label The label to show in the completion picker.
3333+ @param detail An optional short piece of information to show after the
3434+ label.
3535+ @param info Additional info to show when the completion is selected.
3636+ @param apply (todo) How to apply the completion.
3737+ @param type The type of the completion. This is used to pick an icon to
3838+ show for the completion.
3939+ @param boost
4040+4141+ {{:https://codemirror.net/6/docs/ref/#autocomplete.Completion} See the
4242+ reference for additional information.} *)
1943end
20442145module Context : sig
4646+ (** An instance of this is passed to completion source functions. *)
4747+2248 type t
2349 (** Completion context *)
24502551 include Jv.CONV with type t := t
26525353+ val state : t -> Editor.State.t
5454+ (** The editor state that the completion happens in. *)
5555+5656+ val pos : t -> int
5757+ (** The position at which the completion is happening. *)
5858+5959+ val explicit : t -> bool
6060+ (** Indicates whether completion was activated explicitly, or implicitly by
6161+ typing. The usual way to respond to this is to only return completions when
6262+ either there is part of a completable entity before the cursor, or explicit
6363+ is true. *)
6464+2765 val token_before : t -> string list -> Jv.t option
6666+ (** Get the extent, content, and (if there is a token) type of the token
6767+ before this.pos. *)
28682969 val match_before : t -> RegExp.t -> Jv.t option
7070+ (** Get the match of the given expression directly before the cursor. *)
7171+7272+ val aborted : t -> bool
7373+ (** Yields true when the query has been aborted. Can be useful in
7474+ asynchronous queries to avoid doing work that will be ignored. *)
3075end
31763277module Result : sig
7878+ (** Objects returned by completion sources. *)
7979+3380 type t
3481 (** Completion result *)
3582···4188 options:Completion.t list ->
4289 ?span:RegExp.t ->
4390 ?filter:bool ->
4444- unit -> t
4545- (** Creating a new completion result (see {{: https://codemirror.net/6/docs/ref/#autocomplete.CompletionResult} the docs}).*)
9191+ unit ->
9292+ t
9393+ (** Creating a new completion result (see {{: https://codemirror.net/6/docs/ref/#autocomplete.CompletionResult} the docs}).
9494+ @param from The start of the range that is being completed.
9595+ @param to_ The end of the range that is being completed. Defaults to the
9696+ main cursor position.
9797+ @param options The completions returned.
9898+ @param span When given, further input that causes the part of the document
9999+ between [from] and [to_] to match this regular expression will not query
100100+ the completion source again
101101+ @param filter By default, the library filters and scores completions. Set
102102+ filter to false to disable this, and cause your completions to all be
103103+ included, in the order they were given.
104104+ *)
46105end
471064848-type source = Context.t -> Result.t option Fut.t
4949-(** A completion source *)
107107+module Source : sig
108108+ type t
109109+ (** Completion source *)
110110+111111+ include Jv.CONV with type t := t
50112113113+ val create : (Context.t -> Result.t option Fut.t) -> t
114114+115115+ val from_list : Completion.t list -> t
116116+ (** Given a a fixed array of options, return an autocompleter that completes
117117+ them. *)
118118+end
5111952120type config
531215454-val config :
5555- ?activate_on_typing:bool ->
5656- ?override:source list ->
122122+val config :
123123+ ?activate_on_typing:bool ->
124124+ ?override:Source.t list ->
57125 ?max_rendered_options:int ->
58126 ?default_key_map:bool ->
59127 ?above_cursor:bool ->
···62130 ?add_to_options:Jv.t ->
63131 unit ->
64132 config
6565- (** Configuration options for your autocompleter, see {{: https://codemirror.net/6/docs/ref/#autocomplete.autocompletion^config} the online docs}.*)
133133+(** Configuration options for your autocompleter, see {{: https://codemirror.net/6/docs/ref/#autocomplete.autocompletion^config} the online docs}.*)
661346767-val create :
6868- ?config:config -> unit ->
6969- Code_mirror.Extension.t
7070- (** Autocompleter *)
135135+val create : ?config:config -> unit -> Code_mirror.Extension.t
136136+(** Autocompleter *)
+21-38
src/autocomplete/regExp.ml
···6677let regexp = Jv.get (Window.to_jv G.window) "RegExp"
8899-type opts =
1010- | Indices
1111- | Global
1212- | Ignore
1313- | Multiline
1414- | DotAll
1515- | Unicode
1616- | Sticky
99+type opts = Indices | Global | Ignore | Multiline | DotAll | Unicode | Sticky
17101811let opts_to_string = function
1919- | Indices ->
2020- "d"
2121- | Global ->
2222- "g"
2323- | Ignore ->
2424- "i"
2525- | Multiline ->
2626- "m"
2727- | DotAll ->
2828- "s"
2929- | Unicode ->
3030- "u"
3131- | Sticky ->
3232- "y"
1212+ | Indices -> "d"
1313+ | Global -> "g"
1414+ | Ignore -> "i"
1515+ | Multiline -> "m"
1616+ | DotAll -> "s"
1717+ | Unicode -> "u"
1818+ | Sticky -> "y"
33193420let create ?(opts = []) s =
3521 let opts =
3622 match List.length opts with
3737- | 0 ->
3838- Jv.undefined
2323+ | 0 -> Jv.undefined
3924 | _ ->
4040- let options = List.sort_uniq Stdlib.compare opts in
4141- let opt_string =
4242- List.fold_left (fun acc t -> acc ^ opts_to_string t) "" options
4343- in
4444- Jv.of_string opt_string
2525+ let options = List.sort_uniq Stdlib.compare opts in
2626+ let opt_string =
2727+ List.fold_left (fun acc t -> acc ^ opts_to_string t) "" options
2828+ in
2929+ Jv.of_string opt_string
4530 in
4631 Jv.new' regexp [| Jv.of_string s; opts |]
4732···5641let get_indices res =
5742 let jv = Jv.get res "indices" in
5843 match Jv.is_null jv with
5959- | true ->
6060- []
4444+ | true -> []
6145 | false ->
6262- let conv arr =
6363- let indices = Jv.to_array Jv.to_int arr in
6464- indices.(0), indices.(1)
6565- in
6666- Jv.to_list conv jv
4646+ let conv arr =
4747+ let indices = Jv.to_array Jv.to_int arr in
4848+ (indices.(0), indices.(1))
4949+ in
5050+ Jv.to_list conv jv
67516852let get_substring_matches res =
6953 let arr = Jv.to_jv_array res in
···7155 Array.sub arr 1 length |> Array.to_list |> List.map Jv.to_string
72567357let exec' t s = Jv.to_option Jv.Id.to_jv @@ Jv.call t "exec" [| Jv.of_jstr s |]
7474-7575-let exec t s = exec' t @@ Jstr.v s5858+let exec t s = exec' t @@ Jstr.v s
+4-11
src/autocomplete/regExp.mli
···11-(** A regular expression *)
21type t
22+(** A regular expression *)
3344include Jv.CONV with type t := t
5566-type opts =
77- | Indices
88- | Global
99- | Ignore
1010- | Multiline
1111- | DotAll
1212- | Unicode
1313- | Sticky
66+type opts = Indices | Global | Ignore | Multiline | DotAll | Unicode | Sticky
147158val create : ?opts:opts list -> string -> t
169(** Create a regular expression from a string. Internally this uses
···1811 {{:https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/RegExp/RegExp}
1912 has it's own documentation}. Note we pass noo flags at the moment. *)
20132121-(** The result of executing a regular expression search on a string *)
2214type result
1515+(** The result of executing a regular expression search on a string *)
23162417val get_full_string_match : result -> string
2518(** The matched text *)
···3831 in a specified string [s]. *)
39324033val exec' : t -> Jstr.t -> result option
4141-(** Same as {!exec} only you can pass a {!Jstr.t} instead. *)3434+(** Same as {!exec} only you can pass a {!Jstr.t} instead. *)
···13131414 module type Facet = sig
1515 type t
1616+1617 include Jv.CONV with type t := t
1717- type input
1818+1919+ type input
1820 type output
19212022 val of_ : t -> input -> Extension.t
2123 end
22242323- module FacetMaker (I : sig type t val to_jv : t -> Jv.t end) : (Facet with type input = I.t and type output = Jv.t) = struct
2525+ module FacetMaker (I : sig
2626+ type t
2727+2828+ val to_jv : t -> Jv.t
2929+ end) : Facet with type input = I.t and type output = Jv.t = struct
2430 type t = Jv.t
25312632 include (Jv.Id : Jv.CONV with type t := t)
···2834 type input = I.t
2935 type output = Jv.t
30363131- let of_ t i =
3232- Jv.call t "of" [| I.to_jv i |] |> Extension.of_jv
3737+ let of_ t i = Jv.call t "of" [| I.to_jv i |] |> Extension.of_jv
3338 end
34393535- type ('i, 'o) facet = Facet : (module Facet with type input = 'i and type output = 'o and type t = 'a) * 'a -> ('i, 'o) facet
4040+ type ('i, 'o) facet =
4141+ | Facet :
4242+ (module Facet with type input = 'i and type output = 'o and type t = 'a)
4343+ * 'a
4444+ -> ('i, 'o) facet
36453746 type t = Jv.t
3847···4655end
47564857(* Helper for function *)
4949-module Func (I : sig type t include Jv.CONV with type t := t end) = struct
5858+module Func (I : sig
5959+ type t
6060+6161+ include Jv.CONV with type t := t
6262+end) =
6363+struct
5064 type t = I.t -> unit
6565+5166 let to_jv f = Jv.repr f
5267end
5368···6782 o
68836984 let g = Jv.get Jv.global "__CM__view"
7070-7171- let create ?(opts = Jv.undefined) () =
7272- Jv.new' g [| opts |]
7373-8585+ let create ?(opts = Jv.undefined) () = Jv.new' g [| opts |]
7486 let state t = Jv.get t "state" |> State.of_jv
7575-7687 let set_state t v = Jv.call t "setState" [| State.to_jv v |] |> ignore
8888+7789 module Update = struct
7890 type t = Jv.t
7991···8597 let dom t = Jv.get t "dom" |> Brr.El.of_jv
86988799 let update_listener _ : (Update.t -> unit, Jv.t) State.facet =
8888- let module F = State.FacetMaker (Func(Update)) in
8989- let jv = Jv.get g "updateListener" in
9090- Facet ((module F), F.of_jv jv)
100100+ let module F = State.FacetMaker (Func (Update)) in
101101+ let jv = Jv.get g "updateListener" in
102102+ Facet ((module F), F.of_jv jv)
9110392104 let line_wrapping () = Jv.get g "lineWrapping" |> Extension.of_jv
93105end
+15-6
src/editor.mli
···17171818 module type Facet = sig
1919 type t
2020+2021 include Jv.CONV with type t := t
2121- type input
2222+2323+ type input
2224 type output
23252426 val of_ : t -> input -> Extension.t
2527 end
26282727- module FacetMaker : functor (I : sig type t include Jv.CONV with type t := t end) -> Facet with type input = I.t
2929+ module FacetMaker : functor
3030+ (I : sig
3131+ type t
3232+3333+ include Jv.CONV with type t := t
3434+ end)
3535+ -> Facet with type input = I.t
28362929- type ('i, 'o) facet = Facet : (module Facet with type input = 'i and type output = 'o and type t = 'a) * 'a -> ('i, 'o) facet
3737+ type ('i, 'o) facet =
3838+ | Facet :
3939+ (module Facet with type input = 'i and type output = 'o and type t = 'a)
4040+ * 'a
4141+ -> ('i, 'o) facet
30423143 val create : ?config:Config.t -> unit -> t
3232-3344 val doc : t -> Text.t
3445end
3546···6879 end
69807081 val dom : t -> Brr.El.t
7171-7282 val update_listener : unit -> (Update.t -> unit, Jv.t) State.facet
7373-7483 val line_wrapping : unit -> Extension.t
7584end
-3
src/lint/lint.ml
···2424 type t = Jv.t
25252626 let from t = Jv.Int.get t "from"
2727-2827 let to_ t = Jv.Int.get t "to"
29283029 type severity = Info | Warning | Error
···5453 o
55545655 let source t = Jv.Jstr.find t "source"
5757-5856 let message t = Jv.Jstr.get t "message"
5959-6057 let actions t = Option.map (Jv.to_array Action.to_jv) (Jv.find t "actions")
61586259 include (Jv.Id : Jv.CONV with type t := t)
-7
src/lint/lint.mli
···14141515module Diagnostic : sig
1616 type t
1717-1817 type severity = Info | Warning | Error
19182019 val severity_of_string : string -> severity
2121-2220 val severity_to_string : severity -> string
23212422 val create :
···3230 t
33313432 val severity : t -> severity
3535-3633 val from : t -> int
3737-3834 val to_ : t -> int
3939-4035 val source : t -> Jstr.t option
4141-4236 val actions : t -> Action.t array option
4343-4437 val message : t -> Jstr.t
4538end
4639
+2-1
src/stream/stream.ml
···44 type t
5566 include (Jv.Id : Jv.CONV with type t := t)
77+78 let g = Jv.get g "StreamLanguage"
8999- let define (l : t) =
1010+ let define (l : t) =
1011 Jv.call g "define" [| to_jv l |] |> Code_mirror.Extension.of_jv
1112end
-6
src/text.ml
···66 type t = Jv.t
7788 let from t = Jv.Int.get t "from"
99-109 let to_ t = Jv.Int.get t "to"
1111-1210 let number t = Jv.Int.get t "number"
1313-1411 let text t = Jv.Jstr.get t "text"
1515-1612 let length t = Jv.Int.get t "length"
1713end
18141915let length t = Jv.Int.get t "length"
2020-2116let line n t = Jv.call t "line" [| Jv.of_int n |]
2222-2317let to_jstr_array t = Jv.call t "toJSON" [||] |> Jv.to_jstr_array
-1
src/text.mli
···2626(** Length of the text *)
27272828val line : int -> t -> Line.t
2929-3029val to_jstr_array : t -> Jstr.t array
···11+open Code_mirror
22+33+let tooltip = Jv.get Jv.global "__CM__tooltip"
44+55+module Tooltip_view = struct
66+ type t = Jv.t
77+88+ include (Jv.Id : Jv.CONV with type t := t)
99+1010+ let dom t = Jv.get t "dom" |> Brr.El.of_jv
1111+1212+ type offset = { x : int; y : int }
1313+ type coords = { left : int; right : int; top : int; bottom : int }
1414+1515+ let offset_of_jv o = { x = Jv.Int.get o "x"; y = Jv.Int.get o "y" }
1616+1717+ let offset_to_jv { x; y } =
1818+ let o = Jv.obj [||] in
1919+ Jv.Int.set o "x" x;
2020+ Jv.Int.set o "y" y;
2121+ o
2222+2323+ let _coords_of_jv o =
2424+ {
2525+ left = Jv.Int.get o "left";
2626+ right = Jv.Int.get o "right";
2727+ top = Jv.Int.get o "top";
2828+ bottom = Jv.Int.get o "bottom";
2929+ }
3030+3131+ let coords_to_jv { left; right; top; bottom } =
3232+ let o = Jv.obj [||] in
3333+ Jv.Int.set o "left" left;
3434+ Jv.Int.set o "right" right;
3535+ Jv.Int.set o "top" top;
3636+ Jv.Int.set o "bottom" bottom;
3737+ o
3838+3939+ let offset t = Jv.get t "offset" |> offset_of_jv
4040+4141+ let create ~dom ?offset ?get_coords ?overlap ?mount ?update ?positioned () =
4242+ let get_coords =
4343+ Option.map
4444+ (fun get_coords ->
4545+ Jv.repr (fun pos -> get_coords (Jv.to_int pos) |> coords_to_jv))
4646+ get_coords
4747+ in
4848+ let o = Jv.obj [||] in
4949+ Jv.set o "dom" (Brr.El.to_jv dom);
5050+ Jv.set_if_some o "offset" @@ Option.map offset_to_jv offset;
5151+ Jv.set_if_some o "getCoords" get_coords;
5252+ Jv.Bool.set_if_some o "overlap" overlap;
5353+ Jv.set_if_some o "mount"
5454+ @@ Option.map
5555+ (fun mount -> Jv.repr (fun view -> mount (Editor.View.of_jv view)))
5656+ mount;
5757+ Jv.set_if_some o "update"
5858+ @@ Option.map
5959+ (fun update ->
6060+ Jv.repr (fun view_up -> update (Editor.View.Update.of_jv view_up)))
6161+ update;
6262+ Jv.set_if_some o "positioned" @@ Option.map Jv.repr positioned;
6363+ o
6464+end
6565+6666+module Tooltip = struct
6767+ type t = Jv.t
6868+6969+ include (Jv.Id : Jv.CONV with type t := t)
7070+7171+ let pos t = Jv.Int.get t "pos"
7272+ let end_ t = Jv.to_option Jv.to_int @@ Jv.get t "end"
7373+7474+ let create ~pos ?end_ ~create ?above ?strict_side ?arrow () =
7575+ let o = Jv.obj [||] in
7676+ Jv.Int.set o "pos" pos;
7777+ Jv.Int.set_if_some o "end" end_;
7878+ Jv.set o "create"
7979+ @@ Jv.repr (fun view ->
8080+ create (Editor.View.of_jv view) |> Tooltip_view.to_jv);
8181+ Jv.Bool.set_if_some o "above" above;
8282+ Jv.Bool.set_if_some o "strictSide" strict_side;
8383+ Jv.Bool.set_if_some o "arrow" arrow;
8484+ o
8585+end
8686+8787+type hover_config = Jv.t
8888+8989+let hover_config ?hide_on_change ?hover_time () =
9090+ let o = Jv.obj [||] in
9191+ Jv.Bool.set_if_some o "hide_on_change" hide_on_change;
9292+ Jv.Int.set_if_some o "hover_time" hover_time;
9393+ o
9494+9595+let hover_tooltip ?config source =
9696+ let source =
9797+ Jv.repr @@ fun view pos side ->
9898+ let fut =
9999+ source ~view:(Editor.View.of_jv view) ~pos:(Jv.to_int pos)
100100+ ~side:(Jv.to_int side)
101101+ in
102102+ let fut = Fut.map (fun v -> Ok v) fut in
103103+ Fut.to_promise fut ~ok:(fun t ->
104104+ Option.value ~default:Jv.null (Option.map Tooltip.to_jv t))
105105+ in
106106+ let args =
107107+ if Option.is_none config then [| source |]
108108+ else [| source; Option.get config |]
109109+ in
110110+ Jv.call tooltip "hoverTooltip" args |> Extension.of_jv
+116
src/tooltip/tooltip.mli
···11+open Code_mirror
22+33+val tooltip : Jv.t
44+(** Global tooltip value *)
55+66+module Tooltip_view : sig
77+ (** Describes the way a tooltip is displayed. *)
88+99+ type t
1010+ (** TooltypeView *)
1111+1212+ include Jv.CONV with type t := t
1313+1414+ val dom : t -> Brr.El.t
1515+ (** The DOM element to position over the editor. *)
1616+1717+ type offset = { x : int; y : int }
1818+ type coords = { left : int; right : int; top : int; bottom : int }
1919+2020+ val offset : t -> offset
2121+2222+ val create :
2323+ dom:Brr.El.t ->
2424+ ?offset:offset ->
2525+ ?get_coords:(int -> coords) ->
2626+ ?overlap:bool ->
2727+ ?mount:(Editor.View.t -> unit) ->
2828+ ?update:(Editor.View.Update.t -> unit) ->
2929+ ?positioned:(unit -> unit) ->
3030+ unit ->
3131+ t
3232+ (** Creates a TooltipView:
3333+3434+ @param dom The DOM element to position over the editor.
3535+ @param offset Adjust the position of the tooltip relative to its anchor
3636+ position.
3737+ @param get_coords This method can be provided to make the tooltip view
3838+ itself responsible for finding its screen position.
3939+ @param overlap By default, tooltips are moved when they overlap with other
4040+ tooltips. Set this to true to disable that behavior for this tooltip.
4141+ @param mount Called after the tooltip is added to the DOM for the first
4242+ time.
4343+ @param update Update the DOM element for a change in the view's state.
4444+ @param positioned Called when the tooltip has been (re)positioned.
4545+4646+ {{:https://codemirror.net/6/docs/ref/#tooltip.TooltipView} See the
4747+ reference for additional information.} *)
4848+end
4949+5050+(** Creates a Tooltip:
5151+5252+ @param pos The document position at which to show the tooltip.
5353+ @param end The end of the range annotated by this tooltip, if different from
5454+ pos.
5555+ @param create A constructor function that creates the tooltip's DOM
5656+ representation.
5757+ @param above Whether the tooltip should be shown above or below the target
5858+ position.
5959+ @param strict_side Whether the above option should be honored when there
6060+ isn't enough space on that side to show the tooltip inside the viewport.
6161+ @param arrow When set to true, show a triangle connecting the tooltip element
6262+ to position pos.
6363+6464+ {{:https://codemirror.net/6/docs/ref/#tooltip.Tooltip} See the
6565+ reference for additional information.} *)
6666+module Tooltip : sig
6767+ (** Describes a tooltip. Values of this type, when provided through the
6868+ show_tooltip facet, control the individual tooltips on the editor. *)
6969+7070+ type t
7171+ (** Tooltip *)
7272+7373+ include Jv.CONV with type t := t
7474+7575+ val pos : t -> int
7676+ (** The document position at which to show the tooltip. *)
7777+7878+ val end_ : t -> int option
7979+ (** The end of the range annotated by this tooltip, if different from pos. *)
8080+8181+ val create :
8282+ pos:int ->
8383+ ?end_:int ->
8484+ create:(Editor.View.t -> Tooltip_view.t) ->
8585+ ?above:bool ->
8686+ ?strict_side:bool ->
8787+ ?arrow:bool ->
8888+ unit ->
8989+ t
9090+end
9191+9292+type hover_config
9393+9494+val hover_config :
9595+ ?hide_on_change:bool -> ?hover_time:int -> unit -> hover_config
9696+(** Options for hover tooltips:
9797+9898+ @param hover_on_change When enabled (this defaults to false), close the
9999+ tooltip whenever the document changes.
100100+@param hover_time Hover time after which the tooltip should appear, in
101101+milliseconds. Defaults to 300ms. *)
102102+103103+val hover_tooltip :
104104+ ?config:hover_config ->
105105+ (view:Editor.View.t -> pos:int -> side:int -> Tooltip.t option Fut.t) ->
106106+ Extension.t
107107+(** Enable a hover tooltip, which shows up when the pointer hovers over ranges
108108+ of text. The callback is called when the mouse hovers over the document text.
109109+ It should, if there is a tooltip associated with position pos return the
110110+ tooltip description (either directly or in a promise). The side argument
111111+ indicates on which side of the position the pointer is—it will be -1 if the
112112+ pointer is before the position, 1 if after the position.
113113+114114+ Note that all hover tooltips are hosted within a single tooltip container
115115+ element. This allows multiple tooltips over the same range to be "merged"
116116+ together without overlapping. *)