Michael Schimmel
1107 lines
41 KiB
ObjectPascal
1107 lines
41 KiB
ObjectPascal
program ExtractPascalInterfaces;
|
|
|
|
{$APPTYPE CONSOLE}
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.IOUtils,
|
|
System.Classes,
|
|
System.Generics.Collections,
|
|
System.Generics.Defaults,
|
|
System.StrUtils,
|
|
System.Types,
|
|
System.Character,
|
|
Winapi.Windows; // For clipboard access
|
|
|
|
type
|
|
{ Forward declaration for TUnitInfoList needed in TUnitInfo }
|
|
TUnitInfo = class;
|
|
TUnitInfoList = TList<TUnitInfo>;
|
|
|
|
{ TUnitInfo holds information about a single Pascal unit }
|
|
TUnitInfo = class
|
|
private
|
|
FOriginalLines: TStringList;
|
|
procedure ExtractUsesFromClause(const Clause: string);
|
|
function StripCommentsFromUsesBlock(const Block: string): string;
|
|
function FindTerminatingSemicolon(const Block: string): Integer;
|
|
function CheckAndExtractKeywordContent(
|
|
const LineInput: string;
|
|
const KeywordUpperCase: string;
|
|
out ContentAfterKeyword: string
|
|
): Boolean;
|
|
public
|
|
Name: string;
|
|
NormalizedName: string;
|
|
FilePath: string;
|
|
InterfaceSection: TStringList;
|
|
InterfaceUses: TStringList;
|
|
|
|
AdjacencyList: TUnitInfoList;
|
|
InDegree: Integer;
|
|
Processed: Boolean;
|
|
|
|
// Fields for the -fc (focus complete) feature
|
|
IsFcStartFile: Boolean;
|
|
FullSource: TStringList;
|
|
|
|
constructor Create(const AFilePath: string);
|
|
destructor Destroy; override;
|
|
function ParseUnit: Boolean;
|
|
end;
|
|
|
|
const
|
|
DefaultExcludedDirNames: array[0..6] of string = ('.svn', '.git', '.hg', '__history', '__recovery', '.vs', '.vscode');
|
|
|
|
// Helper procedure to set clipboard text using WinAPI
|
|
procedure SetClipboardText(const Text: string);
|
|
var
|
|
hGlobal: THandle;
|
|
pGlobal: Pointer;
|
|
begin
|
|
if not OpenClipboard(0) then
|
|
RaiseLastOSError;
|
|
try
|
|
EmptyClipboard;
|
|
hGlobal := GlobalAlloc(GMEM_MOVEABLE, (Length(Text) + 1) * SizeOf(Char));
|
|
if hGlobal = 0 then
|
|
RaiseLastOSError;
|
|
|
|
pGlobal := GlobalLock(hGlobal);
|
|
if pGlobal = nil then
|
|
begin
|
|
GlobalFree(hGlobal);
|
|
RaiseLastOSError;
|
|
end;
|
|
|
|
try
|
|
Move(PChar(Text)^, pGlobal^, (Length(Text) + 1) * SizeOf(Char));
|
|
finally
|
|
GlobalUnlock(hGlobal);
|
|
end;
|
|
|
|
if SetClipboardData(CF_UNICODETEXT, hGlobal) = 0 then
|
|
begin
|
|
GlobalFree(hGlobal); // We must free it if SetClipboardData fails
|
|
RaiseLastOSError;
|
|
end;
|
|
// On success, the system owns the memory handle.
|
|
finally
|
|
CloseClipboard;
|
|
end;
|
|
end;
|
|
|
|
{ TUnitInfo implementation }
|
|
constructor TUnitInfo.Create(const AFilePath: string);
|
|
begin
|
|
inherited Create;
|
|
FilePath := AFilePath;
|
|
Name := '';
|
|
NormalizedName := '';
|
|
InterfaceSection := TStringList.Create;
|
|
InterfaceUses := TStringList.Create;
|
|
FOriginalLines := TStringList.Create;
|
|
AdjacencyList := TUnitInfoList.Create;
|
|
InDegree := 0;
|
|
Processed := False;
|
|
IsFcStartFile := False;
|
|
FullSource := TStringList.Create;
|
|
end;
|
|
|
|
destructor TUnitInfo.Destroy;
|
|
begin
|
|
InterfaceSection.Free;
|
|
InterfaceUses.Free;
|
|
FOriginalLines.Free;
|
|
AdjacencyList.Free;
|
|
FullSource.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TUnitInfo.StripCommentsFromUsesBlock(const Block: string): string;
|
|
var
|
|
Builder: TStringBuilder;
|
|
i: Integer;
|
|
L: Integer;
|
|
inLineComment: Boolean;
|
|
inBlockCommentParen: Boolean;
|
|
inBlockCommentBrace: Boolean;
|
|
currentChar, nextChar: Char;
|
|
tempResult: string;
|
|
begin
|
|
Builder := TStringBuilder.Create;
|
|
L := Length(Block);
|
|
i := 1;
|
|
inLineComment := False;
|
|
inBlockCommentParen := False;
|
|
inBlockCommentBrace := False;
|
|
while i <= L do
|
|
begin
|
|
currentChar := Block[i];
|
|
if i < L then
|
|
nextChar := Block[i + 1]
|
|
else
|
|
nextChar := #0;
|
|
if inLineComment then
|
|
begin
|
|
if (currentChar = #13) or (currentChar = #10) then
|
|
begin
|
|
inLineComment := False;
|
|
if (Builder.Length > 0) and (Builder[Builder.Length - 1] <> ' ') and (Builder[Builder.Length - 1] <> ',') then
|
|
Builder.Append(' ');
|
|
end;
|
|
Inc(i);
|
|
Continue;
|
|
end;
|
|
if inBlockCommentParen then
|
|
begin
|
|
if (currentChar = '*') and (nextChar = ')') then
|
|
begin
|
|
inBlockCommentParen := False;
|
|
Inc(i, 2);
|
|
end
|
|
else
|
|
Inc(i);
|
|
Continue;
|
|
end;
|
|
if inBlockCommentBrace then
|
|
begin
|
|
if currentChar = '}' then
|
|
begin
|
|
inBlockCommentBrace := False;
|
|
Inc(i);
|
|
end
|
|
else
|
|
Inc(i);
|
|
Continue;
|
|
end;
|
|
if (currentChar = '/') and (nextChar = '/') then
|
|
begin
|
|
inLineComment := True;
|
|
Inc(i, 2);
|
|
Continue;
|
|
end;
|
|
if (currentChar = '(') and (nextChar = '*') then
|
|
begin
|
|
inBlockCommentParen := True;
|
|
Inc(i, 2);
|
|
Continue;
|
|
end;
|
|
if currentChar = '{' then
|
|
begin
|
|
inBlockCommentBrace := True;
|
|
Inc(i);
|
|
Continue;
|
|
end;
|
|
if (currentChar = #13) or (currentChar = #10) or (currentChar = #9) then
|
|
begin
|
|
if (Builder.Length = 0) or ((Builder.Length > 0) and (Builder[Builder.Length - 1] <> ' ')) then
|
|
Builder.Append(' ');
|
|
Inc(i);
|
|
end
|
|
else
|
|
begin
|
|
Builder.Append(currentChar);
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
tempResult := Trim(Builder.ToString);
|
|
Builder.Free;
|
|
while Pos(' ', tempResult) > 0 do
|
|
tempResult := StringReplace(tempResult, ' ', ' ', [rfReplaceAll]);
|
|
tempResult := StringReplace(tempResult, ' ,', ',', [rfReplaceAll]);
|
|
tempResult := StringReplace(tempResult, ', ', ',', [rfReplaceAll]);
|
|
Result := tempResult;
|
|
end;
|
|
|
|
procedure TUnitInfo.ExtractUsesFromClause(const Clause: string);
|
|
var
|
|
parts: TArray<string>;
|
|
partName: string;
|
|
begin
|
|
if Trim(Clause) = '' then
|
|
Exit;
|
|
parts := Clause.Split([','], TStringSplitOptions.ExcludeEmpty);
|
|
for partName in parts do
|
|
begin
|
|
var pn := Trim(partName);
|
|
if pn <> '' then
|
|
InterfaceUses.Add(System.SysUtils.LowerCase(pn));
|
|
end;
|
|
end;
|
|
|
|
function TUnitInfo.FindTerminatingSemicolon(const Block: string): Integer;
|
|
var
|
|
i: Integer;
|
|
L: Integer;
|
|
inLineComment: Boolean;
|
|
inBlockCommentParen: Boolean;
|
|
inBlockCommentBrace: Boolean;
|
|
currentChar: Char;
|
|
nextChar: Char;
|
|
begin
|
|
Result := 0;
|
|
L := Length(Block);
|
|
i := 1;
|
|
inLineComment := False;
|
|
inBlockCommentParen := False;
|
|
inBlockCommentBrace := False;
|
|
while i <= L do
|
|
begin
|
|
currentChar := Block[i];
|
|
if i < L then
|
|
nextChar := Block[i + 1]
|
|
else
|
|
nextChar := #0;
|
|
if inLineComment then
|
|
begin
|
|
if (currentChar = #13) or (currentChar = #10) then
|
|
inLineComment := False;
|
|
Inc(i);
|
|
Continue;
|
|
end;
|
|
if inBlockCommentParen then
|
|
begin
|
|
if (currentChar = '*') and (nextChar = ')') then
|
|
begin
|
|
inBlockCommentParen := False;
|
|
Inc(i, 2);
|
|
end
|
|
else
|
|
Inc(i);
|
|
Continue;
|
|
end;
|
|
if inBlockCommentBrace then
|
|
begin
|
|
if currentChar = '}' then
|
|
begin
|
|
inBlockCommentBrace := False;
|
|
Inc(i);
|
|
end
|
|
else
|
|
Inc(i);
|
|
Continue;
|
|
end;
|
|
if (currentChar = '/') and (nextChar = '/') then
|
|
begin
|
|
inLineComment := True;
|
|
Inc(i, 2);
|
|
Continue;
|
|
end;
|
|
if (currentChar = '(') and (nextChar = '*') then
|
|
begin
|
|
inBlockCommentParen := True;
|
|
Inc(i, 2);
|
|
Continue;
|
|
end;
|
|
if currentChar = '{' then
|
|
begin
|
|
inBlockCommentBrace := True;
|
|
Inc(i);
|
|
Continue;
|
|
end;
|
|
if currentChar = ';' then
|
|
begin
|
|
Result := i;
|
|
Exit;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
function TUnitInfo.CheckAndExtractKeywordContent(
|
|
const LineInput: string;
|
|
const KeywordUpperCase: string;
|
|
out ContentAfterKeyword: string
|
|
): Boolean;
|
|
var
|
|
trimmedLine: string;
|
|
keywordLen: Integer;
|
|
charAfterKeyword: Char;
|
|
begin
|
|
Result := False;
|
|
ContentAfterKeyword := '';
|
|
trimmedLine := Trim(LineInput);
|
|
keywordLen := Length(KeywordUpperCase);
|
|
if Length(trimmedLine) >= keywordLen then
|
|
begin
|
|
if System.SysUtils.UpperCase(Copy(trimmedLine, 1, keywordLen)) = KeywordUpperCase then
|
|
begin
|
|
if Length(trimmedLine) = keywordLen then
|
|
begin
|
|
Result := True;
|
|
ContentAfterKeyword := '';
|
|
end
|
|
else
|
|
begin
|
|
charAfterKeyword := trimmedLine[keywordLen + 1];
|
|
if not charAfterKeyword.IsLetterOrDigit then
|
|
begin
|
|
Result := True;
|
|
ContentAfterKeyword := Trim(Copy(trimmedLine, keywordLen + 1, MaxInt));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TUnitInfo.ParseUnit: Boolean;
|
|
var
|
|
i: Integer;
|
|
LineValue: string;
|
|
upperLine: string;
|
|
inInterface: Boolean;
|
|
inUsesBlock: Boolean;
|
|
usesBuilder: TStringBuilder;
|
|
potentialUnitNameLine: string;
|
|
nameExtracted: Boolean;
|
|
contentAfterKeyword: string;
|
|
accumulatedContent: string;
|
|
trueEndOfUsesPos: Integer;
|
|
contentToClean: string;
|
|
cleanedContent: string;
|
|
begin
|
|
Result := False;
|
|
if not TFile.Exists(FilePath) then
|
|
exit;
|
|
FOriginalLines.LoadFromFile(FilePath);
|
|
inInterface := False;
|
|
inUsesBlock := False;
|
|
nameExtracted := False;
|
|
usesBuilder := TStringBuilder.Create;
|
|
try
|
|
for i := 0 to FOriginalLines.Count - 1 do
|
|
begin
|
|
LineValue := FOriginalLines[i];
|
|
upperLine := System.SysUtils.UpperCase(Trim(LineValue));
|
|
|
|
if not nameExtracted and CheckAndExtractKeywordContent(LineValue, 'UNIT', contentAfterKeyword) then
|
|
begin
|
|
potentialUnitNameLine := contentAfterKeyword;
|
|
if Pos(';', potentialUnitNameLine) > 0 then
|
|
Name := Trim(Copy(potentialUnitNameLine, 1, Pos(';', potentialUnitNameLine) - 1))
|
|
else
|
|
Name := Trim(potentialUnitNameLine);
|
|
if Name <> '' then
|
|
begin
|
|
NormalizedName := System.SysUtils.LowerCase(Name);
|
|
nameExtracted := True;
|
|
end
|
|
else
|
|
begin
|
|
WriteLn('Warning: Could not parse unit name from: ' + LineValue + ' in file ' + FilePath);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
if not inInterface and upperLine.StartsWith('INTERFACE') then
|
|
begin
|
|
inInterface := True;
|
|
end;
|
|
|
|
if inInterface then
|
|
begin
|
|
if upperLine.StartsWith('IMPLEMENTATION') or upperLine.StartsWith('END.') then
|
|
begin
|
|
if inUsesBlock and (usesBuilder.Length > 0) then
|
|
begin
|
|
accumulatedContent := usesBuilder.ToString;
|
|
trueEndOfUsesPos := FindTerminatingSemicolon(accumulatedContent);
|
|
if trueEndOfUsesPos > 0 then
|
|
contentToClean := Trim(Copy(accumulatedContent, 1, trueEndOfUsesPos - 1))
|
|
else
|
|
contentToClean := Trim(accumulatedContent);
|
|
if contentToClean <> '' then
|
|
begin
|
|
cleanedContent := StripCommentsFromUsesBlock(contentToClean);
|
|
if Trim(cleanedContent) <> '' then
|
|
ExtractUsesFromClause(cleanedContent);
|
|
end;
|
|
end;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
|
|
var lineIsForUses := inUsesBlock;
|
|
if not inUsesBlock and CheckAndExtractKeywordContent(LineValue, 'USES', contentAfterKeyword) then
|
|
begin
|
|
usesBuilder.Clear;
|
|
inUsesBlock := True;
|
|
usesBuilder.AppendLine(contentAfterKeyword); // Use AppendLine to preserve structure for comment stripping
|
|
lineIsForUses := True;
|
|
end
|
|
else if inUsesBlock then
|
|
begin
|
|
usesBuilder.AppendLine(Trim(LineValue));
|
|
lineIsForUses := True;
|
|
end;
|
|
|
|
if not upperLine.StartsWith('INTERFACE') and not lineIsForUses then
|
|
begin
|
|
InterfaceSection.Add(LineValue);
|
|
end;
|
|
|
|
if inUsesBlock then
|
|
begin
|
|
accumulatedContent := usesBuilder.ToString;
|
|
trueEndOfUsesPos := FindTerminatingSemicolon(accumulatedContent);
|
|
if trueEndOfUsesPos > 0 then
|
|
begin
|
|
contentToClean := Trim(Copy(accumulatedContent, 1, trueEndOfUsesPos - 1));
|
|
usesBuilder.Clear;
|
|
inUsesBlock := False;
|
|
if contentToClean <> '' then
|
|
begin
|
|
cleanedContent := StripCommentsFromUsesBlock(contentToClean);
|
|
if Trim(cleanedContent) <> '' then
|
|
ExtractUsesFromClause(cleanedContent);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if inInterface then
|
|
begin
|
|
Result := True;
|
|
end;
|
|
finally
|
|
usesBuilder.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure CollectPasFilesRecursively(const Path: string; Files: TStringList; const ExcludedDirPatterns: TStrings);
|
|
var
|
|
dirName: string;
|
|
foundPasFiles: TStringDynArray;
|
|
subDirs: TStringDynArray;
|
|
i: Integer;
|
|
currentSubDir: string;
|
|
isExcluded: Boolean;
|
|
exclusionPattern: string;
|
|
begin
|
|
try
|
|
foundPasFiles := TDirectory.GetFiles(Path, '*.pas', TSearchOption.soTopDirectoryOnly);
|
|
for i := Low(foundPasFiles) to High(foundPasFiles) do
|
|
Files.Add(foundPasFiles[i]);
|
|
except
|
|
on E: EDirectoryNotFoundException do
|
|
begin
|
|
WriteLn('Warning: Could not access path ' + Path + ' while scanning files: ' + E.Message);
|
|
Exit;
|
|
end;
|
|
on E: EInOutError do
|
|
begin
|
|
WriteLn('Warning: IO error accessing path ' + Path + ' while scanning files: ' + E.Message);
|
|
Exit;
|
|
end;
|
|
end;
|
|
try
|
|
subDirs := TDirectory.GetDirectories(Path);
|
|
except
|
|
on E: EDirectoryNotFoundException do
|
|
begin
|
|
WriteLn('Warning: Could not access path ' + Path + ' while scanning subdirectories: ' + E.Message);
|
|
Exit;
|
|
end;
|
|
on E: EInOutError do
|
|
begin
|
|
WriteLn('Warning: IO error accessing path ' + Path + ' while scanning subdirectories: ' + E.Message);
|
|
Exit;
|
|
end;
|
|
end;
|
|
for currentSubDir in subDirs do
|
|
begin
|
|
dirName := ExtractFileName(currentSubDir);
|
|
isExcluded := False;
|
|
for exclusionPattern in ExcludedDirPatterns do
|
|
begin
|
|
if SameText(dirName, exclusionPattern) then
|
|
begin
|
|
isExcluded := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if not isExcluded then
|
|
CollectPasFilesRecursively(currentSubDir, Files, ExcludedDirPatterns);
|
|
end;
|
|
end;
|
|
|
|
var
|
|
allUnits: TDictionary<string, TUnitInfo>;
|
|
sortedUnits: TList<TUnitInfo>;
|
|
sourceDirectories: TList<string>;
|
|
processingQueue: TQueue<TUnitInfo>;
|
|
excludedDirectoryPatternsList: TStringList;
|
|
allFoundPasFilesList: TStringList;
|
|
item: TUnitInfo;
|
|
outputLineText: string;
|
|
recursiveSearch: Boolean;
|
|
outputFileName: string;
|
|
writeToClipboard: Boolean;
|
|
currentParamIndex: Integer;
|
|
focusMode: Boolean;
|
|
fcMode: Boolean;
|
|
focusFilesParameter: string;
|
|
initialFocusFiles: TStringList;
|
|
filesToExcludeFromOutput: TStringList;
|
|
|
|
begin
|
|
recursiveSearch := False;
|
|
outputFileName := '';
|
|
writeToClipboard := False;
|
|
sourceDirectories := nil;
|
|
allUnits := nil;
|
|
sortedUnits := nil;
|
|
processingQueue := nil;
|
|
excludedDirectoryPatternsList := nil;
|
|
allFoundPasFilesList := nil;
|
|
initialFocusFiles := nil;
|
|
filesToExcludeFromOutput := nil;
|
|
exitcode := 0;
|
|
focusMode := False;
|
|
fcMode := False;
|
|
focusFilesParameter := '';
|
|
|
|
try
|
|
var usageStr := 'Usage: ExtractPascalInterfaces.exe [-r] [-dirs <file>] [-f|-fx|-fc <files>] [-o <file> | -c] <SrcDir1> ...';
|
|
|
|
WriteLn('Delphi Interface Extractor');
|
|
sourceDirectories := TList<string>.Create;
|
|
excludedDirectoryPatternsList := TStringList.Create;
|
|
initialFocusFiles := TStringList.Create;
|
|
filesToExcludeFromOutput := TStringList.Create;
|
|
for var excludedName in DefaultExcludedDirNames do
|
|
excludedDirectoryPatternsList.Add(excludedName);
|
|
|
|
currentParamIndex := 1;
|
|
while currentParamIndex <= ParamCount do
|
|
begin
|
|
var currentParam := ParamStr(currentParamIndex);
|
|
|
|
if SameText(currentParam, '-r') then
|
|
begin
|
|
recursiveSearch := True;
|
|
Inc(currentParamIndex);
|
|
end
|
|
else if SameText(currentParam, '-c') then
|
|
begin
|
|
writeToClipboard := True;
|
|
Inc(currentParamIndex);
|
|
end
|
|
else if SameText(currentParam, '-o') then
|
|
begin
|
|
if currentParamIndex + 1 <= ParamCount then
|
|
begin
|
|
outputFileName := ParamStr(currentParamIndex + 1);
|
|
Inc(currentParamIndex, 2);
|
|
end
|
|
else
|
|
begin
|
|
WriteLn('Error: Missing filename after -o option.');
|
|
WriteLn(usageStr);
|
|
exitcode := 1;
|
|
exit;
|
|
end;
|
|
end
|
|
else if SameText(currentParam, '-dirs') then
|
|
begin
|
|
if currentParamIndex + 1 <= ParamCount then
|
|
begin
|
|
var dirsFileName := ParamStr(currentParamIndex + 1);
|
|
if TFile.Exists(dirsFileName) then
|
|
begin
|
|
var dirsFromFile := TStringList.Create;
|
|
try
|
|
dirsFromFile.LoadFromFile(dirsFileName);
|
|
for var dirPath in dirsFromFile do
|
|
sourceDirectories.Add(dirPath);
|
|
finally
|
|
dirsFromFile.Free;
|
|
end;
|
|
end
|
|
else
|
|
WriteLn('Warning: File specified with -dirs not found: ' + dirsFileName);
|
|
Inc(currentParamIndex, 2);
|
|
end
|
|
else
|
|
begin
|
|
WriteLn('Error: Missing filename after -dirs option.');
|
|
WriteLn(usageStr);
|
|
exitcode := 1;
|
|
exit;
|
|
end;
|
|
end
|
|
else if SameText(currentParam, '-f') or SameText(currentParam, '-fx') or SameText(currentParam, '-fc') then
|
|
begin
|
|
if focusMode then
|
|
begin
|
|
WriteLn('Error: Focus options (-f, -fx, -fc) cannot be used together.');
|
|
WriteLn(usageStr);
|
|
exitcode := 1;
|
|
exit;
|
|
end;
|
|
|
|
if currentParamIndex + 1 <= ParamCount then
|
|
begin
|
|
focusMode := True;
|
|
fcMode := SameText(currentParam, '-fc');
|
|
focusFilesParameter := ParamStr(currentParamIndex + 1);
|
|
var patternsList := TStringList.Create;
|
|
var expandedFocusFiles := TStringList.Create;
|
|
try
|
|
patternsList.Text := StringReplace(focusFilesParameter, ';', sLineBreak, [rfReplaceAll]);
|
|
for var pattern in patternsList do
|
|
begin
|
|
if (pattern.Contains('*')) or (pattern.Contains('?')) then
|
|
begin
|
|
var searchPath := ExtractFilePath(pattern);
|
|
var searchMask := ExtractFileName(pattern);
|
|
if searchPath = '' then
|
|
searchPath := TDirectory.GetCurrentDirectory;
|
|
try
|
|
expandedFocusFiles.AddStrings(TDirectory.GetFiles(searchPath, searchMask));
|
|
except
|
|
on E: EDirectoryNotFoundException do
|
|
WriteLn('Warning: Directory for pattern not found, skipping: ' + pattern);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
expandedFocusFiles.Add(pattern);
|
|
end;
|
|
end;
|
|
|
|
initialFocusFiles.Clear;
|
|
initialFocusFiles.AddStrings(expandedFocusFiles);
|
|
|
|
if SameText(currentParam, '-fx') then
|
|
filesToExcludeFromOutput.Text := initialFocusFiles.Text;
|
|
finally
|
|
patternsList.Free;
|
|
expandedFocusFiles.Free;
|
|
end;
|
|
Inc(currentParamIndex, 2);
|
|
end
|
|
else
|
|
begin
|
|
WriteLn('Error: Missing file list after ' + currentParam + ' option.');
|
|
WriteLn(usageStr);
|
|
exitcode := 1;
|
|
exit;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
sourceDirectories.Add(currentParam);
|
|
inc(currentParamIndex);
|
|
end;
|
|
end;
|
|
|
|
var i := sourceDirectories.Count - 1;
|
|
while i >= 0 do
|
|
begin
|
|
var trimmedPath := Trim(sourceDirectories[i]);
|
|
if (trimmedPath = '') or (not TDirectory.Exists(trimmedPath)) then
|
|
begin
|
|
if trimmedPath <> '' then
|
|
WriteLn('Warning: Directory "' + trimmedPath + '" not found or is not a directory. Skipping.');
|
|
sourceDirectories.Delete(i);
|
|
end
|
|
else
|
|
sourceDirectories[i] := trimmedPath;
|
|
Dec(i);
|
|
end;
|
|
|
|
if writeToClipboard and (outputFileName <> '') then
|
|
begin
|
|
WriteLn('Error: -o (output to file) and -c (output to clipboard) cannot be used together.');
|
|
exitcode := 1;
|
|
exit;
|
|
end;
|
|
|
|
if sourceDirectories.Count = 0 then
|
|
begin
|
|
WriteLn('Error: No source directories specified.');
|
|
WriteLn(usageStr);
|
|
exitcode := 1;
|
|
exit;
|
|
end;
|
|
|
|
allFoundPasFilesList := TStringList.Create;
|
|
WriteLn(IfThen(recursiveSearch, 'Recursive search enabled.', 'Non-recursive search.'));
|
|
|
|
for var currentScanDir in sourceDirectories do
|
|
begin
|
|
WriteLn('Scanning directory: ' + currentScanDir + IfThen(recursiveSearch, ' (recursively)', ''));
|
|
if recursiveSearch then
|
|
CollectPasFilesRecursively(currentScanDir, allFoundPasFilesList, excludedDirectoryPatternsList)
|
|
else
|
|
begin
|
|
var filesInDir := TDirectory.GetFiles(currentScanDir, '*.pas', TSearchOption.soTopDirectoryOnly);
|
|
for var fName in filesInDir do
|
|
allFoundPasFilesList.Add(fName);
|
|
end;
|
|
end;
|
|
|
|
if focusMode then
|
|
begin
|
|
for var focusFile in initialFocusFiles do
|
|
begin
|
|
if not TFile.Exists(focusFile) then
|
|
begin
|
|
WriteLn('Warning: Focus file not found, skipping: ' + focusFile);
|
|
Continue;
|
|
end;
|
|
if allFoundPasFilesList.IndexOf(focusFile) = -1 then
|
|
allFoundPasFilesList.Add(focusFile);
|
|
end;
|
|
end;
|
|
|
|
if allFoundPasFilesList.Count = 0 then
|
|
begin
|
|
WriteLn('No .pas files found in any specified directory (respecting exclusions).');
|
|
exit;
|
|
end;
|
|
|
|
allUnits := TDictionary<string, TUnitInfo>.Create(TStringComparer.Ordinal);
|
|
sortedUnits := TList<TUnitInfo>.Create;
|
|
processingQueue := TQueue<TUnitInfo>.Create;
|
|
|
|
WriteLn('Found ' + IntToStr(allFoundPasFilesList.Count) + ' .pas files in total. Parsing...');
|
|
for var filePathKey in allFoundPasFilesList do
|
|
begin
|
|
var unitInfo := TUnitInfo.Create(filePathKey);
|
|
if unitInfo.ParseUnit then
|
|
begin
|
|
if unitInfo.Name <> '' then
|
|
begin
|
|
if not allUnits.ContainsKey(unitInfo.NormalizedName) then
|
|
allUnits.Add(unitInfo.NormalizedName, unitInfo)
|
|
else
|
|
begin
|
|
WriteLn('Warning: Duplicate unit name "' + unitInfo.Name + '" found.');
|
|
WriteLn(' Existing: ' + allUnits[unitInfo.NormalizedName].FilePath);
|
|
WriteLn(' Skipped: ' + unitInfo.FilePath);
|
|
unitInfo.Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
WriteLn('Warning: Could not determine unit name for file: ' + filePathKey + '. Skipping.');
|
|
unitInfo.Free;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
WriteLn('Warning: Failed to parse unit: ' + filePathKey + '. Skipping.');
|
|
unitInfo.Free;
|
|
end;
|
|
end;
|
|
|
|
if allUnits.Count = 0 then
|
|
begin
|
|
WriteLn('No units successfully parsed.');
|
|
exit;
|
|
end;
|
|
|
|
if focusMode then
|
|
begin
|
|
WriteLn('Focus mode active. Finding dependency cone for files: ' + focusFilesParameter);
|
|
var workQueue := TQueue<TUnitInfo>.Create;
|
|
var requiredUnits := TDictionary<string, TUnitInfo>.Create(TStringComparer.Ordinal);
|
|
var unitsToRemove := TStringList.Create;
|
|
try
|
|
for var unitInfo in allUnits.Values do
|
|
begin
|
|
if initialFocusFiles.IndexOf(unitInfo.FilePath) > -1 then
|
|
begin
|
|
if not requiredUnits.ContainsKey(unitInfo.NormalizedName) then
|
|
begin
|
|
workQueue.Enqueue(unitInfo);
|
|
requiredUnits.Add(unitInfo.NormalizedName, unitInfo);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if requiredUnits.Count = 0 then
|
|
WriteLn('Warning: None of the initial focus files could be parsed successfully.');
|
|
|
|
while workQueue.Count > 0 do
|
|
begin
|
|
var currentUnit := workQueue.Dequeue;
|
|
for var usedUnitName in currentUnit.InterfaceUses do
|
|
begin
|
|
var dependencyUnit: TUnitInfo;
|
|
if allUnits.TryGetValue(usedUnitName, dependencyUnit) and (not requiredUnits.ContainsKey(usedUnitName)) then
|
|
begin
|
|
requiredUnits.Add(dependencyUnit.NormalizedName, dependencyUnit);
|
|
workQueue.Enqueue(dependencyUnit);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
WriteLn('Found ' + requiredUnits.Count.ToString + ' required units in total.');
|
|
for var unitInfo in allUnits.Values do
|
|
if not requiredUnits.ContainsKey(unitInfo.NormalizedName) then
|
|
unitsToRemove.Add(unitInfo.NormalizedName);
|
|
|
|
if unitsToRemove.Count > 0 then
|
|
begin
|
|
WriteLn('Filtering out ' + unitsToRemove.Count.ToString + ' unneeded units...');
|
|
for var unitNameToRemove in unitsToRemove do
|
|
begin
|
|
allUnits[unitNameToRemove].Free;
|
|
allUnits.Remove(unitNameToRemove);
|
|
end;
|
|
end;
|
|
|
|
finally
|
|
workQueue.Free;
|
|
requiredUnits.Free;
|
|
unitsToRemove.Free;
|
|
end;
|
|
end;
|
|
|
|
if fcMode then
|
|
begin
|
|
// After filtering, identify the start files and store their full source
|
|
for var unitInfo in allUnits.Values do
|
|
begin
|
|
if initialFocusFiles.IndexOf(unitInfo.FilePath) > -1 then
|
|
begin
|
|
unitInfo.IsFcStartFile := True;
|
|
unitInfo.FullSource.AddStrings(unitInfo.FOriginalLines);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
WriteLn('Building dependency graph...');
|
|
for var currentUnit in allUnits.Values do
|
|
for var usedUnitName in currentUnit.InterfaceUses do
|
|
begin
|
|
var usedUnitInfo: TUnitInfo;
|
|
if allUnits.TryGetValue(usedUnitName, usedUnitInfo) then
|
|
begin
|
|
currentUnit.InDegree := currentUnit.InDegree + 1;
|
|
usedUnitInfo.AdjacencyList.Add(currentUnit);
|
|
end;
|
|
end;
|
|
|
|
WriteLn('');
|
|
WriteLn('--------------------------------------------------------------------------------');
|
|
WriteLn('Dependency Graph (Project Units Only):');
|
|
WriteLn('--------------------------------------------------------------------------------');
|
|
if allUnits.Count = 0 then
|
|
WriteLn('(No units to display in graph)')
|
|
else
|
|
begin
|
|
var tempUnitListForDisplay: TList<TUnitInfo>;
|
|
tempUnitListForDisplay := TList<TUnitInfo>.Create(allUnits.Values);
|
|
try
|
|
tempUnitListForDisplay.Sort(
|
|
TComparer<TUnitInfo>
|
|
.Construct(function(const L, R: TUnitInfo): Integer begin Result := CompareText(L.Name, R.Name); end)
|
|
);
|
|
for var unitToDisplay in tempUnitListForDisplay do
|
|
begin
|
|
var usesClauseText := '';
|
|
var projectDependenciesFound := False;
|
|
if unitToDisplay.InterfaceUses.Count > 0 then
|
|
begin
|
|
var usedUnitDisplayNames := TStringList.Create;
|
|
try
|
|
for var usedNormalizedName in unitToDisplay.InterfaceUses do
|
|
begin
|
|
var usedUnitActualInfo: TUnitInfo;
|
|
if allUnits.TryGetValue(usedNormalizedName, usedUnitActualInfo) then
|
|
begin
|
|
usedUnitDisplayNames.Add(usedUnitActualInfo.Name);
|
|
projectDependenciesFound := True;
|
|
end;
|
|
end;
|
|
if projectDependenciesFound then
|
|
usesClauseText := usedUnitDisplayNames.CommaText
|
|
else
|
|
usesClauseText := '(none)';
|
|
finally
|
|
usedUnitDisplayNames.Free;
|
|
end;
|
|
end
|
|
else
|
|
usesClauseText := '(none)';
|
|
WriteLn(Format(' %-40s -> %s', [unitToDisplay.Name, usesClauseText]));
|
|
end;
|
|
finally
|
|
tempUnitListForDisplay.Free;
|
|
end;
|
|
end;
|
|
WriteLn('--------------------------------------------------------------------------------');
|
|
WriteLn('');
|
|
|
|
WriteLn('Performing topological sort...');
|
|
for item in allUnits.Values do
|
|
if item.InDegree = 0 then
|
|
processingQueue.Enqueue(item);
|
|
while processingQueue.Count > 0 do
|
|
begin
|
|
var u := processingQueue.Dequeue;
|
|
sortedUnits.Add(u);
|
|
u.Processed := True;
|
|
for var v in u.AdjacencyList do
|
|
begin
|
|
v.InDegree := v.InDegree - 1;
|
|
if (v.InDegree = 0) and (not v.Processed) then
|
|
processingQueue.Enqueue(v);
|
|
end;
|
|
end;
|
|
|
|
if sortedUnits.Count < allUnits.Count then
|
|
begin
|
|
WriteLn('Error: Circular dependency detected among units. Output generation aborted.');
|
|
WriteLn('Units not processed:');
|
|
for item in allUnits.Values do
|
|
if not item.Processed then
|
|
WriteLn('- ' + item.Name + ' (InDegree: ' + item.InDegree.ToString + ', File: ' + item.FilePath + ')');
|
|
exitcode := 1;
|
|
end
|
|
else
|
|
begin
|
|
var outputContent := TStringList.Create;
|
|
var externalUses := TDictionary<string, boolean>.Create;
|
|
try
|
|
outputContent.Add('// Combined interfaces from directories:');
|
|
for var dirPath in sourceDirectories do
|
|
outputContent.Add('// - ' + dirPath + IfThen(recursiveSearch, ' (recursive)', ''));
|
|
if focusMode then
|
|
begin
|
|
var modeStr: string;
|
|
if fcMode then
|
|
modeStr := '-fc'
|
|
else if filesToExcludeFromOutput.Count > 0 then
|
|
modeStr := '-fx'
|
|
else
|
|
modeStr := '-f';
|
|
outputContent.Add('// Focus mode (' + modeStr + ') active for files: ' + focusFilesParameter);
|
|
end;
|
|
outputContent.Add('// Generated on: ' + DateTimeToStr(Now));
|
|
outputContent.Add('');
|
|
|
|
for item in sortedUnits do
|
|
begin
|
|
if filesToExcludeFromOutput.IndexOf(item.FilePath) > -1 then
|
|
Continue;
|
|
|
|
for var usedUnit in item.InterfaceUses do
|
|
if not allUnits.ContainsKey(usedUnit) then
|
|
externalUses.AddOrSetValue(usedUnit, True);
|
|
end;
|
|
|
|
if externalUses.Count > 0 then
|
|
begin
|
|
var externalUsesList := TStringList.Create;
|
|
try
|
|
for var extUse in externalUses.Keys do
|
|
externalUsesList.Add(extUse);
|
|
externalUsesList.Sort;
|
|
outputContent.Add('uses');
|
|
for var j := 0 to externalUsesList.Count - 1 do
|
|
begin
|
|
if j = externalUsesList.Count - 1 then
|
|
outputContent.Add(' ' + externalUsesList[j] + ';')
|
|
else
|
|
outputContent.Add(' ' + externalUsesList[j] + ',');
|
|
end;
|
|
outputContent.Add('');
|
|
finally
|
|
externalUsesList.Free;
|
|
end;
|
|
end;
|
|
|
|
for item in sortedUnits do
|
|
begin
|
|
if filesToExcludeFromOutput.IndexOf(item.FilePath) > -1 then
|
|
Continue;
|
|
|
|
if item.IsFcStartFile then
|
|
begin
|
|
// For -fc start files, add the complete source code
|
|
outputContent
|
|
.Add('//==================================================================================================');
|
|
outputContent.Add('//== FULL UNIT START: ' + item.Name + ' (from ' + ExtractFileName(item.FilePath) + ')');
|
|
outputContent
|
|
.Add('//==================================================================================================');
|
|
outputContent.AddStrings(item.FullSource);
|
|
outputContent
|
|
.Add('//==================================================================================================');
|
|
outputContent.Add('//== FULL UNIT END: ' + item.Name);
|
|
outputContent
|
|
.Add('//==================================================================================================');
|
|
outputContent.Add('');
|
|
end
|
|
else if item.InterfaceSection.Count > 0 then
|
|
begin
|
|
// For all other units, add the interface section only
|
|
outputContent
|
|
.Add('//==================================================================================================');
|
|
outputContent.Add('//== INTERFACE START: ' + item.Name + ' (from ' + ExtractFileName(item.FilePath) + ')');
|
|
outputContent
|
|
.Add('//==================================================================================================');
|
|
outputContent.AddStrings(item.InterfaceSection);
|
|
outputContent.Add('//== INTERFACE END: ' + item.Name);
|
|
outputContent
|
|
.Add('//==================================================================================================');
|
|
outputContent.Add('');
|
|
end;
|
|
end;
|
|
|
|
if writeToClipboard then
|
|
begin
|
|
SetClipboardText(outputContent.Text);
|
|
WriteLn('Output successfully copied to clipboard.');
|
|
end
|
|
else if outputFileName <> '' then
|
|
begin
|
|
outputContent.SaveToFile(outputFileName);
|
|
WriteLn('Output successfully written to: ' + outputFileName);
|
|
end
|
|
else
|
|
begin
|
|
for outputLineText in outputContent do
|
|
WriteLn(outputLineText);
|
|
end;
|
|
finally
|
|
outputContent.Free;
|
|
externalUses.Free;
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
WriteLn('An error occurred: ' + E.ClassName + ': ' + E.Message);
|
|
exitcode := 1;
|
|
end;
|
|
end;
|
|
if Assigned(filesToExcludeFromOutput) then
|
|
filesToExcludeFromOutput.Free;
|
|
if Assigned(initialFocusFiles) then
|
|
initialFocusFiles.Free;
|
|
if Assigned(excludedDirectoryPatternsList) then
|
|
excludedDirectoryPatternsList.Free;
|
|
if Assigned(allFoundPasFilesList) then
|
|
allFoundPasFilesList.Free;
|
|
if Assigned(sourceDirectories) then
|
|
sourceDirectories.Free;
|
|
if Assigned(allUnits) then
|
|
begin
|
|
for item in allUnits.Values do
|
|
item.Free;
|
|
allUnits.Free;
|
|
end;
|
|
if Assigned(sortedUnits) then
|
|
sortedUnits.Free;
|
|
if Assigned(processingQueue) then
|
|
processingQueue.Free;
|
|
if exitcode <> 0 then
|
|
WriteLn('Extraction failed.');
|
|
end.
|