Source file hook0.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
open! Core
open! Import
module Current_buffer = Current_buffer0

type after_change =
  { beginning_of_changed_region : Position.t
  ; end_of_changed_region : Position.t
  ; length_before_change : int
  }
[@@deriving sexp_of]

type before_change =
  { beginning_of_changed_region : Position.t
  ; end_of_changed_region : Position.t
  }
[@@deriving sexp_of]

type file = { file : string } [@@deriving sexp_of]
type normal = unit [@@deriving sexp_of]
type frame = { frame : Frame.t } [@@deriving sexp_of]

type window =
  { window : Window.t
  ; start : Position.t
  }
[@@deriving sexp_of]

module Hook_type = struct
  type 'a t =
    | After_change_hook : after_change t
    | Before_change_hook : before_change t
    | File_hook : file t
    | Normal_hook : normal t
    | Frame_hook : frame t
    | Window_hook : window t
  [@@deriving sexp_of]
end

type 'a t =
  { var : Function.t list Var.t
  ; hook_type : 'a Hook_type.t
  }
[@@deriving fields]

let symbol t = t.var.symbol
let value t = Current_buffer.value t.var
let value_exn t = Current_buffer.value_exn t.var

let sexp_of_t _ t =
  [%message
    ""
      ~symbol:(symbol t : Symbol.t)
      ~hook_type:(t.hook_type : _ Hook_type.t)
      ~value:(value t : Function.t list option)]
;;

module Wrap = struct
  let ( <: ) name hook_type =
    { var = { symbol = name |> Symbol.intern; type_ = Value.Type.(list Function.t) }
    ; hook_type
    }
  ;;
end