program ISHelpGen;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
StrUtils,
Classes,
ActiveX,
ComObj,
TypInfo,
XMLParse in 'XMLParse.pas',
UIsxclassesParser in 'UIsxclassesParser.pas',
PathFunc in '..\..\Components\PathFunc.pas';
const
Version = '1.23';
XMLFileVersion = '1';
SNewLine = #13#10;
type
TElement = (
el_Text,
elA,
elAnchorLink,
elB,
elBody,
elBR,
elContents,
elContentsHeading,
elContentsTopic,
elDD,
elDL,
elDT,
elExample,
elExamples,
elExtLink,
elFlag,
elFlagList,
elHeading,
elI,
elImg,
elIndent,
elKeyword,
elLI,
elLink,
elOL,
elP,
elParam,
elParamList,
elPre,
elPreCode,
elSetupDefault,
elSetupFormat,
elSetupValid,
elSetupTopic,
elSmall,
elTable,
elTD,
elTopic,
elTR,
elTT,
elU,
elUL);
TElementSet = set of TElement;
TKeywordInfo = class
public
Topic, Anchor: String;
end;
var
SourceDir, OutputDir: String;
NoContentsHtm: Boolean;
Keywords, DefinedTopics, TargetTopics, SetupDirectives: TStringList;
TopicsGenerated: Integer = 0;
CurrentTopicName: String;
CurrentListIsCompact: Boolean;
CurrentTableColumnIndex: Integer;
procedure UnexpectedElementError(const Node: IXMLNode);
begin
raise Exception.CreateFmt('Element "%s" is unexpected here', [Node.NodeName]);
end;
function ElementFromNode(const Node: IXMLNode): TElement;
var
I: Integer;
begin
case Node.NodeType of
NODE_ELEMENT:
begin
I := GetEnumValue(TypeInfo(TElement), 'el' + Node.NodeName);
if I < 0 then
raise Exception.CreateFmt('Unknown element "%s"', [Node.NodeName]);
Result := TElement(I);
end;
NODE_TEXT, NODE_ENTITY_REFERENCE: Result := el_Text;
else
raise Exception.CreateFmt('ElementFromNode: Unknown node type %d', [Node.NodeType]);
end;
end;
function IsWhitespace(const Node: IXMLNode): Boolean;
{ Returns True if the node is text that consists only of whitespace }
var
S: String;
I: Integer;
begin
Result := False;
if Node.NodeType = NODE_TEXT then begin
S := Node.Text;
for I := 1 to Length(S) do
if not CharInSet(S[I], [#9, #10, ' ']) then
Exit;
Result := True;
end;
end;
function IsFirstNonWhitespaceNode(Node: IXMLNode): Boolean;
{ Returns True if there are no preceding non-whitespace sibling elements }
begin
repeat
Node := Node.PreviousSibling;
until (Node = nil) or not IsWhitespace(Node);
Result := (Node = nil);
end;
function IsLastNonWhitespaceNode(Node: IXMLNode): Boolean;
{ Returns True if no non-whitespace sibling elements follow }
begin
repeat
Node := Node.NextSibling;
until (Node = nil) or not IsWhitespace(Node);
Result := (Node = nil);
end;
function NodeHasChildren(Node: IXMLNode): Boolean;
{ Returns True if the node has non-whitespace children }
begin
Node := Node.GetFirstChild;
while Assigned(Node) do begin
if not IsWhitespace(Node) then begin
Result := True;
Exit;
end;
Node := Node.NextSibling;
end;
Result := False;
end;
function ListItemExists(const SL: TStrings; const S: String): Boolean;
var
I: Integer;
begin
for I := 0 to SL.Count-1 do
if SL[I] = S then begin
Result := True;
Exit;
end;
Result := False;
end;
function StringChange(var S: String; const FromStr, ToStr: String): Integer;
var
FromStrLen, I, EndPos, J: Integer;
IsMatch: Boolean;
label 1;
begin
Result := 0;
if FromStr = '' then Exit;
FromStrLen := Length(FromStr);
I := 1;
1:EndPos := Length(S) - FromStrLen + 1;
while I <= EndPos do begin
IsMatch := True;
J := 0;
while J < FromStrLen do begin
if S[J+I] <> FromStr[J+1] then begin
IsMatch := False;
Break;
end;
Inc(J);
end;
if IsMatch then begin
Inc(Result);
Delete(S, I, FromStrLen);
Insert(ToStr, S, I);
Inc(I, Length(ToStr));
goto 1;
end;
Inc(I);
end;
end;
procedure SaveStringToFile(const S, Filename: String);
var
F: TFileStream;
U: UTF8String;
begin
F := TFileStream.Create(Filename, fmCreate);
try
U := UTF8String(S);
F.WriteBuffer(U[1], Length(U));
finally
F.Free;
end;
end;
function EscapeHTML(const S: String; const EscapeDoubleQuotes: Boolean = True): String;
begin
Result := S;
StringChange(Result, '&', '&');
StringChange(Result, '<', '<');
StringChange(Result, '>', '>');
if EscapeDoubleQuotes then
StringChange(Result, '"', '"');
{ Also convert the Unicode representation of a non-breaking space into
so it's easily to tell them apart from normal spaces when viewing the
generated HTML source }
StringChange(Result, #$00A0, ' ');
end;
procedure CheckTopicNameValidity(const TopicName: String);
var
I: Integer;
begin
if TopicName = '' then
raise Exception.Create('Topic name cannot be empty');
{ Security: Make sure topic names don't include slashes etc. }
for I := 1 to Length(TopicName) do
if not CharInSet(TopicName[I], ['A'..'Z', 'a'..'z', '0'..'9', '_', '-']) then
raise Exception.CreateFmt('Topic name "%s" includes invalid characters', [TopicName]);
end;
procedure CheckAnchorNameValidity(const AnchorName: String);
var
I: Integer;
begin
if AnchorName = '' then
raise Exception.Create('Anchor name cannot be empty');
for I := 1 to Length(AnchorName) do
if not CharInSet(AnchorName[I], ['A'..'Z', 'a'..'z', '0'..'9', '_', '-', '.']) then
raise Exception.CreateFmt('Anchor name "%s" includes invalid characters', [AnchorName]);
end;
function GenerateTopicFilename(const TopicName: String): String;
begin
CheckTopicNameValidity(TopicName);
Result := 'topic_' + Lowercase(TopicName) + '.htm';
end;
function GenerateTopicLink(const TopicName, AnchorName: String): String;
begin
if TopicName <> '' then
Result := GenerateTopicFileName(TopicName)
else begin
Result := '';
if AnchorName = '' then
raise Exception.Create('Cannot create link with neither a target topic nor anchor');
end;
if AnchorName <> '' then begin
CheckAnchorNameValidity(AnchorName);
Result := Result + '#' + AnchorName;
end;
end;
function GenerateAnchorHTML(const AnchorName, InnerContents: String): String;
{ Generates HTML for an anchor on the current topic, also updating
DefinedTopics and checking for duplicates }
var
S: String;
begin
if CurrentTopicName = '' then
raise Exception.Create('Cannot create anchor outside of topic');
CheckAnchorNameValidity(AnchorName);
S := CurrentTopicName + '#' + AnchorName;
if ListItemExists(DefinedTopics, S) then
raise Exception.CreateFmt('Anchor name "%s" in topic "%s" defined more than once',
[AnchorName, CurrentTopicName]);
DefinedTopics.Add(S);
Result := Format('%s', [EscapeHTML(AnchorName), InnerContents]);
end;
function GenerateTopicLinkHTML(const TopicName, AnchorName, InnerContents: String): String;
{ Generates HTML for a link to a topic and/or anchor, also updating
TargetTopics }
var
S: String;
begin
if TopicName <> '' then
S := TopicName
else begin
S := CurrentTopicName;
if S = '' then
raise Exception.Create('Cannot create link outside of topic with empty target topic');
if AnchorName = '' then
raise Exception.Create('Cannot create link with neither a target topic nor anchor');
end;
CheckTopicNameValidity(S);
if AnchorName <> '' then begin
CheckAnchorNameValidity(AnchorName);
S := S + '#' + AnchorName;
end;
if not ListItemExists(TargetTopics, S) then
TargetTopics.Add(S);
Result := Format('%s',
[EscapeHTML(GenerateTopicLink(TopicName, AnchorName)), InnerContents]);
end;
procedure CreateKeyword(const AKeyword, ATopicName, AAnchorName: String);
var
KeywordInfo: TKeywordInfo;
begin
KeywordInfo := TKeywordInfo.Create;
KeywordInfo.Topic := ATopicName;
KeywordInfo.Anchor := AAnchorName;
Keywords.AddObject(AKeyword, KeywordInfo);
end;
function ParseFormattedText(Node: IXMLNode): String;
var
S: String;
I: Integer;
B: Boolean;
begin
Result := '';
Node := Node.FirstChild;
while Assigned(Node) do begin
const Element = ElementFromNode(Node);
case Element of
el_Text:
Result := Result + EscapeHTML(Node.Text, False);
elA:
begin
S := Node.Attributes['name'];
Result := Result + GenerateAnchorHTML(S, ParseFormattedText(Node));
end;
elAnchorLink:
begin
S := Node.Attributes['name'];
Result := Result + GenerateTopicLinkHTML('', S, ParseFormattedText(Node));
end;
elB:
Result := Result + '' + ParseFormattedText(Node) + '';
elBR:
Result := Result + ' ';
elDD:
Result := Result + '
' + ParseFormattedText(Node) + '
';
elDL:
Result := Result + '
' + ParseFormattedText(Node) + '
';
elDT:
Result := Result + '
' + ParseFormattedText(Node) + '
';
elExample, elExamples:
begin
Result := Result + '
' + SNewLine;
if Node.OptionalAttributes['noheader'] <> '1' then
Result := Result + '
';
Result := Result + ParseFormattedText(Node) + '
';
end;
elFlag:
begin
S := Node.Attributes['name'];
if CurrentTopicName = '' then
raise Exception.Create(' used outside of topic');
CreateKeyword(S, CurrentTopicName, S);
Result := Result + '
' + GenerateAnchorHTML(S, EscapeHTML(S)) +
'
' + SNewLine + '
' + ParseFormattedText(Node) +
'
';
end;
elFlagList:
Result := Result + '
' + ParseFormattedText(Node) + '
';
elI:
Result := Result + '' + ParseFormattedText(Node) + '';
elImg:
begin
S := EscapeHTML(Node.Attributes['src']);
Result := Result + Format('', [S]);
end;
elIndent:
Result := Result + '
' + ParseFormattedText(Node) + '
';
elLI:
begin
Result := Result + '
' + ParseFormattedText(Node) + '
';
end;
elLink:
begin
S := Node.Attributes['topic'];
Result := Result + GenerateTopicLinkHTML(S, Node.OptionalAttributes['anchor'],
ParseFormattedText(Node));
end;
elExtLink:
begin
S := EscapeHTML(Node.Attributes['href']);
if Pos('ms-its:', S) = 1 then
Result := Result + Format('%s', [S, ParseFormattedText(Node)])
else
Result := Result + Format('%s',
[S, S, ParseFormattedText(Node)]);
end;
elHeading:
begin
if IsFirstNonWhitespaceNode(Node) then
Result := Result + '
'
else
Result := Result + '
';
Result := Result + ParseFormattedText(Node) + '
';
end;
elOL:
Result := Result + '' + ParseFormattedText(Node) + '';
elP:
begin
if Node.HasAttribute('margin') and (Node.Attributes['margin'] = 'no') then
Result := Result + '
' + ParseFormattedText(Node) + '
'
else
Result := Result + '
' + ParseFormattedText(Node) + '
';
end;
elParam:
begin
{ IE doesn't support immediate-child-only selectors in CSS (e.g.
"DL.paramlist > DT") so we have to apply the class to each DT
instead of just on the DL. }
S := Node.Attributes['name'];
if CurrentTopicName = '' then
raise Exception.Create(' used outside of topic');
CreateKeyword(S, CurrentTopicName, S);
Result := Result + '
' + GenerateAnchorHTML(S, EscapeHTML(S)) + '';
if Node.Attributes['required'] = 'yes' then
Result := Result + ' (Required)';
Result := Result + '
' + ParseFormattedText(Node) + '
';
end;
elParamList:
Result := Result + '
' + ParseFormattedText(Node) + '
';
elPre:
begin
Result := Result + '
inside example boxes: Don't include a
bottom margin if
is the last element }
if (ElementFromNode(Node.ParentNode) in [elExample, elExamples]) and
IsLastNonWhitespaceNode(Node) then
Result := Result + ' class="nomargin"';
Result := Result + '>' + ParseFormattedText(Node) + '
';
end;
elPreCode:
Result := Result + '
' + ParseFormattedText(Node) + '
';
elSmall:
Result := Result + '' + ParseFormattedText(Node) + '';
elTable:
Result := Result + '
' + ParseFormattedText(Node) + '
';
elTD:
begin
Result := Result + '
' + ParseFormattedText(Node) + '
';
Inc(CurrentTableColumnIndex);
end;
elTR:
begin
I := CurrentTableColumnIndex;
CurrentTableColumnIndex := 0;
Result := Result + '
' + ParseFormattedText(Node) + '
';
CurrentTableColumnIndex := I;
end;
elTT:
Result := Result + '' + ParseFormattedText(Node) + '';
elU:
Result := Result + '' + ParseFormattedText(Node) + '';
elUL:
begin
B := CurrentListIsCompact;
CurrentListIsCompact := (Node.HasAttribute('appearance') and (Node.Attributes['appearance'] = 'compact'));
Result := Result + '
' + ParseFormattedText(Node) + '
';
CurrentListIsCompact := B;
end;
else
UnexpectedElementError(Node);
end;
Node := Node.NextSibling;
end;
end;
function GenerateSetupDirectiveTopicName(const Directive: String): String;
begin
Result := 'setup_' + Lowercase(Directive);
end;
procedure ParseTopic(const TopicNode: IXMLNode; const SetupTopic: Boolean);
var
TopicDirective, TopicName, TopicTitle: String;
BodyText, SetupFormatText, SetupValidText, SetupDefaultText, S: String;
Node: IXMLNode;
begin
if not SetupTopic then begin
TopicName := TopicNode.Attributes['name'];
TopicTitle := TopicNode.Attributes['title'];
end
else begin
TopicDirective := TopicNode.Attributes['directive'];
TopicName := GenerateSetupDirectiveTopicName(TopicDirective);
CreateKeyword(TopicDirective, TopicName, '');
if TopicNode.HasAttribute('title') then
TopicTitle := '[Setup]: ' + TopicNode.Attributes['title']
else
TopicTitle := '[Setup]: ' + TopicDirective;
end;
CheckTopicNameValidity(TopicName);
if ListItemExists(DefinedTopics, TopicName) then
raise Exception.CreateFmt('Topic "%s" defined more than once', [TopicName]);
DefinedTopics.Add(TopicName);
CurrentTopicName := TopicName;
Node := TopicNode.FirstChild;
while Assigned(Node) do begin
if not IsWhitespace(Node) then begin
case ElementFromNode(Node) of
elBody:
BodyText := ParseFormattedText(Node);
elKeyword:
CreateKeyword(Node.Attributes['value'], TopicName, Node.OptionalAttributes['anchor']);
elSetupDefault:
begin
if not SetupTopic then
raise Exception.Create(' is only valid inside ');
{
is used instead of
since the data could
contain
's of its own, which can't be nested.
NOTE: The space before
is intentional -- as noted in
styles.css, "vertical-align: baseline" doesn't work right on IE6,
but putting a space before works around the problem, at
least when it comes to lining up normal text with a single line
of monospaced text. }
SetupDefaultText := '
Default value:
' +
'
' + ParseFormattedText(Node) +
'
' + SNewLine;
end;
elSetupFormat:
begin
if not SetupTopic then
raise Exception.Create(' is only valid inside ');
{ See comments above! }
SetupFormatText := '
Format:
' +
'
' + ParseFormattedText(Node) +
'
' + SNewLine;
end;
elSetupValid:
begin
if not SetupTopic then
raise Exception.Create(' is only valid inside ');
{ See comments above! }
SetupValidText := '
';
if TopicName = 'whatisinnosetup' then begin
S := S + SNewLine + SNewLine +
'';
end;
if SetupTopic then begin
if (SetupFormatText <> '') or
(SetupValidText <> '') or
(SetupDefaultText <> '') then
S := S + SNewLine + '
',
[EscapeHTML(Title), EscapeHTML(GenerateTopicLink(TopicName, ''))]));
end;
procedure HandleSetupDirectivesNode;
var
I: Integer;
begin
SL.Add('
');
for I := 0 to SetupDirectives.Count-1 do
AddLeaf(SetupDirectives[I], GenerateSetupDirectiveTopicName(SetupDirectives[I]));
SL.Add('
');
end;
procedure HandleNode(const ParentNode: IXMLNode);
var
Node: IXMLNode;
begin
SL.Add('
');
Node := ParentNode.FirstChild;
while Assigned(Node) do begin
if not IsWhitespace(Node) then begin
case ElementFromNode(Node) of
elContentsHeading:
begin
SL.Add(Format('
',
[EscapeHTML(GenerateTopicLink(TopicName, '')), EscapeHTML(Title)]));
end;
procedure HandleSetupDirectivesNode;
var
I: Integer;
begin
for I := 0 to SetupDirectives.Count-1 do
AddLeaf(SetupDirectives[I], GenerateSetupDirectiveTopicName(SetupDirectives[I]));
end;
procedure HandleNode(const ParentNode: IXMLNode);
var
Node: IXMLNode;
begin
Node := ParentNode.FirstChild;
while Assigned(Node) do begin
if not IsWhitespace(Node) then begin
case ElementFromNode(Node) of
elContentsHeading:
begin
Inc(CurHeadingID);
SL.Add(Format('
');
TemplateSL := TStringList.Create;
try
TemplateSL.LoadFromFile(OutputDir + 'contents-template.htm');
S := TemplateSL.Text;
if StringChange(S, '%CONTENTSTABLES%' + SNewLine, SL.Text) <> 1 then
raise Exception.Create('GenerateStaticContents: Unexpected result from StringChange');
TemplateSL.Text := S;
TemplateSL.WriteBOM := False;
TemplateSL.SaveToFile(OutputDir + 'contents.htm', TEncoding.UTF8);
finally
TemplateSL.Free;
end;
finally
SL.Free;
end;
end;
procedure GenerateHTMLHelpIndex;
function MultiKeyword(const Keyword: String): Boolean;
var
I, N: Integer;
begin
N := 0;
for I := 0 to Keywords.Count-1 do begin
if Keywords[I] = Keyword then begin
Inc(N);
if N > 1 then
Break;
end;
end;
Result := N > 1;
end;
var
SL: TStringList;
I: Integer;
Anchor: String;
begin
SL := TStringList.Create;
try
SL.Add('
');
for I := 0 to Keywords.Count-1 do begin
{ If a keyword is used more then once, don't use anchors: the 'Topics Found'
dialog displayed when clicking on such a keyword doesn't display the correct
topic titles anymore for each item with an anchor. Some HTML Help bug, see
http://social.msdn.microsoft.com/Forums/en-US/devdocs/thread/a2ee989e-4488-4edd-b034-745ed91c19e2 }
if not MultiKeyword(Keywords[I]) then
Anchor := TKeywordInfo(Keywords.Objects[I]).Anchor
else
Anchor := '';
SL.Add(Format('