{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: Parser.pas, released 2002-01-06. The Initial Developer of the Original Code is David Polberger Portions created by David Polberger are Copyright (C) 2002 David Polberger. All Rights Reserved. Contributor(s): Cetkovsky Current Version: 2.00 You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Known Issues: Please see the accompanying documentation. Description: Parser.pas provides both the IParser interface, as well as a class providing a default implementation. A class implementing IParser is supposed to parse a string, and return a tree representation represented by a TNodeTree. Note: Documentation for this unit can be found in Doc\Source.txt and Doc\Readme.txt! -----------------------------------------------------------------------------} // $Id: JvLinkLabelParser.pas 10612 2006-05-19 19:04:09Z jfudickar $ unit JvLinkLabelParser; {$I jvcl.inc} interface uses {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} Classes, SysUtils, Graphics, JvLinkLabelTree, JvLinkLabelTools; type IDynamicNodeHandler = interface procedure HandleDynamicNode(out Source: string; const Node: TDynamicNode); end; IParser = interface function Parse(const Text: string): TNodeTree; overload; function Parse(const List: TStringList): TNodeTree; overload; procedure SetDynamicNodeHandler(Handler: IDynamicNodeHandler); procedure AddSourceTreeToDynamicNode(const Node: TDynamicNode; const Source: string); end; IElementEnumerator = interface; TDefaultParser = class(TInterfacedObject, IParser) private FEnum: IElementEnumerator; FDynamicNodeHandler: IDynamicNodeHandler; procedure ParseNode(const Node: TParentNode); protected function GetNodeFromTag(const Tag: string): TNode; virtual; procedure HandleDynamicTag(const Node: TDynamicNode); public procedure SetElementEnumerator(NewEnum: IElementEnumerator); function Parse(const Text: string): TNodeTree; overload; function Parse(const List: TStringList): TNodeTree; overload; procedure SetDynamicNodeHandler(Handler: IDynamicNodeHandler); procedure AddSourceTreeToDynamicNode(const Node: TDynamicNode; const Source: string); end; TElementKind = (ekBeginTag, ekEndTag, ekString); TElement = record Kind: TElementKind; Text: string; end; IElementEnumerator = interface function PopNextElement: TElement; function PeekNextElement: TElement; function IsEndReached: Boolean; end; {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_33_PREPARATION/run/JvLinkLabelParser.pas $'; Revision: '$Revision: 10612 $'; Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} implementation uses JvResources; //=== { TElementEnumerator } ================================================= type TElementEnumerator = class(TInterfacedObject, IElementEnumerator) private FText: string; FPosInText: Integer; FOldPosInText: Integer; // Used to see whether we should use our cached copy FCachedElement: TElement; FNewPosInText: Integer; function GetNextElement(const IncrementPos: Boolean): TElement; public constructor Create(const Text: string); function PopNextElement: TElement; function PeekNextElement: TElement; function IsEndReached: Boolean; end; const OpenTag = '<'; CloseTag = '>'; EndMarker = '/'; constructor TElementEnumerator.Create(const Text: string); begin inherited Create; FPosInText := 1; FOldPosInText := -1; FText := Text; end; function TElementEnumerator.GetNextElement(const IncrementPos: Boolean): TElement; function GetElementKind: TElementKind; var TempString: string; begin TempString := Copy(FText, FPosInText, 2); if Copy(TempString, 1, 2) = OpenTag + EndMarker then // " CloseTag) do Inc(EndPos); Inc(EndPos); Padding := 1; end; begin StartPos := FPosInText; EndPos := FPosInText; Padding := 0; case Kind of ekBeginTag: FindNewTagPos(1); ekEndTag: FindNewTagPos(2); ekString: while (EndPos <= Length(FText)) and (FText[EndPos] <> OpenTag) do Inc(EndPos); end; Result := Copy(FText, StartPos, (EndPos - StartPos - Padding)); FNewPosInText := EndPos; end; begin if IsEndReached then raise EParserError.CreateRes(@RsENoMoreElementsToReturn); if FOldPosInText = FPosInText then // Use cached element Result := FCachedElement else begin FOldPosInText := FPosInText; Result.Kind := GetElementKind; Result.Text := GetElementText(Result.Kind); FCachedElement := Result; end; if IncrementPos then FPosInText := FNewPosInText; end; function TElementEnumerator.IsEndReached: Boolean; begin Result := FPosInText > Length(FText); end; function TElementEnumerator.PeekNextElement: TElement; begin Result := GetNextElement(False); end; function TElementEnumerator.PopNextElement: TElement; begin Result := GetNextElement(True); end; //=== { TDefaultParser } ===================================================== procedure TDefaultParser.AddSourceTreeToDynamicNode(const Node: TDynamicNode; const Source: string); var Parser: TDefaultParser; Tree: TNodeTree; I: Integer; begin Tree := nil; try Parser := TDefaultParser.Create; try Tree := Parser.Parse(Source); finally Parser.Free; end; Tree.Root.OwnsChildren := False; for I := 0 to Tree.Root.Children.Count - 1 do Node.AddChild(Tree.Root.Children[I], Node.Root); finally Tree.Free; end; end; function TDefaultParser.GetNodeFromTag(const Tag: string): TNode; type TTag = (ttBold, ttItalic, ttUnderline, ttColor, ttLink, ttLineBreak, ttParagraphBreak, ttDynamic); var CurrentTag: TTag; UnknownTag: Boolean; //Cetkovsky --> function GetStringFromTag: string; begin if (Pos('=', Tag) > 0) then Result := Copy(Tag, Pos('=', Tag) + 1, Length(Tag)) else Result := ''; end; //<-- Cetkovsky // Bianconi function GetColorFromTag: TColor; var sVar: string; begin Result := clNone; //Cetkovsky --> sVar := GetStringFromTag; //<-- Cetkovsky try Result := StringToColor(sVar); except // Only to avoid raise an exception on invalid color end; end; // End of Bianconi function GetTagFromString: TTag; const TagStrings: array [TTag] of PChar = ('B', 'I', 'U', 'COLOR=', // Bianconi // 'LINK', //Cetkovsky --> 'LINK=', //<-- Cetkovsky 'BR', 'P', 'DYNAMIC'); DontCare = 0; var S: string; begin UnknownTag := False; // Bianconi for Result := Low(TTag) to High(TTag) do begin S := TagStrings[Result]; if (AnsiUpperCase(Tag) = S) or // (Copy(AnsiUpperCase(Tag), 1, Length(TagStrings[Result])) = 'COLOR=') //Cetkovsky --> //We allow style tag without "=" ((Pos('=', S) > 0) and ((Copy(AnsiUpperCase(Tag), 1, Length(S) - 1) = Copy(S, 1, Length(S) - 1)))) then //<-- Cetkovsky Exit; end; //End of Bianconi Result := TTag(DontCare); UnknownTag := True; end; begin { Descendant parsers should override this routine, call inherited and add support for proprietary tags (using custom node objects, which descend from TNode). Note that appropriate modifications need to be made to the renderer as well, either by creating a new class which implements the IRenderer interface, or by extending the TDefaultRenderer class. See this class for more information. } CurrentTag := GetTagFromString; if not UnknownTag then case CurrentTag of ttBold: Result := TStyleNode.Create(fsBold); ttItalic: Result := TStyleNode.Create(fsItalic); ttUnderline: Result := TStyleNode.Create(fsUnderline); // Bianconi ttColor: Result := TColorNode.Create(GetColorFromTag); // End of Bianconi //Cetkovsky --> ttLink: Result := TLinkNode.Create(GetStringFromTag); //<-- Cetkovsky ttLineBreak: Result := TActionNode.Create(atLineBreak); ttParagraphBreak: Result := TActionNode.Create(atParagraphBreak); ttDynamic: Result := TDynamicNode.Create; else Result := TUnknownNode.Create(Tag); end else Result := TUnknownNode.Create(Tag); end; procedure TDefaultParser.HandleDynamicTag(const Node: TDynamicNode); var Source: string; begin if Assigned(FDynamicNodeHandler) then begin FDynamicNodeHandler.HandleDynamicNode(Source, Node); if Source <> '' then AddSourceTreeToDynamicNode(Node, Source); end; end; function TDefaultParser.Parse(const List: TStringList): TNodeTree; begin Result := Parse(List.Text); end; function TDefaultParser.Parse(const Text: string): TNodeTree; begin Result := TNodeTree.Create; FEnum := TElementEnumerator.Create(TStringTools.RemoveCRLF(Text)); try ParseNode(Result.Root); finally FEnum := nil; end; end; procedure TDefaultParser.ParseNode(const Node: TParentNode); var Element: TElement; NewNode: TNode; function EndReached: Boolean; begin Result := FEnum.IsEndReached or (FEnum.PeekNextElement.Kind = ekEndTag); end; function IsNodeContainer(const Node: TNode; const Element: TElement): Boolean; begin { Returns whether the given node is can contain other elements and thus descends from TParentNode. Descendants from this class begin with and end with (for example, and . Nodes that descend from TActionNode shouldn't be terminated with (for example,

). Note that TDynamicNode is special; while it descends from TParentNode, it never contains children at parse-time, thus we shouldn't wait for a redundant . Instead, its contents are supplied before it's rendered by compiled program code. } Result := (Element.Kind = ekBeginTag) and (Node is TParentNode) and not (Node is TDynamicNode); end; begin while not EndReached do begin Element := FEnum.PopNextElement; case Element.Kind of ekString: NewNode := TStringNode.Create(Element.Text); ekBeginTag: NewNode := GetNodeFromTag(Element.Text); else raise EParserError.CreateRes(@RsEUnsupportedState); end; if (Node.GetNodeType = ntRootNode) then Node.AddChild(NewNode, TRootNode(Node)) else Node.AddChild(NewNode, Node.Root); if NewNode is TDynamicNode then HandleDynamicTag(NewNode as TDynamicNode); if IsNodeContainer(NewNode, Element) then ParseNode(NewNode as TParentNode); end; { When we have reached the end of a tag ( for example) we don't enter the main body. We have called FEnum.PeekElement and have determined (in EndReached in this routine) that the next element to be returned by FEnum. PopElement will be an end-tag. Thus, we exit this routine and return either to another copy of ParseNode (if we've been called recursively) or to Parse. However, if we only check the next element to be returned using PeekElement, it won't be popped off our "stack", which is what we do here. If we hadn't popped it here, EndReached would've returned True in all other incarnations of this routine in the call stack; thus, one single end-tag would've caused the whole parse process to stop. This is obviously not what we want. } if not FEnum.IsEndReached then FEnum.PopNextElement; end; procedure TDefaultParser.SetDynamicNodeHandler( Handler: IDynamicNodeHandler); begin FDynamicNodeHandler := Handler; end; procedure TDefaultParser.SetElementEnumerator(NewEnum: IElementEnumerator); begin if Assigned(NewEnum) then FEnum := NewEnum; end; {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} end.