codetools: started FindFileAtCursor

git-svn-id: trunk@53269 -

components/codetools/basiccodetools.pas

@@ -319,6 +319,8 @@ function RemoveUnitFromUsesSection(Source:TSourceLog;
 // compiler directives
 function FindIncludeDirective(const Source,Section:string; Index:integer;
    out IncludeStart,IncludeEnd:integer):boolean;
+function ExtractLongParamDirective(const Source: string; CommentStartPos: integer;
+   out DirectiveName, FileParam: string): boolean;
 function SplitCompilerDirective(const Directive:string;
    out DirectiveName,Parameters:string):boolean;
 
@@ -432,6 +434,36 @@ begin
   until Atom='';
 end;
 
+function ExtractLongParamDirective(const Source: string; CommentStartPos: integer;
+  out DirectiveName, FileParam: string): boolean;
+var
+  p, StartPos: PChar;
+begin
+  Result:=false;
+  FileParam:='';
+  if CommentStartPos>length(Source) then exit;
+  p:=@Source[CommentStartPos];
+  if (p^<>'{') or (p[1]<>'$') then exit;
+  inc(p,2);
+  StartPos:=p;
+  if not IsIdentStartChar[p^] then exit;
+  while IsIdentChar[p^] do inc(p);
+  DirectiveName:=copy(Source,StartPos-PChar(Source)+1,p-StartPos);
+  Result:=true;
+  while p^ in [' ',#9] do inc(p);
+  if p^='''' then begin
+    // 'param with spaces'
+    inc(p);
+    StartPos:=p;
+    while not (p^ in [#0,#10,#13,'''']) do inc(p);
+  end else begin
+    // param without spaces
+    StartPos:=p;
+    while not (p^ in [#0,#9,#10,#13,' ','}']) do inc(p);
+  end;
+  FileParam:=copy(Source,StartPos-PChar(Source)+1,p-StartPos);
+end;
+
 function SplitCompilerDirective(const Directive:string;
    out DirectiveName,Parameters:string):boolean;
 var EndPos,DirStart,DirEnd:integer;

components/codetools/codetoolmanager.pas

@@ -470,6 +470,10 @@ type
     function FindDeclarationOfPropertyPath(Code: TCodeBuffer;
           const PropertyPath: string; out NewCode: TCodeBuffer;
           out NewX, NewY, NewTopLine: integer): Boolean;
+    function FindFileAtCursor(Code: TCodeBuffer; X,Y: integer;
+      out Found: TFindFileAtCursorFlag; out FoundFilename: string;
+      Allowed: TFindFileAtCursorFlags = DefaultFindFileAtCursorAllowed;
+      StartPos: PCodeXYPosition = nil): boolean;
 
     // get code context
     function FindCodeContext(Code: TCodeBuffer; X,Y: integer;
@@ -2255,6 +2259,31 @@ begin
   {$ENDIF}
 end;
 
+function TCodeToolManager.FindFileAtCursor(Code: TCodeBuffer; X, Y: integer;
+  out Found: TFindFileAtCursorFlag; out FoundFilename: string;
+  Allowed: TFindFileAtCursorFlags; StartPos: PCodeXYPosition): boolean;
+var
+  CursorPos: TCodeXYPosition;
+begin
+  Result:=false;
+  {$IFDEF CTDEBUG}
+  DebugLn('TCodeToolManager.FindFileAtCursor A ',Code.Filename,' x=',dbgs(x),' y=',dbgs(y));
+  {$ENDIF}
+  if not InitCurCodeTool(Code) then exit;
+  CursorPos.X:=X;
+  CursorPos.Y:=Y;
+  CursorPos.Code:=Code;
+  try
+    Result:=FCurCodeTool.FindFileAtCursor(CursorPos,Found,FoundFilename,
+      Allowed,StartPos);
+  except
+    on e: Exception do HandleException(e);
+  end;
+  {$IFDEF CTDEBUG}
+  DebugLn('TCodeToolManager.FindFileAtCursor END ');
+  {$ENDIF}
+end;
+
 function TCodeToolManager.FindCodeContext(Code: TCodeBuffer; X, Y: integer; out
   CodeContexts: TCodeContextInfo): boolean;
 var

components/codetools/codetree.pas

@@ -80,10 +80,10 @@ const
   ctnVarDefinition      = 21;
   ctnConstDefinition    = 22;
   ctnGlobalProperty     = 23;
-  ctnUseUnit            = 24; // StartPos=unit, EndPos=unitname+inFilename, children ctnUseUnitNamespace, ctnUseUnitClearName
-  ctnVarArgs            = 25;
-  ctnUseUnitNamespace   = 26; // <namespace>.clearname.pas
-  ctnUseUnitClearName   = 27; // namespace.<clearname>.pas
+  ctnVarArgs            = 24;
+  ctnUseUnit            = 25; // StartPos=unit, EndPos=unitname+inFilename, children ctnUseUnitNamespace, ctnUseUnitClearName, parent ctnUsesSection
+  ctnUseUnitNamespace   = 26; // <namespace>.clearname.pas, parent ctnUseUnit
+  ctnUseUnitClearName   = 27; // namespace.<clearname>.pas, parent ctnUseUnit
 
   ctnClass              = 30;
   ctnClassInterface     = 31;

components/codetools/finddeclarationtool.pas

@@ -629,6 +629,7 @@ type
   //----------------------------------------------------------------------------
   // TFindDeclarationTool is source based and can therefore search for more
   // than declarations:
+type
   TFindSmartFlag = (
     fsfIncludeDirective, // search for include file
     fsfFindMainDeclaration, // stop if already on a declaration
@@ -636,7 +637,11 @@ type
     fsfSkipClassForward  // when a forward class was found, jump further to the class
     );
   TFindSmartFlags = set of TFindSmartFlag;
-  
+const
+  DefaultFindSmartFlags = [fsfIncludeDirective];
+  DefaultFindSmartHintFlags = DefaultFindSmartFlags+[fsfFindMainDeclaration];
+
+type
   TFindSrcStartType = (
     fsstIdentifier
     );
@@ -655,9 +660,18 @@ type
     foeEnumeratorCurrentExprType // expression type of 'enumerator Current'
     );
 
+  TFindFileAtCursorFlag = (
+    ffatNone,
+    ffatUsedUnit,
+    ffatIncludeFile,
+    ffatDisabledIncludeFile,
+    ffatResource,
+    ffatLiteral,
+    ffatComment
+    );
+  TFindFileAtCursorFlags = set of TFindFileAtCursorFlag;
 const
-  DefaultFindSmartFlags = [fsfIncludeDirective];
-  DefaultFindSmartHintFlags = DefaultFindSmartFlags+[fsfFindMainDeclaration];
+  DefaultFindFileAtCursorAllowed = [Low(TFindFileAtCursorFlag)..high(TFindFileAtCursorFlag)];
 
 type
   //----------------------------------------------------------------------------
@@ -853,7 +867,6 @@ type
     procedure OnFindUsedUnitIdentifier(Sender: TPascalParserTool;
       IdentifierCleanPos: integer; Range: TEPRIRange;
       Node: TCodeTreeNode; Data: Pointer; var {%H-}Abort: boolean);
-  protected
   public
     constructor Create;
     destructor Destroy; override;
@@ -903,7 +916,7 @@ type
     function FindUnitInAllUsesSections(const AnUnitName: string;
           out NamePos, InPos: TAtomPosition): boolean;
     function GetUnitNameForUsesSection(TargetTool: TFindDeclarationTool): string;
-    function GetUnitForUsesSection(TargetTool: TFindDeclarationTool): string; deprecated;
+    function GetUnitForUsesSection(TargetTool: TFindDeclarationTool): string; deprecated 'use GetUnitNameForUsesSection instead';
     function IsHiddenUsedUnit(TheUnitName: PChar): boolean;
 
     function FindCodeToolForUsedUnit(const AnUnitName, AnUnitInFilename: string;
@@ -919,6 +932,10 @@ type
 
     function IsIncludeDirectiveAtPos(CleanPos, CleanCodePosInFront: integer;
       out IncludeCode: TCodeBuffer): boolean;
+    function FindFileAtCursor(const CursorPos: TCodeXYPosition;
+      out Found: TFindFileAtCursorFlag; out FoundFilename: string;
+      Allowed: TFindFileAtCursorFlags = DefaultFindFileAtCursorAllowed;
+      StartPos: PCodeXYPosition = nil): boolean;
 
     function FindSmartHint(const CursorPos: TCodeXYPosition;
                     Flags: TFindSmartFlags = DefaultFindSmartHintFlags): string;
@@ -2786,6 +2803,8 @@ end;
 
 function TFindDeclarationTool.GetUnitNameForUsesSection(
   TargetTool: TFindDeclarationTool): string;
+// if unit is already used return ''
+// else return nice name
 var
   UsesNode: TCodeTreeNode;
   Alternative: String;
@@ -3471,6 +3490,121 @@ begin
   end;
 end;
 
+function TFindDeclarationTool.FindFileAtCursor(
+  const CursorPos: TCodeXYPosition; out Found: TFindFileAtCursorFlag; out
+  FoundFilename: string; Allowed: TFindFileAtCursorFlags;
+  StartPos: PCodeXYPosition): boolean;
+var
+  CleanPos, CommentStart, CommentEnd: integer;
+  Node: TCodeTreeNode;
+  aUnitName, UnitInFilename, DirectiveName, Param, Line: string;
+  NewCode: TCodeBuffer;
+  NewCodePtr: Pointer;
+  MissingIncludeFile: TMissingIncludeFile;
+begin
+  Result:=false;
+  Found:=ffatNone;
+  FoundFilename:='';
+  if StartPos<>nil then
+   StartPos^:=CleanCodeXYPosition;
+  if [ffatUsedUnit,ffatIncludeFile,ffatDisabledIncludeFile]*Allowed<>[]
+  then begin
+    try
+      BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanPos,
+                    [btSetIgnoreErrorPos,btCursorPosOutAllowed]);
+      Node:=FindDeepestNodeAtPos(CleanPos,false);
+      if Node<>nil then begin
+        // cursor in parsed code
+        if CleanPosIsInComment(CleanPos,Node.StartPos,CommentStart,CommentEnd,true)
+        then begin
+          // cursor in comment in parsed code
+          if (ffatIncludeFile in Allowed)
+          and IsIncludeDirectiveAtPos(CleanPos,CommentStart,NewCode) then begin
+            // enabled include directive
+            Found:=ffatIncludeFile;
+            FoundFilename:=NewCode.Filename;
+            Result:=true;
+            exit;
+          end else if ExtractLongParamDirective(Src,CommentStart,DirectiveName,Param)
+          then begin
+            DirectiveName:=lowercase(DirectiveName);
+            if (ffatDisabledIncludeFile in Allowed)
+            and ((DirectiveName='i') or (DirectiveName='include')) then begin
+              // disabled include directive
+              if (Param<>'') and (Param[1]<>'%') then begin
+                Result:=true;
+                Found:=ffatDisabledIncludeFile;
+                FoundFilename:=ResolveDots(GetForcedPathDelims(Param));
+                // search include file
+                MissingIncludeFile:=nil;
+                if Scanner.SearchIncludeFile(FoundFilename,NewCodePtr,
+                  MissingIncludeFile)
+                then
+                  FoundFilename:=TCodeBuffer(NewCodePtr).Filename;
+                exit;
+              end;
+            end else if (ffatResource in Allowed)
+            and ((DirectiveName='r') or (DirectiveName='resource')) then begin
+              // resource directive
+              Result:=true;
+              Found:=ffatResource;
+              FoundFilename:=ResolveDots(GetForcedPathDelims(Param));
+              if (FoundFilename<>'') and (copy(FoundFilename,1,2)='*.') then begin
+                Delete(FoundFilename,1,1);
+                FoundFilename:=ChangeFileExt(MainFilename,FoundFilename);
+              end else if not FilenameIsAbsolute(FoundFilename) then begin
+                FoundFilename:=ResolveDots(ExtractFilePath(MainFilename)+FoundFilename);
+              end;
+              exit;
+            end;
+          end;
+          if ffatComment in Allowed then begin
+            // ToDo: check comment
+
+          end;
+        end else begin
+          if Node.Desc in [ctnUseUnitClearName,ctnUseUnitNamespace] then
+            Node:=Node.Parent;
+          if Node.Desc=ctnUseUnit then begin
+            if (CleanPos>=Node.StartPos) and (CleanPos<Node.EndPos) then begin
+              // cursor on used unit
+              Found:=ffatUsedUnit;
+              if StartPos<>nil then
+                CleanPosToCaret(Node.StartPos,StartPos^);
+              MoveCursorToNodeStart(Node);
+              ReadNextAtom;
+              aUnitName:=ExtractUsedUnitNameAtCursor(@UnitInFilename);
+              NewCode:=FindUnitSource(aUnitName,UnitInFilename,false);
+              if NewCode<>nil then begin
+                FoundFilename:=NewCode.Filename;
+                Result:=true;
+              end else begin
+                FoundFilename:=UnitInFilename;
+                Result:=false;
+              end;
+              exit;
+            end;
+          end;
+        end;
+      end;
+    except
+      on ELinkScannerError do ;
+      on ECodeToolError do ;
+    end;
+  end;
+
+  // fallback: ignore parsed code and read the line at cursor directly
+  if (CursorPos.Y<1) or (CursorPos.Y>CursorPos.Code.LineCount) then exit;
+  Line:=CursorPos.Code.GetLine(CursorPos.Y,false);
+  if CursorPos.X>length(Line) then exit;
+  if ffatLiteral in Allowed then begin
+    // ToDo: check literal
+  end;
+  if ffatComment in Allowed then begin
+    // ToDo: check simple
+  end;
+end;
+
 function TFindDeclarationTool.FindDeclarationOfIdentAtParam(
   Params: TFindDeclarationParams): boolean;
 var

components/codetools/linkscanner.pas

@@ -567,8 +567,6 @@ type
     function DoDirective(StartPos, DirLen: integer): boolean;
     
     function IncludeFile(const AFilename: string): boolean;
-    function SearchIncludeFile(AFilename: string; out NewCode: Pointer;
-                         var MissingIncludeFile: TMissingIncludeFile): boolean;
     procedure PushIncludeLink(ACleanedPos, ASrcPos: integer; ACode: Pointer);
     function PopIncludeLink: TSourceLink;
     function GetIncludeFileIsMissing: boolean;
@@ -681,6 +679,9 @@ type
     function CleanPosIsAfterIgnorePos(CleanPos: integer): boolean;
     function LoadSourceCaseLoUp(const AFilename: string; AllowVirtual: boolean = false): pointer;
 
+    function SearchIncludeFile(AFilename: string; out NewCode: Pointer;
+                         var MissingIncludeFile: TMissingIncludeFile): boolean;
+
     function GuessMisplacedIfdefEndif(StartCursorPos: integer;
                                       StartCode: pointer;
                                       out EndCursorPos: integer;

components/codetools/tests/testfinddeclaration.pas

@@ -52,6 +52,7 @@ type
     procedure TestFindDeclaration_ObjCClass;
     procedure TestFindDeclaration_ObjCCategory;
     procedure TestFindDeclaration_Generics;
+    procedure TestFindDeclaration_FileAtCursor;
     procedure TestFindDeclaration_FPCTests;
     procedure TestFindDeclaration_LazTests;
   end;
@@ -311,6 +312,34 @@ begin
   FindDeclarations('moduletests/fdt_generics.pas');
 end;
 
+procedure TTestFindDeclaration.TestFindDeclaration_FileAtCursor;
+var
+  Code, SubUnit2Code: TCodeBuffer;
+  Found: TFindFileAtCursorFlag;
+  FoundFilename: string;
+begin
+  Code:=CodeToolBoss.CreateFile('test1.lpr');
+  Code.Source:='uses unit2 in ''sub/unit2.pas'';'+LineEnding;
+  SubUnit2Code:=CodeToolBoss.CreateFile('unit2.pas');
+  try
+    // test cursor on 'unit2'
+    CodeToolBoss.FindFileAtCursor(Code,5,1,Found,FoundFilename);
+    // test cursor on 'in'
+    // test cursor on in-file literal
+  finally
+    Code.IsDeleted:=true;
+    SubUnit2Code.IsDeleted:=true;
+  end;
+  // ToDo: test $i in code
+  // ToDo: test $i 'file with spaces' in code
+  // ToDo: test $i in disabled code
+  // ToDo: test $R file.lfm
+  // ToDo: test $R *.lfm
+  // ToDo: test 'readme.txt' in active code
+  // ToDo: test readme.txt in active code fails
+  // ToDo: test readme.txt in comment works
+end;
+
 procedure TTestFindDeclaration.TestFindDeclaration_FPCTests;
 begin
   TestFiles('fpctests');