mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 12:18:03 +02:00
LCL: implemented TMask, MatchesMask, added Masks docs
git-svn-id: trunk@11592 -
This commit is contained in:
tombo
parent
d53bbc8fee
commit
77381cc8d4
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -1051,6 +1051,7 @@ docs/xml/lcl/lmessages.xml svneol=LF#text/xml eol=lf
|
||||
docs/xml/lcl/lresources.xml svneol=LF#text/xml eol=lf
|
||||
docs/xml/lcl/maps.xml svneol=native#text/plain
|
||||
docs/xml/lcl/maskedit.xml svneol=LF#text/xml eol=lf
|
||||
docs/xml/lcl/masks.xml svneol=LF#text/xml eol=lf
|
||||
docs/xml/lcl/menus.xml svneol=LF#text/xml eol=lf
|
||||
docs/xml/lcl/pairsplitter.xml svneol=LF#text/xml eol=lf
|
||||
docs/xml/lcl/postscriptcanvas.xml svneol=LF#text/xml eol=lf
|
||||
@ -2845,6 +2846,7 @@ lcl/lmessages.pp svneol=native#text/pascal
|
||||
lcl/lresources.pp svneol=native#text/pascal
|
||||
lcl/maps.pp svneol=native#text/pascal
|
||||
lcl/maskedit.pp svneol=native#text/pascal
|
||||
lcl/masks.pas svneol=native#text/pascal
|
||||
lcl/menus.pp svneol=native#text/pascal
|
||||
lcl/nonwin32/README.txt svneol=native#text/plain
|
||||
lcl/nonwin32/messages.pp svneol=native#text/pascal
|
||||
@ -2890,6 +2892,8 @@ lcl/tests/test4_3listview.lpr svneol=native#text/plain
|
||||
lcl/tests/test5_1asyncprocess.lpi svneol=native#text/plain
|
||||
lcl/tests/test5_1asyncprocess.lpr svneol=native#text/plain
|
||||
lcl/tests/test5_1worker.pas svneol=native#text/plain
|
||||
lcl/tests/test6_1masks.lpi svneol=native#text/plain
|
||||
lcl/tests/test6_1masks.lpr svneol=native#text/plain
|
||||
lcl/textstrings.pas svneol=native#text/pascal
|
||||
lcl/themes.pas svneol=native#text/pascal
|
||||
lcl/tmschema.pas svneol=native#text/pascal
|
||||
|
||||
408
docs/xml/lcl/masks.xml
Normal file
408
docs/xml/lcl/masks.xml
Normal file
@ -0,0 +1,408 @@
|
||||
<?xml version="1.0" encoding="ISO-8859-1"?>
|
||||
<fpdoc-descriptions>
|
||||
<package name="lcl">
|
||||
|
||||
<!--
|
||||
====================================================================
|
||||
Masks
|
||||
====================================================================
|
||||
-->
|
||||
|
||||
<module name="Masks">
|
||||
<short>This unit contains classes for mask matching.</short>
|
||||
<descr>
|
||||
</descr>
|
||||
|
||||
<!-- unresolved type reference Visibility: default -->
|
||||
<element name="Classes">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- unresolved type reference Visibility: default -->
|
||||
<element name="SysUtils">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- unresolved type reference Visibility: default -->
|
||||
<element name="Contnrs">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- enumeration type Visibility: default -->
|
||||
<element name="TMaskCharType">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- enumeration value Visibility: default -->
|
||||
<element name="TMaskCharType.mcChar">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- enumeration value Visibility: default -->
|
||||
<element name="TMaskCharType.mcCharSet">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- enumeration value Visibility: default -->
|
||||
<element name="TMaskCharType.mcAnyChar">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- enumeration value Visibility: default -->
|
||||
<element name="TMaskCharType.mcAnyText">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- set type Visibility: default -->
|
||||
<element name="TCharSet">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- pointer type Visibility: default -->
|
||||
<element name="PCharSet">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- record type Visibility: default -->
|
||||
<element name="TMaskChar">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- variable Visibility: default -->
|
||||
<element name="TMaskChar.CharValue">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- variable Visibility: default -->
|
||||
<element name="TMaskChar.Negative">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- variable Visibility: default -->
|
||||
<element name="TMaskChar.SetValue">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- record type Visibility: default -->
|
||||
<element name="TMaskString">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- variable Visibility: default -->
|
||||
<element name="TMaskString.MinLength">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- variable Visibility: default -->
|
||||
<element name="TMaskString.MaxLength">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- variable Visibility: default -->
|
||||
<element name="TMaskString.Chars">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- object Visibility: default -->
|
||||
<element name="TMask">
|
||||
<short>The TMask class represents a mask.</short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- variable Visibility: private -->
|
||||
<element name="TMask.FMask">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- constructor Visibility: public -->
|
||||
<element name="TMask.Create">
|
||||
<short>Creates new mask for matching.</short>
|
||||
<descr><p>Creates new mask for matching. Matching is case-insensitive. The mask consist of literal elements such as:</p>
|
||||
<ul>
|
||||
<li>characters</li>
|
||||
<li>character sets - each character set starts with "[" and ends with "]", contains list of single characters or range denoted with "-".</li>
|
||||
<li>wild cards "?" for any character</li>
|
||||
<li>wild cards "*" for any string</li>
|
||||
</ul>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="TMask.Create.AValue">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- destructor Visibility: public -->
|
||||
<element name="TMask.Destroy">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- function Visibility: public -->
|
||||
<element name="TMask.Matches">
|
||||
<short>If the file name matches the mask.</short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- function result Visibility: default -->
|
||||
<element name="TMask.Matches.Result">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="TMask.Matches.AFileName">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- object Visibility: default -->
|
||||
<element name="TMaskList">
|
||||
<short>The TMaskList class represents a list of masks.</short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
<link id="TMask"/>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- variable Visibility: private -->
|
||||
<element name="TMaskList.FMasks">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- function Visibility: private -->
|
||||
<element name="TMaskList.GetItem">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- function result Visibility: default -->
|
||||
<element name="TMaskList.GetItem.Result">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="TMaskList.GetItem.Index">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- constructor Visibility: public -->
|
||||
<element name="TMaskList.Create">
|
||||
<short>Creates new list of masks from passed value, each item is seperated by separator.</short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
<link id="TMask.Create"/>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="TMaskList.Create.AValue">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="TMaskList.Create.ASeparator">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- destructor Visibility: public -->
|
||||
<element name="TMaskList.Destroy">
|
||||
<short></short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- function Visibility: public -->
|
||||
<element name="TMaskList.Matches">
|
||||
<short>If the file name matches at least one of mask list items.</short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- function result Visibility: default -->
|
||||
<element name="TMaskList.Matches.Result">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="TMaskList.Matches.AFileName">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- property Visibility: public -->
|
||||
<element name="TMaskList.Items">
|
||||
<short>The items of mask list.</short>
|
||||
<descr>
|
||||
</descr>
|
||||
<seealso>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="TMaskList.Items.Index">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- function Visibility: default -->
|
||||
<element name="MatchesMask">
|
||||
<short>If the file name matches the passed mask.</short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
<link id="TMask.Create"/>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- function result Visibility: default -->
|
||||
<element name="MatchesMask.Result">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="MatchesMask.FileName">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="MatchesMask.Mask">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- function Visibility: default -->
|
||||
<element name="MatchesMaskList">
|
||||
<short>If the file name matches at least one of passed masks sepearated by separator.</short>
|
||||
<descr>
|
||||
</descr>
|
||||
<errors>
|
||||
</errors>
|
||||
<seealso>
|
||||
<link id="TMask.Create"/>
|
||||
</seealso>
|
||||
</element>
|
||||
|
||||
<!-- function result Visibility: default -->
|
||||
<element name="MatchesMaskList.Result">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="MatchesMaskList.FileName">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="MatchesMaskList.Mask">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
<!-- argument Visibility: default -->
|
||||
<element name="MatchesMaskList.Separator">
|
||||
<short></short>
|
||||
</element>
|
||||
|
||||
</module> <!-- Masks -->
|
||||
|
||||
</package>
|
||||
</fpdoc-descriptions>
|
||||
@ -35,7 +35,7 @@ interface
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, StdCtrls, FileUtil;
|
||||
Classes, SysUtils, StdCtrls, FileUtil, Masks;
|
||||
|
||||
Type
|
||||
|
||||
@ -162,7 +162,7 @@ begin
|
||||
faAnyFile, Info)=0
|
||||
then
|
||||
Repeat
|
||||
if FileInFilenameMasks(Info.Name,Mask) then begin
|
||||
if MatchesMaskList(Info.Name,Mask) then begin
|
||||
Added:=false;
|
||||
AddFile(ftReadOnly,faReadOnly);
|
||||
AddFile(ftHidden,faHidden);
|
||||
|
||||
@ -78,7 +78,6 @@ function CreateAbsoluteSearchPath(const SearchPath, BaseDirectory: string): stri
|
||||
function CreateRelativePath(const Filename, BaseDirectory: string): string;
|
||||
function FileIsInPath(const Filename, Path: string): boolean;
|
||||
function FileIsInDirectory(const Filename, Directory: string): boolean;
|
||||
function FileInFilenameMasks(const Filename, Masks: string): boolean;
|
||||
|
||||
// file search
|
||||
type
|
||||
|
||||
@ -1046,111 +1046,6 @@ begin
|
||||
and (CompareFilenames(ExpDir,LeftStr(ExpFile,p))=0);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function FileInFilenameMasks(const Filename, Masks: string): boolean;
|
||||
|
||||
Checks if 'Filename' fits to one of the mask in 'Masks'.
|
||||
Note: It checks the whole Filename. So, for example /somewhere/unit1.pas does
|
||||
not fit the mask 'unit*.pas', but it will fit '*.pas'.
|
||||
|
||||
Masks is delimited by semicolon.
|
||||
Masks allows asterisk (*) for arbitrary text and question mark (?) for one
|
||||
arbitrary character.
|
||||
Examples:
|
||||
'*.pas;*.pp;*.inc'
|
||||
'*.tar.*'
|
||||
'lazarus*.xpm'
|
||||
------------------------------------------------------------------------------}
|
||||
function FileInFilenameMasks(const Filename, Masks: string): boolean;
|
||||
var
|
||||
TrimmedFile: String;
|
||||
MasksLen: Integer;
|
||||
MaskStartPos: Integer;
|
||||
MaskEndPos: Integer;
|
||||
MaskPos: LongInt;
|
||||
FilePos: Integer;
|
||||
FileLen: Integer;
|
||||
MaskChar: Char;
|
||||
begin
|
||||
Result:=false;
|
||||
if (Filename='') or (Masks='') then exit;
|
||||
TrimmedFile:=TrimFilename(Filename); // only cleanup, do not expand
|
||||
if TrimmedFile='' then exit;
|
||||
// try each Mask
|
||||
MasksLen:=length(Masks);
|
||||
FileLen:=length(TrimmedFile);
|
||||
MaskEndPos:=1;
|
||||
repeat
|
||||
|
||||
// find next Mask
|
||||
MaskStartPos:=MaskEndPos;
|
||||
while (MaskStartPos<=MasksLen) and (Masks[MaskStartPos]=';') do
|
||||
inc(MaskStartPos);
|
||||
if MaskStartPos>MasksLen then exit; // no mask -> end
|
||||
MaskEndPos:=MaskStartPos+1;
|
||||
while (MaskEndPos<=MasksLen) and (Masks[MaskEndPos]<>';') do
|
||||
inc(MaskEndPos);
|
||||
|
||||
// check if mask fits to filename
|
||||
MaskPos:=MaskStartPos;
|
||||
FilePos:=1;
|
||||
while MaskPos<MaskEndPos do begin
|
||||
MaskChar:=Masks[MaskPos];
|
||||
case MaskChar of
|
||||
|
||||
'?': begin
|
||||
// skip one character
|
||||
if FilePos>FileLen then break;
|
||||
inc(FilePos);
|
||||
inc(MaskPos);
|
||||
end;
|
||||
|
||||
'*': begin
|
||||
// Anything. Will be handled by the 'else' part below
|
||||
inc(MaskPos);
|
||||
if MaskPos=MaskEndPos then
|
||||
FilePos:=FileLen+1;
|
||||
end;
|
||||
|
||||
else
|
||||
begin
|
||||
if FilePos>FileLen then break;
|
||||
{$IFDEF WINDOWS}
|
||||
if UpperCaseTable[byte(MaskChar)]
|
||||
=UpperCaseTable[byte(TrimmedFile[FilePos])] then
|
||||
{$ELSE}
|
||||
if MaskChar=TrimmedFile[FilePos] then
|
||||
{$ENDIF}
|
||||
begin
|
||||
// character fits
|
||||
inc(MaskPos);
|
||||
inc(FilePos);
|
||||
end else begin
|
||||
//character does not fit
|
||||
// -> go back to last astersik (*)
|
||||
while (MaskPos>MaskStartPos) and (Masks[MaskPos-1]<>'*') do begin
|
||||
dec(MaskPos);
|
||||
dec(FilePos);
|
||||
end;
|
||||
if (MaskPos=MaskStartPos) then begin
|
||||
// there was no asterisk (*) => the filename does not fit this mask
|
||||
break;
|
||||
end else begin
|
||||
// there is an asterisk (*) => try the next position
|
||||
inc(FilePos);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (MaskPos=MaskEndPos) and (FilePos>FileLen) then begin
|
||||
// found
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function CopyFile(const SrcFilename, DestFilename: string): boolean;
|
||||
------------------------------------------------------------------------------}
|
||||
|
||||
@ -30,7 +30,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, FileUtil, LCLStrConsts, Dialogs,
|
||||
LazConfigStorage, HelpIntfs;
|
||||
LazConfigStorage, HelpIntfs, Masks;
|
||||
|
||||
type
|
||||
{ THelpQueryItem }
|
||||
@ -2279,7 +2279,7 @@ begin
|
||||
end;
|
||||
//debugln('THelpDBISourceDirectory.FileMatches FileMask="',FileMask,'"');
|
||||
if (FileMask<>'')
|
||||
and (not FileInFilenameMasks(ExtractFilename(AFilename),FileMask)) then exit;
|
||||
and (not MatchesMaskList(ExtractFilename(AFilename),FileMask)) then exit;
|
||||
//debugln('THelpDBISourceDirectory.FileMatches Success');
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
@ -134,7 +134,7 @@ ResourceString
|
||||
|
||||
// StringHashList, LResource, Menus, ExtCtrls, ImgList, Spin
|
||||
// StdCtrls, Calendar, CustomTimer, Forms, Grids, LCLProc, Controls, ComCtrls,
|
||||
// ExtDlgs, EditBtn
|
||||
// ExtDlgs, EditBtn, Masks
|
||||
sInvalidActionRegistration = 'Invalid action registration';
|
||||
sInvalidActionUnregistration = 'Invalid action unregistration';
|
||||
sInvalidActionEnumeration = 'Invalid action enumeration';
|
||||
@ -147,6 +147,7 @@ ResourceString
|
||||
sInvalidImageSize = 'Invalid image size';
|
||||
sDuplicateMenus = 'Duplicate menus';
|
||||
sCannotFocus = 'Cannot focus a disabled or invisible window';
|
||||
sInvalidCharSet = 'The char set in mask "%s" is not valid!';
|
||||
|
||||
rsListMustBeEmpty = 'List must be empty';
|
||||
rsInvalidPropertyValue = 'Invalid property value';
|
||||
|
||||
373
lcl/masks.pas
Normal file
373
lcl/masks.pas
Normal file
@ -0,0 +1,373 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
masks.pas
|
||||
---------
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program 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. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
unit Masks;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Contnrs;
|
||||
|
||||
type
|
||||
TMaskCharType = (mcChar, mcCharSet, mcAnyChar, mcAnyText);
|
||||
|
||||
TCharSet = set of Char;
|
||||
PCharSet = ^TCharSet;
|
||||
|
||||
TMaskChar = record
|
||||
case CharType: TMaskCharType of
|
||||
mcChar: (CharValue: Char);
|
||||
mcCharSet: (Negative: Boolean; SetValue: PCharSet);
|
||||
mcAnyChar, mcAnyText: ();
|
||||
end;
|
||||
|
||||
TMaskString = record
|
||||
MinLength: Integer;
|
||||
MaxLength: Integer;
|
||||
Chars: Array of TMaskChar;
|
||||
end;
|
||||
|
||||
{ TMask }
|
||||
|
||||
TMask = class
|
||||
private
|
||||
FMask: TMaskString;
|
||||
public
|
||||
constructor Create(const AValue: String);
|
||||
destructor Destroy; override;
|
||||
|
||||
function Matches(const AFileName: String): Boolean;
|
||||
end;
|
||||
|
||||
{ TMaskList }
|
||||
|
||||
TMaskList = class
|
||||
private
|
||||
FMasks: TObjectList;
|
||||
function GetItem(Index: Integer): TMask;
|
||||
public
|
||||
constructor Create(const AValue: String; ASeparator: Char = ';');
|
||||
destructor Destroy; override;
|
||||
|
||||
function Matches(const AFileName: String): Boolean;
|
||||
|
||||
property Items[Index: Integer]: TMask read GetItem;
|
||||
end;
|
||||
|
||||
function MatchesMask(const FileName, Mask: String): Boolean;
|
||||
function MatchesMaskList(const FileName, Mask: String; Separator: Char = ';'): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses LCLProc, LCLStrConsts;
|
||||
|
||||
function MatchesMask(const FileName, Mask: String): Boolean;
|
||||
var
|
||||
AMask: TMask;
|
||||
begin
|
||||
AMask := TMask.Create(Mask);
|
||||
try
|
||||
Result := AMask.Matches(FileName);
|
||||
finally
|
||||
AMask.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function MatchesMaskList(const FileName, Mask: String; Separator: Char): Boolean;
|
||||
var
|
||||
AMaskList: TMaskList;
|
||||
begin
|
||||
AMaskList := TMaskList.Create(Mask, Separator);
|
||||
try
|
||||
Result := AMaskList.Matches(FileName);
|
||||
finally
|
||||
AMaskList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TMask }
|
||||
|
||||
constructor TMask.Create(const AValue: String);
|
||||
var
|
||||
I: Integer;
|
||||
SkipAnyText: Boolean;
|
||||
|
||||
procedure CharSetError;
|
||||
begin
|
||||
raise EConvertError.CreateFmt(sInvalidCharSet, [AValue]);
|
||||
end;
|
||||
|
||||
procedure AddAnyText;
|
||||
begin
|
||||
if SkipAnyText then
|
||||
begin
|
||||
Inc(I);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SetLength(FMask.Chars, Length(FMask.Chars) + 1);
|
||||
FMask.Chars[High(FMask.Chars)].CharType := mcAnyText;
|
||||
|
||||
FMask.MaxLength := MaxInt;
|
||||
SkipAnyText := True;
|
||||
Inc(I);
|
||||
end;
|
||||
|
||||
procedure AddAnyChar;
|
||||
begin
|
||||
SkipAnyText := False;
|
||||
|
||||
SetLength(FMask.Chars, Length(FMask.Chars) + 1);
|
||||
FMask.Chars[High(FMask.Chars)].CharType := mcAnyChar;
|
||||
|
||||
Inc(FMask.MinLength);
|
||||
if FMask.MaxLength < MaxInt then Inc(FMask.MaxLength);
|
||||
|
||||
Inc(I);
|
||||
end;
|
||||
|
||||
procedure AddCharSet;
|
||||
var
|
||||
CharSet: TCharSet;
|
||||
Valid: Boolean;
|
||||
C, Last: Char;
|
||||
begin
|
||||
SkipAnyText := False;
|
||||
|
||||
SetLength(FMask.Chars, Length(FMask.Chars) + 1);
|
||||
FMask.Chars[High(FMask.Chars)].CharType := mcCharSet;
|
||||
|
||||
Inc(I);
|
||||
if (I <= Length(AValue)) and (AValue[I] = '!') then
|
||||
begin
|
||||
FMask.Chars[High(FMask.Chars)].Negative := True;
|
||||
Inc(I);
|
||||
end
|
||||
else FMask.Chars[High(FMask.Chars)].Negative := False;
|
||||
|
||||
Last := '-';
|
||||
CharSet := [];
|
||||
Valid := False;
|
||||
while I <= Length(AValue) do
|
||||
begin
|
||||
case AValue[I] of
|
||||
'-':
|
||||
begin
|
||||
if Last = '-' then CharSetError;
|
||||
Inc(I);
|
||||
|
||||
if (I > Length(AValue)) then CharSetError;
|
||||
//DebugLn('Set: ' + Last + '-' + UpCase(AValue[I]));
|
||||
for C := Last to UpCase(AValue[I]) do Include(CharSet, C);
|
||||
Inc(I);
|
||||
end;
|
||||
']':
|
||||
begin
|
||||
Valid := True;
|
||||
Break;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
Last := UpCase(AValue[I]);
|
||||
Include(CharSet, Last);
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (not Valid) or (CharSet = []) then CharSetError;
|
||||
|
||||
New(FMask.Chars[High(FMask.Chars)].SetValue);
|
||||
FMask.Chars[High(FMask.Chars)].SetValue^ := CharSet;
|
||||
|
||||
Inc(FMask.MinLength);
|
||||
if FMask.MaxLength < MaxInt then Inc(FMask.MaxLength);
|
||||
|
||||
Inc(I);
|
||||
end;
|
||||
|
||||
procedure AddChar;
|
||||
begin
|
||||
SkipAnyText := False;
|
||||
|
||||
SetLength(FMask.Chars, Length(FMask.Chars) + 1);
|
||||
with FMask.Chars[High(FMask.Chars)] do
|
||||
begin
|
||||
CharType := mcChar;
|
||||
CharValue := UpCase(AValue[I]);
|
||||
end;
|
||||
|
||||
Inc(FMask.MinLength);
|
||||
if FMask.MaxLength < MaxInt then Inc(FMask.MaxLength);
|
||||
|
||||
Inc(I);
|
||||
end;
|
||||
|
||||
begin
|
||||
SetLength(FMask.Chars, 0);
|
||||
FMask.MinLength := 0;
|
||||
FMask.MaxLength := 0;
|
||||
SkipAnyText := False;
|
||||
|
||||
I := 1;
|
||||
while I <= Length(AValue) do
|
||||
begin
|
||||
case AValue[I] of
|
||||
'*': AddAnyText;
|
||||
'?': AddAnyChar;
|
||||
'[': AddCharSet;
|
||||
else AddChar;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMask.Destroy;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to High(FMask.Chars) do
|
||||
if FMask.Chars[I].CharType = mcCharSet then
|
||||
Dispose(FMask.Chars[I].SetValue);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TMask.Matches(const AFileName: String): Boolean;
|
||||
var
|
||||
L: Integer;
|
||||
S: String;
|
||||
|
||||
function MatchToEnd(MaskIndex, CharIndex: Integer): Boolean;
|
||||
var
|
||||
I, J: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
for I := MaskIndex to High(FMask.Chars) do
|
||||
begin
|
||||
case FMask.Chars[I].CharType of
|
||||
mcChar:
|
||||
begin
|
||||
if CharIndex > L then Exit;
|
||||
//DebugLn('Match ' + S[CharIndex] + '<?>' + FMask.Chars[I].CharValue);
|
||||
if S[CharIndex] <> FMask.Chars[I].CharValue then Exit;
|
||||
Inc(CharIndex);
|
||||
end;
|
||||
mcCharSet:
|
||||
begin
|
||||
if CharIndex > L then Exit;
|
||||
if FMask.Chars[I].Negative xor
|
||||
(S[CharIndex] in FMask.Chars[I].SetValue^) then Inc(CharIndex)
|
||||
else Exit;
|
||||
end;
|
||||
mcAnyChar:
|
||||
begin
|
||||
if CharIndex > L then Exit;
|
||||
Inc(CharIndex);
|
||||
end;
|
||||
mcAnyText:
|
||||
begin
|
||||
if I = High(FMask.Chars) then
|
||||
begin
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
for J := CharIndex to L do
|
||||
if MatchToEnd(I + 1, J) then
|
||||
begin
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := CharIndex > L;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
L := Length(AFileName);
|
||||
if L = 0 then
|
||||
begin
|
||||
if FMask.MinLength = 0 then Result := True;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (L < FMask.MinLength) or (L > FMask.MaxLength) then Exit;
|
||||
|
||||
S := UpperCase(AFileName);
|
||||
Result := MatchToEnd(0, 1);
|
||||
end;
|
||||
|
||||
{ TMaskList }
|
||||
|
||||
function TMaskList.GetItem(Index: Integer): TMask;
|
||||
begin
|
||||
Result := TMask(FMasks.Items[Index]);
|
||||
end;
|
||||
|
||||
constructor TMaskList.Create(const AValue: String; ASeparator: Char);
|
||||
var
|
||||
S: TStringList;
|
||||
I: Integer;
|
||||
begin
|
||||
FMasks := TObjectList.Create(True);
|
||||
|
||||
S := TStringList.Create;
|
||||
try
|
||||
S.Delimiter := ASeparator;
|
||||
S.DelimitedText := AValue;
|
||||
|
||||
for I := 0 to S.Count - 1 do
|
||||
FMasks.Add(TMask.Create(S[I]));
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TMaskList.Destroy;
|
||||
begin
|
||||
FMasks.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TMaskList.Matches(const AFileName: String): Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
for I := 0 to FMasks.Count - 1 do
|
||||
begin
|
||||
if TMask(FMasks.Items[I]).Matches(AFileName) then
|
||||
begin
|
||||
Result := True;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
122
lcl/tests/test6_1masks.lpi
Normal file
122
lcl/tests/test6_1masks.lpi
Normal file
@ -0,0 +1,122 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="\"/>
|
||||
<Version Value="5"/>
|
||||
<General>
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=".exe"/>
|
||||
<Title Value="fpcunitproject1"/>
|
||||
<ActiveEditorIndexAtStart Value="0"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<ProjectVersion Value=""/>
|
||||
<Language Value=""/>
|
||||
<CharSet Value=""/>
|
||||
</VersionInfo>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
<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="3">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FPCUnitTestRunner"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item3>
|
||||
</RequiredPackages>
|
||||
<Units Count="7">
|
||||
<Unit0>
|
||||
<Filename Value="test6_1masks.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="test6_1masks"/>
|
||||
<CursorPos X="21" Y="1"/>
|
||||
<TopLine Value="1"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="20"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="..\..\..\test\TMask\testcase1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="TestCase1"/>
|
||||
<CursorPos X="1" Y="7"/>
|
||||
<TopLine Value="1"/>
|
||||
<UsageCount Value="20"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="..\..\..\test\TMask\masks.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Masks"/>
|
||||
<CursorPos X="1" Y="67"/>
|
||||
<TopLine Value="83"/>
|
||||
<UsageCount Value="20"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="..\..\..\fpcbeta\fpcsrc\packages\fcl-fpcunit\src\fpcunit.pp"/>
|
||||
<UnitName Value="fpcunit"/>
|
||||
<CursorPos X="3" Y="57"/>
|
||||
<TopLine Value="43"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="..\..\..\fpcbeta\fpcsrc\rtl\objpas\sysutils\sysutilh.inc"/>
|
||||
<CursorPos X="48" Y="132"/>
|
||||
<TopLine Value="122"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="..\..\components\fpcunit\guitestrunner.pas"/>
|
||||
<ComponentName Value="GUITestRunner"/>
|
||||
<HasResources Value="True"/>
|
||||
<UnitName Value="GuiTestRunner"/>
|
||||
<CursorPos X="8" Y="39"/>
|
||||
<TopLine Value="25"/>
|
||||
<UsageCount Value="10"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="..\masks.pas"/>
|
||||
<UnitName Value="Masks"/>
|
||||
<CursorPos X="1" Y="83"/>
|
||||
<TopLine Value="69"/>
|
||||
<EditorIndex Value="1"/>
|
||||
<UsageCount Value="10"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit6>
|
||||
</Units>
|
||||
<JumpHistory Count="0" HistoryIndex="-1"/>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<PathDelim Value="\"/>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="2">
|
||||
<Item1>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item2>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
176
lcl/tests/test6_1masks.lpr
Normal file
176
lcl/tests/test6_1masks.lpr
Normal file
@ -0,0 +1,176 @@
|
||||
{
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.LCL, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program 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. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
|
||||
LCL Test 6_1
|
||||
|
||||
Mask creating and matching test.
|
||||
}
|
||||
program test6_1masks;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Interfaces, Forms, GuiTestRunner, Masks,
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry;
|
||||
|
||||
type
|
||||
|
||||
{ TTestMask }
|
||||
|
||||
TTestMask = class(TTestCase)
|
||||
private
|
||||
FS, FMask: String;
|
||||
procedure Test;
|
||||
protected
|
||||
procedure TestMask(const S, Mask: String; Result: Boolean);
|
||||
procedure TestMaskException(const S, Mask: String; AFail: Boolean);
|
||||
published
|
||||
procedure TestNil;
|
||||
procedure TestAnyText;
|
||||
procedure TestAnyChar;
|
||||
procedure TestCharSet;
|
||||
procedure TestMaskSyntax;
|
||||
end;
|
||||
|
||||
procedure TTestMask.Test;
|
||||
begin
|
||||
MatchesMask(FS, FMask);
|
||||
end;
|
||||
|
||||
procedure TTestMask.TestMask(const S, Mask: String; Result: Boolean);
|
||||
begin
|
||||
AssertEquals(S + ' match ' + Mask + ': ', Result, MatchesMask(S, Mask));
|
||||
end;
|
||||
|
||||
procedure TTestMask.TestMaskException(const S, Mask: String; AFail: Boolean);
|
||||
begin
|
||||
FS := S;
|
||||
FMask := Mask;
|
||||
if AFail then
|
||||
AssertException('Invalid syntax: ' + S + ' match ' + Mask + ': ', EConvertError, @Test)
|
||||
else
|
||||
try
|
||||
Test;
|
||||
except
|
||||
Fail('Invalid syntax: ' + S + ' match ' + Mask);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestMask.TestMaskSyntax;
|
||||
begin
|
||||
TestMaskException('', '', False);
|
||||
TestMaskException('', 'a', False);
|
||||
TestMaskException('', '?', False);
|
||||
TestMaskException('', '*', False);
|
||||
TestMaskException('', '[a]', False);
|
||||
TestMaskException('', '[a-b]', False);
|
||||
TestMaskException('', '[!a-b]', False);
|
||||
TestMaskException('', '[abc]', False);
|
||||
TestMaskException('', '[abc-fgh]', False);
|
||||
TestMaskException('', '[a------h]', False);
|
||||
TestMaskException('', '**', False);
|
||||
TestMaskException('', 'aa', False);
|
||||
TestMaskException('', 'a*', False);
|
||||
TestMaskException('', '*a', False);
|
||||
TestMaskException('', '*?', False);
|
||||
|
||||
TestMaskException('', '[', True);
|
||||
TestMaskException('', '[a', True);
|
||||
TestMaskException('', '[]', True);
|
||||
TestMaskException('', '[!]', True);
|
||||
TestMaskException('', '[-]', True);
|
||||
TestMaskException('', '[a-]', True);
|
||||
TestMaskException('', '[-a]', True);
|
||||
TestMaskException('', '[--a]', True);
|
||||
end;
|
||||
|
||||
procedure TTestMask.TestNil;
|
||||
begin
|
||||
TestMask('', '', True);
|
||||
TestMask('', '*', True);
|
||||
TestMask('', '?', False);
|
||||
TestMask('', 'a', False);
|
||||
TestMask('', '[a]', False);
|
||||
end;
|
||||
|
||||
procedure TTestMask.TestAnyText;
|
||||
begin
|
||||
TestMask('abc', '*', True);
|
||||
TestMask('abc', 'a*', True);
|
||||
TestMask('abc', '*c', True);
|
||||
TestMask('abc', '*a*', True);
|
||||
TestMask('abc', '*b*', True);
|
||||
TestMask('abc', '*c*', True);
|
||||
TestMask('abc', 'a*c', True);
|
||||
TestMask('abc', '*bc', True);
|
||||
TestMask('abc', 'ab*', True);
|
||||
|
||||
TestMask('abcde', '*', True);
|
||||
TestMask('abcde', 'a*e', True);
|
||||
TestMask('abcde', 'a*b*e', True);
|
||||
TestMask('abcde', 'a*d*e', True);
|
||||
TestMask('abcde', 'a*c*e', True);
|
||||
TestMask('abcde', 'a*b*e', True);
|
||||
|
||||
TestMask('abc', '*b', False);
|
||||
TestMask('abc', 'b*', False);
|
||||
TestMask('abc', '*a', False);
|
||||
TestMask('abc', 'c*', False);
|
||||
TestMask('abc', 'ab*d', False);
|
||||
|
||||
TestMask('abcde', 'a*d', False);
|
||||
TestMask('abcde', 'a*c*d', False);
|
||||
TestMask('abcde', 'b*d*e', False);
|
||||
end;
|
||||
|
||||
procedure TTestMask.TestAnyChar;
|
||||
begin
|
||||
TestMask('abc', '?bc', True);
|
||||
TestMask('abc', '?b?', True);
|
||||
TestMask('abc', '???', True);
|
||||
|
||||
TestMask('abc', '?*?', True);
|
||||
TestMask('abc', '?*??', True);
|
||||
TestMask('abc', '?*?*?', True);
|
||||
|
||||
TestMask('abc', 'a?', False);
|
||||
TestMask('abc', 'abc?', False);
|
||||
TestMask('abc', '?abc', False);
|
||||
TestMask('abc', '??*??', False);
|
||||
TestMask('abc', '?*?*??', False);
|
||||
end;
|
||||
|
||||
procedure TTestMask.TestCharSet;
|
||||
begin
|
||||
TestMask('c', '[c]', True);
|
||||
TestMask('c', '[!b]', True);
|
||||
TestMask('c', '[a-c]', True);
|
||||
TestMask('c', '[a-d]', True);
|
||||
TestMask('c', '[!a-b]', True);
|
||||
TestMask('c', '[abc]', True);
|
||||
|
||||
TestMask('c', '[a]', False);
|
||||
TestMask('c', '[!c]', False);
|
||||
TestMask('c', '[a-b]', False);
|
||||
TestMask('c', '[abd]', False);
|
||||
end;
|
||||
|
||||
begin
|
||||
RegisterTest(TTestMask);
|
||||
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TGuiTestRunner, TestRunner);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user