codetools: added functions to search for resource directives platform independent

git-svn-id: trunk@13030 -

.gitattributes

@@ -104,6 +104,8 @@ components/codetools/examples/methodjumping.lpi svneol=native#text/plain
 components/codetools/examples/methodjumping.pas svneol=native#text/plain
 components/codetools/examples/reduceifdefs.lpi svneol=native#text/plain
 components/codetools/examples/reduceifdefs.lpr svneol=native#text/plain
+components/codetools/examples/replaceresourcedirectives.lpi svneol=native#text/plain
+components/codetools/examples/replaceresourcedirectives.lpr svneol=native#text/plain
 components/codetools/examples/scanexamples/BigLettersUnit.pas svneol=native#text/plain
 components/codetools/examples/scanexamples/addeventexample.pas svneol=native#text/plain
 components/codetools/examples/scanexamples/brokenfilenames.pas svneol=native#text/plain

components/codetools/codetoolmanager.pas

@@ -319,10 +319,10 @@ type
           var NewCode: TCodeBuffer;
           var NewX, NewY, NewTopLine: integer): boolean;
     function FindResourceDirective(Code: TCodeBuffer; StartX, StartY: integer;
-          var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer;
-          const Filename: string = ''): boolean;
-    function AddResourceDirective(Code: TCodeBuffer; const Filename: string
-          ): boolean;
+          out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
+          const Filename: string = ''; SearchInCleanSrc: boolean = true): boolean;
+    function AddResourceDirective(Code: TCodeBuffer; const Filename: string;
+          SearchInCleanSrc: boolean = true): boolean;
     function FixIncludeFilenames(Code: TCodeBuffer; Recursive: boolean;
           out MissingIncludeFilesCodeXYPos: TFPList): boolean;
     function FixMissingH2PasDirectives(Code: TCodeBuffer;
@@ -2352,45 +2352,92 @@ end;
 
 function TCodeToolManager.FindResourceDirective(Code: TCodeBuffer; StartX,
   StartY: integer;
-  var NewCode: TCodeBuffer; var NewX, NewY, NewTopLine: integer;
-  const Filename: string): boolean;
+  out NewCode: TCodeBuffer; out NewX, NewY, NewTopLine: integer;
+  const Filename: string; SearchInCleanSrc: boolean): boolean;
 var
   CursorPos: TCodeXYPosition;
   NewPos: TCodeXYPosition;
+  Tree: TCompilerDirectivesTree;
+  p: integer;
 begin
   Result:=false;
   {$IFDEF CTDEBUG}
   DebugLn('TCodeToolManager.FindResourceDirective A ',Code.Filename);
   {$ENDIF}
-  if not InitCurCodeTool(Code) then exit;
-  CursorPos.X:=StartX;
-  CursorPos.Y:=StartY;
-  CursorPos.Code:=Code;
-  try
-    Result:=FCurCodeTool.FindResourceDirective(CursorPos,NewPos,NewTopLine,
-                                               Filename);
-    if Result then begin
-      NewX:=NewPos.X;
-      NewY:=NewPos.Y;
-      NewCode:=NewPos.Code;
+  NewCode:=nil;
+  NewX:=0;
+  NewY:=0;
+  NewTopLine:=0;
+  if SearchInCleanSrc then begin
+    if not InitCurCodeTool(Code) then exit;
+    CursorPos.X:=StartX;
+    CursorPos.Y:=StartY;
+    CursorPos.Code:=Code;
+    try
+      Result:=FCurCodeTool.FindResourceDirective(CursorPos,NewPos,NewTopLine,
+                                                 Filename);
+      if Result then begin
+        NewX:=NewPos.X;
+        NewY:=NewPos.Y;
+        NewCode:=NewPos.Code;
+      end;
+    except
+      on e: Exception do Result:=HandleException(e);
+    end;
+  end else begin
+    try
+      Tree:=TCompilerDirectivesTree.Create;
+      try
+        Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
+        Code.LineColToPosition(StartY,StartX,p);
+        Result:=Tree.NodeStartToCodePos(Tree.FindResourceDirective(Filename,p),
+                                        CursorPos);
+        NewCode:=CursorPos.Code;
+        NewX:=CursorPos.X;
+        NewY:=CursorPos.Y;
+        NewTopLine:=NewY;
+      finally
+        Tree.Free;
+      end;
+    except
+      on e: Exception do Result:=HandleException(e);
     end;
