* Remove debug output and add DoPush to RouteRequest

demo/fpcunit/browsertest.lpi

@@ -1,6 +1,6 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
-  <ProjectOptions BuildModesCount="1">
+  <ProjectOptions>
     <Version Value="12"/>
     <General>
       <Flags>
@@ -10,12 +10,11 @@
         <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="browsertest"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
     </General>
-    <BuildModes>
+    <BuildModes Count="1">
       <Item1 Name="default" Default="True"/>
     </BuildModes>
     <PublishOptions>

demo/fpcunit/browsertest.lpr

@@ -1,16 +1,91 @@
 program browsertest;
 
 uses
-  SysUtils, BrowserTestRunner, demotests, frmrunform;
+  SysUtils, TypInfo,BrowserTestRunner, demotests, frmrunform;
 
 Var
   Application : TTestRunner;
 
+Type
+
+  { TMyMethod }
+{$M+}
+  TMyMethod = Class(TObject)
+  Public
+    Class Function MyMethodAddress (aName : String) : Pointer;
+  Published
+    Procedure DoIt;
+  end;
+
+  { TMyMethod2 }
+
+  TMyMethod2 = Class(TMyMethod)
+  Published
+    Procedure DoIt2;
+  end;
+
+{ TMyMethod2 }
+
+procedure TMyMethod2.DoIt2;
 begin
-  Application:=TTestRunner.Create(Nil);
+  Writeln('OK 2');
+end;
+
+{ TMyMethod }
+
+class function TMyMethod.MyMethodAddress(aName: String): Pointer;
+
+Var
+  i : integer;
+  TI : TTypeInfoClass;
+  N,MN : String;
+
+begin
+  Result:=nil;
+  N:=LowerCase(aName);
+  TI:=TypeInfo(Self);
+  MN:='';
+  While (MN='') and Assigned(TI) do
+    begin
+    I:=0;
+    While (MN='') and (I<TI.MethodCount) do
+      begin
+      If TI.GetMethod(i).Name=aName then
+        MN:=TI.GetMethod(i).Name;
+      Inc(I);
+      end;
+    if MN='' then
+      TI:=TI.Ancestor;
+    end;
+  if MN<>'' then
+    asm
+    return this[MN];
+    end;
+end;
+
+procedure TMyMethod.DoIt;
+begin
+  Writeln('Doit 1');
+end;
+
+Var
+  A : TMyMethod;
+  B : TMyMethod2;
+
+begin
+  A:=TMyMethod.Create();
+  A.Doit;
+  B:=TMyMethod2.Create();
+  B.Doit2;
+
+  Writeln('Doit A',A.MyMethodAddress('doit')<>Nil);
+  Writeln('Doit B',B.MyMethodAddress('doit')<>Nil);
+  Writeln('Doit2 A',A.MyMethodAddress('doit2')<>Nil);
+  Writeln('Doit2 B',B.MyMethodAddress('doit2')<>Nil);
+{  Application:=TTestRunner.Create(Nil);
   Application.RunFormClass:=TTestRunForm;
   Application.Initialize;
   Application.Run;
-  Application.Free;
+  Application.Free;}
 end.
 

demo/webwidget/designdemo/designdemo.lpr

@@ -1,7 +1,7 @@
 program designdemo;
 
 {$mode objfpc}
-{$DEFINE USEIDE}
+{ $DEFINE USEIDE}
 
 uses
   browserapp, JS, Classes, SysUtils, Web, designer, webideclient;

packages/rtl/pas2js_rtl.lpk

@@ -32,7 +32,9 @@
         <CompilerPath Value="pas2js"/>
         <ExecuteBefore>
           <Command Value="$MakeExe(IDE,pas2js) -O- -Jc -vbq pas2js_rtl.pas"/>
-          <ScanForFPCMsgs Value="True"/>
+          <Parsers Count="1">
+            <Item1 Value="Pas2JS"/>
+          </Parsers>
         </ExecuteBefore>
       </Other>
       <SkipCompiler Value="True"/>

packages/rtl/webrouter.pp

@@ -18,7 +18,8 @@
 }
 
 {$mode objfpc}
-
+// Define this to output some debugging output
+{ $DEFINE DEBUGROUTER }
 unit webrouter;
 
 interface
@@ -225,7 +226,7 @@ Type
     Procedure CheckDuplicate(APattern : String; isDefault : Boolean);
     // Actually route request. Override this for customized behaviour.
     function DoRouteRequest(ARoute : TRoute; Const AURL : String; AParams : TStrings) : TRoute; virtual;
-    function DoRouteRequest(AURL : String) : TRoute;
+    function DoRouteRequest(AURL : String; DoPush : Boolean = False) : TRoute;
   Public
     Constructor Create(AOwner: TComponent); override;
     Destructor Destroy; override;
@@ -253,13 +254,13 @@ Type
     function FindHTTPRoute(const Path: String; Params: TStrings): TRoute;
     function GetRoute(const Path: String; Params: TStrings): TRoute;
     // Do actual routing. Exceptions raised will not be caught.
