paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-08 06:20:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: added ExtractFileUnitname

Browse Source 
git-svn-id: trunk@50119 -
This commit is contained in:
mattias 2015-10-19 11:22:24 +00:00
parent 90ec47f43b
commit 5c15224a08
1 changed files with 18 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/codetools/fileprocs.pas
View File

@ -220,6 +220,7 @@ function FilenameIsPascalUnit(const Filename: string;
CaseSensitive: boolean = false): boolean;
function FilenameIsPascalUnit(Filename: PChar; FilenameLen: integer;
CaseSensitive: boolean = false): boolean;
function ExtractFileUnitname(Filename: string; WithNameSpace: boolean): string;
function IsPascalUnitExt(FileExt: PChar; CaseSensitive: boolean = false): boolean;
function SearchPascalUnitInDir(const AnUnitName, BaseDirectory: string;
SearchCase: TCTSearchFileCase): string;
@ -1146,6 +1147,23 @@ begin
Result:=false;
end;
function ExtractFileUnitname(Filename: string; WithNameSpace: boolean): string;
var
p: Integer;
begin
Result:=ExtractFileNameOnly(Filename);
if (Result='') or WithNameSpace then exit;
// find last dot
p:=length(Filename);
while p>0 do begin
if Filename[p]='.' then begin
Delete(Result,1,p);
exit;
end;
dec(p);
end;
end;
function IsPascalUnitExt(FileExt: PChar; CaseSensitive: boolean): boolean;
// check if asciiz FileExt is a CTPascalExtension '.pp', '.pas'
var