-  except
-    on e: Exception do Result:=HandleException(e);
   end;
 end;
 
 function TCodeToolManager.AddResourceDirective(Code: TCodeBuffer;
-  const Filename: string): boolean;
+  const Filename: string; SearchInCleanSrc: boolean): boolean;
+var
+  Tree: TCompilerDirectivesTree;
+  Node: TCodeTreeNode;
 begin
   Result:=false;
   {$IFDEF CTDEBUG}
   DebugLn('TCodeToolManager.AddResourceDirective A ',Code.Filename,' Filename=',Filename);
   {$ENDIF}
-  if not InitCurCodeTool(Code) then exit;
-  try
-    Result:=FCurCodeTool.AddResourceDirective(Filename,SourceChangeCache);
-  except
-    on e: Exception do Result:=HandleException(e);
+  if SearchInCleanSrc then begin
+    if not InitCurCodeTool(Code) then exit;
+    try
+      Result:=FCurCodeTool.AddResourceDirective(Filename,SourceChangeCache);
+    except
+      on e: Exception do Result:=HandleException(e);
+    end;
+  end else begin
+    try
+      Tree:=TCompilerDirectivesTree.Create;
+      try
+        Tree.Parse(Code,GetNestedCommentsFlagForFile(Code.Filename));
+        Node:=Tree.FindResourceDirective(Filename);
+        if Node=nil then
+          Result:=AddResourceDirective(Code,Filename,true)
+        else
+          Result:=true;
+      finally
+        Tree.Free;
+      end;
+    except
+      on e: Exception do Result:=HandleException(e);
+    end;
   end;
 end;
 

components/codetools/directivestree.pas

@@ -38,7 +38,7 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, SysUtils, FileProcs, CodeToolsStructs, BasicCodeTools,
-  KeywordFuncLists, LinkScanner, CodeCache, AVL_Tree,
+  KeywordFuncLists, LinkScanner, CodeAtom, CodeCache, AVL_Tree,
   CodeToolMemManager, CodeTree;
 
 type
@@ -180,6 +180,12 @@ type
                                    FindDefNodes: boolean);
     procedure FixMissingH2PasDirectives(var Changed: boolean);
     
