diff --git a/components/codetools/ctunitgroupgraph.pas b/components/codetools/ctunitgroupgraph.pas index 47bc452400..4545caeff6 100644 --- a/components/codetools/ctunitgroupgraph.pas +++ b/components/codetools/ctunitgroupgraph.pas @@ -45,6 +45,7 @@ type TUGGroup = class private + FBaseDir: string; FGroups: TUGGroups; FName: string; FUnits: TAVLTree; @@ -56,6 +57,7 @@ type procedure AddUnit(anUnit: TUGGroupUnit); procedure RemoveUnit(anUnit: TUGGroupUnit); property Name: string read FName write SetName; + property BaseDir: string read FBaseDir write FBaseDir; property Groups: TUGGroups read FGroups; property Units: TAVLTree read FUnits; // tree of TUGGroupUnit sorted for Filename end; diff --git a/components/codetools/fileprocs.pas b/components/codetools/fileprocs.pas index 1366d16edb..8131f019ca 100644 --- a/components/codetools/fileprocs.pas +++ b/components/codetools/fileprocs.pas @@ -114,6 +114,10 @@ function CreateRelativePath(const Filename, BaseDirectory: string; function FileIsInPath(const Filename, Path: string): boolean; inline; function AppendPathDelim(const Path: string): string; inline; function ChompPathDelim(const Path: string): string; inline; +function FilenameIsMatching(const Mask, Filename: string; + MatchExactly: boolean): boolean; +function FindNextDirectoryInFilename(const Filename: string; + var Position: integer): string; // file operations function FileExistsUTF8(const Filename: string): boolean; inline; @@ -143,8 +147,6 @@ function SearchFileInDir(const Filename, BaseDirectory: string; SearchCase: TCTSearchFileCase): string; function SearchFileInPath(const Filename, BasePath, SearchPath, Delimiter: string; SearchCase: TCTSearchFileCase): string; -function FilenameIsMatching(const Mask, Filename: string; - MatchExactly: boolean): boolean; function FindDiskFilename(const Filename: string): string; {$IFDEF darwin} function GetDarwinSystemFilename(Filename: string): string; @@ -1646,6 +1648,45 @@ begin //debugl(' [FilenameIsMatching] Result=',Result,' ',DirStartMask,',',length(Mask),' ',DirStartFile,',',length(Filename)); end; +function FindNextDirectoryInFilename(const Filename: string; + var Position: integer): string; +{ for example: + Unix: + '/a/b' -> returns first 'a', then 'b' + '/a/' -> returns 'a', then '' + '/a//' -> returns 'a', then '', then '' + 'a/b.pas' -> returns first 'a', then 'b.pas' + Windows + 'C:\a\b.pas' -> returns first 'C:\', then 'a', then 'b.pas' + 'C:\a\' -> returns first 'C:\', then 'a', then '' + 'C:\a\\' -> returns first 'C:\', then 'a', then '', then '' +} +var + StartPos: Integer; +begin + if Position>length(Filename) then exit(''); + {$IFDEF Windows} + if Position=1 then begin + Result := ExtractUNCVolume(Filename); + if Result<>'' then begin + // is it like \\?\C:\Directory? then also include the "C:\" part + if (Result = '\\?\') and (Length(FileName) > 6) and + (FileName[5] in ['a'..'z','A'..'Z']) and (FileName[6] = ':') and (FileName[7] = PathDelim) + then + Result := Copy(FileName, 1, 7); + Position:=length(Result)+1; + exit; + end; + end; + {$ENDIF} + if Filename[Position]=PathDelim then + inc(Position); + StartPos:=Position; + while (Position<=length(Filename)) and (Filename[Position]<>PathDelim) do + inc(Position); + Result:=copy(Filename,StartPos,Position-StartPos); +end; + procedure InvalidateFileStateCache(const Filename: string = ''); begin LazFileCache.InvalidateFileStateCache(Filename); diff --git a/components/codetools/ide/codyunitdepwnd.pas b/components/codetools/ide/codyunitdepwnd.pas index 5b8f5414e6..7efa2b759b 100644 --- a/components/codetools/ide/codyunitdepwnd.pas +++ b/components/codetools/ide/codyunitdepwnd.pas @@ -453,6 +453,9 @@ var begin if AProject=nil then exit; Result:=Groups.GetGroup(GroupPrefixProject,true); + Result.BaseDir:=ExtractFilePath(AProject.ProjectInfoFile); + if not FilenameIsAbsolute(Result.BaseDir) then + Result.BaseDir:=''; //debugln(['TUnitDependenciesDialog.CreateProjectGroup ',Result.Name,' FileCount=',AProject.FileCount]); for i:=0 to AProject.FileCount-1 do begin ProjFile:=AProject.Files[i]; @@ -478,6 +481,9 @@ var begin if APackage=nil then exit; Result:=Groups.GetGroup(APackage.Name,true); + Result.BaseDir:=APackage.DirectoryExpanded; + if not FilenameIsAbsolute(Result.BaseDir) then + Result.BaseDir:=''; //debugln(['TUnitDependenciesDialog.CreatePackageGroup ',Result.Name]); for i:=0 to APackage.FileCount-1 do begin Filename:=APackage.Files[i].GetFullFilename; @@ -515,6 +521,7 @@ var CurUnit: TUGGroupUnit; Directory: String; Grp: TUGGroup; + BaseDir: String; begin FPCSrcDir:=AppendPathDelim(GetFPCSrcDir); @@ -530,14 +537,16 @@ begin then continue; // a unit in the FPC sources - Directory:=ExtractFilePath(CurUnit.Filename); - Directory:=copy(Directory,length(FPCSrcDir)+1,length(Directory)); + BaseDir:=ExtractFilePath(CurUnit.Filename); + Directory:=copy(BaseDir,length(FPCSrcDir)+1,length(BaseDir)); Directory:=ExtractFilePathStart(Directory,2); if LeftStr(Directory,length('rtl'))='rtl' then Directory:='RTL' else if LeftStr(Directory,length('packages'))='packages' then System.Delete(Directory,1,length('packages'+PathDelim)); Grp:=Groups.GetGroup(GroupPrefixFPCSrc+Directory,true); + if Grp.BaseDir='' then + Grp.BaseDir:=BaseDir; //debugln(['TUnitDependenciesDialog.CreateFPCSrcGroups ',Grp.Name]); Grp.AddUnit(TUGGroupUnit(CurUnit)); end; @@ -620,6 +629,12 @@ var AVLNode: TAVLTreeNode; Group: TUGGroup; GroupNode: TUDNode; + Filename: String; + p: Integer; + Dir: String; + DirNode: TUDNode; + BaseDir: String; + CurDir: String; begin Filter:=UTF8LowerCase(GetAllUnitsFilter); ShowGroups:=AllUnitsShowGroupNodesSpeedButton.Down; @@ -627,25 +642,47 @@ begin RootNode:=TUDNode.Create; for AVLNode in UsesGraph.FilesTree do begin UGUnit:=TUGGroupUnit(AVLNode.Data); - NodeText:=ExtractFileName(UGUnit.Filename); + Filename:=UGUnit.Filename; + NodeText:=ExtractFileName(Filename); if (Filter<>'') and (Pos(Filter, UTF8LowerCase(NodeText))<1) then continue; Group:=UGUnit.Group; - if Group=nil then + BaseDir:=''; + if Group=nil then begin GroupName:=GroupNone - else + end else begin GroupName:=Group.Name; + if FilenameIsAbsolute(Group.BaseDir) then + BaseDir:=ChompPathDelim(Group.BaseDir); + end; ParentNode:=RootNode; if ShowGroups then begin // create group nodes GroupNode:=ParentNode.GetNode(udnGroup,GroupName,true); - GroupNode.Identifier:=GroupName; - GroupNode.Group:=GroupName; + if GroupNode.Identifier='' then begin + GroupNode.Identifier:=GroupName; + GroupNode.Group:=GroupName; + end; ParentNode:=GroupNode; + if FilenameIsAbsolute(BaseDir) and FilenameIsAbsolute(Filename) then + Filename:=CreateRelativePath(Filename,BaseDir); end; if ShowDirectories then begin // create directory nodes - + CurDir:=BaseDir; + p:=1; + repeat + Dir:=FindNextDirectoryInFilename(Filename,p); + if p>length(Filename) then break; + if Dir<>'' then begin + DirNode:=ParentNode.GetNode(udnDirectory,Dir,true); + CurDir+=PathDelim+Dir; + if DirNode.Identifier='' then begin + DirNode.Identifier:=CurDir; + end; + ParentNode:=DirNode; + end; + until false; end; Node:=ParentNode.GetNode(udnUnit, NodeText, true); Node.Identifier:=UGUnit.Filename;