package ecaml
Library for writing Emacs plugin in OCaml
Install
Dune Dependency
Authors
Maintainers
Sources
ecaml-v0.16.0.tar.gz
sha256=d9c6f98e7b0906a7e3d332d1a30fe950b59586b860e4f051348ea854c3ae3434
doc/src/ecaml.ecaml_test_helpers/buffer_helper.ml.html
Source file buffer_helper.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 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
open! Core open! Import let with_buffer sync_or_async contents ~f = Current_buffer.set_temporarily_to_temp_buffer sync_or_async (fun () -> Point.insert_text (contents |> Text.of_utf8_bytes); f ()) ;; let with_buffer_and_point sync_or_async contents line_and_column ~f = with_buffer sync_or_async contents ~f:(fun () -> Point.goto_line_and_column line_and_column; f ()) ;; let utf8_full_block_U2588 = "\xE2\x96\x88" let show_buffer ~block_out = let contents = Current_buffer.contents () |> Text.to_utf8_bytes in Current_buffer.set_temporarily_to_temp_buffer Sync (fun () -> Point.insert contents; List.iter block_out ~f:(fun position -> let min = Point.min () in let max = Point.max () in let start = Position.clamp_exn position ~min ~max in let end_ = Position.clamp_exn (Position.add position 1) ~min ~max in Point.goto_char start; let contains_newline = Current_buffer.contents ~start ~end_ () |> Text.to_utf8_bytes |> String.is_substring ~substring:"\n" in Current_buffer.delete_region ~start ~end_; Point.insert utf8_full_block_U2588; if contains_newline then Point.insert "\n"); message (Current_buffer.contents () |> Text.to_utf8_bytes)) ;; let show_point () = show_buffer ~block_out:[ Point.get () ] module Region = struct type t = { start : Line_and_column.t ; end_ : Line_and_column.t } [@@deriving sexp_of] end open Region let with_buffer_and_active_region sync_or_async contents { start; end_ } ~f = with_buffer sync_or_async contents ~f:(fun () -> Current_buffer.set_mark (Current_buffer.position_of_line_and_column start); Point.goto_line_and_column end_; f ()) ;; let show_active_region () = match Current_buffer.active_region () with | None -> print_s [%message "No region is active."] | Some (start, end_) -> show_buffer ~block_out:[ start; end_ ] ;; (* The semantics of how to display overlay [before-string] and [after-string] properties are taken from the documentation of [overlay_strings] in buffer.c: {v /* Concatenate the strings associated with overlays that begin or end at POS, ignoring overlays that are specific to windows other than W. The strings are concatenated in the appropriate order: shorter overlays nest inside longer ones, and higher priority inside lower. Normally all of the after-strings come first, but zero-sized overlays have their after-strings ride along with the before-strings because it would look strange to print them inside-out. Returns the concatenated string's length, and return the pointer to that string via PSTR, if that variable is non-NULL. The storage of the concatenated strings may be overwritten by subsequent calls. */ v} *) let show_with_overlay_text () = Buffer.with_temp_buffer Sync (fun temp_buffer -> let write before text after = Current_buffer.set_temporarily Sync temp_buffer ~f:(fun () -> Point.insert before; Point.insert_text text; Point.insert after) in let write_text_property_if_present overlay property_name = match Overlay.get_property overlay property_name with | exception _ -> () | s -> write "<overlay>" s "</overlay>" in Current_buffer.save_excursion Sync (fun () -> Point.goto_min (); let all_overlays = Overlay.in_ ~start:(Point.min ()) ~end_:(Point.max ()) in let all_endpoints = List.concat_map all_overlays ~f:(fun overlay -> [ Overlay.start overlay; Overlay.end_ overlay ]) |> Position.Set.of_list in let rec loop () = if Position.( < ) (Point.get ()) (Point.max ()) then ( (* after-strings (for overlays ending here) are displayed before before-strings (for overlays beginning here), except that before-strings are displayed before after-strings for any empty overlays at this position. *) let overlays_starting_here = ref [] in let overlays_ending_here = ref [] in let empty_overlays = ref [] in List.iter all_overlays ~f:(fun o -> let start = Overlay.start o in let end_ = Overlay.end_ o in if Position.equal start (Point.get ()) then if Position.equal end_ (Point.get ()) then empty_overlays := o :: !empty_overlays else overlays_starting_here := o :: !overlays_starting_here else if Position.equal end_ (Point.get ()) then overlays_ending_here := o :: !overlays_ending_here); (* Smaller overlays are printed before larger overlays *) let compare_overlay a b = Comparable.lift Int.compare ~f:(fun o -> Position.diff (Overlay.end_ o) (Overlay.start o)) a b in (* These lists are sorted from "inside" to "outside". *) let overlays_starting_here = List.sort !overlays_starting_here ~compare:compare_overlay in let overlays_ending_here = List.sort !overlays_ending_here ~compare:compare_overlay in let empty_overlays = (* This sort does nothing right now, because compare_overlay only checks overlay length, but if we figure out how to sort by priority, it will be necessary to sort here. *) List.sort !empty_overlays ~compare:compare_overlay in (* Print "outer" strings first, for [after-string]s. *) List.iter (List.rev overlays_ending_here) ~f:(fun o -> write_text_property_if_present o Text.Property_name.after_string); List.iter empty_overlays ~f:(fun o -> write_text_property_if_present o Text.Property_name.before_string; write_text_property_if_present o Text.Property_name.after_string); List.iter overlays_starting_here ~f:(fun o -> write_text_property_if_present o Text.Property_name.before_string); (* Go to next overlay endpoint, or the end of the invisibility overlay if one starts here. If there is no invisibility overlay, write the buffer contents that we just skipped. *) let () = match List.filter_map overlays_starting_here ~f:(fun o -> match Overlay.get_property o Text.Property_name.invisible with | exception _ -> None | invisible -> if Value.is_not_nil invisible then Some (Overlay.end_ o) else None) |> List.max_elt ~compare:Position.compare with | Some end_of_invisibility when (* Avoid infinite loop *) Position.( > ) end_of_invisibility (Point.get ()) -> write "<invisible>" (Current_buffer.contents ~start:(Point.get ()) ~end_:end_of_invisibility ~text_properties:true ()) "</invisible>"; Point.goto_char end_of_invisibility | Some _ | None -> let next_overlay_endpoint_or_end_of_buffer = match Set.to_sequence all_endpoints ~greater_or_equal_to:(Position.add (Point.get ()) 1) |> Sequence.hd with | Some next_overlay_endpoint -> next_overlay_endpoint | None -> Point.max () in write "" (Current_buffer.contents ~start:(Point.get ()) ~end_:next_overlay_endpoint_or_end_of_buffer ~text_properties:true ()) ""; Point.goto_char next_overlay_endpoint_or_end_of_buffer in loop ()) in loop (); Current_buffer.set_temporarily Sync temp_buffer ~f:(fun () -> show_buffer ~block_out:[]))) ;; module Sample_input = struct let table1 = {| ┌──────────────────────────────────────┬─────┬──────┬────────┬───────────┐ │ feature │ CRs │ XCRs │ review │ next step │ ├──────────────────────────────────────┼─────┼──────┼────────┼───────────┤ │ jane │ │ │ │ │ │ plugd │ │ │ │ fix build │ │ rewrite-flags │ 1 │ 1 │ 9 │ │ └──────────────────────────────────────┴─────┴──────┴────────┴───────────┘ |} ;; let table2 = {| Features you own: ┌──────────────────────────┬─────┬──────┬───────┬───────────────────────┐ │ feature │ CRs │ XCRs │ #left │ next step │ ├──────────────────────────┼─────┼──────┼───────┼───────────────────────┤ │ jane │ │ │ │ │ │ plugd │ │ │ │ fix build │ │ clean-up-obligations │ │ │ 3 │ review │ │ commander │ │ │ │ rebase, release │ │ versioned-types │ │ │ 1 │ review │ │ pipe-rpc │ │ │ 1 │ rebase, enable-review │ └──────────────────────────┴─────┴──────┴───────┴───────────────────────┘ |} ;; end
sectionYPositions = computeSectionYPositions($el), 10)"
x-init="setTimeout(() => sectionYPositions = computeSectionYPositions($el), 10)"
>