Converter: Improved syntax of replacement functions. Can test param values. Refactoring.

git-svn-id: trunk@26640 -

converter/convcodetool.pas

@@ -23,21 +23,6 @@ type
   // For future, when .dfm form file can be used for both Delphi and Lazarus.
 {  TFormFileAction = (faUseDfm, faRenameToLfm, faUseBothDfmAndLfm); }
 
-  { TFuncCallPosition }
-
-  TCalledFuncInfo = class
-  private
-    fFuncName: string;
-    fReplacement: string;
-    fStartPos: Integer;
-    fEndPos: Integer;
-    fInclSemiColon: string;
-    fParams: TStringList;
-  public
-    constructor Create(aFuncName, aReplacement: string);
-    destructor Destroy; override;
-  end;
-
   { TConvDelphiCodeTool }
 
   TConvDelphiCodeTool = class
@@ -93,22 +78,6 @@ type
 
 implementation
 
-{ TCalledFuncInfo }
-
-constructor TCalledFuncInfo.Create(aFuncName, aReplacement: string);
-begin
-  fFuncName:=aFuncName;
-  fReplacement:=aReplacement;
-  fParams:=TStringList.Create;
-end;
-
-destructor TCalledFuncInfo.Destroy;
-begin
-  fParams.Free;
-  inherited Destroy;
-end;
-
-
 { TConvDelphiCodeTool }
 
 constructor TConvDelphiCodeTool.Create(Code: TCodeBuffer);
