Fix limitations of the summary field

c-cube · Jan 21, 2024 · 014a2da · 014a2da
1 parent 093e74e
commit 014a2da
Show file tree

Hide file tree

Showing 5 changed files with 94 additions and 45 deletions.
diff --git 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 ->
-      {|<span style="|} ^ String.concat ";" (List.map (fun (k,v) -> k ^ ": " ^ v) s) ^ {|">|}, "</span>"
+  let sty_pre, sty_post =
+    match s with
+      | [] -> "", ""
+      | s ->
+        {|<span style="|} ^ String.concat ";" (List.map (fun (k,v) -> k ^ ": " ^ v) s) ^ {|">|},
+        "</span>" in
+  let bold_pre, bold_post =
+    match bold, in_html with
+    | false, _ -> "", ""
+    | true, false -> "**", "**"
+    | true, true -> "<b>", "</b>" 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 "<br>"; 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 {|<span style="border:thin solid">%a</span>|}
-          (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 "<br>"; 
-           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 "<details><summary>%a</summary>@,%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 "@,%s</details>" prefix
     | B.Link {uri; inner} ->
       pp_print_string out "[";
-      loop ~inline:true ~prefix:(prefix ^ " ") inner;
+      loop ~in_html ~prefix:(prefix ^ " ") inner;
       fprintf out "](%s)" uri in
   pp_open_vbox out 0;
-  loop ~inline:false ~prefix:"" b;
+  loop ~in_html:false ~prefix:"" b;
   pp_close_box out ()
 
 let to_string ~tables ~foldable_trees b =

diff --git a/src/printbox-md/playground.md b/src/printbox-md/playground.md
@@ -32,7 +32,7 @@
 
 Framed fold:
 
-> <details><summary>List 2:</summary>
+> <details><summary> List 2: </summary>
 >
 > - Element 1<br>
 >   second line of element 1
@@ -49,7 +49,7 @@ Framed fold:
 > </details>
 
 
-> <details><summary>List 3:</summary>
+> <details><summary> `List 3:` </summary>
 >
 > - Element 1
 >   second line of element 1
@@ -69,6 +69,46 @@ Framed fold:
 
 
 <details>
-> <summary> List 4: </summary>
+<summary> [Hyperlink header](./playground.md) </summary>
 
-</details>
+- [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)
+</details>
+
+[This is
+**multiline**<br>
+hyperlink](../../test/test_md.expected#L23)
+
+**This is
+multiline<br>
+bold text**
+
+`this is
+multiline<br>
+code`
+
+```
+this is
+multiline<br>
+code
+```
+
+<span style="font-family: monospace">this is
+multiline<br>
+code</span>
+
+> `this is
+> multiline<br>
+> code`
+
+> ```
+> this is
+> multiline<br>
+> code
+> ```
+
+> <span style="font-family: monospace">this is
+> multiline<br>
+> code</span>
diff --git 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<br>
   line 2<br>
   line 3
@@ -11,15 +11,15 @@ Test unfolded:
 - 
   - > header 4
     - subchild 4
-- > header 5
+- > `header 5`
   > - subchild 5
-- > child 5
+- > child 6
 
 Test foldable:
 <details><summary><span style="border:thin solid">root</span></summary>
 
 - > child 1
-- child 2
+- `child 2`
 - line 1<br>
   line 2<br>
   line 3
@@ -37,11 +37,11 @@ Test foldable:
     - subchild 4
     </details>
   </details>
-- > <details><summary>header 5</summary>
+- > <details><summary><span style="font-family: monospace">header 5</span></summary>
   > 
   > - subchild 5
   > </details>
-- > child 5
+- > child 6
 </details>
 
 The end.
diff --git a/test/test_md.expected.md b/test/test_md.expected.md
@@ -1,7 +1,7 @@
 Test unfolded:
 > root
 - > child 1
-- child 2
+- `child 2`
 - line 1<br>
   line 2<br>
   line 3
@@ -11,15 +11,15 @@ Test unfolded:
 - 
   - > header 4
     - subchild 4
-- > header 5
+- > `header 5`
   > - subchild 5
-- > child 5
+- > child 6
 
 Test foldable:
 <details><summary><span style="border:thin solid">root</span></summary>
 
 - > child 1
-- child 2
+- `child 2`
 - line 1<br>
   line 2<br>
   line 3
@@ -37,11 +37,11 @@ Test foldable:
     - subchild 4
     </details>
   </details>
-- > <details><summary>header 5</summary>
+- > <details><summary><span style="font-family: monospace">header 5</span></summary>
   > 
   > - subchild 5
   > </details>
-- > child 5
+- > child 6
 </details>
 
 The end.
diff --git a/test/test_md.ml b/test/test_md.ml
@@ -2,16 +2,16 @@ let b =
   let open PrintBox in
   tree (frame @@ text "root") [
     frame @@ text "child 1";
-    text "child 2";
+    text_with_style Style.preformatted "child 2";
     lines ["line 1"; "line 2"; "line 3"];
     frame @@ tree empty [
       tree (frame @@ text "header 3") [frame @@ text "subchild 3"]
     ];
     tree empty [
       tree (frame @@ text "header 4") [text "subchild 4"]
     ];
-    frame @@ tree (text "header 5") [text "subchild 5"];
-    frame @@ text "child 5"
+    frame @@ tree (text_with_style Style.preformatted "header 5") [text "subchild 5"];
+    frame @@ text "child 6"
   ]
 
 let () = print_endline "Test unfolded:"