paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-31 22:10:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented a stack of javascriptstacks. InitializeJavaScriptStack creates and adds a new JSStack to this stack, FreeJavascriptStack destroys and removes it again

Browse Source 
git-svn-id: trunk@14994 -
This commit is contained in:
joost 2010-03-09 08:45:45 +00:00
parent cee190b1f8
commit 0dd62e7d05
2 changed files with 46 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
packages/fcl-web/src/fphtml.pp
View File

@ -69,24 +69,28 @@ type
FBaseURL: string;
FMessageBoxHandler: TMessageBoxHandler;
FScriptName: string;
FScriptStack: TFPObjectList;
procedure SetBaseURL(const AValue: string);
procedure SetScriptName(const AValue: string);
protected
function GetScriptFileReferences: TStringList; virtual; abstract;
function GetCurrentJavaScriptStack: TJavaScriptStack; virtual; abstract;
function GetCurrentJavaScriptStack: TJavaScriptStack; virtual;
function GetScripts: TFPObjectList; virtual; abstract;
function GetRequest: TRequest;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddScriptFileReference(AScriptFile: String); virtual; abstract;
function InitializeJavaScriptStack: TJavaScriptStack; virtual; abstract;
function CreateNewJavascriptStack: TJavaScriptStack; virtual; abstract;
function InitializeJavaScriptStack: TJavaScriptStack;
procedure FreeJavascriptStack; virtual;
function HasJavascriptStack: boolean; virtual; abstract;
function GetUrl(ParamNames, ParamValues, KeepParams: array of string; Action: string = ''): string; virtual; abstract;
procedure InitializeAjaxRequest; virtual;
procedure InitializeShowRequest; virtual;
procedure CleanupShowRequest; virtual;
procedure CleanupAfterRequest; virtual;
procedure FreeJavascriptStack; virtual; abstract;
procedure BeforeGenerateHead; virtual;
procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); virtual; abstract;
function MessageBox(AText: String; Buttons: TWebButtons): string; virtual;
function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons): string; virtual; abstract;
@ -110,6 +114,7 @@ type
FSendXMLAnswer: boolean;
FXMLAnswer: TXMLDocument;
FRootNode: TDOMNode;
FWebController: TWebController;
function GetXMLAnswer: TXMLDocument;
public
constructor Create(AWebController: TWebController; AResponse: TResponse); virtual;
@ -1134,13 +1139,16 @@ constructor TAjaxResponse.Create(AWebController: TWebController;
begin
FSendXMLAnswer:=true;
FResponse:=AResponse;
FJavascriptCallStack:=AWebController.InitializeJavaScriptStack;
FWebController := AWebController;
FJavascriptCallStack:=FWebController.InitializeJavaScriptStack;
end;
destructor TAjaxResponse.Destroy;
begin
FXMLAnswer.Free;
FJavascriptCallStack.Free;
assert(FWebController.CurrentJavaScriptStack=FJavascriptCallStack);
FWebController.FreeJavascriptStack;
FJavascriptCallStack:=nil;
inherited Destroy;
end;
@ -1193,6 +1201,11 @@ begin
FScriptName:=AValue;
end;
function TWebController.GetCurrentJavaScriptStack: TJavaScriptStack;
begin
result := TJavaScriptStack(FScriptStack.Items[FScriptStack.Count-1]);
end;
procedure TWebController.InitializeAjaxRequest;
begin
// do nothing
@ -1203,11 +1216,21 @@ begin
// do nothing
end;
procedure TWebController.CleanupShowRequest;
begin
// Do Nothing
end;
procedure TWebController.CleanupAfterRequest;
begin
// Do Nothing
end;
procedure TWebController.BeforeGenerateHead;
begin
// do nothing
end;
function TWebController.MessageBox(AText: String; Buttons: TWebButtons): string;
begin
if assigned(MessageBoxHandler) then
@ -1229,15 +1252,28 @@ begin
inherited Create(AOwner);
{ TODO : Do this prperly using a notification. And make the WebController property readonly }
if owner is TWebPage then TWebPage(Owner).WebController := self;
FScriptStack := TFPObjectList.Create(true);
end;
destructor TWebController.Destroy;
begin
if (Owner is TWebPage) and (TWebPage(Owner).WebController=self) then
TWebPage(Owner).WebController := nil;
FScriptStack.Free;
inherited Destroy;
end;
function TWebController.InitializeJavaScriptStack: TJavaScriptStack;
begin
result := CreateNewJavascriptStack;
FScriptStack.Add(result);
end;
procedure TWebController.FreeJavascriptStack;
begin
FScriptStack.Delete(FScriptStack.Count-1);
end;
end.

30
packages/fcl-web/src/webpage.pp
View File

@ -23,19 +23,15 @@ type
TStandardWebController = class(TWebController)
private
FScriptFileReferences: TStringList;
FCurrentJavascriptStack: TJavaScriptStack;
FScripts: TFPObjectList;
protected
function GetScriptFileReferences: TStringList; override;
function GetScripts: TFPObjectList; override;
function GetCurrentJavaScriptStack: TJavaScriptStack; override;
procedure SetCurrentJavascriptStack(const AJavascriptStack: TJavaScriptStack);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function InitializeJavaScriptStack: TJavaScriptStack; override;
function CreateNewJavascriptStack: TJavaScriptStack; override;
function GetUrl(ParamNames, ParamValues, KeepParams: array of string; Action: string = ''): string; override;
procedure FreeJavascriptStack; override;
procedure BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string); override;
procedure AddScriptFileReference(AScriptFile: String); override;
function DefaultMessageBoxHandler(Sender: TObject; AText: String; Buttons: TWebButtons): string; override;
@ -207,6 +203,8 @@ begin
WebController.InitializeShowRequest;
DoBeforeShowPage(ARequest);
AResponse.Content := ProduceContent;
if HasWebController then
WebController.CleanupShowRequest;
end;
finally
CleanupAfterRequest;
@ -333,16 +331,6 @@ begin
Result:=FScripts;
end;
function TStandardWebController.GetCurrentJavaScriptStack: TJavaScriptStack;
begin
Result:=FCurrentJavascriptStack;
end;
procedure TStandardWebController.SetCurrentJavascriptStack(const AJavascriptStack: TJavaScriptStack);
begin
FCurrentJavascriptStack := AJavascriptStack;
end;
function TStandardWebController.CreateNewScript: TStringList;
begin
Result:=TStringList.Create;
@ -400,12 +388,9 @@ begin
inherited Destroy;
end;
function TStandardWebController.InitializeJavaScriptStack: TJavaScriptStack;
function TStandardWebController.CreateNewJavascriptStack: TJavaScriptStack;
begin
if assigned(FCurrentJavascriptStack) then
raise exception.Create('There is still an old JavascriptStack available');
FCurrentJavascriptStack := TJavaScriptStack.Create(self);
Result:=FCurrentJavascriptStack;
Result:=TJavaScriptStack.Create(self);
end;
function TStandardWebController.GetUrl(ParamNames, ParamValues,
@ -491,11 +476,6 @@ begin
result := result + ConnectChar + p
end;
procedure TStandardWebController.FreeJavascriptStack;
begin
FreeAndNil(FCurrentJavascriptStack);
end;
procedure TStandardWebController.BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string);
begin
if AnEvent='onclick' then