(** Scrollycode Extension for odoc Provides scroll-driven code tutorials. Theme styling is handled externally via CSS custom properties defined in {!Scrollycode_css} and set by theme files in {!Scrollycode_themes}. Authoring format uses [@scrolly] custom tags with an ordered list inside, where each list item is a tutorial step containing a bold title, prose paragraphs, and a code block. For backward compatibility, \@scrolly.warm / \@scrolly.dark / \@scrolly.notebook are still accepted but the theme suffix is ignored — theme selection is now a CSS concern. *) module Comment = Odoc_model.Comment module Location_ = Odoc_model.Location_ module Block = Odoc_document.Types.Block module Inline = Odoc_document.Types.Inline module Scrollycode_css = Scrollycode_css module Scrollycode_themes = Scrollycode_themes (** {1 Step Extraction} *) (** A single tutorial step extracted from the ordered list structure *) type step = { title : string; prose : string; code : string; focus : int list; (** 1-based line numbers to highlight *) } (** Extract plain text from inline elements *) let rec text_of_inline (el : Comment.inline_element Location_.with_location) = match el.Location_.value with | `Space -> " " | `Word w -> w | `Code_span c -> "`" ^ c ^ "`" | `Math_span m -> m | `Raw_markup (_, r) -> r | `Styled (_, content) -> text_of_inlines content | `Reference (_, content) -> text_of_link_content content | `Link (_, content) -> text_of_link_content content and text_of_inlines content = String.concat "" (List.map text_of_inline content) and text_of_link_content content = String.concat "" (List.map text_of_non_link content) and text_of_non_link (el : Comment.non_link_inline_element Location_.with_location) = match el.Location_.value with | `Space -> " " | `Word w -> w | `Code_span c -> "`" ^ c ^ "`" | `Math_span m -> m | `Raw_markup (_, r) -> r | `Styled (_, content) -> text_of_link_content content let text_of_paragraph (p : Comment.paragraph) = String.concat "" (List.map text_of_inline p) (** Extract title, prose, code and focus lines from a single list item *) let extract_step (item : Comment.nestable_block_element Location_.with_location list) : step = let title = ref "" in let prose_parts = ref [] in let code = ref "" in let focus = ref [] in List.iter (fun (el : Comment.nestable_block_element Location_.with_location) -> match el.Location_.value with | `Paragraph p -> ( let text = text_of_paragraph p in (* Check if the paragraph starts with bold text — that's the title *) match p with | first :: _ when (match first.Location_.value with | `Styled (`Bold, _) -> true | _ -> false) -> if !title = "" then title := text else prose_parts := text :: !prose_parts | _ -> prose_parts := text :: !prose_parts) | `Code_block { content = code_content; _ } -> let code_text = code_content.Location_.value in (* Check for focus annotation in the code: lines starting with >>> *) let lines = String.split_on_char '\n' code_text in let focused_lines = ref [] in let clean_lines = List.mapi (fun i line -> if String.length line >= 4 && String.sub line 0 4 = "(* >" then ( focused_lines := (i + 1) :: !focused_lines; (* Remove the focus marker *) let rest = String.sub line 4 (String.length line - 4) in let rest = if String.length rest >= 4 && String.sub rest (String.length rest - 4) 4 = "< *)" then String.sub rest 0 (String.length rest - 4) else rest in String.trim rest) else line) lines in code := String.concat "\n" clean_lines; focus := List.rev !focused_lines | `Verbatim v -> prose_parts := v :: !prose_parts | _ -> ()) item; { title = !title; prose = String.concat "\n\n" (List.rev !prose_parts); code = !code; focus = !focus; } (** Extract all steps from the tag content (expects an ordered list) *) let extract_steps (content : Comment.nestable_block_element Location_.with_location list) : string * step list = (* First element might be a paragraph with the tutorial title *) let tutorial_title = ref "Tutorial" in let steps = ref [] in List.iter (fun (el : Comment.nestable_block_element Location_.with_location) -> match el.Location_.value with | `Paragraph p -> let text = text_of_paragraph p in if !steps = [] then tutorial_title := text | `List (`Ordered, items) -> steps := List.map extract_step items | _ -> ()) content; (!tutorial_title, !steps) (** {1 HTML Escaping} *) let html_escape s = let buf = Buffer.create (String.length s) in String.iter (function | '&' -> Buffer.add_string buf "&" | '<' -> Buffer.add_string buf "<" | '>' -> Buffer.add_string buf ">" | '"' -> Buffer.add_string buf """ | c -> Buffer.add_char buf c) s; Buffer.contents buf (** {1 Diff Computation} *) type diff_line = | Same of string | Added of string | Removed of string (** Simple LCS-based line diff between two code strings *) let diff_lines old_code new_code = let old_lines = String.split_on_char '\n' old_code |> Array.of_list in let new_lines = String.split_on_char '\n' new_code |> Array.of_list in let n = Array.length old_lines in let m = Array.length new_lines in let dp = Array.make_matrix (n + 1) (m + 1) 0 in for i = 1 to n do for j = 1 to m do if old_lines.(i-1) = new_lines.(j-1) then dp.(i).(j) <- dp.(i-1).(j-1) + 1 else dp.(i).(j) <- max dp.(i-1).(j) dp.(i).(j-1) done done; let result = ref [] in let i = ref n and j = ref m in while !i > 0 || !j > 0 do if !i > 0 && !j > 0 && old_lines.(!i-1) = new_lines.(!j-1) then begin result := Same old_lines.(!i-1) :: !result; decr i; decr j end else if !j > 0 && (!i = 0 || dp.(!i).(!j-1) >= dp.(!i-1).(!j)) then begin result := Added new_lines.(!j-1) :: !result; decr j end else begin result := Removed old_lines.(!i-1) :: !result; decr i end done; !result (** {1 OCaml Syntax Highlighting} A simple lexer-based highlighter for OCaml code. Produces HTML spans with classes for keywords, types, strings, comments, operators. *) let ocaml_keywords = [ "let"; "in"; "if"; "then"; "else"; "match"; "with"; "fun"; "function"; "type"; "module"; "struct"; "sig"; "end"; "open"; "include"; "val"; "rec"; "and"; "of"; "when"; "as"; "begin"; "do"; "done"; "for"; "to"; "while"; "downto"; "try"; "exception"; "raise"; "mutable"; "ref"; "true"; "false"; "assert"; "failwith"; "not"; ] let ocaml_types = [ "int"; "float"; "string"; "bool"; "unit"; "list"; "option"; "array"; "char"; "bytes"; "result"; "exn"; "ref"; ] (** Tokenize and highlight OCaml code into HTML *) let highlight_ocaml code = let len = String.length code in let buf = Buffer.create (len * 2) in let i = ref 0 in let peek () = if !i < len then Some code.[!i] else None in let advance () = incr i in let current () = code.[!i] in while !i < len do match current () with (* Comments *) | '(' when !i + 1 < len && code.[!i + 1] = '*' -> Buffer.add_string buf ""; Buffer.add_string buf "(*"; i := !i + 2; let depth = ref 1 in while !depth > 0 && !i < len do if !i + 1 < len && code.[!i] = '(' && code.[!i + 1] = '*' then ( Buffer.add_string buf "(*"; i := !i + 2; incr depth) else if !i + 1 < len && code.[!i] = '*' && code.[!i + 1] = ')' then ( Buffer.add_string buf "*)"; i := !i + 2; decr depth) else ( Buffer.add_string buf (html_escape (String.make 1 code.[!i])); advance ()) done; Buffer.add_string buf "" (* Strings *) | '"' -> Buffer.add_string buf ""; Buffer.add_char buf '"'; advance (); while !i < len && current () <> '"' do if current () = '\\' && !i + 1 < len then ( Buffer.add_string buf (html_escape (String.make 1 (current ()))); advance (); Buffer.add_string buf (html_escape (String.make 1 (current ()))); advance ()) else ( Buffer.add_string buf (html_escape (String.make 1 (current ()))); advance ()) done; if !i < len then ( Buffer.add_char buf '"'; advance ()); Buffer.add_string buf "" (* Char literals *) | '\'' when !i + 2 < len && code.[!i + 2] = '\'' -> Buffer.add_string buf ""; Buffer.add_char buf '\''; advance (); Buffer.add_string buf (html_escape (String.make 1 (current ()))); advance (); Buffer.add_char buf '\''; advance (); Buffer.add_string buf "" (* Numbers *) | '0' .. '9' -> Buffer.add_string buf ""; while !i < len && match current () with | '0' .. '9' | '.' | '_' | 'x' | 'o' | 'b' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false do Buffer.add_char buf (current ()); advance () done; Buffer.add_string buf "" (* Identifiers and keywords *) | 'a' .. 'z' | '_' -> let start = !i in while !i < len && match current () with | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '\'' -> true | _ -> false do advance () done; let word = String.sub code start (!i - start) in if List.mem word ocaml_keywords then Buffer.add_string buf (Printf.sprintf "%s" (html_escape word)) else if List.mem word ocaml_types then Buffer.add_string buf (Printf.sprintf "%s" (html_escape word)) else Buffer.add_string buf (html_escape word) (* Module/constructor names (capitalized identifiers) *) | 'A' .. 'Z' -> let start = !i in while !i < len && match current () with | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '\'' -> true | _ -> false do advance () done; let word = String.sub code start (!i - start) in Buffer.add_string buf (Printf.sprintf "%s" (html_escape word)) (* Operators *) | '|' | '-' | '+' | '*' | '/' | '=' | '<' | '>' | '@' | '^' | '~' | '!' | '?' | '%' | '&' -> Buffer.add_string buf ""; Buffer.add_string buf (html_escape (String.make 1 (current ()))); advance (); (* Consume multi-char operators *) while !i < len && match current () with | '|' | '-' | '+' | '*' | '/' | '=' | '<' | '>' | '@' | '^' | '~' | '!' | '?' | '%' | '&' -> true | _ -> false do Buffer.add_string buf (html_escape (String.make 1 (current ()))); advance () done; Buffer.add_string buf "" (* Punctuation *) | ':' | ';' | '.' | ',' | '[' | ']' | '{' | '}' | '(' | ')' -> Buffer.add_string buf (Printf.sprintf "%s" (html_escape (String.make 1 (current ())))); advance () (* Arrow special case: -> *) | ' ' | '\t' | '\n' | '\r' -> Buffer.add_char buf (current ()); advance () | _ -> let _ = peek () in Buffer.add_string buf (html_escape (String.make 1 (current ()))); advance () done; Buffer.contents buf (** Render a diff as HTML with colored lines *) let render_diff_html diff = let buf = Buffer.create 1024 in List.iter (fun line -> match line with | Same s -> Buffer.add_string buf (Printf.sprintf "
%s
\n" (highlight_ocaml s)) | Added s -> Buffer.add_string buf (Printf.sprintf "
%s
\n" (highlight_ocaml s)) | Removed s -> Buffer.add_string buf (Printf.sprintf "
%s
\n" (highlight_ocaml s))) diff; Buffer.contents buf (** {1 Shared JavaScript} The scrollycode runtime handles IntersectionObserver-based step detection and line-level transition animations. *) let shared_js = {| (function() { 'use strict'; function initScrollycode(container) { var steps = container.querySelectorAll('.sc-step'); var codeBody = container.querySelector('.sc-code-body'); var stepBadge = container.querySelector('.sc-step-badge'); var pips = container.querySelectorAll('.sc-pip'); var currentStep = -1; function parseLines(el) { if (!el) return []; var items = el.querySelectorAll('.sc-line'); return Array.from(items).map(function(line) { return { id: line.dataset.id, html: line.innerHTML, focused: line.classList.contains('sc-focused') }; }); } function renderStep(index) { if (index === currentStep || index < 0 || index >= steps.length) return; var stepEl = steps[index]; var codeSlot = stepEl.querySelector('.sc-code-slot'); var newLines = parseLines(codeSlot); var oldLines = parseLines(codeBody); var oldById = {}; oldLines.forEach(function(l) { oldById[l.id] = l; }); var newById = {}; newLines.forEach(function(l) { newById[l.id] = l; }); // Determine exiting lines var exiting = oldLines.filter(function(l) { return !newById[l.id]; }); // Animate exit exiting.forEach(function(l, i) { var el = codeBody.querySelector('[data-id="' + l.id + '"]'); if (el) { el.style.animationDelay = (i * 30) + 'ms'; el.classList.add('sc-exiting'); } }); var exitTime = exiting.length > 0 ? 200 + exiting.length * 30 : 0; setTimeout(function() { // Rebuild DOM codeBody.innerHTML = ''; var firstNew = null; newLines.forEach(function(l, i) { var div = document.createElement('div'); var isNew = !oldById[l.id]; div.className = 'sc-line' + (l.focused ? ' sc-focused' : '') + (isNew ? ' sc-entering' : ''); div.dataset.id = l.id; div.innerHTML = '' + (i + 1) + '' + l.html; if (isNew) { div.style.animationDelay = (i * 25) + 'ms'; if (!firstNew) firstNew = div; } codeBody.appendChild(div); }); // Scroll to first new line, with some context above if (firstNew) { var lineH = firstNew.offsetHeight || 24; var scrollTarget = firstNew.offsetTop - lineH * 2; codeBody.scrollTo({ top: Math.max(0, scrollTarget), behavior: 'smooth' }); } // Update badge and pips if (stepBadge) stepBadge.textContent = (index + 1) + ' / ' + steps.length; pips.forEach(function(pip, i) { pip.classList.toggle('sc-active', i === index); }); }, exitTime); currentStep = index; } // Set up IntersectionObserver var observer = new IntersectionObserver(function(entries) { entries.forEach(function(entry) { if (entry.isIntersecting) { var idx = parseInt(entry.target.dataset.stepIndex, 10); renderStep(idx); } }); }, { rootMargin: '-30% 0px -30% 0px', threshold: 0 }); steps.forEach(function(step) { observer.observe(step); }); // Initialize first step renderStep(0); // Playground overlay var overlay = document.getElementById('sc-playground-overlay'); var closeBtn = overlay ? overlay.querySelector('.sc-playground-close') : null; if (overlay && closeBtn) { // Close button closeBtn.addEventListener('click', function() { overlay.classList.remove('sc-open'); }); // ESC key closes document.addEventListener('keydown', function(e) { if (e.key === 'Escape') overlay.classList.remove('sc-open'); }); // Click outside closes overlay.addEventListener('click', function(e) { if (e.target === overlay) overlay.classList.remove('sc-open'); }); } // Try it buttons container.querySelectorAll('.sc-playground-btn').forEach(function(btn) { btn.addEventListener('click', function() { var stepIndex = parseInt(btn.dataset.step, 10); // Collect code from all steps up to and including this one var allCode = []; for (var si = 0; si <= stepIndex; si++) { var slot = steps[si].querySelector('.sc-code-slot'); if (slot) { var lines = slot.querySelectorAll('.sc-line'); var code = Array.from(lines).map(function(l) { return l.textContent.replace(/^\d+/, ''); }).join('\n'); allCode.push(code); } } var fullCode = allCode.join('\n\n'); var editor = document.getElementById('sc-playground-x-ocaml'); if (editor) { editor.textContent = fullCode; // Trigger re-initialization if x-ocaml supports it if (editor.setSource) editor.setSource(fullCode); } if (overlay) overlay.classList.add('sc-open'); }); }); } // Initialize any uninitialised scrollycode containers. function initAll() { document.querySelectorAll('.sc-container').forEach(function(c) { if (!c.dataset.scInit) { c.dataset.scInit = '1'; initScrollycode(c); } }); } // Run now if DOM is ready, otherwise wait. if (document.readyState === 'loading') { document.addEventListener('DOMContentLoaded', function() { initAll(); // Watch for new containers added by SPA navigation. new MutationObserver(function() { initAll(); }) .observe(document.body, { childList: true, subtree: true }); }); } else { initAll(); new MutationObserver(function() { initAll(); }) .observe(document.body, { childList: true, subtree: true }); } })(); |} (** {1 HTML Generation} *) (** Generate the code lines HTML for a step's code slot *) let generate_code_lines code focus = let lines = String.split_on_char '\n' code in let buf = Buffer.create 1024 in List.iteri (fun i line -> let line_num = i + 1 in let focused = focus = [] || List.mem line_num focus in let highlighted = highlight_ocaml line in Buffer.add_string buf (Printf.sprintf "
%s
\n" (if focused then " sc-focused" else "") line_num highlighted)) lines; Buffer.contents buf (** Generate the mobile stacked layout with diffs between steps *) let generate_mobile_html steps = let buf = Buffer.create 8192 in Buffer.add_string buf "
\n"; let prev_code = ref None in List.iteri (fun i step -> Buffer.add_string buf (Printf.sprintf "
\n"); Buffer.add_string buf (Printf.sprintf "
Step %02d
\n" (i + 1)); if step.title <> "" then Buffer.add_string buf (Printf.sprintf "

%s

\n" (html_escape step.title)); if step.prose <> "" then Buffer.add_string buf (Printf.sprintf "

%s

\n" (html_escape step.prose)); (* Diff block *) Buffer.add_string buf "
\n"; let diff = match !prev_code with | None -> List.map (fun l -> Added l) (String.split_on_char '\n' step.code) | Some prev -> diff_lines prev step.code in Buffer.add_string buf (render_diff_html diff); Buffer.add_string buf "
\n"; Buffer.add_string buf (Printf.sprintf " \n" i); Buffer.add_string buf "
\n"; prev_code := Some step.code) steps; Buffer.add_string buf "
\n"; Buffer.contents buf (** Generate the full scrollycode HTML. Theme styling is handled externally via CSS — this produces theme-agnostic semantic HTML. *) let generate_html ~title ~filename steps = let buf = Buffer.create 16384 in (* Container — no theme class, CSS custom properties handle theming *) Buffer.add_string buf "
\n"; (* Hero *) Buffer.add_string buf "
\n"; Buffer.add_string buf (Printf.sprintf "

%s

\n" (html_escape title)); Buffer.add_string buf "
\n"; (* Progress pips *) Buffer.add_string buf "\n"; (* Desktop layout *) Buffer.add_string buf "
\n"; Buffer.add_string buf "
\n"; (* Steps column *) Buffer.add_string buf "
\n"; List.iteri (fun i step -> Buffer.add_string buf (Printf.sprintf "
\n" i); Buffer.add_string buf (Printf.sprintf "
Step %02d
\n" (i + 1)); if step.title <> "" then Buffer.add_string buf (Printf.sprintf "

%s

\n" (html_escape step.title)); if step.prose <> "" then Buffer.add_string buf (Printf.sprintf "

%s

\n" (html_escape step.prose)); (* Hidden code slot for JS to read *) Buffer.add_string buf "
\n"; Buffer.add_string buf (generate_code_lines step.code step.focus); Buffer.add_string buf "
\n"; Buffer.add_string buf (Printf.sprintf " \n" i); Buffer.add_string buf "
\n") steps; Buffer.add_string buf "
\n"; (* Code column *) Buffer.add_string buf "
\n"; Buffer.add_string buf "
\n"; Buffer.add_string buf "
\n"; Buffer.add_string buf "
\n"; Buffer.add_string buf (Printf.sprintf " %s\n" (html_escape filename)); Buffer.add_string buf (Printf.sprintf " 1 / %d\n" (List.length steps)); Buffer.add_string buf "
\n"; Buffer.add_string buf "
\n"; (* Initial code from first step *) (match steps with | first :: _ -> Buffer.add_string buf (generate_code_lines first.code first.focus) | [] -> ()); Buffer.add_string buf "
\n"; Buffer.add_string buf "
\n"; Buffer.add_string buf "
\n"; Buffer.add_string buf "
\n"; Buffer.add_string buf "
\n"; (* Mobile stacked layout *) Buffer.add_string buf (generate_mobile_html steps); (* Playground overlay *) Buffer.add_string buf {|
Playground
|}; Buffer.contents buf (** {1 Extension Registration} *) let meta_tag_script name value = Printf.sprintf {|(function(){var m=document.createElement('meta');m.name='%s';m.content='%s';document.head.appendChild(m)})();|} name value module Scrolly : Odoc_extension_api.Extension = struct let prefix = "scrolly" let to_document ~tag:_ content = let tutorial_title, steps = extract_steps content in let filename = "main.ml" in let html = generate_html ~title:tutorial_title ~filename steps in let block : Block.t = [ { Odoc_document.Types.Block.attr = [ "scrollycode" ]; desc = Raw_markup ("html", html); }; ] in let x_ocaml_worker_url = match Sys.getenv_opt "ODOC_X_OCAML_WORKER" with | Some url -> url | None -> "../odoc-interactive-extension/universe/worker.js" in { Odoc_extension_api.content = block; overrides = []; resources = [ Css_url "extensions/scrollycode.css"; Js_url "extensions/scrollycode.js"; Js_inline (meta_tag_script "x-ocaml-backend" "jtw"); Js_inline (meta_tag_script "x-ocaml-worker" x_ocaml_worker_url); Js_url "_x-ocaml/x-ocaml.js"; ]; assets = []; } end (* Register extension and structural CSS support file. *) let () = Odoc_extension_api.Registry.register (module Scrolly); Odoc_extension_api.Registry.register_support_file ~prefix:"scrolly" { filename = "extensions/scrollycode.css"; content = Inline Scrollycode_css.structural_css; }; Odoc_extension_api.Registry.register_support_file ~prefix:"scrolly" { filename = "extensions/scrollycode.js"; content = Inline shared_js; }; (* Find x-ocaml.js: env var, then dune build install dir (walk up from CWD). *) let x_ocaml_js_path = match Sys.getenv_opt "ODOC_X_OCAML_JS_PATH" with | Some p -> Some p | None -> let target = "_build/install/default/share/x-ocaml/x-ocaml.js" in let rec walk dir = let candidate = Filename.concat dir target in if Sys.file_exists candidate then Some candidate else let parent = Filename.dirname dir in if parent = dir then None else walk parent in walk (Sys.getcwd ()) in (match x_ocaml_js_path with | Some path -> Odoc_extension_api.Registry.register_support_file ~prefix:"scrolly" { filename = "_x-ocaml/x-ocaml.js"; content = Copy_from path; } | None -> ())