forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
Add @figure extension to odoc-jons-plugins
Block-tag extension for native figures with captions:
@figure src=foo.png alt="Alt text" link=https://…
Caption paragraph (with inline formatting preserved).
Produces <figure class="figure"><a><img></a><figcaption>…</figcaption></figure>.
Bare first token is treated as src for terse usage: @figure foo.png.
Replaces the raw-HTML <figure> blocks currently used in blog posts.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+201
+201
src/odoc_jons_plugins.ml
+201
src/odoc_jons_plugins.ml
···
534
534
let () =
535
535
Api.Registry.register (module Page_tags)
536
536
537
+
(* --- Figure extension ---
538
+
539
+
[@figure src=foo.png alt="…" link="…"]
540
+
Caption body (one or more paragraphs, with inline formatting).
541
+
542
+
Renders to <figure><a><img></a><figcaption>…</figcaption></figure>.
543
+
The caption body is rendered through the normal odoc document layer
544
+
so links, references, and emphasis work inside it. *)
545
+
546
+
module Figure = struct
547
+
open Odoc_document.Types
548
+
549
+
let prefix = "figure"
550
+
551
+
let figure_css = {|
552
+
/* Figure extension - neutralize the at-tags list wrapper */
553
+
.jon-shell-main ul.at-tags:has(li.figure) {
554
+
list-style: none;
555
+
margin: 0;
556
+
padding: 0;
557
+
}
558
+
.jon-shell-main .at-tags li.figure {
559
+
list-style: none;
560
+
margin: 0;
561
+
padding: 0;
562
+
text-indent: 0;
563
+
}
564
+
figure.figure {
565
+
margin: 1.5em auto;
566
+
text-align: center;
567
+
}
568
+
figure.figure img {
569
+
max-width: 100%;
570
+
height: auto;
571
+
border-radius: 4px;
572
+
}
573
+
figure.figure figcaption {
574
+
margin-top: 0.6em;
575
+
font-size: 0.9rem;
576
+
color: var(--text-muted, #666);
577
+
font-style: italic;
578
+
line-height: 1.5;
579
+
}
580
+
figure.figure figcaption p {
581
+
margin: 0;
582
+
}
583
+
|}
584
+
585
+
(* Parse key=value pairs out of a single line of raw text. Supports
586
+
quoted values ("…") and bare values (stop at whitespace). Returns
587
+
an assoc list. Unknown keys are kept — the caller decides what to
588
+
do with them. *)
589
+
let parse_attrs line =
590
+
let len = Stdlib.String.length line in
591
+
let i = ref 0 in
592
+
let attrs = ref [] in
593
+
let skip_ws () =
594
+
while !i < len && (line.[!i] = ' ' || line.[!i] = '\t') do
595
+
incr i
596
+
done
597
+
in
598
+
let read_key () =
599
+
let start = !i in
600
+
while !i < len
601
+
&& line.[!i] <> '='
602
+
&& line.[!i] <> ' '
603
+
&& line.[!i] <> '\t'
604
+
do incr i done;
605
+
Stdlib.String.sub line start (!i - start)
606
+
in
607
+
let read_quoted () =
608
+
(* assumes current char is '"' *)
609
+
incr i;
610
+
let start = !i in
611
+
while !i < len && line.[!i] <> '"' do incr i done;
612
+
let v = Stdlib.String.sub line start (!i - start) in
613
+
if !i < len then incr i; (* consume closing quote *)
614
+
v
615
+
in
616
+
let read_bare () =
617
+
let start = !i in
618
+
while !i < len && line.[!i] <> ' ' && line.[!i] <> '\t' do
619
+
incr i
620
+
done;
621
+
Stdlib.String.sub line start (!i - start)
622
+
in
623
+
(try
624
+
while !i < len do
625
+
skip_ws ();
626
+
if !i >= len then raise Exit;
627
+
let key = read_key () in
628
+
if key = "" then raise Exit;
629
+
if !i < len && line.[!i] = '=' then begin
630
+
incr i;
631
+
let value =
632
+
if !i < len && line.[!i] = '"' then read_quoted ()
633
+
else read_bare ()
634
+
in
635
+
attrs := (key, value) :: !attrs
636
+
end else begin
637
+
(* bare token — treat as the source if no src= seen yet *)
638
+
attrs := (key, "") :: !attrs
639
+
end
640
+
done
641
+
with Exit -> ());
642
+
List.rev !attrs
643
+
644
+
let find_attr key attrs =
645
+
List.assoc_opt key attrs
646
+
647
+
(* If the author wrote [@figure foo.png …] (no src=), the first bare
648
+
token becomes the src. *)
649
+
let infer_src attrs =
650
+
match find_attr "src" attrs with
651
+
| Some _ -> attrs
652
+
| None ->
653
+
match List.find_opt (fun (_k, v) -> v = "") attrs with
654
+
| Some (k, _) ->
655
+
(* Promote the first bare token to src *)
656
+
let rest = List.filter (fun (k', v) -> not (k' = k && v = "")) attrs in
657
+
("src", k) :: rest
658
+
| None -> attrs
659
+
660
+
(* HTML-escape an attribute / text value. *)
661
+
let escape s =
662
+
let b = Buffer.create (Stdlib.String.length s) in
663
+
Stdlib.String.iter (fun c ->
664
+
match c with
665
+
| '&' -> Buffer.add_string b "&"
666
+
| '<' -> Buffer.add_string b "<"
667
+
| '>' -> Buffer.add_string b ">"
668
+
| '"' -> Buffer.add_string b """
669
+
| c -> Buffer.add_char b c
670
+
) s;
671
+
Buffer.contents b
672
+
673
+
let raw_block html =
674
+
Block.{ attr = []; desc = Raw_markup ("html", html) }
675
+
676
+
(* Split the incoming body into (first paragraph text, remaining
677
+
nestable blocks used as caption). *)
678
+
let split_first_paragraph content =
679
+
match content with
680
+
| [] -> ("", [])
681
+
| first :: rest ->
682
+
let first_text =
683
+
Api.text_of_nestable_block_elements [first]
684
+
|> Stdlib.String.trim
685
+
in
686
+
(first_text, rest)
687
+
688
+
let to_document ~tag:_ content =
689
+
let attr_line, caption_blocks = split_first_paragraph content in
690
+
let attrs = parse_attrs attr_line |> infer_src in
691
+
match find_attr "src" attrs with
692
+
| None ->
693
+
(* No src — fall back to emitting the original content so the
694
+
author sees something rather than silence. *)
695
+
Api.simple_output (Api.blocks_of_nestable_elements content)
696
+
| Some src ->
697
+
let alt = Option.value ~default:"" (find_attr "alt" attrs) in
698
+
let link = find_attr "link" attrs in
699
+
let extra_class = Option.value ~default:"" (find_attr "class" attrs) in
700
+
let open_tag =
701
+
let cls =
702
+
if extra_class = "" then "figure"
703
+
else "figure " ^ extra_class
704
+
in
705
+
Printf.sprintf {|<figure class="%s">|} (escape cls)
706
+
in
707
+
let img_html =
708
+
match link with
709
+
| Some url ->
710
+
Printf.sprintf {|<a href="%s"><img src="%s" alt="%s"></a>|}
711
+
(escape url) (escape src) (escape alt)
712
+
| None ->
713
+
Printf.sprintf {|<img src="%s" alt="%s">|}
714
+
(escape src) (escape alt)
715
+
in
716
+
let caption_opening, caption_closing =
717
+
if caption_blocks = [] then "", ""
718
+
else {|<figcaption>|}, {|</figcaption>|}
719
+
in
720
+
let blocks =
721
+
[ raw_block (open_tag ^ img_html ^ caption_opening) ]
722
+
@ (if caption_blocks = []
723
+
then []
724
+
else Api.blocks_of_nestable_elements caption_blocks)
725
+
@ [ raw_block (caption_closing ^ "</figure>") ]
726
+
in
727
+
{
728
+
Api.content = blocks;
729
+
overrides = [];
730
+
resources = [ Api.Css_inline figure_css ];
731
+
assets = [];
732
+
}
733
+
end
734
+
735
+
let () =
736
+
Api.Registry.register (module Figure)
737
+
537
738
(* --- Recent posts extension --- *)
538
739
539
740
module Recent_posts = struct