paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 12:40:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazUtils: Restore the José Mejuto's version of TMask. Faster and better. Can be tested now without hurry.

Browse Source
This commit is contained in:
Juha 2021-10-13 12:41:41 +03:00
parent e5ed5082d5
commit d7036bb000
4 changed files with 982 additions and 507 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
components/lazutils/fileutil.inc
View File

@ -795,12 +795,8 @@ var
// Deal with both files and directories
if (PathInfo.Attr and faDirectory) = 0 then
begin // File
{$IFDEF Windows}
if (MaskList = nil) or MaskList.MatchesWindowsMask(PathInfo.Name)
{$ELSE}
if (MaskList = nil) or MaskList.Matches(PathInfo.Name)
{$ENDIF}
then begin
if (MaskList = nil) or MaskList.Matches(PathInfo.Name) then
begin
FPath := APath;
FLevel := ALevel;
FFileInfo := PathInfo;
@ -848,14 +844,9 @@ var
i: Integer;
Dir: String;
OtherDir: String;
MaskOptions: TMaskOptions;
begin
if FSearching then RaiseSearchingError;
if CaseSensitive then
MaskOptions := [moCaseSensitive]
else
MaskOptions := [];
MaskList := TMaskList.Create(ASearchMask, FMaskSeparator, MaskOptions);
MaskList := TMaskList.CreateSysNative(ASearchMask, FMaskSeparator, CaseSensitive);
// empty mask = all files mask
if MaskList.Count = 0 then
FreeAndNil(MaskList);

10
components/lazutils/lazutilsstrconsts.pas
View File

@ -16,7 +16,6 @@ interface
resourceString
lrsModified = ' modified ';
lrsInvalidCharSet = 'The char set in mask "%s" is not valid!';
lrsSize = ' size ';
lrsFileDoesNotExist = 'file "%s" does not exist';
lrsFileIsADirectoryAndNotAnExecutable = 'file "%s" is a directory and not an'
@ -42,6 +41,15 @@ resourceString
lrsERRORInCode = 'ERROR in code: ';
lrsCreatingGdbCatchableError = 'Creating gdb catchable error:';
// Masks
rsInvalidCharMaskAt = 'Invalid char mask "%s" at %d';
rsInvalidCharMask = 'Invalid char mask "%s"';
rsMissingCloseCharMaskAt = 'Missing close char mask "%s" at %d';
rsMissingCloseCharMask = 'Missing close char mask "%s"';
rsIncompleteMask = 'Reached end of mask, but missing close/escape sequence.';
rsInvalidEscapeChar = 'Escape character must be ASCII <= 127';
rsInternalError = 'Internal %s error.';
// XPath
lrsNodeSet = 'node set';
lrsBoolean = 'boolean';

1444
components/lazutils/masks.pas
View File

File diff suppressed because it is too large Load Diff

20
lcl/shellctrls.pas
View File

@ -687,12 +687,11 @@ procedure GetFilesInDir(const ABaseDir: string; AMask: string;
var
DirInfo: TSearchRec;
FindResult, i: Integer;
IsDirectory, IsValidDirectory, IsHidden, AddFile, UseMaskList: Boolean;
IsDirectory, IsValidDirectory, IsHidden, AddFile, UseMaskList, CaseSens: Boolean;
SearchStr, ShortFilename: string;
MaskList: TMaskList = nil;
Files: TList;
FileItem: TFileItem;
MaskOptions: TMaskOptions;
{$if defined(windows) and not defined(wince)}
ErrMode : LongWord;
{$endif}
@ -718,19 +717,16 @@ begin
;
if UseMaskList then
begin
//Disable the use of sets in the masklist.
//this behaviour would be incompatible with the situation if no MaskList was used
//and it would break backwards compatibilty and could raise unexpected EConvertError where it did not in the past.
//If you need sets in the MaskList, use the OnAddItem event for that. (BB)
MaskOptions := [moDisableSets];
// Disable ranges in the MaskList. [...] is interpreted as literal chars.
// Otherwise this would be incompatible with the situation if no MaskList was used
// and would break backwards compatibilty and could raise unexpected EConvertError.
// If you need ranges in the MaskList, use the OnAddItem event for that. (BB)
{$ifdef NotLiteralFilenames}
if (ACaseSensitivity = mcsCaseSensitive) then
MaskOptions := [moDisableSets, moCaseSensitive];
CaseSens := ACaseSensitivity = mcsCaseSensitive;
{$else}
if (ACaseSensitivity <> mcsCaseInsensitive) then
MaskOptions := [moDisableSets, moCaseSensitive];
CaseSens := ACaseSensitivity <> mcsCaseInsensitive;
{$endif}
MaskList := TMaskList.Create(AMask, ';', MaskOptions); //False by default
MaskList := TMaskList.Create(AMask, ';', CaseSens, MaskOpCodesDisableRange);
end;
try