diff --git a/src/printbox-md/PrintBox_md.ml b/src/printbox-md/PrintBox_md.ml
index be1e289..da3d776 100644
--- a/src/printbox-md/PrintBox_md.ml
+++ b/src/printbox-md/PrintBox_md.ml
@@ -84,9 +84,9 @@ let to_md_rec ~tables ~trees (b: B.t) =
to_md_rec b
*)
- let style_format (s:B.Style.t) =
+ let style_format ~in_html (s:B.Style.t) =
let open B.Style in
- let {bold = _; bg_color; fg_color; preformatted = _} = s in
+ let {bold; bg_color; fg_color; preformatted} = s in
let encode_color = function
| Red -> "red"
| Blue -> "blue"
@@ -99,49 +99,58 @@ let to_md_rec ~tables ~trees (b: B.t) =
in
let s =
(match bg_color with None -> [] | Some c -> ["background-color", encode_color c]) @
- (match fg_color with None -> [] | Some c -> ["color", encode_color c])
+ (match fg_color with None -> [] | Some c -> ["color", encode_color c]) @
+ (if in_html && preformatted then ["font-family", "monospace"] else [])
in
- match s with
- | [] -> "", ""
- | s ->
- {| k ^ ": " ^ v) s) ^ {|">|}, ""
+ let sty_pre, sty_post =
+ match s with
+ | [] -> "", ""
+ | s ->
+ {| k ^ ": " ^ v) s) ^ {|">|},
+ "" in
+ let bold_pre, bold_post =
+ match bold, in_html with
+ | false, _ -> "", ""
+ | true, false -> "**", "**"
+ | true, true -> "", "" in
+ bold_pre ^ sty_pre, sty_post ^ bold_post
let pp ~tables ~foldable_trees out b =
let open Format in
(* We cannot use Format for indentation, because we need to insert ">" at the right places. *)
- let rec loop ~inline ~prefix b =
+ let rec loop ~in_html ~prefix b =
match B.view b with
| B.Empty -> ()
| B.Text {l; style} ->
- let sty_pre, sty_post = style_format style in
+ let sty_pre, sty_post = style_format ~in_html style in
pp_print_string out sty_pre;
(* use html for gb_color, fg_color and md for bold, preformatted. *)
pp_print_list
~pp_sep:(fun out () ->
pp_print_string out "
"; pp_print_cut out (); pp_print_string out prefix)
(fun out s ->
- let s = if style.B.Style.preformatted then String.concat "" ["`"; s; "`"] else s in
- let s = if style.B.Style.bold then String.concat "" ["**"; s; "**"] else s in
- pp_print_string out s
+ if not in_html && style.B.Style.preformatted
+ then fprintf out"`%s`" s
+ else pp_print_string out s
) out l;
pp_print_string out sty_post
| B.Frame b ->
- if inline then
+ if in_html then
fprintf out {|%a|}
- (fun _out -> loop ~inline ~prefix) b
- else fprintf out "> %a" (fun _out -> loop ~inline ~prefix:(prefix ^ "> ")) b
+ (fun _out -> loop ~in_html ~prefix) b
+ else fprintf out "> %a" (fun _out -> loop ~in_html ~prefix:(prefix ^ "> ")) b
| B.Pad (_, b) ->
(* NOT IMPLEMENTED YET *)
- loop ~inline ~prefix b
+ loop ~in_html ~prefix b
| B.Align {h = _; v=_; inner} ->
(* NOT IMPLEMENTED YET *)
- loop ~inline ~prefix inner
+ loop ~in_html ~prefix inner
| B.Grid (_, _) when tables = `Html && String.length prefix = 0 ->
- PrintBox_html.pp ~indent:(not inline) () out b
+ PrintBox_html.pp ~indent:(not in_html) () out b
| B.Grid (_, _) ->
let table =
if tables = `Text then PrintBox_text.to_string b
- else PrintBox_html.(if inline then to_string else to_string_indent) b in
+ else PrintBox_html.(if in_html then to_string else to_string_indent) b in
let lines = String.split_on_char '\n' table in
let lines =
List.map (fun s ->
@@ -150,29 +159,29 @@ let pp ~tables ~foldable_trees out b =
pp_print_list
~pp_sep:(fun out () ->
pp_print_string out "
";
- if not inline then fprintf out "@,%s" prefix)
+ if not in_html then fprintf out "@,%s" prefix)
pp_print_string out lines
| B.Tree (_extra_indent, header, [||]) ->
- loop ~inline ~prefix header
+ loop ~in_html ~prefix header
| B.Tree (extra_indent, header, body) ->
if foldable_trees
then
fprintf out "%a
@,%s@,%s- "
- (fun _out -> loop ~inline:true ~prefix) header prefix prefix
- else (loop ~inline ~prefix header; fprintf out "@,%s- " prefix);
+ (fun _out -> loop ~in_html:true ~prefix) header prefix prefix
+ else (loop ~in_html ~prefix header; fprintf out "@,%s- " prefix);
let pp_sep out () = fprintf out "@,%s- " prefix in
let subprefix = prefix ^ String.make (2 + extra_indent) ' ' in
pp_print_list
~pp_sep
- (fun _out sub -> loop ~inline ~prefix:subprefix sub)
+ (fun _out sub -> loop ~in_html ~prefix:subprefix sub)
out @@ Array.to_list body;
if foldable_trees then fprintf out "@,%sList 2:
+> List 2:
>
> - Element 1
> second line of element 1
@@ -49,7 +49,7 @@ Framed fold:
> List 3:
+> `List 3:`
>
> - Element 1
> second line of element 1
@@ -69,6 +69,46 @@ Framed fold:
-> List 4:
+ [Hyperlink header](./playground.md)
-
\ No newline at end of file
+- [Hyperlink 1](../../test/test_md.ml#L19)
+- [Hyperlink 2](../../test/test_md.ml#L23)
+- [Hyperlink 3](../../test/test_md.ml#L8)
+- [Hyperlink 4](../../test/test_md.expected#L23)
+
+hyperlink](../../test/test_md.expected#L23)
+
+**This is
+multiline
+bold text**
+
+`this is
+multiline
+code`
+
+```
+this is
+multiline
+code
+```
+
+this is
+multiline
+code
+
+> `this is
+> multiline
+> code`
+
+> ```
+> this is
+> multiline
+> code
+> ```
+
+> this is
+> multiline
+> code
\ No newline at end of file
diff --git a/test/test_md.expected b/test/test_md.expected
index 97026dc..4242d46 100644
--- a/test/test_md.expected
+++ b/test/test_md.expected
@@ -1,7 +1,7 @@
Test unfolded:
> root
- > child 1
-- child 2
+- `child 2`
- line 1
line 2
line 3
@@ -11,15 +11,15 @@ Test unfolded:
-
- > header 4
- subchild 4
-- > header 5
+- > `header 5`
> - subchild 5
-- > child 5
+- > child 6
Test foldable:
root
- > child 1
-- child 2
+- `child 2`
- line 1
line 2
line 3
@@ -37,11 +37,11 @@ Test foldable:
- subchild 4
header 5
+- > header 5
>
> - subchild 5
>
line 2
line 3
@@ -11,15 +11,15 @@ Test unfolded:
-
- > header 4
- subchild 4
-- > header 5
+- > `header 5`
> - subchild 5
-- > child 5
+- > child 6
Test foldable:
root
- > child 1
-- child 2
+- `child 2`
- line 1
line 2
line 3
@@ -37,11 +37,11 @@ Test foldable:
- subchild 4
header 5
+- > header 5
>
> - subchild 5
>