Base
diff --git a/Src/UHTMLSnippetDoc.pas b/Src/UHTMLSnippetDoc.pas
new file mode 100644
index 000000000..27ca5d861
--- /dev/null
+++ b/Src/UHTMLSnippetDoc.pas
@@ -0,0 +1,528 @@
+{
+ * This Source Code Form is subject to the terms of the Mozilla Public License,
+ * v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ * obtain one at https://mozilla.org/MPL/2.0/
+ *
+ * Copyright (C) 2025, Peter Johnson (gravatar.com/delphidabbler).
+ *
+ * Implements a class that renders a HTML document that describes a snippet.
+}
+
+
+unit UHTMLSnippetDoc;
+
+interface
+
+uses
+ // Delphi
+ SysUtils,
+ Graphics,
+ // Project
+ ActiveText.UHTMLRenderer,
+ ActiveText.UMain,
+ Hiliter.UGlobals,
+ UColours,
+ UEncodings,
+ UHTMLBuilder,
+ UHTMLUtils,
+ UIStringList,
+ USnippetDoc;
+
+type
+ THTMLSnippetDocClass = class of THTMLSnippetDoc;
+
+ /// Abstract base class for classes that render a document that
+ /// describes a snippet using HTML.
+ THTMLSnippetDoc = class abstract (TSnippetDoc)
+ strict private
+ var
+ /// Attributes that determine the formatting of highlighted
+ /// source code.
+ fHiliteAttrs: IHiliteAttrs;
+ /// Flag indicates whether to output in colour.
+ fUseColour: Boolean;
+ /// Object used to build HTML source code document.
+ fDocument: TStringBuilder;
+ /// Type of class used to generate the HTML of the snippet's
+ /// source code and to provide addition HTML information.
+ fBuilderClass: THTMLBuilderClass;
+ /// Static class used to generate HTML tags.
+ fTagGen: THTMLClass;
+ const
+ /// Colour of plain text in the HTML document.
+ TextColour = clBlack;
+ /// Colour of HTML links in the document.
+ LinkColour = clExternalLink;
+ /// Colour of warning text in the HTML document.
+ WarningColour = clWarningText;
+ /// Colour used for <var> tags in the HTML document.
+ ///
+ VarColour = clVarText;
+
+ // Names of various HTML tags used in the document
+ HTMLTag = 'html';
+ HeadTag = 'head';
+ TitleTag = 'title';
+ BodyTag = 'body';
+ H1Tag = 'h1';
+ H2Tag = 'h2';
+ DivTag = 'div';
+ ParaTag = 'p';
+ StrongTag = 'strong';
+ EmphasisTag = 'em';
+ CodeTag = 'code';
+ LinkTag = 'a';
+ StyleTag = 'style';
+ TableTag = 'table';
+ TableBodyTag = 'tbody';
+ TableRowTag = 'tr';
+ TableColTag = 'td';
+
+ // Names of HTML attributes used in the document
+ ClassAttr = 'class';
+
+ // Names of HTML classes used in the document
+ DBInfoClass = 'db-info';
+ MainDBClass = 'main-db';
+ UserDBClass = 'user-db';
+ IndentClass = 'indent';
+ WarningClass = 'warning';
+
+ /// Name of document body font.
+ BodyFontName = 'Tahoma';
+ /// Size of paragraph font, in points.
+ BodyFontSize = 10; // points
+ /// Size of H1 heading font, in points.
+ H1FontSize = 14; // points
+ /// Size of H2 heading font, in points.
+ H2FontSize = 12; // points
+ /// Size of font used for database information, in points.
+ ///
+ DBInfoFontSize = 9; // points
+
+ strict private
+ /// Creates and returns the inline CSS used in the HTML document.
+ ///
+ function BuildCSS: string;
+ /// Renders the given active text as HTML.
+ function ActiveTextToHTML(ActiveText: IActiveText): string;
+ strict protected
+ /// Returns a reference to the builder class used to create the
+ /// required flavour of HTML.
+ function BuilderClass: THTMLBuilderClass; virtual; abstract;
+ /// Initialises the HTML document.
+ procedure InitialiseDoc; override;
+ /// Adds the given heading (i.e. snippet name) to the document.
+ /// Can be user defined or from main database.
+ /// The heading is coloured according to whether user defined or
+ /// not iff coloured output is required.
+ procedure RenderHeading(const Heading: string; const UserDefined: Boolean);
+ override;
+ /// Adds the given snippet description to the document.
+ /// Active text formatting is observed and styled to suit the
+ /// document.
+ procedure RenderDescription(const Desc: IActiveText); override;
+ /// Highlights the given source code and adds it to the document.
+ ///
+ procedure RenderSourceCode(const SourceCode: string); override;
+ /// Adds the given title, followed by the given text, to the
+ /// document.
+ procedure RenderTitledText(const Title, Text: string); override;
+ /// Adds a comma-separated list of text, preceded by the given
+ /// title, to the document.
+ procedure RenderTitledList(const Title: string; List: IStringList);
+ override;
+ /// Outputs the given compiler test info, preceded by the given
+ /// heading.
+ procedure RenderCompilerInfo(const Heading: string;
+ const Info: TCompileDocInfoArray); override;
+ /// Outputs the given message stating that there is no compiler
+ /// test info, preceded by the given heading.
+ procedure RenderNoCompilerInfo(const Heading, NoCompileTests: string);
+ override;
+ /// Adds the given extra information about the snippet to the
+ /// document.
+ /// Active text formatting is observed and styled to suit the
+ /// document.
+ procedure RenderExtra(const ExtraText: IActiveText); override;
+ /// Adds the given information about a code snippets database to
+ /// the document.
+ procedure RenderDBInfo(const Text: string); override;
+ /// Finalises the document and returns its content as encoded
+ /// data.
+ function FinaliseDoc: TEncodedData; override;
+ public
+ /// Constructs an object to render snippet information.
+ /// IHiliteAttrs [in] Defines the style of
+ /// syntax highlighting to be used for the source code.
+ /// Boolean [in] Set True to render
+ /// the document in colour or False for black and white.
+ constructor Create(const HiliteAttrs: IHiliteAttrs;
+ const UseColour: Boolean = True);
+ /// Destroys the object.
+ destructor Destroy; override;
+ end;
+
+ /// Class that renders a document that describes a snippet using
+ /// XHTML.
+ TXHTMLSnippetDoc = class sealed (THTMLSnippetDoc)
+ strict protected
+ /// Returns a reference to the builder class used to create valid
+ /// XHTML.
+ function BuilderClass: THTMLBuilderClass; override;
+ end;
+
+ /// Class that renders a document that describes a snippet using
+ /// HTML 5.
+ THTML5SnippetDoc = class sealed (THTMLSnippetDoc)
+ strict protected
+ /// Returns a reference to the builder class used to create valid
+ /// HTML 5.
+ function BuilderClass: THTMLBuilderClass; override;
+ end;
+
+implementation
+
+uses
+ // Project
+ Hiliter.UCSS,
+ Hiliter.UHiliters,
+ UCSSBuilder,
+ UCSSUtils,
+ UFontHelper,
+ UPreferences;
+
+{ THTMLSnippetDoc }
+
+function THTMLSnippetDoc.ActiveTextToHTML(ActiveText: IActiveText): string;
+var
+ HTMLWriter: TActiveTextHTML; // Object that generates HTML from active text
+begin
+ HTMLWriter := TActiveTextHTML.Create(fTagGen);
+ try
+ Result := HTMLWriter.Render(ActiveText);
+ finally
+ HTMLWriter.Free;
+ end;
+end;
+
+function THTMLSnippetDoc.BuildCSS: string;
+var
+ CSS: TCSSBuilder;
+ HiliterCSS: THiliterCSS;
+ BodyFont: TFont; // default content font sized per preferences
+ MonoFont: TFont; // default mono font sized per preferences
+begin
+ BodyFont := nil;
+ MonoFont := nil;
+ CSS := TCSSBuilder.Create;
+ try
+ MonoFont := TFont.Create;
+ TFontHelper.SetDefaultMonoFont(MonoFont);
+ BodyFont := TFont.Create;
+ BodyFont.Name := BodyFontName;
+ BodyFont.Size := BodyFontSize;
+ MonoFont.Size := BodyFontSize;
+
+ // tag style
+ CSS.AddSelector(BodyTag)
+ .AddProperty(TCSS.FontProps(BodyFont))
+ .AddProperty(TCSS.ColorProp(TextColour));
+ // tag style
+ CSS.AddSelector(H1Tag)
+ .AddProperty(TCSS.FontSizeProp(H1FontSize))
+ .AddProperty(TCSS.FontWeightProp(cfwBold))
+ .AddProperty(TCSS.MarginProp(0.75, 0, 0.75, 0, cluEm));
+ // tag
+ CSS.AddSelector(H2Tag)
+ .AddProperty(TCSS.FontSizeProp(H2FontSize));
+ //
tag style
+ CSS.AddSelector(ParaTag)
+ .AddProperty(TCSS.MarginProp(0.5, 0, 0.5, 0, cluEm));
+ //
tag style
+ // note: wanted to use :last-child to style right column, but not supported
+ // by TWebBrowser that is used for the preview
+ CSS.AddSelector(TableTag)
+ .AddProperty(TCSS.MarginProp(0.5, 0, 0.5, 0, cluEm));
+ CSS.AddSelector(TableColTag)
+ .AddProperty(TCSS.PaddingProp(cssRight, 0.5, cluEm))
+ .AddProperty(TCSS.PaddingProp(cssLeft, 0));
+ // tag style
+ CSS.AddSelector(CodeTag)
+ .AddProperty(TCSS.FontProps(MonoFont));
+ // tag style
+ CSS.AddSelector(LinkTag)
+ .AddProperty(TCSS.ColorProp(LinkColour))
+ .AddProperty(TCSS.TextDecorationProp([ctdUnderline]));
+ // tag style
+ CSS.AddSelector('var')
+ .AddProperty(TCSS.ColorProp(VarColour))
+ .AddProperty(TCSS.FontStyleProp(cfsItalic));
+
+ // Set active text list classes
+
+ // list styling
+ CSS.AddSelector('ul, ol')
+ .AddProperty(TCSS.MarginProp(0.5, 0, 0.5, 0, cluEm))
+ .AddProperty(TCSS.PaddingProp(cssAll, 0))
+ .AddProperty(TCSS.PaddingProp(cssLeft, 1.5, cluEm))
+ .AddProperty(TCSS.ListStylePositionProp(clspOutside))
+ .AddProperty(TCSS.ListStyleTypeProp(clstDisc));
+ CSS.AddSelector('ul')
+ .AddProperty(TCSS.ListStyleTypeProp(clstDisc));
+ CSS.AddSelector('ol')
+ .AddProperty(TCSS.ListStyleTypeProp(clstDecimal));
+ CSS.AddSelector('li')
+ .AddProperty(TCSS.PaddingProp(cssAll, 0))
+ .AddProperty(TCSS.MarginProp(0.25, 0, 0.25, 0, cluEm));
+ CSS.AddSelector('li ol, li ul')
+ .AddProperty(TCSS.MarginProp(0.25, 0, 0.25, 0, cluEm));
+ CSS.AddSelector('li li')
+ .AddProperty(TCSS.PaddingProp(cssLeft, 0))
+ .AddProperty(TCSS.MarginProp(0));
+
+ // class used to denote snippet is user defined
+ CSS.AddSelector('.' + UserDBClass)
+ .AddProperty(TCSS.ColorProp(Preferences.DBHeadingColours[True]));
+ // class used for smaller text describing database
+ CSS.AddSelector('.' + DBInfoClass)
+ .AddProperty(TCSS.FontSizeProp(DBInfoFontSize))
+ .AddProperty(TCSS.FontStyleProp(cfsItalic));
+ // class used to indent tag content
+ CSS.AddSelector('.' + IndentClass)
+ .AddProperty(TCSS.MarginProp(cssLeft, 1.5, cluEm));
+
+ // default active text classes
+ CSS.AddSelector('.' + WarningClass)
+ .AddProperty(TCSS.ColorProp(WarningColour))
+ .AddProperty(TCSS.FontWeightProp(cfwBold));
+
+ // CSS used by highlighters
+ fHiliteAttrs.FontSize := BodyFontSize;
+ HiliterCSS := THiliterCSS.Create(fHiliteAttrs);
+ try
+ HiliterCSS.BuildCSS(CSS);
+ finally
+ HiliterCSS.Free;
+ end;
+
+ Result := CSS.AsString;
+ finally
+ BodyFont.Free;
+ MonoFont.Free;
+ CSS.Free;
+ end;
+end;
+
+constructor THTMLSnippetDoc.Create(const HiliteAttrs: IHiliteAttrs;
+ const UseColour: Boolean);
+begin
+ inherited Create;
+ fDocument := TStringBuilder.Create;
+ fBuilderClass := BuilderClass;
+ fTagGen := BuilderClass.TagGenerator;
+ fHiliteAttrs := HiliteAttrs;
+ fUseColour := UseColour;
+end;
+
+destructor THTMLSnippetDoc.Destroy;
+begin
+ fDocument.Free;
+ inherited;
+end;
+
+function THTMLSnippetDoc.FinaliseDoc: TEncodedData;
+begin
+ //
+ fDocument.AppendLine(fTagGen.ClosingTag(BodyTag));
+ //