+    function NodeStartToCodePos(Node: TCodeTreeNode;
+                                out CodePos: TCodeXYPosition): boolean;
+    function FindResourceDirective(const Filename: string = '';
+                                   StartPos: integer = 1): TCodeTreeNode;
+    function IsResourceDirective(Node: TCodeTreeNode;
+                                 const Filename: string = ''): boolean;
     function GetDirectiveName(Node: TCodeTreeNode): string;
     function GetDirective(Node: TCodeTreeNode): string;
     function GetIfExpression(Node: TCodeTreeNode;
@@ -372,7 +378,7 @@ begin
   cdnsLongSwitch  : Result:='LongSwitch';
   cdnsMode        : Result:='Mode';
   cdnsThreading   : Result:='Threading';
-  cdnsOther       : Result:='?';
+  cdnsOther       : Result:='Other';
   else              Result:='?';
   end;
 end;
@@ -540,7 +546,10 @@ function TCompilerDirectivesTree.ShortSwitchDirective: boolean;
 // example: {$H+} or {$H+, R- comment}
 begin
   Result:=true;
-  CreateChildNode(cdnDefine,cdnsShortSwitch);
+  if Src[AtomStart+3] in ['+','-'] then
+    CreateChildNode(cdnDefine,cdnsShortSwitch)
+  else
+    CreateChildNode(cdnDefine,cdnsOther);
   AtomStart:=SrcPos;
   EndChildNode;
 end;
@@ -2208,6 +2217,51 @@ begin
   end;
 end;
 
+function TCompilerDirectivesTree.NodeStartToCodePos(Node: TCodeTreeNode; out
+  CodePos: TCodeXYPosition): boolean;
+begin
+  CodePos.Code:=nil;
+  CodePos.Y:=0;
+  CodePos.X:=0;
+  if (Node=nil) or (Code=nil) then exit(false);
+  CodePos.Code:=Code;
+  Code.AbsoluteToLineCol(Node.StartPos,CodePos.Y,CodePos.X);
+  Result:=true;
+end;
+
+function TCompilerDirectivesTree.FindResourceDirective(const Filename: string;
+  StartPos: integer): TCodeTreeNode;
+begin
+  if Tree=nil then exit(nil);
+  Result:=Tree.Root;
+  while Result<>nil do begin
+    if (Result.StartPos>=StartPos)
+    and IsResourceDirective(Result,Filename) then exit;
+    Result:=Result.Next;
+  end;
+end;
+
+function TCompilerDirectivesTree.IsResourceDirective(Node: TCodeTreeNode;
+  const Filename: string): boolean;
+// search for {$R filename}
+// if filename='' then search for any {$R } directive
+// Beware: do not find {$R+}
+var
+  p: LongInt;
+begin
+  Result:=false;
+  if (Node=nil) or (Node.Desc<>cdnDefine) or (Node.SubDesc<>cdnsOther) then exit;
+  p:=Node.StartPos;
+  if (Node.EndPos-p>=5) and (Src[p]='{') and (Src[p+1]='$') and (Src[p+2]='R')
+  and IsSpaceChar[Src[p+3]] then
+  begin
+    if (Filename='') then exit(true);
+    inc(p,4);
+    while (p<Node.EndPos) and IsSpaceChar[Src[p]] do inc(p);
+    if CompareFilenames(Filename,copy(Src,p,Node.EndPos-p-1))=0 then exit(true);
+  end;
+end;
+
 function TCompilerDirectivesTree.GetDirectiveName(Node: TCodeTreeNode): string;
 begin
   Result:=GetIdentifier(@Src[Node.StartPos+2]);

components/codetools/examples/replaceresourcedirectives.lpi

@@ -0,0 +1,56 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="6"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <Title Value="reduceifdefs"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="CodeTools"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="replaceresourcedirectives.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="ReplaceResourceDirectives"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="scanexamples/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

components/codetools/examples/replaceresourcedirectives.lpr

@@ -0,0 +1,72 @@
+{
+ ***************************************************************************
+ *                                                                         *
+ *   This source is free software; you can redistribute it and/or modify   *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ *   This code is distributed in the hope that it will be useful, but      *
+ *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
+ *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
+ *   General Public License for more details.                              *
+ *                                                                         *
+ *   A copy of the GNU General Public License is available on the World    *
+ *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
+ *   obtain it by writing to the Free Software Foundation,                 *
+ *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
+ *                                                                         *
+ ***************************************************************************
+
+  Author: Mattias Gaertner
+
+  Abstract:
+    Demonstration of how to reduce IFDEFs in a source file.
+}
+program ReplaceResourceDirectives;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, CodeCache, CodeToolManager, FileProcs,
+  CodeTree, DirectivesTree;
+  
+var
+  Filename: string;
+  Code: TCodeBuffer;
+  NewCode: TCodeBuffer;
+  NewX, NewY, NewTopLine: integer;
+begin
+  // load the file
+  if ParamCount>=1 then
+    Filename:=ExpandFileName(ParamStr(1))
+  else
+    Filename:=ExpandFileName(SetDirSeparators('scanexamples/resourcetest1.pas'));
+  Code:=CodeToolBoss.LoadFile(Filename,false,false);
+  if Code=nil then
+    raise Exception.Create('loading failed '+Filename);
+    
+  if not CodeToolBoss.AddResourceDirective(Code,'*.res',false) then begin
+    writeln('FAILED: unable to add resource');
+    if CodeToolBoss.ErrorMessage<>'' then
+      writeln('CodeToolBoss.ErrorMessage=',CodeToolBoss.ErrorMessage);
+    halt;
+  end;
+
+  if not CodeToolBoss.FindResourceDirective(Code,1,1,
+    NewCode,NewX,NewY,NewTopLine,'',false) then
+  begin
+    writeln('FAILED: did not find the resource');
+    if CodeToolBoss.ErrorMessage<>'' then
+      writeln('CodeToolBoss.ErrorMessage=',CodeToolBoss.ErrorMessage);
+    halt;
+  end;
+  
+  writeln(NewCode.Filename,' X=',NewX,' Y=',NewY);
+
+  // write the new source:
+  writeln('-----------------------------------');
+  writeln(Code.Source);
+  writeln('-----------------------------------');
+end.
+