package miaou-core

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file modal_renderer.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
(*****************************************************************************)
(*                                                                           *)
(* SPDX-License-Identifier: MIT                                              *)
(* Copyright (c) 2025 Nomadic Labs <contact@nomadic-labs.com>                *)
(*                                                                           *)
(*****************************************************************************)
[@@@warning "-32-34-37-69"]

module Logger_capability = Miaou_interfaces.Logger_capability
module Style_context = Miaou_style.Style_context

let debug_enabled =
  lazy
    (let get_env var =
       match Miaou_interfaces.System.get () with
       | Some sys -> sys.get_env_var var
       | None -> Sys.getenv_opt var
     in
     match get_env "MIAOU_TUI_DEBUG_MODAL" with
     | Some ("1" | "true" | "TRUE" | "yes" | "YES") -> true
     | _ -> false)

let dprintf fmt =
  if Lazy.force debug_enabled then Printf.eprintf fmt
  else Printf.ifprintf stdout fmt

(* Append diagnostics using Logger capability if available *)
let append_log line =
  match Logger_capability.get () with
  | Some logger -> logger.logf Debug line
  | None -> ()

let trim_preview (s : string) ~max_lines ~max_chars =
  let lines = String.split_on_char '\n' s in
  let lines =
    let rec take n xs acc =
      match (n, xs) with
      | 0, _ | _, [] -> List.rev acc
      | n, x :: xt -> take (n - 1) xt (x :: acc)
    in
    take max_lines lines []
  in
  let joined = String.concat "\n" lines in
  if String.length joined <= max_chars then joined
  else String.sub joined 0 (max 0 (max_chars - 1)) ^ "…"

let render_overlay ~(cols : int option) ~base ?rows () =
  let frames = Modal_snapshot.get_stack_snapshot () in
  dprintf
    "[DEBUG] Modal_renderer.render_overlay: stack_size=%d\n%!"
    (List.length frames) ;
  if Lazy.force debug_enabled then
    append_log (Printf.sprintf "RENDERER: stack_size=%d" (List.length frames)) ;
  if frames = [] then None
  else
    (* Deduplicate by title keeping last occurrence *)
    let with_idx = List.mapi (fun i fr -> (i, fr)) frames in
    let last_idx =
      List.fold_left
        (fun acc (i, (t, _l, _m, _d, _v)) ->
          let acc = List.remove_assoc t acc in
          (t, i) :: acc)
        []
        with_idx
    in
    let frames =
      List.filter
        (fun (i, (t, _l, _m, _d, _v)) ->
          match List.assoc_opt t last_idx with Some j -> i = j | None -> true)
        with_idx
      |> List.map snd
    in
    dprintf
      "[DEBUG] Modal_renderer.render_overlay: after dedup, rendering %d frames\n\
       %!"
      (List.length frames) ;
    if Lazy.force debug_enabled then
      append_log
        (Printf.sprintf "RENDERER: after_dedup=%d" (List.length frames)) ;
    (* Use the shared modal wrapping helper from miaou_internals to keep
       wrapping logic centralized and testable. *)
    let wrap_content_to_width = Modal_utils.wrap_content_to_width in

    let rendered =
      List.fold_left
        (fun acc
             (title, left_opt, max_width_spec_opt, dim_background, view_thunk)
           ->
          let cols_val = match cols with Some c -> c | None -> 80 in
          let max_width_opt =
            match max_width_spec_opt with
            | None -> None
            | Some spec -> Modal_snapshot.resolve_max_width spec ~cols:cols_val
          in
          (try
             append_log
               (Printf.sprintf
                  "RENDERER_FRAME: title='%s' left=%s max_w=%s dim_bg=%b"
                  title
                  (match left_opt with
                  | Some l -> string_of_int l
                  | None -> "-")
                  (match max_width_opt with
                  | Some w -> string_of_int w
                  | None -> "-")
                  dim_background)
           with _ -> ()) ;
          (* Determine effective left and max_width based on available cols. *)
          let rows_val =
            match rows with
            | Some r -> r
            | None -> List.length (String.split_on_char '\n' base)
          in
          let geom =
            Modal_utils.compute_modal_geometry
              ~cols:cols_val
              ~rows:rows_val
              ~left_opt
              ~max_width_opt
          in
          (* Wrap modal rendering in the current theme context to ensure modals
             inherit styling from the page's theme setup. This includes both the
             view_thunk AND center_modal (for themed borders). If no theme context
             is active, this falls back to Theme.default. *)
          let theme = Style_context.current_theme () in
          let out, content_line_count =
            Style_context.with_theme theme (fun () ->
                let raw_content =
                  view_thunk
                    {
                      LTerm_geom.rows = geom.max_content_h;
                      cols = geom.content_width;
                    }
                in
                (try
                   let preview =
                     trim_preview raw_content ~max_lines:8 ~max_chars:400
                   in
                   append_log
                     (Printf.sprintf
                        "RENDERER_FRAME_PREVIEW: title='%s'\n%s"
                        title
                        preview)
                 with _ -> ()) ;
                let content =
                  wrap_content_to_width raw_content geom.content_width
                in
                let dim_background = dim_background || true in
                (* Derive an adaptive max_height from the current base output lines.
                   Keep a higher floor so content like Select lists isn't clipped by header lines. *)
                let max_height = geom.max_height in
                let modal_out =
                  Miaou_widgets_display.Widgets.center_modal
                    ~cols:(Some cols_val)
                    ~rows:rows_val
                    ~title
                    ~dim_background
                    ~left:geom.left
                    ~max_width:geom.max_width
                    ~max_height
                    ~content
                    ~base:acc
                    ()
                in
                (modal_out, List.length (String.split_on_char '\n' content)))
          in
          (* Compute and store the modal content position for click handling.
             This mirrors center_modal's positioning logic:
             - total_h = 2 (borders) + content_lines
             - top = (rows - total_h) / 2
             - content starts at top + 1 (after top border)
             - left = geom.left, content starts at left + 1 (after left border) *)
          let content_lines = content_line_count in
          let total_h = 2 + content_lines in
          let modal_top = max 0 ((rows_val - total_h) / 2) in
          let content_top = modal_top + 1 in
          (* +1 for top border *)
          let content_left = geom.left + 1 in
          (* +1 for left border *)
          Modal_snapshot.set_rendered_position
            ~top:content_top
            ~left:content_left ;
          (try
             append_log
               (Printf.sprintf
                  "RENDERER_COMPOSED: title='%s' out_len=%d"
                  title
                  (String.length out))
           with _ -> ()) ;
          out)
        base
        frames
    in
    Some rendered