Skip to content

Commit

Permalink
box_debug: Highlight whitespaces
Browse files Browse the repository at this point in the history
This avoids whitespaces from being removed by the HTML parser and
highlights strings that contain whitespaces to make them easy to see.
  • Loading branch information
Julow committed Nov 12, 2024
1 parent 4c5c7b5 commit d8f1776
Show file tree
Hide file tree
Showing 2 changed files with 15 additions and 2 deletions.
2 changes: 1 addition & 1 deletion lib/Fmt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -143,7 +143,7 @@ let utf8_length s =
let str_as n s =
let stack = Box_debug.get_stack () in
with_pp (fun fs ->
Box_debug.start_str fs ;
Box_debug.start_str fs s ;
Format_.pp_print_as fs n s ;
Box_debug.end_str ~stack fs )

Expand Down
15 changes: 14 additions & 1 deletion lib/box_debug.ml
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,11 @@ let css =
.fits_or_breaks {
background-color: red;
}
.string_with_whitespaces {
background-color: yellow;
white-space: pre;
}

.tooltiptext {
visibility: hidden;
width: min-content;
Expand Down Expand Up @@ -132,7 +137,15 @@ let force_newline ?stack fs =
debugf fs "<div class=\"break force_newline\">force_newline%a</div>"
stack_tooltip stack

let start_str fs = debugf fs "<span class='string'>"
let start_str fs s =
let extra_class =
match String.lfindi s ~f:(fun _ c -> Char.is_whitespace c) with
| Some _ ->
(* String contains whitespaces, color it *)
" string_with_whitespaces"
| None -> ""
in
debugf fs "<span class='string%s'>" extra_class

let end_str ?stack fs = debugf fs "%a</span>" stack_tooltip stack

Expand Down

0 comments on commit d8f1776

Please sign in to comment.