@@ -505,7 +474,7 @@ procedure SplitParam(const aStr: string; aDelimiter: Char; ResultList: TStringLi
       Dec(Len);
     end
     else
-      raise EConverterError.Create('Replacement function parameter should start with "$".');
+      raise EDelphiConverterError.Create('Replacement function parameter should start with "$".');
     ResultList.Add(Copy(aStr, Start, Len));
   end;
 
@@ -543,7 +512,7 @@ var
   // Parse replacement params. They show which original params are copied where.
   // Returns the first position where comments can be searched from.
   var
-    ParamBeg, ParamEnd: Integer;          // Start and end of parameters.
+    ParamBeg, ParamEnd: Integer;        // Start and end of parameters.
     s: String;
   begin
     Result:=1;
@@ -551,9 +520,9 @@ var
     if ParamBeg>0 then begin
       ParamEnd:=Pos(')', aStr);
       if ParamEnd=0 then
-        raise EConverterError.Create('")" is missing from replacement function.');
+        raise EDelphiConverterError.Create('")" is missing from replacement function.');
       s:=Copy(aStr, ParamBeg+1, ParamEnd-ParamBeg-1);
-      SplitParam(s, ',', ParamList);      // The actual parameter list.
+      SplitParam(s, ',', ParamList);    // The actual parameter list.
       BodyEnd:=ParamBeg-1;
       Result:=ParamEnd+1;
     end;
@@ -570,9 +539,9 @@ var
     for i:=0 to ParamList.Count-1 do begin
       ParamPos:=StrToInt(ParamList[i]);
       if ParamPos < 1 then
-        raise EConverterError.Create('Replacement function parameter number should be >= 1.');
+        raise EDelphiConverterError.Create('Replacement function parameter number should be >= 1.');
-      Param:='nil';         // Default value if not found from original code.
+      Param:='nil';                // Default value if not found from original code.
-      if ParamPos <= aParams.Count then
+      if ParamPos<=aParams.Count then
         Param:=aParams[ParamPos-1];
       if Result<>'' then
         Result:=Result+', ';
@@ -619,13 +588,13 @@ begin
     for i:=fFuncsToReplace.Count-1 downto 0 do begin
       FuncInfo:=TCalledFuncInfo(fFuncsToReplace[i]);
       BodyEnd:=-1;
-      PossibleCommPos:=ParseReplacementParams(FuncInfo.fReplacement);
+      PossibleCommPos:=ParseReplacementParams(FuncInfo.fReplFunc);
       NewParamStr:=CollectParams(FuncInfo.fParams);
-      Comment:=GetComment(FuncInfo.fReplacement, PossibleCommPos);
+      Comment:=GetComment(FuncInfo.fReplFunc, PossibleCommPos);
       // Separate function body
       if BodyEnd=-1 then
-        BodyEnd:=Length(FuncInfo.fReplacement);
+        BodyEnd:=Length(FuncInfo.fReplFunc);
-      NewFunc:=Trim(Copy(FuncInfo.fReplacement, 1, BodyEnd));
+      NewFunc:=Trim(Copy(FuncInfo.fReplFunc, 1, BodyEnd));
       NewFunc:=Format('%s(%s)%s { *Converted from %s* %s }',
         [NewFunc, NewParamStr, FuncInfo.fInclSemiColon, FuncInfo.fFuncName, Comment]);
       // Old function call with params for IDE message output.
@@ -714,7 +683,7 @@ var
               break;
             end;
             if not AtomIsChar(',') then
-              raise EConverterError.Create('Bracket not found');
+              raise EDelphiConverterError.Create('Bracket not found');
             ReadNextAtom;
           end;
         end;
@@ -722,6 +691,7 @@ var
       else
         CheckSemiColon(FuncInfo);
     end;
+    FuncInfo.UpdateReplacement;
   end;
 
   procedure ReadFuncCall(MaxPos: Integer);
@@ -761,7 +731,7 @@ var
     while StartPos<=aNode.EndPos do begin
       case Src[StartPos] of
 
-      '{': // pascal comment
+      '{':                         // pascal comment
         begin
           inc(StartPos);
           CommentLvl:=1;
@@ -782,7 +752,7 @@ var
           inc(StartPos);
         end;
 
-      '/':  // Delphi comment
+      '/':                         // Delphi comment
         if (Src[StartPos+1]<>'/') then begin
           inc(StartPos);
         end else begin
@@ -803,7 +773,7 @@ var
             inc(StartPos);
         end;
 
-      '(': // turbo pascal comment
+      '(':                         // turbo pascal comment
         if (Src[StartPos+1]<>'*') then begin
           inc(StartPos);
         end else begin
@@ -825,8 +795,7 @@ var
         ReadFuncCall(aNode.EndPos);
 
       '''':
-        begin
+        begin                      // skip string constant
-          // skip string constant
           inc(StartPos);
           while (StartPos<=aNode.EndPos) do begin
             if (not (Src[StartPos] in ['''',#10,#13])) then

converter/convertertypes.pas

@@ -13,7 +13,7 @@ type
 
   { EConverterError }
 
-  EConverterError = class(Exception)
+  EDelphiConverterError = class(Exception)
     constructor Create(const AMessage: string);
   end;
 
@@ -22,7 +22,7 @@ implementation
 
 { EConverterError }
 
-constructor EConverterError.Create(const AMessage: string);
+constructor EDelphiConverterError.Create(const AMessage: string);
 begin
   inherited Create('Converter: '+AMessage);
 end;

converter/convertsettings.pas

@@ -253,7 +253,7 @@ begin
 
   // Map Delphi function names to FCL/LCL functions.
   TheMap:=fReplaceFuncs;
-  MapReplacement('ShellExecute',      'OpenURL($3) // Can be also OpenDocument depending on parameter.');
+  MapReplacement('ShellExecute', 'if $3 match ":/" then OpenURL($3); OpenDocument($3)');
   // File name encoding. ToDo: add other similar funcs with UTF8 counterparts.
   MapReplacement('FileExists',        'FileExistsUTF8($1)');
   // File functions using a handle.

converter/replacenamesunit.pas

@@ -7,10 +7,30 @@ interface
 uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
   Grids, Buttons, ExtCtrls, Menus, CodeToolsStructs, SynRegExpr,
-  LazarusIDEStrConsts;
+  LazarusIDEStrConsts, ConverterTypes;
 
 type
 
+  { TCalledFuncInfo }
+
+  TCalledFuncInfo = class
+  // Used for function replacements.
+  private
+    function ParseIf(var StartPos: integer): boolean;
+  public
+    fFuncName: string;
+    fReplClause: string;
+    fReplFunc: string;
+    fStartPos: Integer;
+    fEndPos: Integer;
+    fInclSemiColon: string;
+    fParams: TStringList;
+    constructor Create(aFuncName, aReplacement: string);
+    destructor Destroy; override;
+    procedure UpdateReplacement;
+  end;
+
+
   { TStringMapUpdater }
 
   TStringMapUpdater = class
@@ -136,6 +156,144 @@ begin
 end;
 
 
+{ TCalledFuncInfo }
+
+constructor TCalledFuncInfo.Create(aFuncName, aReplacement: string);
+begin
+  fFuncName:=aFuncName;
+  fReplClause:=aReplacement;
+  fParams:=TStringList.Create;
+end;
+
+destructor TCalledFuncInfo.Destroy;
+begin
+  fParams.Free;
+  inherited Destroy;
+end;
+
+function TCalledFuncInfo.ParseIf(var StartPos: integer): boolean;
+// Parse a clause starting with "if" and set fReplFunc if the condition matches.
+// Example:  'if $3 match ":/" then OpenURL($3); OpenDocument($3)'
+// Return true if the condition matched.
+var
+  RE: TRegExpr;
+  ParamPos: integer;
+  Str, Param: String;
+  Repl: String;
+
+  procedure ReadWhiteSpace(NewStartPos: integer);
+  begin
+    StartPos:=NewStartPos;
+    while (StartPos<=Length(fReplClause)) and (fReplClause[StartPos]=' ') do
+      inc(StartPos);
+  end;
+
+  function ParseParamNum: integer;
+  var
+    EndPos: Integer;
+    s: String;
+  begin
+    if fReplClause[StartPos]<>'$' then
+      raise EDelphiConverterError.Create(Format('$ expected, %s found.', [fReplClause[StartPos]]));
+    Inc(StartPos);      // Skip $
+    EndPos:=StartPos;
+    while (EndPos<=Length(fReplClause)) and (fReplClause[EndPos] in ['0'..'9']) do
+      Inc(EndPos);
+    s:=Copy(fReplClause, StartPos, EndPos-StartPos);
+    Result:=StrToInt(s);
+    ReadWhiteSpace(EndPos);
+  end;
+
+  procedure ParseString(aStr: string);
+  var
+    EndPos: Integer;
+    s: String;
+  begin
+    EndPos:=StartPos;
+    while (EndPos<=Length(fReplClause)) and
+          (fReplClause[EndPos] in ['a'..'z','A'..'Z','_']) do
+      Inc(EndPos);
+    s:=Copy(fReplClause, StartPos, EndPos-StartPos);
+    if s<>aStr then
+      raise EDelphiConverterError.Create(Format('%s expected, %s found.', [aStr, s]));
+    ReadWhiteSpace(EndPos);
+  end;
+
+  function ParseDoubleQuoted: string;
+  var
+    EndPos: Integer;
+  begin
+    if fReplClause[StartPos]<>'"' then
+      raise EDelphiConverterError.Create(Format('" expected, %s found.', [fReplClause[StartPos]]));
+    Inc(StartPos);      // Skip "
+    EndPos:=StartPos;
+    while (EndPos<=Length(fReplClause)) and (fReplClause[EndPos]<>'"') do
+      inc(EndPos);
+    Result:=Copy(fReplClause, StartPos, EndPos-StartPos);
+    ReadWhiteSpace(EndPos+1);
+  end;
+
+  function GetReplacement: string;
+  var
+    EndPos: Integer;
+  begin
+    EndPos:=StartPos;
+    while (EndPos<=Length(fReplClause)) and (fReplClause[EndPos]<>';') do
+      inc(EndPos);
+    Result:=Copy(fReplClause, StartPos, EndPos-StartPos);
+    StartPos:=EndPos+1;    // Skip ';'
+  end;
+
+begin
+  // "if " is already skipped when coming here.
+  ReadWhiteSpace(StartPos);            // Possible space in the beginning.
+  ParamPos:=ParseParamNum;
+  ParseString('match');
+  Str:=ParseDoubleQuoted;
+  ParseString('then');
+  Repl:=GetReplacement;
+
+  Result:=False;
+  if ParamPos<=fParams.Count then begin
+    Param:=fParams[ParamPos-1];
+    RE:=TRegExpr.Create;
+    try
+      RE.Expression:=Str;
+      if RE.Exec(Param) then begin
+        fReplFunc:=Repl;
+        Result:=True;
+      end;
+    finally
+      RE.Free;
+    end;
+  end;
+end;
+
+procedure TCalledFuncInfo.UpdateReplacement;
+// Parse fReplClause and set fReplFunc, maybe conditionally based on parameters.
+var
+  StartPos, EndPos: Integer;
+begin
+  StartPos:=1;
+  while true do begin // StartPos<=Length(fReplClause)
+    // "If" condition can match or not. Continue if it didn't match.
+    if Copy(fReplClause, StartPos, 3) = 'if ' then begin
+      Inc(StartPos, 3);
+      if ParseIf(StartPos) then
+        Break;
+    end
+    else begin
+      // Replacement without conditions. Copy it and stop.
+      EndPos:=StartPos;
+      while (EndPos<=Length(fReplClause)) and (fReplClause[EndPos]<>';') do
+        inc(EndPos);
+      fReplFunc:=Copy(fReplClause, StartPos, EndPos-StartPos);
+      Break;
+    end;
+  end;
+end;
+
+
 { TStringMapUpdater }
 
 constructor TStringMapUpdater.Create(AStringsMap: TStringToStringTree);