-    // This bypasses the history mechanism.
-    Function RouteRequest(Const ARouteURL : String) : TRoute;
+    // If DoPush is true, the URL will be pushed on the browser history. If False, the route is simply activated.
+    Function RouteRequest(Const ARouteURL : String; DoPush : Boolean = False) : TRoute;
     // Extract request path from URL. By default, returns the URL
     function GetRequestPath(const URL: String): String; virtual;
     // Navigation. These are easy-access methods for history.
     function GetCurrentLocation: String;
-    // These pass by the history mechanism
+    // These use the history mechanism
     Function Push (location: TRawLocation) : TTransitionResult;
     Function Replace (location: TRawLocation) : TTransitionResult;
     function Go(N: integer): TTransitionResult;
@@ -618,7 +619,7 @@ begin
     Raise EHTTPRoute.CreateFmt('No route for URL: %s',[aURL]);
 end;
 
-function TRouter.DoRouteRequest(AURL: String): TRoute;
+function TRouter.DoRouteRequest(AURL: String; DoPush : Boolean = False): TRoute;
 
 Var
   APath : String;
@@ -629,7 +630,10 @@ begin
   Params:=TStringList.Create;
   try
     Result:=GetRoute(APath,Params);
-    Result:=DoRouteRequest(Result,aPath,Params);
+    if DoPush then
+      Push(aURL)
+    else
+      Result:=DoRouteRequest(Result,aPath,Params);
   finally
     Params.Free;
   end;
@@ -797,7 +801,7 @@ begin
     Raise EHTTPRoute.Create('Not found');
 end;
 
-function TRouter.RouteRequest(const ARouteURL: String): TRoute;
+function TRouter.RouteRequest(const ARouteURL: String; DoPush: Boolean): TRoute;
 
 Var
   AURL : String;
@@ -806,7 +810,7 @@ begin
   AURL:=ARouteURL;
   If Assigned(FBeforeRequest) then
     FBeforeRequest(Self,AURL);
-  Result:=DoRouteRequest(AURL);
+  Result:=DoRouteRequest(AURL,DoPush);
   If Assigned(FAfterRequest) then
     FAfterRequest(Self,AURL);
 end;
@@ -877,7 +881,7 @@ Function TRoute.MatchPattern(Const Path : String; L : TStrings) : Boolean;
   var
     P: Integer;
   begin
-    Writeln('ExtractNextPathLevel >:',Aleft,' (',aLvl,') ',aRight);
+    {$IFDEF DEBUGROUTER}Writeln('ExtractNextPathLevel >:',Aleft,' (',aLvl,') ',aRight);{$ENDIF}
     if (ALvl<>ADelim) then
       begin
       ALeft:=ALeft+ALvl;
@@ -892,7 +896,7 @@ Function TRoute.MatchPattern(Const Path : String; L : TStrings) : Boolean;
       P:=Length(ARight)+1;
     ALvl:=Copy(ARight,1,P-1);
     ARight:=Copy(ARight,P,MaxInt);
-    Writeln('ExtractNextPathLevel <:',Aleft,' (',aLvl,') ',aRight);
+    {$IFDEF DEBUGROUTER} Writeln('ExtractNextPathLevel <:',Aleft,' (',aLvl,') ',aRight);{$ENDIF}
   end;
 
   procedure ExtractPrevPathLevel(var ALeft: string;
@@ -900,7 +904,7 @@ Function TRoute.MatchPattern(Const Path : String; L : TStrings) : Boolean;
   var
     P,L: Integer;
   begin
-    Writeln('ExtractPrevPathLevel >:',Aleft,' (',aLvl,') ',aRight);
+    {$IFDEF DEBUGROUTER}Writeln('ExtractPrevPathLevel >:',Aleft,' (',aLvl,') ',aRight);{$ENDIF}
     if (ALvl<>ADelim) then
       begin
       ARight:=ALvl+ARight;
@@ -914,7 +918,7 @@ Function TRoute.MatchPattern(Const Path : String; L : TStrings) : Boolean;
     P:=RPos(ADelim,ALeft);
     ALvl:=Copy(ALeft,P+1,MaxInt);
     ALeft:=Copy(ALeft,1,P);
-    Writeln('ExtractPrevPathLevel <:',Aleft,' (',aLvl,') ',aRight);
+    {$IFDEF DEBUGROUTER} Writeln('ExtractPrevPathLevel <:',Aleft,' (',aLvl,') ',aRight);{$ENDIF}
   end;
 
   Procedure AddParam(aName,AValue : String);
@@ -947,12 +951,12 @@ begin
   VVal := '/'; // init value is '/', not ''
   VRightPat := APattern;
   VRightVal := APathInfo;
-  Writeln('Check match on ',URLPattern);
+  {$IFDEF DEBUGROUTER}Writeln('Check match on ',URLPattern);{$ENDIF}
   repeat
     // Extract next part
     ExtractNextPathLevel(VLeftPat, VPat, VRightPat);
     ExtractNextPathLevel(VLeftVal, VVal, VRightVal);
-    Writeln('Pat: ',VPat,' Val: ',VVal);
+      {$IFDEF DEBUGROUTER}Writeln('Pat: ',VPat,' Val: ',VVal);{$ENDIF}
     if StartsWith(':',VPat) then
       AddParam(Copy(VPat,2,Maxint),VVal)
     else