* Added TWebController.onGetURL property

 * Made TWebPage.Module public
 * Fixed handling ajax-calls of components within containers
 * THtmlContentProducer.GetIdentification added
 * Ability to reset the iteration-level

git-svn-id: trunk@17615 -

packages/fcl-web/src/base/fphtml.pp

@@ -39,6 +39,7 @@ type
   TWebButtons = array of TWebButton;
 
   TMessageBoxHandler = function(Sender: TObject; AText: String; Buttons: TWebButtons; Loaded: string = ''): string of object;
+  TOnGetUrlProc = procedure(ParamNames, ParamValues, KeepParams: array of string; Action: string; var URL: string) of object;
   TWebController = class;
   THTMLContentProducer = class;
 
@@ -125,6 +126,7 @@ type
     FAddRelURLPrefix: boolean;
     FBaseURL: string;
     FMessageBoxHandler: TMessageBoxHandler;
+    FOnGetURL: TOnGetUrlProc;
     FScriptName: string;
     FScriptStack: TFPObjectList;
     FIterationIDs: array of string;
@@ -139,6 +141,7 @@ type
     function GetStyleSheetReferences: TContainerStylesheets; virtual; abstract;
     function GetScripts: TFPObjectList; virtual; abstract;
     function GetRequest: TRequest;
+    property OnGetURL: TOnGetUrlProc read FOnGetURL write FOnGetURL;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -164,6 +167,7 @@ type
     procedure ShowRegisteredScript(ScriptID: integer); virtual; abstract;
 
     function IncrementIterationLevel: integer; virtual;
+    function ResetIterationLevel: integer; virtual;
     procedure SetIterationIDSuffix(AIterationLevel: integer; IDSuffix: string); virtual;
     function GetIterationIDSuffix: string; virtual;
     procedure DecrementIterationLevel; virtual;
@@ -247,6 +251,7 @@ type
     procedure SetParent(const AValue: TComponent);
   Protected
     function CreateWriter (Doc : THTMLDocument) : THTMLWriter; virtual;
+    function GetIdentification: string; virtual;
     function GetIDSuffix: string; virtual;
     procedure SetIDSuffix(const AValue: string); virtual;
   protected
@@ -284,6 +289,7 @@ type
     function MoveContentProducer(MoveElement, MoveBeforeElement: THTMLContentProducer) : boolean;
     procedure HandleAjaxRequest(ARequest: TRequest; AnAjaxResponse: TAjaxResponse); virtual;
     procedure ForeachContentProducer(AForeachChildsProc: TForeachContentProducerProc; Recursive: boolean);
+    property Identification: string read GetIdentification;
     property Childs[Index: integer]: THTMLContentProducer read GetContentProducers;
     property AcceptChildsAtDesignTime: boolean read FAcceptChildsAtDesignTime;
     property parent: TComponent read FParent write SetParent;
@@ -676,6 +682,11 @@ begin
   Result := FChilds;
 end;
 
+function THTMLContentProducer.GetIdentification: string;
+begin
+  result := '';
+end;
+
 function THTMLContentProducer.ProduceContent: String;
 var WCreated, created : boolean;
     el : THtmlCustomElement;
@@ -1440,6 +1451,11 @@ begin
   SetLength(FIterationIDs,Result);
 end;
 
+function TWebController.ResetIterationLevel: integer;
+begin
+  SetLength(FIterationIDs,0);
+end;
+
 procedure TWebController.SetIterationIDSuffix(AIterationLevel: integer; IDSuffix: string);
 begin
   FIterationIDs[AIterationLevel-1]:=IDSuffix;

packages/fcl-web/src/base/webpage.pp

@@ -61,6 +61,8 @@ type
     function CreateNewScript: TStringList; override;
     procedure ShowRegisteredScript(ScriptID: integer); override;
     procedure FreeScript(var AScript: TStringList); override;
+  published
+    property OnGetURL;
   end;
 
   { TWebPage }
@@ -89,7 +91,6 @@ type
     procedure DoHandleAjaxRequest(ARequest: TRequest; AnAjaxResponse: TAjaxResponse; var Handled: boolean); virtual;
     procedure DoBeforeRequest(ARequest: TRequest); virtual;
     procedure DoBeforeShowPage(ARequest: TRequest); virtual;
-    property WebModule: TFPWebModule read FWebModule;
     procedure DoCleanupAfterRequest(const AContentProducer: THTMLContentProducer);
     procedure SetRequest(ARequest: TRequest); virtual;
     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
@@ -114,6 +115,7 @@ type
     property ContentProducers[Index: integer]: THTMLContentProducer read GetContentProducer;
     property HasWebController: boolean read GetHasWebController;
     property WebController: TWebController read GetWebController write FWebController;
+    property WebModule: TFPWebModule read FWebModule;
   published
     property BeforeRequest: TRequestEvent read FBeforeRequest write FBeforeRequest;
     property BeforeShowPage: TRequestEvent read FBeforeShowPage write FBeforeShowPage;
@@ -263,7 +265,7 @@ begin
               AComponent:=self;
               while (i > 0) and (assigned(AComponent)) do
                 begin
-                AComponent := FindComponent(copy(CompName,1,i-1));
+                AComponent := AComponent.FindComponent(copy(CompName,1,i-1));
                 CompName := copy(compname,i+1,length(compname)-i);
                 i := pos('$',CompName);
                 end;
@@ -277,6 +279,7 @@ begin
                 if ASuffixID<>'' then
                   begin
                   SetIdSuffixes(THTMLContentProducer(AComponent));
+                  webcontroller.ResetIterationLevel;
                   end;
                 THTMLContentProducer(AComponent).HandleAjaxRequest(ARequest, AnAjaxResponse);
                 end;
@@ -611,7 +614,9 @@ begin
 
   p := copy(qs,1,length(qs)-1);
   if p <> '' then
-    result := result + ConnectChar + p
+    result := result + ConnectChar + p;
+  if assigned(OnGetURL) then
+    OnGetURL(ParamNames, ParamValues, KeepParams, Action, Result);
 end;
 
 procedure TStandardWebController.BindJavascriptCallstackToElement(AComponent: TComponent; AnElement: THtmlCustomElement; AnEvent: string);