mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-19 04:19:09 +02:00
codetools: started tool to explore fpc sources
git-svn-id: trunk@20435 -
This commit is contained in:
parent
82eab88ac2
commit
62772a8398
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -118,6 +118,8 @@ components/codetools/examples/fixfilenames.lpi svneol=native#text/plain
|
|||||||
components/codetools/examples/fixfilenames.pas svneol=native#text/plain
|
components/codetools/examples/fixfilenames.pas svneol=native#text/plain
|
||||||
components/codetools/examples/fixh2pasdirectives.lpi svneol=native#text/plain
|
components/codetools/examples/fixh2pasdirectives.lpi svneol=native#text/plain
|
||||||
components/codetools/examples/fixh2pasdirectives.lpr svneol=native#text/plain
|
components/codetools/examples/fixh2pasdirectives.lpr svneol=native#text/plain
|
||||||
|
components/codetools/examples/fpcunitlinks.lpi svneol=native#text/plain
|
||||||
|
components/codetools/examples/fpcunitlinks.pas svneol=native#text/pascal
|
||||||
components/codetools/examples/getcontext.lpi svneol=native#text/plain
|
components/codetools/examples/getcontext.lpi svneol=native#text/plain
|
||||||
components/codetools/examples/getcontext.lpr svneol=native#text/plain
|
components/codetools/examples/getcontext.lpr svneol=native#text/plain
|
||||||
components/codetools/examples/h2pastest.lpi svneol=native#text/plain
|
components/codetools/examples/h2pastest.lpi svneol=native#text/plain
|
||||||
|
65
components/codetools/examples/fpcunitlinks.lpi
Normal file
65
components/codetools/examples/fpcunitlinks.lpi
Normal file
@ -0,0 +1,65 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="7"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<MainUnitHasUsesSectionForAllUnits Value="False"/>
|
||||||
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
|
<MainUnitHasTitleStatement Value="False"/>
|
||||||
|
<LRSInOutputDirectory Value="False"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<TargetFileExt Value=""/>
|
||||||
|
<Title Value="fpcunitlinks"/>
|
||||||
|
</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="1">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="CodeTools"/>
|
||||||
|
</Item1>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="5">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="fpcunitlinks.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="FPCUnitLinks"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="scanexamples/brokenfilenames.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="BrokenFilenames"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="scanexamples/brokenincfiles.inc"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit2>
|
||||||
|
<Unit3>
|
||||||
|
<Filename Value="scanexamples/empty.inc"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit3>
|
||||||
|
<Unit4>
|
||||||
|
<Filename Value="scanexamples/indentation.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="Indentation"/>
|
||||||
|
</Unit4>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="8"/>
|
||||||
|
<Other>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
</CONFIG>
|
69
components/codetools/examples/fpcunitlinks.pas
Normal file
69
components/codetools/examples/fpcunitlinks.pas
Normal file
@ -0,0 +1,69 @@
|
|||||||
|
{
|
||||||
|
***************************************************************************
|
||||||
|
* *
|
||||||
|
* 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:
|
||||||
|
List fpc units.
|
||||||
|
}
|
||||||
|
program FPCUnitLinks;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, DefineTemplates, CodeToolsConfig, FileProcs,
|
||||||
|
CodeToolsStructs, CodeToolManager, CodeCache, CodeBeautifier;
|
||||||
|
|
||||||
|
procedure CollectUnits(Dir: string; List: TStringList);
|
||||||
|
var
|
||||||
|
FileInfo: TSearchRec;
|
||||||
|
begin
|
||||||
|
if FindFirstUTF8(Dir+FileMask,faAnyFile,FileInfo)=0 then begin
|
||||||
|
repeat
|
||||||
|
// check if special file
|
||||||
|
if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='')
|
||||||
|
then
|
||||||
|
continue;
|
||||||
|
|
||||||
|
if FilenameIsPascalUnit(FileInfo.Name,false) then begin
|
||||||
|
List.Add(Dir+FileInfo.Name);
|
||||||
|
end else if (FileInfo.Attr and faDirectory)>0 then begin
|
||||||
|
CollectUnits(Dir+);
|
||||||
|
end;
|
||||||
|
until FindNextUTF8(FileInfo)<>0;
|
||||||
|
end;
|
||||||
|
FindCloseUTF8(FileInfo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
FPCSrcDir: String;
|
||||||
|
Files: TStringList;
|
||||||
|
begin
|
||||||
|
if Paramcount<>1 then begin
|
||||||
|
writeln('Usage: '+ParamStrUTF8(0)+' fpc-source-directory');
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
FPCSrcDir:=AppendPathDelim(ExpandFileNameUTF8(ParamStrUTF8(1)));
|
||||||
|
Files:=TStringList.Create;
|
||||||
|
CollectUnits(FPCSrcDir,Files);
|
||||||
|
writeln(Files.Count);
|
||||||
|
Files.Free;
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user