Source file syntax_theme.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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
type t = { base : Ansi.Style.t; overlays : (string, Ansi.Style.t) Hashtbl.t }

let make ~base mappings =
  let overlays = Hashtbl.create (List.length mappings) in
  List.iter
    (fun (group, style) -> Hashtbl.replace overlays group style)
    mappings;
  { base; overlays }

let rec resolve_overlay t group =
  match Hashtbl.find_opt t.overlays group with
  | Some overlay -> overlay
  | None -> (
      match String.rindex_opt group '.' with
      | Some i -> resolve_overlay t (String.sub group 0 i)
      | None -> Ansi.Style.default)

let resolve t group =
  Ansi.Style.merge ~base:t.base ~overlay:(resolve_overlay t group)

let default =
  let base = Ansi.Style.default in
  make ~base
    [
      ( "comment",
        Ansi.Style.make ~italic:true ~fg:(Ansi.Color.grayscale ~level:12) () );
      ( "keyword",
        Ansi.Style.make ~bold:true ~fg:(Ansi.Color.of_rgb 255 151 0) () );
      ("string", Ansi.Style.make ~fg:(Ansi.Color.of_rgb 229 192 123) ());
      ("number", Ansi.Style.make ~fg:(Ansi.Color.of_rgb 209 154 102) ());
      ("function", Ansi.Style.make ~fg:(Ansi.Color.of_rgb 97 175 239) ());
      ("type", Ansi.Style.make ~fg:(Ansi.Color.of_rgb 86 182 194) ());
      ("variable", Ansi.Style.make ~fg:(Ansi.Color.of_rgb 224 108 117) ());
      ("operator", Ansi.Style.make ~fg:(Ansi.Color.of_rgb 255 151 0) ());
      ("punctuation", Ansi.Style.make ~fg:(Ansi.Color.grayscale ~level:16) ());
      ("constant", Ansi.Style.make ~fg:(Ansi.Color.of_rgb 209 154 102) ());
      ("tag", Ansi.Style.make ~fg:(Ansi.Color.of_rgb 224 108 117) ());
      ("attribute", Ansi.Style.make ~fg:(Ansi.Color.of_rgb 229 192 123) ());
    ]

(* Count dots in a group name — more dots means more specific. *)
let specificity group =
  let n = ref 0 in
  String.iter (fun c -> if c = '.' then incr n) group;
  !n

(* A boundary event: a range starts or ends at a byte offset. *)
type boundary = Start of int * string | End of int * string

let apply t ~content ranges =
  let len = String.length content in
  List.iter
    (fun (s, e, _) ->
      if s < 0 || e > len || s > e then
        invalid_arg
          (Printf.sprintf
             "Syntax_theme.apply: range (%d, %d) out of bounds for content of \
              length %d"
             s e len))
    ranges;
  if ranges = [] then
    if len = 0 then [] else [ { Text_buffer.text = content; style = t.base } ]
  else
    (* Build sorted boundary list. Each range contributes a Start and End. *)
    let boundaries =
      let acc = ref [] in
      List.iter
        (fun (s, e, group) -> acc := Start (s, group) :: End (e, group) :: !acc)
        ranges;
      List.sort
        (fun a b ->
          let pos_of = function Start (p, _) -> p | End (p, _) -> p in
          let pa = pos_of a and pb = pos_of b in
          if pa <> pb then Int.compare pa pb
          else
            (* Ends before Starts at same position *)
            match (a, b) with
            | End _, Start _ -> -1
            | Start _, End _ -> 1
            | _ -> 0)
        !acc
    in
    (* Walk boundaries, tracking active groups. *)
    let active : (string * int) list ref = ref [] in
    (* (group, order) — order is insertion order for tie-breaking *)
    let order = ref 0 in
    let result = ref [] in
    let last_pos = ref 0 in
    let flush_segment pos =
      if pos > !last_pos then begin
        let text = String.sub content !last_pos (pos - !last_pos) in
        let style =
          match !active with
          | [] -> t.base
          | _ ->
              (* Cascade-merge all active groups: least-specific first, then by
                 insertion order. This matches CSS/TextMate cascade semantics
                 where child scopes inherit parent properties. *)
              let sorted =
                List.map (fun (g, ord) -> (g, specificity g, ord)) !active
                |> List.sort (fun (_, s1, o1) (_, s2, o2) ->
                    let c = Int.compare s1 s2 in
                    if c <> 0 then c else Int.compare o1 o2)
              in
              List.fold_left
                (fun acc (g, _, _) ->
                  Ansi.Style.merge ~base:acc ~overlay:(resolve_overlay t g))
                t.base sorted
        in
        result := { Text_buffer.text; style } :: !result
      end;
      last_pos := pos
    in
    List.iter
      (fun boundary ->
        match boundary with
        | Start (pos, group) ->
            flush_segment pos;
            let o = !order in
            incr order;
            active := (group, o) :: !active
        | End (pos, group) ->
            flush_segment pos;
            active :=
              List.filter (fun (g, _) -> not (String.equal g group)) !active)
      boundaries;
    (* Flush any trailing text after the last boundary. *)
    flush_segment len;
    List.rev !result