diff --git a/tools/namespaceslist/makenamespaceslist.lpi b/tools/namespaceslist/makenamespaceslist.lpi new file mode 100644 index 0000000..086a1e9 --- /dev/null +++ b/tools/namespaceslist/makenamespaceslist.lpi @@ -0,0 +1,61 @@ + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <Units> + <Unit> + <Filename Value="makenamespaceslist.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="makenamespaceslist"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Other> + <ConfigFile> + <WriteConfigFilePath Value=""/> + </ConfigFile> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/tools/namespaceslist/makenamespaceslist.lpr b/tools/namespaceslist/makenamespaceslist.lpr new file mode 100644 index 0000000..6406fbe --- /dev/null +++ b/tools/namespaceslist/makenamespaceslist.lpr @@ -0,0 +1,158 @@ +program makenamespaceslist; +{$mode objfpc} +{$h+} + +uses sysutils, classes; + +Function ExtractInclude(const aFileName : string) : string; + +Const + SInclude = '{$include '; + SI = '{$i '; + + +var + aFile: TStringList; + FN,S : String; + P : Integer; + +begin + Result:=''; + aFile:=TStringList.Create; + try + aFile.LoadFromFile(aFileName); + For S in aFile do + begin + FN:=S; + P:=Pos(SInclude,LowerCase(FN)); + if P<>0 then + Delete(FN,1,P+Length(SInclude)-1) + else + begin + P:=Pos(SI,LowerCase(FN)); + if P<>0 then + Delete(FN,1,P+Length(SI)-1) + end; + if P<>0 then + begin + P:=Pos('}',FN); + if P>0 then + begin + FN:=Trim(Copy(FN,1,P-1)); + FN:=ExtractFilePath(aFileName)+FN; + Result:=ExpandFileName(FN); + end; + end; + end; + finally + aFile.Free; + end; +end; + +Procedure AddNameSpaces(const aBaseDir,aSubDir : String; aList : TStrings; IsKnownList : Boolean); + +var + Info : TSearchRec; + Ext : string; + NS,NonNS: String; + +begin + Writeln('Examining dir: ',aSubDir+AllFilesMask); + if FindFirst(aSubDir+AllFilesMask,0,Info)=0 then + try + Repeat + if ((Info.Attr and faDirectory)=0) then + begin + Ext:=ExtractFileExt(Info.Name); + Writeln('Examining ',Info.Name); + if SameText(Ext,'.pp') or SameText(Ext,'.pas') then + begin + NS:=aSubDir+Info.Name; + NonNS:=ExtractInclude(NS); + Writeln(NS,' -> ',NonNS); + if NonNS<>'' then + begin + if IsKnownList then + begin + NS:='*'+ChangeFileExt(ExtractFileName(NS),''); + NonNS:=ChangeFileExt(ExtractFileName(NonNS),''); + end + else + begin + NS:=ExtractRelativePath(aBaseDir,NS); + NonNS:=ExtractRelativePath(aBaseDir,NonNS); + end; + aList.Add(NonNS+'='+NS); + end; + end; + end; + Until (FindNext(Info)<>0); + finally + FindClose(Info); + end; +end; + +Procedure CreateNameSpaces(const aBaseDir : string; const aListFile : String; MakeKnownList : Boolean); + +var + L : TStringList; + Info : TSearchRec; + Subdir : string; + +begin + L:=TStringList.Create; + try + if FindFirst(aBaseDir+AllFilesMask,faDirectory,Info)=0 then + try + Repeat + if ((Info.Attr and faDirectory)=faDirectory) and + Not ((Info.Name='.') or (Info.Name='..')) then + begin + SubDir:=aBaseDir+Info.Name+PathDelim+'namespaced'+PathDelim; + if DirectoryExists(SubDir) then + AddNameSpaces(aBaseDir,SubDir,L,MakeKnownList); + end; + Until FindNext(Info)<>0; + finally + FindClose(Info); + end; + if L.Count>0 then + begin + Writeln('Writing ',L.Count,' namespaces to ',aListFile); + L.SaveToFile(aListFile) + end + else + Writeln('Error : no namespaced files found'); + finally + L.Free; + end; +end; + + +var + ListFile,BaseDir : String; + MakeKnownList : Boolean; + +begin + BaseDir:=ParamStr(1); + if BaseDir='-k' then + begin + MakeKnownList:=True; + BaseDir:=ParamStr(2); + end; + if (BaseDir='') then + begin + Writeln('Usage : ',ExtractFileName(Paramstr(0)),' [-k] DIR [LISTFILE]'); + Writeln('If Listfile is not specified then it defaults to : DIR/namespaces.lst'); + Halt(1); + end; + BaseDir:=IncludeTrailingPathDelimiter(BaseDir); + ListFile:=ParamStr(2+Ord(MakeKNownList)); + if ListFile='' then + if MakeKnownList then + ListFile:=BaseDir+'knownaliases.lst' + else + ListFile:=BaseDir+'namespaces.lst'; + CreateNameSpaces(BaseDir,ListFile,MakeKnownList); +end. +