mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-08 13:18:16 +02:00
implemented help jump to FPDoc html unit
git-svn-id: trunk@5838 -
This commit is contained in:
mattias
parent
e910a6ac44
commit
845b65c847
@ -36,9 +36,9 @@ uses
|
||||
Classes, SysUtils, LCLProc, Forms, Controls, Buttons, StdCtrls, Dialogs,
|
||||
CodeToolManager, CodeAtom, CodeCache, CustomCodeTool, CodeTree,
|
||||
PascalParserTool, FindDeclarationTool,
|
||||
HelpIntf, HelpHTML, DialogProcs,
|
||||
IDEOptionDefs, EnvironmentOpts, AboutFrm, Project, PackageDefs, MainBar,
|
||||
HelpOptions, MainIntf;
|
||||
HelpIntf, HelpHTML, HelpFPDoc,
|
||||
TransferMacros, DialogProcs, IDEOptionDefs, EnvironmentOpts, AboutFrm,
|
||||
Project, PackageDefs, MainBar, HelpOptions, MainIntf;
|
||||
|
||||
type
|
||||
{ TBaseHelpManager }
|
||||
@ -62,13 +62,15 @@ type
|
||||
|
||||
TIDEHelpDatabases = class(THelpDatabases)
|
||||
public
|
||||
function ShowHelpSelector(Nodes: TList; var ErrMsg: string;
|
||||
function ShowHelpSelector(Query: THelpQuery; Nodes: TList;
|
||||
var ErrMsg: string;
|
||||
var Selection: THelpNode): TShowHelpResult; override;
|
||||
procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); override;
|
||||
function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; override;
|
||||
function ShowHelpForSourcePosition(const Filename: string;
|
||||
const CodePos: TPoint;
|
||||
function ShowHelpForSourcePosition(Query: THelpQuerySourcePosition;
|
||||
var ErrMsg: string): TShowHelpResult; override;
|
||||
function StrHasMacros(const s: string): boolean; override;
|
||||
function SubstituteMacros(var s: string): boolean; override;
|
||||
end;
|
||||
|
||||
|
||||
@ -81,6 +83,7 @@ type
|
||||
procedure mnuHelpOnlineHelpClicked(Sender: TObject);
|
||||
private
|
||||
FMainHelpDB: THelpDatabase;
|
||||
FFCLHelpDB: THelpDatabase;
|
||||
procedure RegisterIDEHelpDatabases;
|
||||
procedure RegisterDefaultIDEHelpViewers;
|
||||
public
|
||||
@ -100,12 +103,15 @@ type
|
||||
var ErrMsg: string): TShowHelpResult; override;
|
||||
public
|
||||
property MainHelpDB: THelpDatabase read FMainHelpDB;
|
||||
property FCLHelpDB: THelpDatabase read FFCLHelpDB;
|
||||
end;
|
||||
|
||||
{ Help Contexts for IDE help }
|
||||
const
|
||||
lihcStartPage = 'StartPage';
|
||||
|
||||
lihcFCLStartPage = 'FCLStartPage';
|
||||
lihcFCLUnits = 'FCLUnits';
|
||||
|
||||
var
|
||||
HelpBoss: TBaseHelpManager;
|
||||
|
||||
@ -232,8 +238,8 @@ end;
|
||||
|
||||
{ TIDEHelpDatabases }
|
||||
|
||||
function TIDEHelpDatabases.ShowHelpSelector(Nodes: TList; var ErrMsg: string;
|
||||
var Selection: THelpNode): TShowHelpResult;
|
||||
function TIDEHelpDatabases.ShowHelpSelector(Query: THelpQuery; Nodes: TList;
|
||||
var ErrMsg: string; var Selection: THelpNode): TShowHelpResult;
|
||||
var
|
||||
Dialog: THelpSelectorDialog;
|
||||
i: LongInt;
|
||||
@ -284,12 +290,26 @@ begin
|
||||
Result:=TProject(BasePathObject).ProjectDirectory
|
||||
else if BasePathObject is TLazPackage then
|
||||
Result:=TLazPackage(BasePathObject).Directory;
|
||||
SubstituteMacros(Result);
|
||||
end;
|
||||
|
||||
function TIDEHelpDatabases.ShowHelpForSourcePosition(const Filename: string;
|
||||
const CodePos: TPoint; var ErrMsg: string): TShowHelpResult;
|
||||
function TIDEHelpDatabases.ShowHelpForSourcePosition(
|
||||
Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult;
|
||||
begin
|
||||
Result:=HelpBoss.ShowHelpForSourcePosition(Filename,CodePos,ErrMsg);
|
||||
Result:=HelpBoss.ShowHelpForSourcePosition(Query.Filename,
|
||||
Query.SourcePosition,ErrMsg);
|
||||
end;
|
||||
|
||||
function TIDEHelpDatabases.StrHasMacros(const s: string): boolean;
|
||||
begin
|
||||
Result:=MainIDEInterface.MacroList.StrHasMacros(s);
|
||||
end;
|
||||
|
||||
function TIDEHelpDatabases.SubstituteMacros(var s: string): boolean;
|
||||
begin
|
||||
//debugln('TIDEHelpDatabases.SubstituteMacros s="',s,'" ');
|
||||
Result:=MainIDEInterface.MacroList.SubstituteStr(s);
|
||||
//debugln('TIDEHelpDatabases.SubstituteMacros END s="',s,'"');
|
||||
end;
|
||||
|
||||
{ THelpManager }
|
||||
@ -311,19 +331,60 @@ begin
|
||||
end;
|
||||
|
||||
procedure THelpManager.RegisterIDEHelpDatabases;
|
||||
var
|
||||
HTMLHelp: THTMLHelpDatabase;
|
||||
StartNode: THelpNode;
|
||||
|
||||
procedure CreateMainIDEHelpDB;
|
||||
var
|
||||
StartNode: THelpNode;
|
||||
HTMLHelp: THTMLHelpDatabase;
|
||||
begin
|
||||
FMainHelpDB:=HelpDatabases.CreateHelpDatabase('Lazarus IDE',
|
||||
THTMLHelpDatabase,true);
|
||||
HTMLHelp:=FMainHelpDB as THTMLHelpDatabase;
|
||||
HTMLHelp.BasePathObject:=Self;
|
||||
// nodes
|
||||
StartNode:=THelpNode.CreateURLID(HTMLHelp,'Lazarus',
|
||||
'file://docs/index.html',lihcStartPage);
|
||||
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,StartNode);
|
||||
HTMLHelp.RegisterItemWithNode(StartNode);
|
||||
end;
|
||||
|
||||
procedure CreateFCLHelpDB;
|
||||
var
|
||||
HTMLHelp: TFPDocHTMLHelpDatabase;
|
||||
StartNode: THelpNode;
|
||||
FPDocNode: THelpNode;
|
||||
DirItem: THelpDBSISourceDirectory;
|
||||
begin
|
||||
FFCLHelpDB:=HelpDatabases.CreateHelpDatabase('FCL',TFPDocHTMLHelpDatabase,
|
||||
true);
|
||||
HTMLHelp:=FFCLHelpDB as TFPDocHTMLHelpDatabase;
|
||||
|
||||
// FCL
|
||||
StartNode:=THelpNode.CreateURLID(HTMLHelp,
|
||||
'FCL - Free Pascal Component Library',
|
||||
'http://www.freepascal.org/docs-html/fcl/index.html',
|
||||
lihcFCLStartPage);
|
||||
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,StartNode);
|
||||
HTMLHelp.RegisterItemWithNode(StartNode);
|
||||
|
||||
// FPDoc: units in the FCL
|
||||
FPDocNode:=THelpNode.CreateURL(HTMLHelp,
|
||||
'FCL - Free Pascal Component Library Units',
|
||||
'http://www.freepascal.org/docs-html/fcl/index.html');
|
||||
DirItem:=THelpDBSISourceDirectory.Create(FPDocNode,'$(FPCSrcDir)/fcl',
|
||||
'*.pp;*.pas',true);
|
||||
HTMLHelp.RegisterItem(DirItem);
|
||||
|
||||
// FPDoc: some RTL units are documented in the FCL
|
||||
DirItem:=THelpDBSISourceDirectory.Create(
|
||||
THelpNode.Create(HTMLHelp,FPDocNode),
|
||||
'$(FPCSrcDir)/rtl','classes.pp;',true);
|
||||
HTMLHelp.RegisterItem(DirItem);
|
||||
end;
|
||||
|
||||
begin
|
||||
FMainHelpDB:=HelpDatabases.CreateHelpDatabase('Lazarus IDE',THTMLHelpDatabase,
|
||||
true);
|
||||
HTMLHelp:=FMainHelpDB as THTMLHelpDatabase;
|
||||
HTMLHelp.BasePathObject:=Self;
|
||||
// nodes
|
||||
StartNode:=THelpNode.CreateURLID(HTMLHelp,'Lazarus',
|
||||
'file://docs/index.html',lihcStartPage);
|
||||
HTMLHelp.TOCNode:=THelpNode.Create(HTMLHelp,StartNode);
|
||||
HTMLHelp.RegisterItemWithNode(StartNode);
|
||||
CreateMainIDEHelpDB;
|
||||
CreateFCLHelpDB;
|
||||
end;
|
||||
|
||||
procedure THelpManager.RegisterDefaultIDEHelpViewers;
|
||||
@ -519,7 +580,7 @@ begin
|
||||
|
||||
// invoke help system
|
||||
debugln('THelpManager.ShowHelpForSourcePosition D PascalHelpContextLists.Count=',dbgs(PascalHelpContextLists.Count));
|
||||
Result:=ShowHelpForPascalContexts(PascalHelpContextLists,ErrMsg);
|
||||
ShowHelpForPascalContexts(Filename,CodePos,PascalHelpContextLists,ErrMsg);
|
||||
end else begin
|
||||
MainIDEInterface.DoJumpToCodeToolBossError;
|
||||
end;
|
||||
|
||||
@ -22,7 +22,7 @@
|
||||
|
||||
Abstract:
|
||||
This unit defines the classes TTransferMacro and TTransferMacroList. These
|
||||
classes stores and substitutes macros in strings. Transfer macros are an
|
||||
classes store and substitute macros in strings. Transfer macros are an
|
||||
easy way to transfer some ide variables to programs like the compiler,
|
||||
the debugger and all the other tools.
|
||||
Transfer macros have the form $(macro_name). It is also possible to define
|
||||
@ -100,13 +100,13 @@ type
|
||||
procedure Add(NewMacro: TTransferMacro);
|
||||
function FindByName(const MacroName: string): TTransferMacro; virtual;
|
||||
function SubstituteStr(var s:string): boolean; virtual;
|
||||
function StrHasMacros(const s: string): boolean;
|
||||
property OnSubstitution: TOnSubstitution
|
||||
read fOnSubstitution write fOnSubstitution;
|
||||
property MarkUnhandledMacros: boolean read FMarkUnhandledMacros
|
||||
write SetMarkUnhandledMacros;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
@ -374,6 +374,34 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTransferMacroList.StrHasMacros(const s: string): boolean;
|
||||
// search for $( or $xxx(
|
||||
var
|
||||
p: Integer;
|
||||
Len: Integer;
|
||||
begin
|
||||
Result:=false;
|
||||
p:=1;
|
||||
Len:=length(s);
|
||||
while (p<Len) do begin
|
||||
if s[p]='$' then begin
|
||||
inc(p);
|
||||
if (p<Len) and (s[p]<>'$') then begin
|
||||
// skip macro function name
|
||||
while (p<Len) and (s[p]<>'(') do inc(p);
|
||||
if (p<Len) then begin
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
// $$ is not a macro
|
||||
inc(p);
|
||||
end;
|
||||
end else
|
||||
inc(p);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTransferMacroList.FindByName(const MacroName: string): TTransferMacro;
|
||||
var
|
||||
l: Integer;
|
||||
|
||||
@ -22,16 +22,75 @@ unit HelpFPDoc;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, HelpIntf;
|
||||
Classes, SysUtils, LCLProc, FileCtrl, HelpIntf, HelpHTML;
|
||||
|
||||
type
|
||||
{ TFPDocHelpDatabase }
|
||||
{ TFPDocHTMLHelpDatabase }
|
||||
|
||||
TFPDocHelpDatabase = class(THelpDatabase)
|
||||
TFPDocHTMLHelpDatabase = class(THTMLHelpDatabase)
|
||||
public
|
||||
function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
|
||||
var ErrMsg: string): TShowHelpResult; override;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TFPDocHTMLHelpDatabase }
|
||||
|
||||
function TFPDocHTMLHelpDatabase.ShowHelp(Query: THelpQuery; BaseNode,
|
||||
NewNode: THelpNode; var ErrMsg: string): TShowHelpResult;
|
||||
var
|
||||
ContextList: TPascalHelpContextList;
|
||||
UnitName: String;
|
||||
URL: String;
|
||||
TheBaseURL: String;
|
||||
Filename: String;
|
||||
begin
|
||||
if (Query is THelpQueryPascalContexts)
|
||||
and (NewNode.QueryItem is TPascalHelpContextList) then begin
|
||||
// a pascal context query
|
||||
ContextList:=TPascalHelpContextList(NewNode.QueryItem);
|
||||
if (ContextList.Count>0) and (ContextList.List[0].Descriptor=pihcFilename)
|
||||
then begin
|
||||
// extract unit filename
|
||||
UnitName:=lowercase(ExtractFileNameOnly(ContextList.List[0].Context));
|
||||
DebugLn('TFPDocHTMLHelpDatabase.ShowHelp A Unitname=',Unitname,' NewNode.HelpType=',dbgs(ord(NewNode.HelpType)),' NewNode.Title=',NewNode.Title,' NewNode.URL=',NewNode.URL);
|
||||
if UnitName<>'' then begin
|
||||
|
||||
Filename:=UnitName+'/';
|
||||
// TODO: context in unit
|
||||
Filename:=Filename+'index.html';
|
||||
|
||||
TheBaseURL:='';
|
||||
if NewNode.URLValid then begin
|
||||
// the node has an URL => use only the path
|
||||
TheBaseURL:=NewNode.URL;
|
||||
debugln('A TheBaseURL=',TheBaseURL);
|
||||
if (HelpDatabases<>nil) then
|
||||
HelpDatabases.SubstituteMacros(TheBaseURL);
|
||||
debugln('B TheBaseURL=',TheBaseURL);
|
||||
TheBaseURL:=ExtractURLDirectory(TheBaseURL);
|
||||
debugln('C TheBaseURL=',TheBaseURL);
|
||||
DebugLn('TFPDocHTMLHelpDatabase.ShowHelp Node Base URL TheBaseURL=',TheBaseURL);
|
||||
end;
|
||||
|
||||
if TheBaseURL='' then
|
||||
TheBaseURL:=GetEffectiveBaseURL;
|
||||
|
||||
// show URL
|
||||
if TheBaseURL<>'' then
|
||||
URL:=TheBaseURL+Filename
|
||||
else
|
||||
URL:=FilenameToURL(Filename);
|
||||
Result:=ShowURL(URL,NewNode.Title,ErrMsg);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
// otherwise use default
|
||||
Result:=inherited ShowHelp(Query, BaseNode, NewNode, ErrMsg);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -34,7 +34,9 @@ type
|
||||
procedure SetBaseURL(const AValue: string);
|
||||
public
|
||||
constructor Create(TheID: THelpDatabaseID); override;
|
||||
function ShowHelp(BaseNode, NewNode: THelpNode;
|
||||
function ShowURL(const URL, Title: string;
|
||||
var ErrMsg: string): TShowHelpResult; virtual;
|
||||
function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode;
|
||||
var ErrMsg: string): TShowHelpResult; override;
|
||||
function GetEffectiveBaseURL: string;
|
||||
public
|
||||
@ -80,54 +82,62 @@ begin
|
||||
AddSupportedMimeType('text/html');
|
||||
end;
|
||||
|
||||
function THTMLHelpDatabase.ShowHelp(BaseNode, NewNode: THelpNode;
|
||||
var ErrMsg: string): TShowHelpResult;
|
||||
function THTMLHelpDatabase.ShowURL(const URL, Title: string; var ErrMsg: string
|
||||
): TShowHelpResult;
|
||||
var
|
||||
URLType, URLPath, URLParams: string;
|
||||
BaseURLType, BaseURLPath, BaseURLParams: string;
|
||||
Viewer: THelpViewer;
|
||||
EffBaseURL: String;
|
||||
Node: THelpNode;
|
||||
URL: String;
|
||||
FullURL: String;
|
||||
begin
|
||||
DebugLn('THTMLHelpDatabase.ShowURL A URL="',URL,'" Title="',Title,'"');
|
||||
|
||||
// find HTML viewer
|
||||
Result:=FindViewer('text/html',ErrMsg,Viewer);
|
||||
if Result<>shrSuccess then exit;
|
||||
|
||||
// make URL absolute
|
||||
SplitURL(URL,URLType,URLPath,URLParams);
|
||||
debugln('THTMLHelpDatabase.ShowHelp A NewNode.URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
|
||||
|
||||
if URLType='file' then begin
|
||||
if not URLFilenameIsAbsolute(URLPath) then begin
|
||||
EffBaseURL:=GetEffectiveBaseURL;
|
||||
SplitURL(EffBaseURL,BaseURLType,BaseURLPath,BaseURLParams);
|
||||
if (BaseURLType='file') and (BaseURLPath<>'') then
|
||||
URLPath:=BaseURLPath+URLPath;
|
||||
end;
|
||||
if (not FileExists(URLPath)) then begin
|
||||
Result:=shrContextNotFound;
|
||||
ErrMsg:=Format(oisHelpTheHelpDatabaseWasUnableToFindFile, ['"', ID,
|
||||
'"', '"', URLPath, '"']);
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
|
||||
end;
|
||||
FullURL:=CombineURL(URLType,URLPath,URLParams);
|
||||
debugln('THTMLHelpDatabase.ShowHelp B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
|
||||
|
||||
// call viewer
|
||||
Node:=nil;
|
||||
try
|
||||
Node:=THelpNode.CreateURL(Self,Title,FullURL);
|
||||
Result:=Viewer.ShowNode(Node,ErrMsg);
|
||||
finally
|
||||
Node.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function THTMLHelpDatabase.ShowHelp(Query: THelpQuery;
|
||||
BaseNode, NewNode: THelpNode; var ErrMsg: string): TShowHelpResult;
|
||||
begin
|
||||
ErrMsg:='';
|
||||
Result:=shrContextNotFound;
|
||||
if NewNode.URLValid then begin
|
||||
// find HTML viewer
|
||||
Result:=FindViewer('text/html',ErrMsg,Viewer);
|
||||
if Result<>shrSuccess then exit;
|
||||
|
||||
// make URL absolute
|
||||
SplitURL(NewNode.URL,URLType,URLPath,URLParams);
|
||||
//debugln('THTMLHelpDatabase.ShowHelp A NewNode.URL=',NewNode.URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
|
||||
|
||||
if URLType='file' then begin
|
||||
if not URLFilenameIsAbsolute(URLPath) then begin
|
||||
EffBaseURL:=GetEffectiveBaseURL;
|
||||
SplitURL(EffBaseURL,BaseURLType,BaseURLPath,BaseURLParams);
|
||||
if (BaseURLType='file') and (BaseURLPath<>'') then
|
||||
URLPath:=BaseURLPath+URLPath;
|
||||
end;
|
||||
if (not FileExists(URLPath)) then begin
|
||||
Result:=shrContextNotFound;
|
||||
ErrMsg:=Format(oisHelpTheHelpDatabaseWasUnableToFindFile, ['"', ID,
|
||||
'"', '"', URLPath, '"']);
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
|
||||
end;
|
||||
URL:=CombineURL(URLType,URLPath,URLParams);
|
||||
//debugln('THTMLHelpDatabase.ShowHelp B URL=',URL,' URLType=',URLType,' URLPath=',URLPath,' URLParams=',URLParams);
|
||||
|
||||
// call viewer
|
||||
Node:=THelpNode.Create(Self,NewNode);
|
||||
try
|
||||
Node.URL:=URL;
|
||||
Result:=Viewer.ShowNode(Node,ErrMsg);
|
||||
finally
|
||||
Node.Free;
|
||||
end;
|
||||
Result:=ShowURL(NewNode.URL,NewNode.Title,ErrMsg);
|
||||
end else begin
|
||||
Result:=shrContextNotFound;
|
||||
ErrMsg:='THTMLHelpDatabase.ShowHelp Node.URLValid=false';
|
||||
@ -137,9 +147,11 @@ end;
|
||||
function THTMLHelpDatabase.GetEffectiveBaseURL: string;
|
||||
begin
|
||||
Result:='';
|
||||
if BaseURL<>'' then
|
||||
Result:=BaseURL
|
||||
else if (BasePathObject<>nil) and (Databases<>nil) then
|
||||
if BaseURL<>'' then begin
|
||||
Result:=BaseURL;
|
||||
if (HelpDatabases<>nil) then
|
||||
HelpDatabases.SubstituteMacros(Result);
|
||||
end else if (BasePathObject<>nil) and (Databases<>nil) then
|
||||
Result:=Databases.GetBaseURLForBasePathObject(BasePathObject);
|
||||
if (Result<>'') and (Result[length(Result)]<>'/') then
|
||||
Result:=Result+'/';
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -821,11 +821,100 @@ 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
|
||||
// TODO
|
||||
Result:=false;
|
||||
if (Filename='') or (Masks='') then exit;
|
||||
TrimmedFile:=TrimFilename(Filename); // do not expand
|
||||
// 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
|
||||
inc(FilePos);
|
||||
inc(MaskPos);
|
||||
end;
|
||||
|
||||
'*': begin
|
||||
// Anything. Will be handled by the 'else' part below
|
||||
inc(MaskPos);
|
||||
end;
|
||||
|
||||
else
|
||||
{$IFDEF win32}
|
||||
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;
|
||||
if (MaskPos=MaskEndPos) and (FilePos>FileLen) then begin
|
||||
// found
|
||||
Result:=true;
|
||||
exit;
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -958,6 +1047,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.48 2004/08/23 15:05:09 mattias
|
||||
implemented help jump to FPDoc html unit
|
||||
|
||||
Revision 1.47 2004/08/22 22:47:43 mattias
|
||||
implemented context help for source editor
|
||||
|
||||
|
||||
@ -4283,7 +4283,7 @@ begin
|
||||
csPreviewFileDialog,
|
||||
csColorDialog,
|
||||
csFontDialog:
|
||||
if GtkWidgetIsA(p,GTK_WINDOW_TYPE) then
|
||||
if GtkWidgetIsA(p,gtk_window_get_type) then
|
||||
gtk_window_set_title(pGtkWindow(p),PLabel);
|
||||
|
||||
csLabel:
|
||||
@ -9268,6 +9268,9 @@ end;
|
||||
{ =============================================================================
|
||||
|
||||
$Log$
|
||||
Revision 1.531 2004/08/23 15:05:09 mattias
|
||||
implemented help jump to FPDoc html unit
|
||||
|
||||
Revision 1.530 2004/08/19 18:50:53 mattias
|
||||
splitted IDE component owner hierachy to reduce notification time
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user