MycLib/GeminiTest/Myc.Api.MarkdownStream.pas

unit Myc.Api.MarkdownStream;

interface

uses
    System.SysUtils,
    System.Classes,
    System.IOUtils,
    System.Threading,
    System.Generics.Collections,
    System.JSON,
    System.Types,
    FMX.WebBrowser;

type
    TBlockType = (btMarkdown, btRawText, btHtml);

    // Manages an incremental Markdown/HTML stream within a TWebBrowser.
    // Supports block-based rendering and collapsible raw text sections.
    IMarkdownStream = interface
        procedure InitializeBrowser(const Browser: TWebBrowser);
        procedure BeginBlock(const AType: TBlockType; const ATitle: string = '');
        procedure Append(const Content: string);
        procedure Clear;
    end;

    TMarkdownStream = class(TInterfacedObject, IMarkdownStream)
    strict private
        type
            TCmd = record
                Func: string;
                Arg: string;
                constructor Create(const F, A: string);
            end;
    strict private
        FBrowser: TWebBrowser;
        FIsReady: Boolean;
        FCommandQueue: TList<TCmd>;
        FTempFileName: string;

        procedure OnDidFinishLoad(Sender: TObject);
        function GetBaseHtml: string;
        procedure ExecuteJS(const FunctionName, Data: string);
        procedure FlushQueue;
        function BlockTypeToString(const AType: TBlockType): string;
    public
        constructor Create;
        destructor Destroy; override;
        procedure InitializeBrowser(const Browser: TWebBrowser);

        procedure BeginBlock(const AType: TBlockType; const ATitle: string = '');
        procedure Append(const Content: string);
        procedure Clear;
    end;

implementation

{ TMarkdownStream.TCmd }

constructor TMarkdownStream.TCmd.Create(const F, A: string);
begin
    Func := F;
    Arg := A;
end;

{ TMarkdownStream }

constructor TMarkdownStream.Create;
begin
    inherited;
    FCommandQueue := TList<TCmd>.Create;
    FIsReady := False;
    FTempFileName := TPath.Combine(TPath.GetTempPath, 'myc_md_stream.html');
end;

destructor TMarkdownStream.Destroy;
begin
    if Assigned(FBrowser) then
        FBrowser.OnDidFinishLoad := nil;
    FCommandQueue.Free;
    if FileExists(FTempFileName) then
        try
            TFile.Delete(FTempFileName);
        except
        end;
    inherited;
end;

procedure TMarkdownStream.InitializeBrowser(const Browser: TWebBrowser);
begin
    FBrowser := Browser;
    FIsReady := False;
    FCommandQueue.Clear;

    if Assigned(FBrowser) then
    begin
        FBrowser.OnDidFinishLoad := OnDidFinishLoad;
        try
            TFile.WriteAllText(FTempFileName, GetBaseHtml, TEncoding.UTF8);
            FBrowser.Navigate('file://' + FTempFileName);
        except
            on E: Exception do
                ;
        end;
    end;
end;

procedure TMarkdownStream.OnDidFinishLoad(Sender: TObject);
begin
    TThread.ForceQueue(
        nil,
        procedure
        begin
            FIsReady := True;
            FlushQueue;
        end
    );
end;

procedure TMarkdownStream.FlushQueue;
var
    cmd: TCmd;
begin
    if not Assigned(FBrowser) then
        exit;
    for cmd in FCommandQueue do
        ExecuteJS(cmd.Func, cmd.Arg);
    FCommandQueue.Clear;
end;

function TMarkdownStream.BlockTypeToString(const AType: TBlockType): string;
begin
    case AType of
        btMarkdown: Result := 'markdown';
        btRawText: Result := 'text';
        btHtml: Result := 'html';
    end;
end;

procedure TMarkdownStream.BeginBlock(const AType: TBlockType; const ATitle: string);
var
    payload: string;
begin
    payload := BlockTypeToString(AType) + '|' + ATitle;
    if FIsReady then
        ExecuteJS('startBlock', payload)
    else
        FCommandQueue.Add(TCmd.Create('startBlock', payload));
end;

procedure TMarkdownStream.Append(const Content: string);
begin
    if Content.IsEmpty then
        exit;
    if FIsReady then
        ExecuteJS('appendData', Content)
    else
        FCommandQueue.Add(TCmd.Create('appendData', Content));
end;

procedure TMarkdownStream.Clear;
begin
    FCommandQueue.Clear;
    if FIsReady then
        ExecuteJS('clearAll', '')
    else
        FCommandQueue.Add(TCmd.Create('clearAll', ''));
end;

procedure TMarkdownStream.ExecuteJS(const FunctionName, Data: string);
var
    jsCommand: string;
    jsonVal: TJSONValue;
begin
    if not Assigned(FBrowser) then
        exit;

    // Sicherer Umgang mit leeren Daten und korrektes Escaping
    jsonVal := TJSONString.Create(Data);
    try
        jsCommand := Format('window.%s(%s);', [FunctionName, jsonVal.ToJSON]);
        try
            FBrowser.EvaluateJavaScript(jsCommand);
        except
            // Browser-Context evtl. während der Zerstörung nicht mehr valide
        end;
    finally
        jsonVal.Free;
    end;
end;

function TMarkdownStream.GetBaseHtml: string;
var
    rs: TResourceStream;
    ss: TStringStream;
begin
    // Load HTML template from embedded resource (which is Myc.Api.MarkdownStream.Base.html)
    rs := TResourceStream.Create(HInstance, 'BASE_HTML', RT_RCDATA);
    try
        ss := TStringStream.Create('', TEncoding.UTF8);
        try
            ss.CopyFrom(rs, 0);
            Result := ss.DataString;
        finally
            ss.Free;
        end;
    finally
        rs.Free;
    end;
end;

end.