diff --git a/packages/webwidget/htmlwidgets.pp b/packages/webwidget/htmlwidgets.pp
index 7d18a41..1e76585 100644
--- a/packages/webwidget/htmlwidgets.pp
+++ b/packages/webwidget/htmlwidgets.pp
@@ -8,20 +8,26 @@ uses
Classes, SysUtils, webwidget, js, web;
Type
+ TTextMode = (tmText,tmHTML);
{ TButtonWidget }
TButtonWidget = Class(TWebWidget)
private
FText: String;
+ FTextMode: TTextMode;
procedure SetText(AValue: String);
+ procedure SetTextMode(AValue: TTextMode);
Protected
+ procedure ApplyText(aElement: TJSHTMLElement);
Procedure SetName(const NewName: TComponentName); override;
Procedure ApplyWidgetSettings(aElement: TJSHTMLElement); override;
Public
Procedure Click;
Function HTMLTag : String; override;
+ Published
Property Text : String Read FText Write SetText;
+ Property TextMode : TTextMode Read FTextMode Write SetTextMode;
end;
{ TViewPort }
@@ -473,9 +479,73 @@ Type
Property LabelFor : TWebWidget Read FLabelFor Write SetLabelFor;
end;
+ TTextTag = (ttParagraph,ttBold,ttItalic,ttUnderline,ttStrikeThrough,ttSpan,ttQuote,ttBlockQuote,ttH1,ttH2,ttH3,ttH4,ttH5,ttH6,ttPre,ttRuby,ttArticle,ttAddress,ttAbbr,ttCustom);
+
+ { TTextWidget }
+
+ { TCustomTextWidget }
+
+ TCustomTextWidget = Class(TCustomWebWidget)
+ private
+ FCustomTag: String;
+ FEnvelopeTag: TTextTag;
+ FTextMode: TTextMode;
+ SerCustomTag: String;
+ procedure SetCustomTag(AValue: String);
+ procedure SetEnvelopeTag(AValue: TTextTag);
+ procedure SetTextMode(AValue: TTextMode);
+ Protected
+ procedure ApplyWidgetSettings(aElement: TJSHTMLElement); override;
+ procedure ApplyText(aElement : TJSHTMLElement); virtual;
+ Function GetText : String; virtual; abstract;
+ Public
+ Function HTMLTag : String; override;
+ Published
+ Property CustomTag : String Read FCustomTag Write SetCustomTag;
+ Property EnvelopeTag : TTextTag Read FEnvelopeTag Write SetEnvelopeTag;
+ Property TextMode : TTextMode Read FTextMode Write SetTextMode;
+ end;
+
+ TTextWidget = Class(TCustomTextWidget)
+ private
+ FText : String;
+ procedure SetText(AValue: String);
+ Protected
+ Function GetText : String; override;
+ published
+ Property Text : String Read FText Write SetText;
+ end;
+
+ { TTextLinesWidget }
+
+ TTextLinesWidget = Class(TCustomTextWidget)
+ private
+ FLines : TStrings;
+ FForceLineBreaks: Boolean;
+ procedure DoLinesChanged(Sender: TObject);
+ procedure SetLines(AValue: TStrings);
+ procedure SetForceLineBreaks(AValue: Boolean);
+ Protected
+ Function GetText : String; override;
+ procedure ApplyText(aElement : TJSHTMLElement); override;
+ Public
+ Constructor Create(aOwner : TComponent); override;
+ Destructor Destroy; override;
+ published
+ Property Lines : TStrings Read FLines Write SetLines;
+ // When forcelinebreaks is true a
will be appended to every line.
+ // Note that for TextMode=tmText this means the lines will be rendered as-is, but there will still be a
between the lines
+ Property ForceLineBreaks : Boolean Read FForceLineBreaks Write SetForceLineBreaks;
+ end;
+
Function ViewPort : TViewPort;
+Const
+ TextTagNames : Array[TTextTag] of string
+ = ('p','b','i','u','s','span','quote','blockquote','h1','h2','h3','h4','h5','h6','pre','ruby','article','address','abbr','');
+
+
implementation
uses DateUtils;
@@ -489,6 +559,145 @@ begin
Result:=TViewPort.Instance;
end;
+{ TCustomTextWidget }
+
+procedure TCustomTextWidget.SetEnvelopeTag(AValue: TTextTag);
+begin
+ if FEnvelopeTag=AValue then Exit;
+ FEnvelopeTag:=AValue;
+ if (FEnvelopeTag=ttCustom) and (FCustomTag='') then
+ FCustomTag:='div';
+ if IsRendered then
+ Refresh;
+end;
+
+procedure TCustomTextWidget.SetCustomTag(AValue: String);
+begin
+ if FCustomTag=AValue then Exit;
+ FCustomTag:=AValue;
+ if (FCustomTag<>'') then
+ FEnvelopeTag:=ttCustom;
+ if IsRendered then
+ Refresh;
+end;
+
+
+procedure TCustomTextWidget.SetTextMode(AValue: TTextMode);
+begin
+ if FTextMode=AValue then Exit;
+ FTextMode:=AValue;
+ if IsRendered then
+ ApplyText(Element);
+end;
+
+procedure TCustomTextWidget.ApplyWidgetSettings(aElement: TJSHTMLElement);
+begin
+ inherited ApplyWidgetSettings(aElement);
+ ApplyText(aElement);
+end;
+
+procedure TCustomTextWidget.ApplyText(aElement: TJSHTMLElement);
+begin
+ if FTextMode=tmText then
+ aElement.innerText:=GetText
+ else
+ aElement.innerHTML:=GetText;
+end;
+
+function TCustomTextWidget.HTMLTag: String;
+
+begin
+ Result:=TextTagNames[FEnvelopeTag];
+ if Result='' then
+ Result:='div';
+end;
+
+{ TTextLinesWidget }
+
+procedure TTextLinesWidget.SetLines(AValue: TStrings);
+begin
+ if FLines=AValue then Exit;
+ FLines.Assign(AValue);
+end;
+
+procedure TTextLinesWidget.SetForceLineBreaks(AValue: Boolean);
+begin
+ if FForceLineBreaks=AValue then Exit;
+ FForceLineBreaks:=AValue;
+ if IsRendered then
+ ApplyText(Element);
+end;
+
+procedure TTextLinesWidget.DoLinesChanged(Sender: TObject);
+begin
+ if IsRendered then
+ ApplyText(Element);
+end;
+
+function TTextLinesWidget.GetText: String;
+
+Var
+ I : integer;
+
+begin
+ if (FTextMode=tmHTML) and ForceLineBreaks then
+ begin
+ Result:='';
+ For I:=0 to FLines.Count-1 do
+ Result:=Result+flines[i]+'
';
+ end
+ else
+ Result:=FLines.Text;
+end;
+
+procedure TTextLinesWidget.ApplyText(aElement: TJSHTMLElement);
+
+Var
+ I : integer;
+
+begin
+ if (TextMode=tmHTML) or (Not ForceLineBreaks) then
+ inherited ApplyText(aElement)
+ else
+ begin
+ For I:=0 to FLines.Count-1 do
+ begin
+ aElement.AppendChild(Document.createTextNode(FLines[i]));
+ aElement.AppendChild(CreateElement('br',''));
+ end;
+ end;
+end;
+
+constructor TTextLinesWidget.Create(aOwner: TComponent);
+begin
+ inherited Create(aOwner);
+ FLines:=TstringList.Create;
+ TstringList(FLines).OnChange:=@DoLinesChanged;
+end;
+
+destructor TTextLinesWidget.Destroy;
+begin
+ FLines:=TstringList.Create;
+ inherited Destroy;
+end;
+
+{ TTextWidget }
+
+procedure TTextWidget.SetText(AValue: String);
+begin
+ if FText=AValue then Exit;
+ FText:=AValue;
+ if IsRendered then
+ ApplyText(Element);
+end;
+
+function TTextWidget.GetText: String;
+begin
+ Result:=FText;
+end;
+
+
+
{ TLabelWidget }
procedure TLabelWidget.ApplyLabelFor(aLabelElement : TJSHTMLLabelElement);
@@ -1399,7 +1608,15 @@ begin
if FText=AValue then Exit;
FText:=AValue;
if IsRendered then
- Element.InnerText:=Ftext;
+ ApplyText(Element);
+end;
+
+procedure TButtonWidget.SetTextMode(AValue: TTextMode);
+begin
+ if FTextMode=AValue then Exit;
+ FTextMode:=AValue;
+ if IsRendered then
+ ApplyText(Element)
end;
@@ -1423,7 +1640,16 @@ end;
procedure TButtonWidget.ApplyWidgetSettings(aElement: TJSHTMLElement);
begin
Inherited;
- aElement.InnerText:=Text;
+ ApplyText(aElement);
+end;
+
+Procedure TButtonWidget.ApplyText(aElement : TJSHTMLElement);
+
+begin
+ if FTextMode=tmText then
+ aElement.InnerText:=FText
+ else
+ aElement.InnerHTML:=FText;
end;
procedure TButtonWidget.Click;
diff --git a/packages/webwidget/tests/tchtmlwidgets.pp b/packages/webwidget/tests/tchtmlwidgets.pp
index 4bf6764..cbad30a 100644
--- a/packages/webwidget/tests/tchtmlwidgets.pp
+++ b/packages/webwidget/tests/tchtmlwidgets.pp
@@ -289,9 +289,237 @@ Type
Procedure TestMultiSelect;
end;
+ TMyTextWidget = Class(TTextWidget)
+ Public
+ Property Element;
+ Property ParentElement;
+ end;
+
+ { TTestTextWidget }
+
+ TTestTextWidget = Class(TBaseTestWidget)
+ private
+ FMy: TMyTextWidget;
+ Protected
+ Procedure Setup; override;
+ Procedure TearDown; override;
+ Property My : TMyTextWidget Read FMy;
+ Published
+ Procedure TestEmpty;
+ Procedure TestRenderText;
+ Procedure TestRenderedTextChange;
+ Procedure TestRenderHTML;
+ Procedure TestRenderedHTMLChange;
+ procedure TestTextModeChangeRenders;
+ procedure TestEnvelopeChangeRenders;
+ end;
+
+ TMyTextLinesWidget = Class(TTextLinesWidget)
+ Public
+ Property Element;
+ Property ParentElement;
+ end;
+
+ { TTestTextLinesWidget }
+
+ TTestTextLinesWidget = Class(TBaseTestWidget)
+ private
+ FMy: TMyTextLinesWidget;
+ Protected
+ Procedure Setup; override;
+ Procedure TearDown; override;
+ Property My : TMyTextLinesWidget Read FMy;
+ Published
+ Procedure TestEmpty;
+ Procedure TestRenderText;
+ Procedure TestRenderedTextChange;
+ Procedure TestRenderTextLineBreaks;
+ Procedure TestRenderHTML;
+ Procedure TestRenderHTMLLineBreaks;
+ Procedure TestRenderedHTMLChange;
+ procedure TestTextModeChangeRenders;
+ procedure TestEnvelopeChangeRenders;
+ end;
implementation
+{ TTestTextLinesWidget }
+
+procedure TTestTextLinesWidget.Setup;
+begin
+ inherited Setup;
+ FMy:=TMyTextLinesWidget.Create(Nil);
+ FMy.ParentID:=SBaseWindowID;
+ FMy.Lines.Add('0<1');
+ FMy.Lines.Add('two');
+end;
+
+procedure TTestTextLinesWidget.TearDown;
+begin
+ FreeAndNil(FMy);
+ inherited TearDown;
+end;
+
+procedure TTestTextLinesWidget.TestEmpty;
+begin
+ AssertNotNull('Have widget',My);
+ AssertNull('widget not rendered',My.Element);
+ AssertTrue('Text mode default text',tmText=My.TextMode);
+ AssertTrue('Envelope tag default paragraph',ttParagraph=My.EnvelopeTag);
+end;
+
+procedure TTestTextLinesWidget.TestRenderText;
+begin
+ My.Refresh;
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have element','P',My.Element.tagName);
+ AssertEquals('Have text','0<1'+slineBreak+'two'+slineBreak,My.Element.InnerText);
+end;
+
+procedure TTestTextLinesWidget.TestRenderedTextChange;
+begin
+ My.Refresh;
+ My.Lines[1]:='Three';
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have element','P',My.Element.tagName);
+ AssertEquals('Have text','0<1'+slineBreak+'Three'+slineBreak,My.Element.InnerText);
+end;
+
+procedure TTestTextLinesWidget.TestRenderTextLineBreaks;
+begin
+ My.ForceLineBreaks:=True;
+ My.Refresh;
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have text','0<1'+slineBreak+'two'+slineBreak,My.Element.InnerText);
+ AssertEquals('Have HTML','0<1
two
',My.Element.InnerHtml);
+end;
+
+procedure TTestTextLinesWidget.TestRenderHTML;
+begin
+ My.TextMode:=tmHTML;
+ My.Refresh;
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have element','P',My.Element.tagName);
+ AssertEquals('Have text','0<1 two',My.Element.InnerText);
+ AssertEquals('Have HTML','0<1'+sLineBreak+'two'+sLineBreak,My.Element.InnerHtml);
+end;
+
+procedure TTestTextLinesWidget.TestRenderHTMLLineBreaks;
+
+begin
+ My.TextMode:=tmHTML;
+ My.ForceLineBreaks:=True;
+ My.Refresh;
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have element','P',My.Element.tagName);
+ AssertEquals('Have text','0<1'+slineBreak+'two'+slineBreak,My.Element.InnerText);
+ AssertEquals('Have HTML','0<1
two
',My.Element.InnerHtml);
+end;
+
+procedure TTestTextLinesWidget.TestRenderedHTMLChange;
+begin
+ TestRenderHTML;
+ My.Lines[1]:='three';
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have element','P',My.Element.tagName);
+ AssertEquals('Have text','0<1 three',My.Element.InnerText);
+ AssertEquals('Have HTML','0<1'+sLineBreak+'three'+sLineBreak,My.Element.InnerHtml);
+end;
+
+procedure TTestTextLinesWidget.TestTextModeChangeRenders;
+begin
+ TestRenderText;
+ My.TextMode:=tmHTML;
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have element','P',My.Element.tagName);
+ AssertEquals('Have text','0<1 two',My.Element.InnerText);
+ AssertEquals('Have HTML','0<1'+sLineBreak+'two'+sLineBreak,My.Element.InnerHtml);
+end;
+
+procedure TTestTextLinesWidget.TestEnvelopeChangeRenders;
+begin
+ TestRenderText;
+ My.EnvelopeTag:=ttSpan;
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have element','SPAN',My.Element.tagName);
+ AssertEquals('Have text','0<1'+slineBreak+'two'+slineBreak,My.Element.InnerText);
+
+end;
+
+{ TTestTextWidget }
+
+procedure TTestTextWidget.Setup;
+begin
+ inherited Setup;
+ FMy:=TMyTextWidget.Create(Nil);
+ FMy.ParentID:=SBaseWindowID;
+ FMy.Text:='0<1';
+end;
+
+procedure TTestTextWidget.TearDown;
+begin
+ FreeAndNil(FMy);
+ inherited TearDown;
+end;
+
+procedure TTestTextWidget.TestEmpty;
+begin
+ AssertNotNull('Have widget',My);
+ AssertNull('widget not rendered',My.Element);
+ AssertTrue('Text mode default text',tmText=My.TextMode);
+ AssertTrue('Envelope tag default paragraph',ttParagraph=My.EnvelopeTag);
+end;
+
+procedure TTestTextWidget.TestRenderText;
+begin
+ My.Refresh;
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have element','P',My.Element.tagName);
+ AssertEquals('Have text','0<1',My.Element.InnerText);
+end;
+
+procedure TTestTextWidget.TestRenderedTextChange;
+begin
+ TestRenderText;
+ My.Text:='Something else';
+ AssertEquals('Have text','Something else',My.Element.InnerText);
+end;
+
+procedure TTestTextWidget.TestRenderHTML;
+begin
+ My.TextMode:=tmHTML;
+ My.Refresh;
+ AssertNotNull('Have element',My.Element);
+ AssertEquals('Have element','P',My.Element.tagName);
+ AssertEquals('Have text','0<1',My.Element.InnerText);
+ AssertEquals('Have HTML','0<1',My.Element.InnerHtml);
+end;
+
+procedure TTestTextWidget.TestRenderedHTMLChange;
+begin
+ TestRenderHtml;
+ My.Text:='2>1';
+ AssertEquals('Have text','2>1',My.Element.InnerText);
+ AssertEquals('Have HTML','2>1',My.Element.InnerHtml);
+end;
+
+procedure TTestTextWidget.TestTextModeChangeRenders;
+begin
+ TestRenderText;
+ My.TextMode:=tmHTML;
+ AssertEquals('Have text','0<1',My.Element.InnerText);
+ AssertEquals('Have HTML','0<1',My.Element.InnerHtml);
+end;
+
+procedure TTestTextWidget.TestEnvelopeChangeRenders;
+begin
+ TestRenderText;
+ My.EnvelopeTag:=ttSpan;
+ AssertEquals('Have element','SPAN',My.Element.tagName);
+ AssertEquals('Have text','0<1',My.Element.InnerText);
+ AssertEquals('Have HTML','0<1',My.Element.InnerHtml);
+end;
+
{ TTestLabelWidget }
procedure TTestLabelWidget.SetUp;
@@ -457,7 +685,6 @@ begin
AssertEquals('SelectionItem[0]','One',My.SelectionItem[0]);
AssertEquals('SelectionValue[1]','3',My.selectionValue[1]);
AssertEquals('SelectionItem[1]','Three',My.selectionItem[1]);
-
end;
{ TTestImageElement }
@@ -1144,12 +1371,12 @@ begin
end;
initialization
- RegisterTests([TTestViewPort,TTestButtonWidget,TTestPage,
+ RegisterTests([{TTestViewPort,TTestButtonWidget,TTestPage,
TTestTextInputElement,TTestTextAreaElement,
TTestRadioInputElement,TTestCheckBoxInputElement,
TTestDateInputElement,TTestFileInputElement,
TTestHiddenInputElement, TTestImageElement,
TTestImageElement,TTestSelectElement,
- TTestLabelWidget]);
+ TTestLabelWidget,TTestTextWidget,}TTestTextLinesWidget]);
end.
diff --git a/packages/webwidget/tests/tcwidget.pp b/packages/webwidget/tests/tcwidget.pp
index c6afd7f..e867474 100644
--- a/packages/webwidget/tests/tcwidget.pp
+++ b/packages/webwidget/tests/tcwidget.pp
@@ -33,7 +33,15 @@ Type
Function MyTop : TJSHTMLElement;
Property AddedClasses : String Read FAdd Write FAdd;
end;
+
+ { TMyChildWidget }
+
TMyChildWidget = Class(TMyWebWidget);
+
+ TMySimpleChildWidget = Class(TMyChildWidget)
+ Public
+ Class Function AllowChildren : Boolean; override;
+ end;
TMyParentWidget = Class(TMyWebWidget);
{ TMySubContentWidget }
@@ -69,6 +77,7 @@ Type
Property References;
Property Subs : TJSHTMLElementArray read FSubs;
Property UL : TJSHTMLElement read FUL;
+ Property Element;
end;
@@ -277,18 +286,42 @@ Type
TTestWebWidgetReferences = Class(TBaseTestWidget)
private
FMy: TMyRefWidget;
+ F : TReferenceItem;
function GetItems: TWebWidgetReferences;
Public
Procedure Setup; override;
Procedure TearDown; override;
+ Procedure AddSet;
+ Procedure GetDRef;
Property MyWidget : TMyRefWidget Read FMy;
Property References : TWebWidgetReferences Read GetItems;
Published
Procedure TestEmpty;
+ Procedure TestAdd;
+ Procedure TestIndexOf;
+ Procedure TestIndexOfCaseInsensitive;
+ Procedure TestFind;
+ Procedure TestGet;
+ Procedure SelectSingleBeforeRefresh;
+ Procedure GetSingleByName;
+ Procedure GetSingleNonExist;
+ Procedure GetSingleByNameCaseInsensitive;
+ Procedure SelectMultiBeforeRefresh;
+ procedure GetMultiByName;
+ procedure GetMultiNonExist;
+ Procedure SelectSingleAfterRefresh;
+ Procedure SelectMultiAfterRefresh;
end;
implementation
+{ TMyChildWidget }
+
+class function TMySimpleChildWidget.AllowChildren: Boolean;
+begin
+ Result:=FAlse;
+end;
+
{ TMyRefWidget }
function TMyRefWidget.DoRenderHTML(aParent, aElement: TJSHTMLElement): TJSHTMLElement;
@@ -310,15 +343,14 @@ Var
I : Integer;
begin
Result:=inherited DoRenderHTML(aParent, aElement);
- FUL:=TJSHTMLElement(Document.CreateElement('
'));
+ FUL:=TJSHTMLElement(Document.CreateElement('ul'));
Result.insertBefore(Ful,FSub);
- Result.AppendChild(FUL);
SetLength(FSubs,10);
For I:=0 to 9 do
begin
FSubs[i]:=TJSHTMLElement(Document.CreateElement('li'));
FSubs[i].InnerText:='item '+IntToStr(I);
- FUL.AppendChild(FSubs);
+ FUL.AppendChild(FSubs[i]);
end;
end;
@@ -332,16 +364,189 @@ end;
procedure TTestWebWidgetReferences.Setup;
begin
inherited Setup;
+ FMy:=TMyRefWidget.Create(Nil);
+ FMy.ParentID:=SBaseWindowID;
end;
procedure TTestWebWidgetReferences.TearDown;
begin
+ FreeAndNil(FMy);
inherited TearDown;
end;
+procedure TTestWebWidgetReferences.AddSet;
+begin
+ MyWidget.References.Add('a','div');
+ MyWidget.References.Add('b','ul');
+ MyWidget.References.Add('c','ul>li');
+end;
+
+procedure TTestWebWidgetReferences.GetDRef;
+begin
+ F:=References.GetReference('D');
+end;
+
procedure TTestWebWidgetReferences.TestEmpty;
begin
+ AssertNotNull('Have widget',MyWidget);
+ AssertNull('widget not rendered',MyWidget.Element);
+ AssertEquals('No references',0,MyWidget.References.Count);
+ AssertSame('Correct references prop',MyWidget.References,References);
+end;
+procedure TTestWebWidgetReferences.TestAdd;
+begin
+ AddSet;
+ AssertEquals('Count',3,references.Count);
+ AssertEquals('0 : Name','a',references[0].name);
+ AssertEquals('0 : Selector','div',references[0].Selector);
+ AssertEquals('1 : Name','b',references[1].name);
+ AssertEquals('1 : Selector','ul',references[1].selector);
+ AssertEquals('2 : Name','c',references[2].name);
+ AssertEquals('2 : Selector','ul>li',references[2].selector);
+end;
+
+procedure TTestWebWidgetReferences.TestIndexOf;
+begin
+ AddSet;
+ AssertEquals('a',0,References.IndexOfReference('a'));
+ AssertEquals('b',1,References.IndexOfReference('b'));
+ AssertEquals('c',2,References.IndexOfReference('c'));
+ AssertEquals('d',-1,References.IndexOfReference('d'));
+end;
+
+procedure TTestWebWidgetReferences.TestIndexOfCaseInsensitive;
+begin
+ AddSet;
+ AssertEquals('a',0,References.IndexOfReference('A'));
+ AssertEquals('b',1,References.IndexOfReference('B'));
+ AssertEquals('c',2,References.IndexOfReference('C'));
+ AssertEquals('d',-1,References.IndexOfReference('D'));
+end;
+
+procedure TTestWebWidgetReferences.TestFind;
+begin
+ AddSet;
+ AssertSame('A',References[0],References.FindReference('A'));
+ AssertSame('a',References[0],References.FindReference('a'));
+ AssertNull('e',References.FindReference('E'));
+end;
+
+procedure TTestWebWidgetReferences.TestGet;
+begin
+ AddSet;
+ AssertSame('A',References[0],References.GetReference('A'));
+ AssertSame('a',References[0],References.GetReference('a'));
+ AssertException('Get unknown',EWidgets,@GetDRef);
+end;
+
+procedure TTestWebWidgetReferences.SelectSingleBeforeRefresh;
+begin
+ MyWidget.References.Add('me','ul');
+ AssertEquals('Ref count',1,MyWidget.References.Count);
+ MyWidget.Refresh;
+ AssertEquals('count of References found',1,Length(References[0].Elements));
+ AssertSame('first array Reference filled',MyWidget.UL,References[0].Elements[0]);
+ AssertSame('Reference filled',MyWidget.UL,References[0].Element);
+end;
+
+procedure TTestWebWidgetReferences.GetSingleByName;
+begin
+ MyWidget.References.Add('me','ul');
+ AssertEquals('Ref count',1,MyWidget.References.Count);
+ MyWidget.Refresh;
+ AssertEquals('count of References found',1,Length(References[0].Elements));
+ AssertSame('first array Reference filled',MyWidget.UL,References[0].Elements[0]);
+ AssertSame('Reference filled',MyWidget.UL,MyWidget.references.GetElementByName('me'));
+ AssertEquals('Reference filled',1,Length(MyWidget.references.GetElementsByName('me')));
+ AssertSame('Reference filled',MyWidget.UL,MyWidget.references.GetElementsByName('me')[0]);
+end;
+
+procedure TTestWebWidgetReferences.GetSingleNonExist;
+begin
+ MyWidget.References.Add('me','ul');
+ AssertEquals('Ref count',1,MyWidget.References.Count);
+ MyWidget.Refresh;
+ AssertNull('Reference filled',MyWidget.references.GetElementByName('a'));
+end;
+
+procedure TTestWebWidgetReferences.GetSingleByNameCaseInsensitive;
+begin
+ MyWidget.References.Add('ME','ul');
+ AssertEquals('Ref count',1,MyWidget.References.Count);
+ MyWidget.Refresh;
+ AssertEquals('count of References found',1,Length(References[0].Elements));
+ AssertSame('first array Reference filled',MyWidget.UL,References[0].Elements[0]);
+ AssertSame('Reference filled',MyWidget.UL,MyWidget.references.GetElementByName('me'));
+ AssertEquals('Reference filled',1,Length(MyWidget.references.GetElementsByName('me')));
+ AssertSame('Reference filled',MyWidget.UL,MyWidget.references.GetElementsByName('me')[0]);
+end;
+
+procedure TTestWebWidgetReferences.SelectMultiBeforeRefresh;
+
+Var
+ I : integer;
+
+begin
+ MyWidget.References.Add('me','li');
+ AssertEquals('Ref count',1,MyWidget.References.Count);
+ MyWidget.Refresh;
+ AssertEquals('Count of References found',10,Length(References[0].Elements));
+ for I:=0 to Length(MyWidget.FSubs)-1 do
+ AssertSame('1 array Reference filled',MyWidget.Subs[I],References[0].Elements[i]);
+ AssertSame('first Reference filled',MyWidget.Subs[0],References[0].Element);
+end;
+
+procedure TTestWebWidgetReferences.GetMultiByName;
+
+Var
+ I : integer;
+ a : TJSHTMLElementArray;
+
+begin
+ MyWidget.References.Add('me','li');
+ AssertEquals('Ref count',1,MyWidget.References.Count);
+ MyWidget.Refresh;
+ a:=References.GetElementsByname('me');
+ AssertEquals('Count of References found',10,Length(a));
+ for I:=0 to Length(MyWidget.FSubs)-1 do
+ AssertSame('1 array Reference filled',MyWidget.Subs[I],a[i]);
+end;
+
+procedure TTestWebWidgetReferences.GetMultiNonExist;
+Var
+ a : TJSHTMLElementArray;
+begin
+ MyWidget.References.Add('me','li');
+ AssertEquals('Ref count',1,MyWidget.References.Count);
+ MyWidget.Refresh;
+ A:=References.GetElementsByName('no');
+ AssertNotNull('Empty array 1',A);
+ AssertEquals('Empty array 2',0, Length(A));
+end;
+
+procedure TTestWebWidgetReferences.SelectSingleAfterRefresh;
+begin
+ MyWidget.Refresh;
+ MyWidget.References.Add('me','ul');
+ AssertEquals('Ref count',1,MyWidget.References.Count);
+ AssertEquals('count of References found',1,Length(References[0].Elements));
+ AssertSame('first array Reference filled',MyWidget.UL,References[0].Elements[0]);
+ AssertSame('Reference filled',MyWidget.UL,References[0].Element);
+end;
+
+procedure TTestWebWidgetReferences.SelectMultiAfterRefresh;
+Var
+ I : integer;
+
+begin
+ MyWidget.Refresh;
+ MyWidget.References.Add('me','li');
+ AssertEquals('Ref count',1,MyWidget.References.Count);
+ AssertEquals('Count of References found',10,Length(References[0].Elements));
+ for I:=0 to Length(MyWidget.FSubs)-1 do
+ AssertSame('1 array Reference filled',MyWidget.Subs[I],References[0].Elements[i]);
+ AssertSame('first Reference filled',MyWidget.Subs[0],References[0].Element);
end;
{ TTestWebWidgetStyles }
@@ -755,9 +960,9 @@ begin
AssertSame('Correct element',El,MyWidget.MyElement);
AssertSame('Correct content element',El,MyWidget.MyContent);
AssertTree('div('+SMyChildID+')');
- AssertEquals('Have element data',el.ID,String(el.dataset['WwElement']));
- AssertEquals('Have element top data',el.ID,String(el.dataset['WwElementTop']));
- AssertEquals('Have element content data',el.ID,String(el.dataset['WwElementContent']));
+ AssertEquals('Have element data',el.ID,String(el.dataset['wwElement']));
+ AssertEquals('Have element top data',el.ID,String(el.dataset['wwElementTop']));
+ AssertEquals('Have element content data',el.ID,String(el.dataset['wwElementContent']));
end;
procedure TTestWidgetBasicOperations.TestSetParent;
@@ -795,9 +1000,9 @@ begin
AssertSame('Have correct parent element',El,El2.parentElement);
AssertSame('Have correct parent',El,MyWidget.MyParent);
AssertEquals('Correct ID',el2.ID,MyWidget.ElementiD);
- AssertEquals('Have element data',el2.ID,String(el2.dataset['WwElement']));
- AssertEquals('Have element top data',el2.ID,String(el2.dataset['WwElementTop']));
- AssertEquals('Have element content data',el2.ID,String(el2.dataset['WwElementContent']));
+ AssertEquals('Have element data',el2.ID,String(el2.dataset['wwElement']));
+ AssertEquals('Have element top data',el2.ID,String(el2.dataset['wwElementTop']));
+ AssertEquals('Have element content data',el2.ID,String(el2.dataset['wwElementContent']));
end;
procedure TTestWidgetBasicOperations.TestRenderParentID;
@@ -815,9 +1020,9 @@ begin
AssertSame('Have correct parent element',El,El2.parentElement);
AssertSame('Have correct parent',El,MyWidget.MyParent);
AssertEquals('Correct ID',el2.ID,MyWidget.ElementiD);
- AssertEquals('Have element data',el2.ID,String(el2.dataset['WwElement']));
- AssertEquals('Have element top data',el2.ID,String(el2.dataset['WwElementTop']));
- AssertEquals('Have element content data',el2.ID,String(el2.dataset['WwElementContent']));
+ AssertEquals('Have element data',el2.ID,String(el2.dataset['wwElement']));
+ AssertEquals('Have element top data',el2.ID,String(el2.dataset['wwElementTop']));
+ AssertEquals('Have element content data',el2.ID,String(el2.dataset['wwElementContent']));
end;
procedure TTestWidgetBasicOperations.TestUnRenderParent;
@@ -1755,6 +1960,6 @@ begin
end;
initialization
- RegisterTests([TTestWidgetBasicOperations,TTestWebWidgetStyles]);
+// RegisterTests([TTestWidgetBasicOperations,TTestWebWidgetStyles,TTestWebWidgetReferences]);
end.
diff --git a/packages/webwidget/webwidget.pas b/packages/webwidget/webwidget.pas
index 314110f..2ecf215 100644
--- a/packages/webwidget/webwidget.pas
+++ b/packages/webwidget/webwidget.pas
@@ -81,7 +81,6 @@ Const
SEventTransitionRun = 'transitionrun';
SEventTransitionStart = 'transitionstart';
SEventWheel = 'wheel';
- SErrNotRendered = 'Cannot perform this operation: Widget not rendered';
Type
@@ -186,8 +185,8 @@ Type
Function Widget : TCustomWebWidget;
// Manipulate
Function Add(Const aName : String; aSelector : String = '') : TReferenceItem; overload;
- Function EnsureReference(Const aName : String) : TReferenceItem;
- Function IndexOfReference(Const aName : String) : TReferenceItem;
+ Function EnsureReference(Const aName : String; Const aSelector : String = '') : TReferenceItem;
+ Function IndexOfReference(Const aName : String) : Integer;
Function FindReference(Const aName : String) : TReferenceItem;
Function GetReference(Const aName : String) : TReferenceItem;
Procedure RemoveReference(Const aName : String);
@@ -353,9 +352,9 @@ Type
Function DisplayElementName : String;
// Make sure there is an element.
function EnsureElement: TJSHTMLElement;
- // Set parent element to nil.
+ // Set parent element to nil. No rendering is done. Can be called when there are no DOM elements
Procedure InvalidateParentElement;
- // Set element to nil, clears styles
+ // Set element to nil, clears styles and references. Can be called when there are no DOM elements
Procedure InvalidateElement;
// Name of the tag to create. Set to '' if you don't want RenderHTML to create one.
Function HTMLTag : String; virtual; abstract;
@@ -382,11 +381,14 @@ Type
// Apply data to Element, Top and Content. Can only be called when the 3 are set, i.e. after RenderHTML or when Element is set from ElementID.
Procedure ApplyData; virtual;
Procedure RemoveData; virtual;
+ // Update references
+ Procedure RefreshReferences; virtual;
// Create html. Creates element below parent, and renders HTML using doRenderHTML
Function RenderHTML(aParent : TJSHTMLELement) : TJSHTMLElement;
+ // Override this if you need to do additional actions besides removing top element from parent. Parent is always assigned
Procedure DoUnRender(aParent : TJSHTMLElement) ; virtual;
// Remove HTML, if any. aParent can be nil.
- Procedure UnRender(aParent : TJSHTMLElement);
+ Procedure UnRender(aParent : TJSHTMLElement); overload;
// Dispatch an event
Function DispatchEvent(aName : String; aEvent : TJSEvent = Nil) : Boolean;
// the rendered or attached element if ElementID was set. Can be Nil;
@@ -426,6 +428,8 @@ Type
Procedure RemoveData(const aName : String);
// Re-render
Procedure Refresh;
+ // Unrender
+ Procedure Unrender; overload;
// These work on the classes property, and on the current element if rendered. Returns the new value of classes.
Function RemoveClasses(const aClasses : String; Normalize : Boolean = false) : String;
Function AddClasses(const aClasses : String; Normalize : Boolean = false) : String;
@@ -674,18 +678,22 @@ ResourceString
SErrElementIDNotAllowed = 'Setting element ID is not allowed';
SErrParentIDNotAllowed = 'Setting parent ID is not allowed';
SErrParentNotAllowed = 'Setting parent is not allowed';
+ SErrChildrenNotAllowed = 'Parent does not allow children';
SErrWidgetNotFound = 'Widget with ID "%s" not found.';
+ SErrUnknownReference = 'Unknown reference: %s';
+ SErrNotRendered = 'Cannot perform this operation: Widget not rendered';
+ SErrCannotRefreshNoWidget = 'Cannot refresh references without widget';
{ TWebWidgetReferences }
function TWebWidgetReferences.GetReferenceItem(aIndex : Integer): TReferenceItem;
begin
-
+ Result:=TReferenceItem(Items[aIndex])
end;
procedure TWebWidgetReferences.SetReferenceItem(aIndex : Integer; AValue: TReferenceItem);
begin
-
+ Items[aIndex]:=aValue;
end;
procedure TWebWidgetReferences.MarkDirty(aItem: TReferenceItem);
@@ -695,8 +703,28 @@ begin
end;
procedure TWebWidgetReferences.RefreshFromDOM(aItem: TReferenceItem; aElement: TJSHTMlElement);
-begin
+Var
+ a : TJSHTMlElementArray;
+ Nodes : TJSNodeList;
+ I : integer;
+
+begin
+ if (Widget=Nil) then
+ Raise EWidgets.Create(SErrCannotRefreshNoWidget);
+ if (Widget.Element=Nil) then
+ Raise EWidgets.Create(SErrNotRendered);
+ if FRefs=Nil then
+ FRefs:=New([]);
+ try
+ Nodes:=Widget.Element.querySelectorAll(aItem.Selector);
+ SetLength(a,Nodes.length);
+ For I:=0 to Nodes.length-1 do
+ A[i]:=TJSHTMLElement(Nodes[i]);
+ except
+ SetLength(a,0);
+ end;
+ FRefs[LowerCase(aItem.Name)]:=A;
end;
function TWebWidgetReferences.Widget: TCustomWebWidget;
@@ -713,44 +741,87 @@ begin
MarkDirty(Result)
end;
-function TWebWidgetReferences.EnsureReference(const aName: String): TReferenceItem;
+function TWebWidgetReferences.EnsureReference(const aName: String; const aSelector: String): TReferenceItem;
begin
-
+ Result:=FindReference(aName);
+ if Result=Nil then
+ Result:=Add(aName,aSelector);
end;
-function TWebWidgetReferences.IndexOfReference(const aName: String): TReferenceItem;
+function TWebWidgetReferences.IndexOfReference(const aName: String): Integer;
begin
-
+ Result:=Count-1;
+ While (Result>=0) and not SameText(GetReferenceItem(Result).Name,aName) do
+ Dec(Result);
end;
function TWebWidgetReferences.FindReference(const aName: String): TReferenceItem;
-begin
+Var
+ Idx:Integer;
+
+begin
+ Idx:=IndexOfReference(aName);
+ if Idx=-1 then
+ Result:=Nil
+ else
+ Result:=GetReferenceItem(Idx)
end;
function TWebWidgetReferences.GetReference(const aName: String): TReferenceItem;
begin
-
+ Result:=FindReference(aName);
+ if (Result=Nil) then
+ Raise EWidgets.CreateFmt(SErrUnknownReference,[aName]);
end;
procedure TWebWidgetReferences.RemoveReference(const aName: String);
-begin
+Var
+ Idx:Integer;
+begin
+ Idx:=IndexOfReference(aName);
+ if Idx<>-1 then
+ Delete(Idx);
end;
function TWebWidgetReferences.GetElementByName(const aName: String): TJSHTMLElement;
-begin
+Var
+ J : JSValue;
+ Arr : TJSArray absolute J;
+
+begin
+ Result:=Nil;
+ if FRefs=Nil then
+ exit;
+ J:=FRefs[LowerCase(aName)];
+ if isArray(J) and (Arr.Length>0) then
+ Result:=TJSHTMLElement(Arr[0])
end;
function TWebWidgetReferences.GetElementsByName(const aName: String): TJSHTMLElementArray;
-begin
+Var
+ J : JSValue;
+ Arr : TJSArray absolute J;
+begin
+ Result:=Nil;
+ if FRefs=Nil then
+ exit;
+ J:=FRefs[LowerCase(aName)];
+ if isArray(J) and (Arr.Length>0) then
+ Result:=TJSHTMLElementArray(Arr)
end;
procedure TWebWidgetReferences.RefreshFromDOM(aElement: TJSHTMlElement);
-begin
+Var
+ I : Integer;
+
+begin
+ For I:=0 to Count-1 do
+ RefreshFromDOM(GetReferenceItem(I),aElement);
end;
{ TReferenceItem }
@@ -1160,21 +1231,36 @@ begin
Result:=RenderHTML(P);
FOwnsElement:=True;
FElement:=Result;
- ApplyData;
end;
+ ApplyData;
+ RefreshReferences; // After data, so data can be used in selectors
end;
end;
procedure TCustomWebWidget.InvalidateParentElement;
+
+Var
+ I : Integer;
+
begin
FParentElement:=nil;
+ For I:=0 to ChildCount-1 do
+ Children[i].InvalidateParentElement;
end;
procedure TCustomWebWidget.InvalidateElement;
+
+Var
+ I : Integer;
+
begin
If FStyles.Count>0 then
FStyles.ClearImported;
+ if Assigned(Freferences) then
+ FReferences.FRefs:=Nil;
FElement:=nil;
+ For I:=0 to ChildCount-1 do
+ Children[i].InvalidateElement;
end;
function TCustomWebWidget.WidgetClasses: String;
@@ -1199,6 +1285,7 @@ begin
ApplyWidgetSettings(el);
FElement:=El;
ApplyData;
+ RefreshReferences;// After data, so data can be used in selectors
end;
end;
Result:=FElement;
@@ -1407,6 +1494,9 @@ begin
if (AValue=FParent) then exit;
if (FixedParent<>Nil) then
Raise EWidgets.Create(SErrParentNotAllowed);
+ if Assigned(aValue) then
+ if Not aValue.AllowChildren then
+ Raise EWidgets.Create(SErrChildrenNotAllowed);
If Assigned(FParent) then
FParent.RemoveChild(Self);
// Unrender
@@ -1423,7 +1513,10 @@ begin
begin
FElement:=RenderHTML(ParentElement);
if Assigned(FElement) then
+ begin
ApplyData;
+ RefreshReferences;
+ end;
end;
end;
@@ -1638,20 +1731,28 @@ end;
procedure TCustomWebWidget.Refresh;
+Var
+ I : integer;
+
+begin
+ if IsRendered then
+ UnRender(ParentElement);
+ InvalidateParentElement;
+ EnsureElement;
+ For I:=0 to ChildCount-1 do
+ Children[i].Refresh;
+
+end;
+
+procedure TCustomWebWidget.Unrender;
+
Var
P : TJSHTMLElement;
begin
- P:=Nil;
- if Assigned(FElement) then
- begin
- P:=ParentElement;
- if Assigned(P) and (FElementID='') then // Do not remove when it's not ours to begin with
- P.removeChild(FElement);
- end;
- InvalidateParentElement;
- InvalidateElement;
- EnsureElement;
+ P:=ParentElement;
+ If Assigned(P) then
+ UnRender(P);
end;
procedure TCustomWebWidget.ApplyWidgetSettings(aElement: TJSHTMLElement);
@@ -1725,6 +1826,15 @@ begin
MaybeUnSet(ContentElement,SContentElementData);
end;
+procedure TCustomWebWidget.RefreshReferences;
+begin
+ if Assigned(FReferences) then
+ if Assigned(Element) then
+ References.RefreshFromDom(Element)
+ else
+ References.FRefs:=Nil;
+end;
+
class function TCustomWebWidget.GenerateID: String;
begin
@@ -1767,8 +1877,8 @@ begin
if Assigned(aParent) and Assigned(FElement) then
begin
if FOwnsElement then
- aParent.removeChild(FElement);
- FElement:=Nil
+ aParent.removeChild(TopElement);
+ InvalidateElement;
end;
end;
@@ -1777,7 +1887,8 @@ begin
if Assigned(FBeforeUnRenderHTML) then
FBeforeUnRenderHTML(Self);
RemoveData;
- DoUnRender(aParent);
+ if assigned(AParent) then
+ DoUnRender(aParent);
if Assigned(FAfterUnRenderHTML) then
FAfterUnRenderHTML(Self);
end;