{ $Id$ } { ***************************************************************************** * * * 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. * * * ***************************************************************************** Author: Mattias Gaertner Abstract: This unit defines various base classes for the Help System used by the IDE. ToDo: - localization support. - Add Help Editing functions - Standalone help system for LCL applications } unit HelpIntf; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LCLProc, Controls, FileUtil, LazConfigStorage; resourcestring rsHelpHelpNodeHasNoHelpDatabase = 'Help node %s%s%s has no Help Database'; rsHelpHelpDatabaseDidNotFoundAViewerForAHelpPageOfType = 'Help Database %s%' +'s%s did not found a viewer for a help page of type %s'; rsHelpAlreadyRegistered = '%s: Already registered'; rsHelpNotRegistered = '%s: Not registered'; rsHelpHelpDatabaseNotFound = 'Help Database %s%s%s not found'; rsHelpHelpKeywordNotFoundInDatabase = 'Help keyword %s%s%s not found in ' +'Database %s%s%s.'; rsHelpHelpKeywordNotFound = 'Help keyword %s%s%s not found.'; rsHelpHelpContextNotFoundInDatabase = 'Help context %s not found in ' +'Database %s%s%s.'; rsHelpHelpContextNotFound = 'Help context %s not found.'; rsHelpNoHelpFoundForSource = 'No help found for line %d, column %d of %s.'; type // All help-specific error messages should be thrown as this type. EHelpSystemException = class(Exception); TShowHelpResult = ( shrNone, shrSuccess, shrCancel, shrDatabaseNotFound, shrContextNotFound, shrViewerNotFound, shrHelpNotFound, shrViewerError, shrSelectorError ); TShowHelpResults = set of TShowHelpResult; { THelpQueryItem } THelpQueryItem = class public function AsString: string; virtual; abstract; function IsEqual(QueryItem: THelpQueryItem): boolean; virtual; end; { TPascalHelpContextList } TPascalHelpContextType = ( pihcFilename, pihcSourceName, // unit name, library name, .. pihcProperty, pihcProcedure, pihcParameterList, pihcVariable, pihcType, pihcConst ); TPascalHelpContext = record Descriptor: TPascalHelpContextType; Context: string; end; TPascalHelpContextPtr = ^TPascalHelpContext; TPascalHelpContextList = class(THelpQueryItem) private FCount: integer; fItems: TPascalHelpContextPtr; function GetItems(Index: integer): TPascalHelpContext; public procedure Add(const Context: TPascalHelpContext); procedure Insert(Index: integer; const Context: TPascalHelpContext); procedure Clear; destructor Destroy; override; function IsEqual(QueryItem: THelpQueryItem): boolean; override; function CompareList(AList: TPascalHelpContextList): integer; function AsString: string; override; public property Count: integer read FCount; property Items[Index: integer]: TPascalHelpContext read GetItems; property List: TPascalHelpContextPtr read fItems; end; THelpDatabase = class; THelpDatabaseID = string; { THelpNode A help node is a position/place in a help database. For example it points to Help file or to a Link on a HTML file. } THelpNodeType = ( hntURLIDContext, // URL, ID and Context valid hntURL, // URL valid, ignore ID and Context hntURLID, // URL and ID valid, ignore Context hntID, // ID valid, ignore URL and Context hntContext, // Context valid, ignore URL and ID hntURLContext // URL and Context valid, ignore ID ); { THelpNode } THelpNode = class(TPersistent) private FContext: THelpContext; FURL: string; FHelpType: THelpNodeType; fID: string; FOwner: THelpDatabase; FTitle: string; public constructor Create(TheOwner: THelpDatabase; Node: THelpNode); constructor Create(TheOwner: THelpDatabase; const TheTitle, TheURL, TheID: string; TheContext: THelpContext); constructor CreateURL(TheOwner: THelpDatabase; const TheTitle, TheURL: string); constructor CreateID(TheOwner: THelpDatabase; const TheTitle, TheID: string); constructor CreateURLID(TheOwner: THelpDatabase; const TheTitle, TheURL, TheID: string); constructor CreateContext(TheOwner: THelpDatabase; const TheTitle: string; TheContext: THelpContext); constructor CreateURLContext(TheOwner: THelpDatabase; const TheTitle, TheURL: string; TheContext: THelpContext); public property Owner: THelpDatabase read FOwner write FOwner; function URLValid: boolean; function IDValid: boolean; function ContextValid: boolean; function AsString: string; procedure Assign(Source: TPersistent); override; published property Title: string read FTitle write FTitle; property HelpType: THelpNodeType read FHelpType write FHelpType; property URL: string read FURL write FURL; property ID: string read fID write fID; property Context: THelpContext read FContext write FContext; end; { THelpNodeQuery } THelpNodeQuery = class private FNode: THelpNode; FQueryItem: THelpQueryItem; public constructor Create; constructor Create(TheNode: THelpNode; TheQueryItem: THelpQueryItem); function IsEqual(TheNode: THelpNode; TheQueryItem: THelpQueryItem): boolean; function IsEqual(NodeQuery: THelpNodeQuery): boolean; function AsString: string; property Node: THelpNode read FNode write FNode; property QueryItem: THelpQueryItem read FQueryItem write FQueryItem; end; { THelpNodeQueryList } THelpNodeQueryList = class private fItems: TFPList; function GetItems(Index: integer): THelpNodeQuery; procedure SetItems(Index: integer; const AValue: THelpNodeQuery); public constructor Create; destructor Destroy; override; function Count: integer; function Add(NodeQuery: THelpNodeQuery): integer; function Add(Node: THelpNode; QueryItem: THelpQueryItem): integer; procedure Delete(Index: integer); function IndexOf(NodeQuery: THelpNodeQuery): integer; function IndexOf(Node: THelpNode; QueryItem: THelpQueryItem): integer; procedure Clear; property Items[Index: integer]: THelpNodeQuery read GetItems write SetItems; default; end; { THelpDBItem Base class for registration items associated with a THelpDatabase. See THelpDBSISourceDirectory for an example. Node is optional, pointing to a help page about the help item. } THelpDBItem = class(TPersistent) private FNode: THelpNode; public constructor Create(TheNode: THelpNode); destructor Destroy; override; published property Node: THelpNode read FNode write FNode; end; { THelpDBSISourceFile Help registration item for a single source file. If Filename is relative, the BasePathObject is used to get a base directory. For example: If BasePathObject is a TLazPackage the Filename is relative to the directory of the .lpk file } THelpDBISourceFile = class(THelpDBItem) private FBasePathObject: TObject; FFilename: string; procedure SetFilename(const AValue: string); public constructor Create(TheNode: THelpNode; const TheFilename: string); function FileMatches(const AFilename: string): boolean; virtual; function GetFullFilename: string; virtual; function GetBasePath: string; virtual; published property BasePathObject: TObject read FBasePathObject write FBasePathObject; property Filename: string read FFilename write SetFilename; end; { THelpDBISourceDirectory Help registration item for a source directory. As THelpDBISourceFile, except that Filename is a directory and the item is valid for all source files fitting the FileMask. FileMask can be for example '*.pp;*.pas;*.inc' For example: A package providing help for all its source files registers a THelpDBISourceDirectory. Node points to the fpdoc main page. } THelpDBISourceDirectory = class(THelpDBISourceFile) private FFileMask: string; FWithSubDirectories: boolean; public constructor Create(TheNode: THelpNode; const TheFilename, TheFileMask: string; Recursive: boolean); function FileMatches(const AFilename: string): boolean; override; published property FileMask: string read FFileMask write FFileMask; property WithSubDirectories: boolean read FWithSubDirectories write FWithSubDirectories; end; { THelpDBIClass Help registration item for a class. Used by the IDE to search for help for a class without source. For example for a registered component class in the component palette, that comes without source. If the component comes with source use the THelpDBISourceDirectory or THelpDBISourceFile instead. } THelpDBIClass = class(THelpDBItem) private FTheClass: TClass; public property TheClass: TClass read FTheClass write FTheClass; end; { THelpDBIMessage Help registration item for a message (e.g. a fpc warning). Used by the IDE to search for help for one message (typically a line). For example a line like "/usr/share/lazarus/components/synedit/syneditkeycmds.pp(532,10) Warning: Function result does not seem to be set" } THelpDBIMessage = class(THelpDBItem) public function MessageMatches(const TheMessage: string; MessageParts: TStrings ): boolean; virtual; abstract; end; { THelpQuery } THelpQuery = class(TPersistent) private FHelpDatabaseID: THelpDatabaseID; public constructor Create(const TheHelpDatabaseID: THelpDatabaseID); property HelpDatabaseID: THelpDatabaseID read FHelpDatabaseID write FHelpDatabaseID; end; { THelpQueryNode } THelpQueryNode = class(THelpQuery) private FNode: THelpNode; public constructor Create(const TheHelpDatabaseID: THelpDatabaseID; const TheNode: THelpNode); property Node: THelpNode read FNode write FNode; end; { THelpQueryTOC } THelpQueryTOC = class(THelpQueryNode) end; { THelpQueryContext } THelpQueryContext = class(THelpQuery) private FContext: THelpContext; public constructor Create(const TheHelpDatabaseID: THelpDatabaseID; const TheContext: THelpContext); property Context: THelpContext read FContext write FContext; end; { THelpQueryKeyword } THelpQueryKeyword = class(THelpQuery) private FKeyword: string; public constructor Create(const TheHelpDatabaseID: THelpDatabaseID; const TheKeyWord: string); property Keyword: string read FKeyword write FKeyword; end; { THelpQuerySourcePosition } THelpQuerySourcePosition = class(THelpQuery) private FFilename: string; FSourcePosition: TPoint; public constructor Create(const TheHelpDatabaseID: THelpDatabaseID; const TheFilename: string; const SrcPos: TPoint); property Filename: string read FFilename write FFilename; property SourcePosition: TPoint read FSourcePosition write FSourcePosition; end; { THelpQueryPascalContexts } THelpQueryPascalContexts = class(THelpQuerySourcePosition) private FContextLists: TList; public constructor Create(const TheHelpDatabaseID: THelpDatabaseID; const TheFilename: string; const SrcPos: TPoint; ContextLists: TList); property ListOfPascalHelpContextList: TList read FContextLists write FContextLists; end; { THelpQueryMessage A query for messages, like the compiler warnings and errors. 'WholeMessage' is the complete line as string. 'MessageParts' can be a list of Name=Value pairs, that has been extracted by the IDE. Common names and values are: Name | Value --------|----------------------------------------------------------------- Stage Indicates what part of the build process the message belongs to. Common values are 'FPC', 'Linker' or 'make' Type For FPC: 'Hint', 'Note', 'Warning', 'Error', 'Fatal', 'Panic', 'Compiling', 'Assembling' For make: For Linker: Line An integer for the linenumber as given by FPC in brackets. Column An integer for the column as given by FPC in brackets. Message The message text without other parsed items. Example: Message written by FPC: unit1.pas(21,3) Warning: unit buttons not used Results in Stage=FPC Type=Warning Line=21 Column=3 Message=unit buttons not used } THelpQueryMessage = class(THelpQuery) private FMessageParts: TStrings; FWholeMessage: string; public constructor Create(const TheHelpDatabaseID: THelpDatabaseID; const TheMessage: string; TheMessageParts: TStrings); destructor Destroy; override; property WholeMessage: string read FWholeMessage write FWholeMessage; property MessageParts: TStrings read FMessageParts write FMessageParts; end; { THelpQueryClass } THelpQueryClass = class(THelpQuery) private FTheClass: TClass; public constructor Create(const TheHelpDatabaseID: THelpDatabaseID; const AClass: TClass); property TheClass: TClass read FTheClass write FTheClass; end; { THelpDatabase Base class for a collection of help files or entries. BasePathObject: THelpDatabase can be created by packages. The IDE will set BasePathObject accordingly. } THelpDatabases = class; THelpViewer = class; THelpDatabase = class(TPersistent) private FBasePathObject: TObject; FID: THelpDatabaseID; FDatabases: THelpDatabases; FRefCount: integer; FSearchItems: TList; FSupportedMimeTypes: TStrings; FTOCNode: THelpNode; procedure SetID(const AValue: THelpDatabaseID); procedure SetDatabases(const AValue: THelpDatabases); protected procedure SetSupportedMimeTypes(List: TStrings); virtual; procedure AddSupportedMimeType(const AMimeType: string); virtual; public constructor Create(TheID: THelpDatabaseID); virtual; destructor Destroy; override; procedure Reference; procedure RegisterSelf; procedure Release; procedure UnregisterSelf; function Registered: boolean; function CanShowTableOfContents: boolean; virtual; procedure ShowTableOfContents; virtual; procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); virtual; function ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelpFile(Query: THelpQuery; BaseNode: THelpNode; const Title, Filename: string; var ErrMsg: string): TShowHelpResult; virtual; function SupportsMimeType(const AMimeType: string): boolean; virtual; function GetNodesForKeyword(const HelpKeyword: string; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function GetNodesForContext(HelpContext: THelpContext; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function GetNodesForPascalContexts(ListOfPascalHelpContextList: TList; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function GetNodesForClass(AClass: TClass; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function GetNodesForMessage(const AMessage: string; MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function FindViewer(const MimeType: string; var ErrMsg: string; var Viewer: THelpViewer): TShowHelpResult; virtual; public // registration procedure RegisterItem(NewItem: THelpDBItem); procedure RegisterItemWithNode(Node: THelpNode); procedure RegisterFileItemWithNode(const Filename: string; Node: THelpNode); procedure UnregisterItem(AnItem: THelpDBItem); function RegisteredItemCount: integer; function GetRegisteredItem(Index: integer): THelpDBItem; procedure Load(Storage: TConfigStorage); virtual; procedure Save(Storage: TConfigStorage); virtual; function GetLocalizedName: string; virtual; public property Databases: THelpDatabases read FDatabases write SetDatabases; property ID: THelpDatabaseID read FID write SetID; property SupportedMimeTypes: TStrings read FSupportedMimeTypes; property BasePathObject: TObject read FBasePathObject write FBasePathObject; property TOCNode: THelpNode read FTOCNode write FTOCNode; end; THelpDatabaseClass = class of THelpDatabase; { THelpDatabases Class for storing all registered THelpDatabase } THelpDatabases = class private FItems: TList; FHelpDBClasses: TList; function GetItems(Index: integer): THelpDatabase; procedure DoRegisterDatabase(ADatabase: THelpDatabase); procedure DoUnregisterDatabase(ADatabase: THelpDatabase); public constructor Create; destructor Destroy; override; function Count: integer; property Items[Index: integer]: THelpDatabase read GetItems; default; public function FindDatabase(ID: THelpDatabaseID): THelpDatabase; function GetDatabase(ID: THelpDatabaseID; var HelpDB: THelpDatabase; var HelpResult: TShowHelpResult; var ErrMsg: string): boolean; function IndexOf(ID: THelpDatabaseID): integer; function CreateUniqueDatabaseID(const WishID: string): THelpDatabaseID; function CreateHelpDatabase(const WishID: string; HelpDataBaseClass: THelpDatabaseClass; AutoRegister: boolean): THelpDatabase; function ShowTableOfContents(var ErrMsg: string): TShowHelpResult; procedure ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); virtual; abstract; function GetBaseURLForBasePathObject(BasePathObject: TObject): string; virtual; function GetBaseDirectoryForBasePathObject(BasePathObject: TObject): string; virtual; function FindViewer(const MimeType: string; var ErrMsg: string; var Viewer: THelpViewer): TShowHelpResult; virtual; function SubstituteMacros(var s: string): boolean; virtual; public // show help for ... function ShowHelpForNodes(Query: THelpQuery; Nodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelpForQuery(Query: THelpQuery; AutoFreeQuery: boolean; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelpForContext(Query: THelpQueryContext; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelpForKeyword(Query: THelpQueryKeyword; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelpForPascalContexts(Query: THelpQueryPascalContexts; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelpForSourcePosition(Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelpForMessageLine(Query: THelpQueryMessage; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelpForClass(Query: THelpQueryClass; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelpFile(const Filename, Title, MimeType: string; var ErrMsg: string): TShowHelpResult; virtual; function ShowHelp(const URL, Title, MimeType: string; var ErrMsg: string): TShowHelpResult; virtual; // search registered items in all databases function GetNodesForKeyword(const HelpKeyword: string; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function GetNodesForContext(HelpContext: THelpContext; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function GetNodesForPascalContexts(ListOfPascalHelpContextList: TList; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function GetNodesForClass(AClass: TClass; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; function GetNodesForMessage(const AMessage: string; MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; virtual; // Show the help selector function ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList; var ErrMsg: string; var Selection: THelpNodeQuery ): TShowHelpResult; virtual; public // registration of THelpDatabaseClass procedure RegisterHelpDatabaseClass(NewHelpDB: THelpDatabaseClass); procedure UnregisterHelpDatabaseClass(AHelpDB: THelpDatabaseClass); function HelpDatabaseClassCount: integer; function GetHelpDatabaseClass(Index: integer): THelpDatabaseClass; procedure Load(Storage: TConfigStorage); virtual; procedure Save(Storage: TConfigStorage); virtual; end; { THelpViewer base class for all Help viewers } THelpViewer = class(TPersistent) private FParameterHelp: string; FStorageName: string; FSupportedMimeTypes: TStrings; protected procedure SetSupportedMimeTypes(List: TStrings); virtual; procedure AddSupportedMimeType(const AMimeType: string); virtual; public constructor Create; destructor Destroy; override; function SupportsTableOfContents: boolean; virtual; procedure ShowTableOfContents(Node: THelpNode); virtual; function SupportsMimeType(const AMimeType: string): boolean; virtual; function ShowNode(Node: THelpNode; var ErrMsg: string): TShowHelpResult; virtual; procedure Hide; virtual; procedure Assign(Source: TPersistent); override; procedure Load(Storage: TConfigStorage); virtual; procedure Save(Storage: TConfigStorage); virtual; function GetLocalizedName: string; virtual; public property SupportedMimeTypes: TStrings read FSupportedMimeTypes; property ParameterHelp: string read FParameterHelp write FParameterHelp; property StorageName: string read FStorageName write FStorageName; end; THelpViewerClass = class of THelpViewer; { THelpViewers } THelpViewers = class private FItems: TList; function GetItems(Index: integer): THelpViewer; public constructor Create; destructor Destroy; override; procedure Clear; function Count: integer; function GetViewersSupportingMimeType(const MimeType: string): TList; procedure RegisterViewer(AHelpViewer: THelpViewer); procedure UnregisterViewer(AHelpViewer: THelpViewer); procedure Load(Storage: TConfigStorage); virtual; procedure Save(Storage: TConfigStorage); virtual; public property Items[Index: integer]: THelpViewer read GetItems; default; end; { THelpBasePathObject Simple class to store a base file path for help databases. } THelpBasePathObject = class(TPersistent) private FBasePath: string; protected procedure SetBasePath(const AValue: string); virtual; public constructor Create; constructor Create(const TheBasePath: string); property BasePath: string read FBasePath write SetBasePath; end; { THelpBaseURLObject Simple class to store a base URL path for help databases. } THelpBaseURLObject = class(TPersistent) private FBaseURL: string; protected procedure SetBaseURL(const AValue: string); public constructor Create; constructor Create(const TheBaseURL: string); property BaseURL: string read FBaseURL write SetBaseURL; end; var HelpDatabases: THelpDatabases; // initialized by the IDE HelpViewers: THelpViewers; // initialized by the IDE //============================================================================== { Showing help (how it works): - starts the help system, if not already started - search all appropriate help Databases for the given context If multiple contexts fit, a help selector is shown and the user chooses one. - calls the help Database to show the context The help Database will search an appropriate help viewer and starts it. } // table of contents function ShowTableOfContents: TShowHelpResult; function ShowTableOfContents(var ErrMsg: string): TShowHelpResult; // help by ID function ShowHelpOrErrorForContext(HelpDatabaseID: THelpDatabaseID; HelpContext: THelpContext): TShowHelpResult; function ShowHelpForContext(HelpDatabaseID: THelpDatabaseID; HelpContext: THelpContext; var ErrMsg: string): TShowHelpResult; function ShowHelpForContext(HelpContext: THelpContext; var ErrMsg: string ): TShowHelpResult; // help by keyword function ShowHelpOrErrorForKeyword(HelpDatabaseID: THelpDatabaseID; const HelpKeyword: string): TShowHelpResult; function ShowHelpForKeyword(HelpDatabaseID: THelpDatabaseID; const HelpKeyword: string; var ErrMsg: string): TShowHelpResult; function ShowHelpForKeyword(const HelpKeyword: string; var ErrMsg: string ): TShowHelpResult; // help for pascal sources function ShowHelpForPascalContexts(const Filename: string; const SourcePosition: TPoint; ListOfPascalHelpContextList: TList; var ErrMsg: string): TShowHelpResult; function ShowHelpOrErrorForSourcePosition(const Filename: string; const SourcePosition: TPoint): TShowHelpResult; // help for messages (compiler messages, codetools messages, make messages, ...) function ShowHelpForMessageLine(const MessageLine: string; MessageParts: TStrings; var ErrMsg: string): TShowHelpResult; function ShowHelpOrErrorForMessageLine(const MessageLine: string; MessageParts: TStrings): TShowHelpResult; // view help function ShowHelpFile(const Filename, Title, MimeType: string; var ErrMsg: string): TShowHelpResult; function ShowHelpFileOrError(const Filename, Title, MimeType: string ): TShowHelpResult; function ShowHelp(const URL, Title, MimeType: string; var ErrMsg: string): TShowHelpResult; function ShowHelpOrError(const URL, Title, MimeType: string ): TShowHelpResult; // URL functions function FilenameToURL(const Filename: string): string; procedure SplitURL(const URL: string; var URLType, URLPath, URLParams: string); function CombineURL(const URLType, URLPath, URLParams: string): string; function URLFilenameIsAbsolute(const Filename: string): boolean; function FindURLPathStart(const URL: string): integer; function FindURLPathEnd(const URL: string): integer; function ChompURLParams(const URL: string): string; function ExtractURLPath(const URL: string): string; function ExtractURLDirectory(const URL: string): string; function TrimUrl(const URL: string): string; function IsFileURL(const URL: string): boolean; procedure CreateListAndAdd(const AnObject: TObject; var List: TList; OnlyIfNotExists: boolean); procedure CreateNodeQueryListAndAdd(const ANode: THelpNode; const QueryItem: THelpQueryItem; var List: THelpNodeQueryList; OnlyIfNotExists: boolean); implementation function ShowTableOfContents: TShowHelpResult; var ErrMsg: String; begin ErrMsg:=''; Result:=ShowTableOfContents(ErrMsg); HelpDatabases.ShowError(Result,ErrMsg); end; function ShowTableOfContents(var ErrMsg: string): TShowHelpResult; begin Result:=HelpDatabases.ShowTableOfContents(ErrMsg); end; function ShowHelpOrErrorForContext(HelpDatabaseID: THelpDatabaseID; HelpContext: THelpContext): TShowHelpResult; var ErrMsg: String; begin ErrMsg:=''; Result:=ShowHelpForContext(HelpDatabaseID,HelpContext,ErrMsg); HelpDatabases.ShowError(Result,ErrMsg); end; function ShowHelpForContext(HelpDatabaseID: THelpDatabaseID; HelpContext: THelpContext; var ErrMsg: string): TShowHelpResult; begin Result:=HelpDatabases.ShowHelpForQuery( THelpQueryContext.Create(HelpDatabaseID,HelpContext), true,ErrMsg); end; function ShowHelpForContext(HelpContext: THelpContext; var ErrMsg: string ): TShowHelpResult; begin Result:=ShowHelpForContext('',HelpContext,ErrMsg); end; function ShowHelpOrErrorForKeyword(HelpDatabaseID: THelpDatabaseID; const HelpKeyword: string): TShowHelpResult; var ErrMsg: String; begin ErrMsg:=''; Result:=ShowHelpForKeyword(HelpDatabaseID,HelpKeyword,ErrMsg); HelpDatabases.ShowError(Result,ErrMsg); end; function ShowHelpForKeyword(HelpDatabaseID: THelpDatabaseID; const HelpKeyword: string; var ErrMsg: string): TShowHelpResult; begin Result:=HelpDatabases.ShowHelpForQuery( THelpQueryKeyword.Create(HelpDatabaseID,HelpKeyword), true,ErrMsg); end; function ShowHelpForKeyword(const HelpKeyword: string; var ErrMsg: string ): TShowHelpResult; begin Result:=ShowHelpForKeyword('',HelpKeyword,ErrMsg); end; function ShowHelpForPascalContexts(const Filename: string; const SourcePosition: TPoint; ListOfPascalHelpContextList: TList; var ErrMsg: string): TShowHelpResult; begin Result:=HelpDatabases.ShowHelpForQuery( THelpQueryPascalContexts.Create('',Filename, SourcePosition,ListOfPascalHelpContextList), true,ErrMsg); end; function ShowHelpOrErrorForSourcePosition(const Filename: string; const SourcePosition: TPoint): TShowHelpResult; var ErrMsg: String; begin ErrMsg:=''; Result:=HelpDatabases.ShowHelpForQuery( THelpQuerySourcePosition.Create('',Filename, SourcePosition), true,ErrMsg); HelpDatabases.ShowError(Result,ErrMsg); end; function ShowHelpForMessageLine(const MessageLine: string; MessageParts: TStrings; var ErrMsg: string): TShowHelpResult; // MessageParts will be freed begin Result:=HelpDatabases.ShowHelpForQuery( THelpQueryMessage.Create('',MessageLine,MessageParts), true,ErrMsg); end; function ShowHelpOrErrorForMessageLine(const MessageLine: string; MessageParts: TStrings): TShowHelpResult; var ErrMsg: String; begin ErrMsg:=''; Result:=ShowHelpForMessageLine(MessageLine,MessageParts,ErrMsg); HelpDatabases.ShowError(Result,ErrMsg); end; function ShowHelpFile(const Filename, Title, MimeType: string; var ErrMsg: string): TShowHelpResult; begin Result:=HelpDatabases.ShowHelpFile(Filename,Title,MimeType,ErrMsg); end; function ShowHelpFileOrError(const Filename, Title, MimeType: string ): TShowHelpResult; var ErrMsg: String; begin ErrMsg:=''; Result:=ShowHelpFile(Filename,Title,MimeType,ErrMsg); HelpDatabases.ShowError(Result,ErrMsg); end; function ShowHelp(const URL, Title, MimeType: string; var ErrMsg: string ): TShowHelpResult; begin Result:=HelpDatabases.ShowHelp(URL,Title,MimeType,ErrMsg); end; function ShowHelpOrError(const URL, Title, MimeType: string): TShowHelpResult; var ErrMsg: String; begin ErrMsg:=''; Result:=ShowHelp(URL,Title,MimeType,ErrMsg); HelpDatabases.ShowError(Result,ErrMsg); end; function FilenameToURL(const Filename: string): string; var i: Integer; begin Result:=Filename; {$warnings off} if PathDelim<>'/' then for i:=1 to length(Result) do if Result[i]=PathDelim then Result[i]:='/'; {$warnings on} if Result<>'' then Result:='file://'+Result; end; procedure SplitURL(const URL: string; var URLType, URLPath, URLParams: string); var Len: Integer; ColonPos: Integer; ParamStartPos: integer; URLStartPos: Integer; begin URLType:=''; URLPath:=''; URLParams:=''; Len:=length(URL); // search colon ColonPos:=1; while (ColonPos<=len) and (URL[ColonPos]<>':') do inc(ColonPos); if ColonPos=len then exit; // get URLType URLType:=copy(URL,1,ColonPos-1); URLStartPos:=ColonPos+1; // skip the '//' after the colon if (URLStartPos<=len) and (URL[URLStartPos]='/') then inc(URLStartPos); if (URLStartPos<=len) and (URL[URLStartPos]='/') then inc(URLStartPos); // search param delimiter ? ParamStartPos:=ColonPos+1; while (ParamStartPos<=len) and (URL[ParamStartPos]<>'?') do inc(ParamStartPos); // get URLPath and URLParams URLPath:=copy(URL,URLStartPos,ParamStartPos-URLStartPos); URLParams:=copy(URL,ParamStartPos+1,len-ParamStartPos); end; function CombineURL(const URLType, URLPath, URLParams: string): string; begin Result:=URLType+'://'+URLPath; if URLParams<>'' then Result:=Result+'?'+URLParams; end; function URLFilenameIsAbsolute(const Filename: string): boolean; begin Result:=FilenameIsUnixAbsolute(Filename); end; function FindURLPathStart(const URL: string): integer; var Len: Integer; ColonPos: Integer; URLStartPos: Integer; begin Result:=-1; Len:=length(URL); // search colon ColonPos:=1; while (ColonPos<=len) and (URL[ColonPos]<>':') do inc(ColonPos); if ColonPos=Len then exit; URLStartPos:=ColonPos+1; // skip the '//' after the colon if (URLStartPos<=Len) and (URL[URLStartPos]='/') then inc(URLStartPos); if (URLStartPos<=Len) and (URL[URLStartPos]='/') then inc(URLStartPos); Result:=URLStartPos; end; function FindURLPathEnd(const URL: string): integer; var Len: Integer; begin Result:=1; Len:=length(URL); while (Result<=Len) and (URL[Result]<>'?') do inc(Result); end; function ChompURLParams(const URL: string): string; begin Result:=copy(URL,1,FindURLPathEnd(URL)-1); end; function ExtractURLDirectory(const URL: string): string; var p: Integer; PathStart: LongInt; begin Result:=''; PathStart:=FindURLPathStart(URL); if PathStart<1 then exit; p:=FindURLPathEnd(URL); while (p>0) and (URL[p]<>'/') do dec(p); if p<=PathStart then exit; Result:=copy(URL,1,p); end; function TrimUrl(const URL: string): string; var URLType, URLPath, URLParams: string; begin SplitURL(URL,URLType,URLPath,URLParams); Result:=CombineURL(URLType,TrimFilename(URLPath),URLParams); end; function IsFileURL(const URL: string): boolean; begin Result:=(length(URL)>=7) and (CompareByte(URL[1],'file://',7)=0); end; function ExtractURLPath(const URL: string): string; var URLType, URLPath, URLParams: string; begin SplitURL(URL,URLType,URLPath,URLParams); Result:=URLPath; end; procedure CreateListAndAdd(const AnObject: TObject; var List: TList; OnlyIfNotExists: boolean); begin if List=nil then List:=TList.Create else if OnlyIfNotExists and (List.IndexOf(AnObject)>=0) then exit; List.Add(AnObject); end; procedure CreateNodeQueryListAndAdd(const ANode: THelpNode; const QueryItem: THelpQueryItem; var List: THelpNodeQueryList; OnlyIfNotExists: boolean); begin if List=nil then List:=THelpNodeQueryList.Create else if OnlyIfNotExists and (List.IndexOf(ANode,QueryItem)>=0) then exit; List.Add(ANode,QueryItem); end; { THelpDatabase } procedure THelpDatabase.SetID(const AValue: THelpDatabaseID); var OldRegistered: Boolean; begin if FID=AValue then exit; OldRegistered:=Registered; if OldRegistered then UnregisterSelf; FID:=AValue; if OldRegistered then RegisterSelf; end; procedure THelpDatabase.SetDatabases(const AValue: THelpDatabases); begin if AValue=Databases then exit; Reference; if FDatabases<>nil then FDatabases.DoUnregisterDatabase(Self); FDatabases:=AValue; if FDatabases<>nil then FDatabases.DoRegisterDatabase(Self); Release; end; procedure THelpDatabase.SetSupportedMimeTypes(List: TStrings); begin FSupportedMimeTypes.Free; FSupportedMimeTypes:=List; end; procedure THelpDatabase.AddSupportedMimeType(const AMimeType: string); begin if FSupportedMimeTypes=nil then SetSupportedMimeTypes(TStringList.Create); FSupportedMimeTypes.Add(AMimeType); end; constructor THelpDatabase.Create(TheID: THelpDatabaseID); begin FID:=TheID; end; destructor THelpDatabase.Destroy; var i: Integer; begin Reference; // reference to not call Free again if Databases<>nil then UnregisterSelf; FSupportedMimeTypes.Free; if FSearchItems<>nil then begin for i:=FSearchItems.Count-1 downto 0 do THelpNode(FSearchItems[i]).Free; FSearchItems.Free; end; FTOCNode.Free; inherited Destroy; end; procedure THelpDatabase.RegisterSelf; begin if Databases<>nil then raise EHelpSystemException.Create(Format(rsHelpAlreadyRegistered, [ID])); Databases:=HelpDatabases; end; procedure THelpDatabase.UnregisterSelf; begin if Databases=nil then raise EHelpSystemException.Create(Format(rsHelpNotRegistered, [ID])); Databases:=nil; end; function THelpDatabase.Registered: boolean; begin Result:=Databases<>nil; end; function THelpDatabase.CanShowTableOfContents: boolean; begin Result:=TOCNode<>nil; end; procedure THelpDatabase.ShowTableOfContents; var ErrMsg: string; ShowResult: TShowHelpResult; Query: THelpQueryTOC; begin if TOCNode=nil then exit; ErrMsg:=''; Query:=THelpQueryTOC.Create(ID,TOCNode); try ShowResult:=ShowHelp(Query,nil,TOCNode,nil,ErrMsg); finally Query.Free; end; ShowError(ShowResult,ErrMsg); end; procedure THelpDatabase.ShowError(ShowResult: TShowHelpResult; const ErrMsg: string); begin if ShowResult=shrSuccess then exit; if Databases<>nil then Databases.ShowError(ShowResult,ErrMsg) else raise EHelpSystemException.Create(ErrMsg); end; function THelpDatabase.ShowHelp(Query: THelpQuery; BaseNode, NewNode: THelpNode; QueryItem: THelpQueryItem; var ErrMsg: string): TShowHelpResult; begin ErrMsg:=''; Result:=shrContextNotFound; end; function THelpDatabase.ShowHelpFile(Query: THelpQuery; BaseNode: THelpNode; const Title, Filename: string; var ErrMsg: string): TShowHelpResult; var FileNode: THelpNode; begin FileNode:=THelpNode.CreateURL(Self,Title,FilenameToURL(Filename)); try Result:=ShowHelp(Query,BaseNode,FileNode,nil,ErrMsg); finally FileNode.Free; end; end; function THelpDatabase.SupportsMimeType(const AMimeType: string): boolean; begin Result:=false; if FSupportedMimeTypes<>nil then Result:=(FSupportedMimeTypes.IndexOf(AMimeType)>=0); end; function THelpDatabase.GetNodesForKeyword(const HelpKeyword: string; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; Node: THelpNode; begin Result:=shrSuccess; ErrMsg:=''; // add the registered nodes if FSearchItems<>nil then begin for i:=0 to FSearchItems.Count-1 do begin Node:=THelpDBItem(FSearchItems[i]).Node; if (Node=nil) or (not Node.IDValid) then continue; if AnsiCompareText(Node.ID,HelpKeyword)<>0 then continue; CreateNodeQueryListAndAdd(Node,nil,ListOfNodes,true); end; end; end; function THelpDatabase.GetNodesForContext(HelpContext: THelpContext; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; Node: THelpNode; begin Result:=shrSuccess; ErrMsg:=''; // add the registered nodes if FSearchItems<>nil then begin for i:=0 to FSearchItems.Count-1 do begin Node:=THelpDBItem(FSearchItems[i]).Node; if (Node=nil) or (not Node.ContextValid) then continue; if Node.Context<>HelpContext then continue; CreateNodeQueryListAndAdd(Node,nil,ListOfNodes,true); end; end; end; function THelpDatabase.GetNodesForPascalContexts( ListOfPascalHelpContextList: TList; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; j: Integer; SearchItem: THelpDBItem; PascalContext: TPascalHelpContextList; FileItem: THelpDBISourceFile; Filename: String; begin Result:=shrSuccess; ErrMsg:=''; if (ListOfPascalHelpContextList=nil) or (ListOfPascalHelpContextList.Count=0) then exit; // add the registered nodes //debugln('THelpDatabase.GetNodesForPascalContexts A ListOfPascalHelpContextList.Count=',dbgs(ListOfPascalHelpContextList.Count)); if FSearchItems<>nil then begin // check every pascal context for j:=0 to ListOfPascalHelpContextList.Count-1 do begin PascalContext:=TPascalHelpContextList(ListOfPascalHelpContextList[j]); //debugln('THelpDatabase.GetNodesForPascalContexts A PascalContext.Count=',dbgs(PascalContext.Count)); if (PascalContext.Count>0) and (PascalContext.List[0].Descriptor=pihcFilename) then begin // search file item for i:=0 to FSearchItems.Count-1 do begin SearchItem:=THelpDBItem(FSearchItems[i]); if not (SearchItem is THelpDBISourceFile) then continue; FileItem:=THelpDBISourceFile(SearchItem); Filename:=PascalContext.List[0].Context; //debugln('THelpDatabase.GetNodesForPascalContexts B FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename); if (FileItem.FileMatches(Filename)) then begin CreateNodeQueryListAndAdd(FileItem.Node,PascalContext,ListOfNodes,true); //debugln('THelpDatabase.GetNodesForPascalContexts C FileItem.ClassName=',FileItem.ClassName,' Filename=',Filename,' ',dbgs(ListOfNodes.Count),' ',TempNode.Title,' ',dbgs(TempNode)); end; end; end; end; end; end; function THelpDatabase.GetNodesForClass(AClass: TClass; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; SearchItem: THelpDBItem; begin Result:=shrSuccess; ErrMsg:=''; // add the registered nodes if FSearchItems<>nil then begin for i:=0 to FSearchItems.Count-1 do begin SearchItem:=THelpDBItem(FSearchItems[i]); if not (SearchItem is THelpDBIClass) then continue; if THelpDBIClass(SearchItem).TheClass<>AClass then continue; CreateNodeQueryListAndAdd(SearchItem.Node,nil,ListOfNodes,true); end; end; end; function THelpDatabase.GetNodesForMessage(const AMessage: string; MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; SearchItem: THelpDBItem; begin Result:=shrSuccess; ErrMsg:=''; // add the registered nodes if FSearchItems<>nil then begin for i:=0 to FSearchItems.Count-1 do begin SearchItem:=THelpDBItem(FSearchItems[i]); if not (SearchItem is THelpDBIMessage) then continue; if not THelpDBIMessage(SearchItem).MessageMatches(AMessage,MessageParts) then continue; CreateNodeQueryListAndAdd(SearchItem.Node,nil,ListOfNodes,true); end; end; end; function THelpDatabase.FindViewer(const MimeType: string; var ErrMsg: string; var Viewer: THelpViewer): TShowHelpResult; var Viewers: TList; begin Viewer:=nil; Viewers:=HelpViewers.GetViewersSupportingMimeType(MimeType); try if (Viewers=nil) or (Viewers.Count=0) then begin ErrMsg:=Format(rsHelpHelpDatabaseDidNotFoundAViewerForAHelpPageOfType, [ '"', ID, '"', MimeType]); Result:=shrViewerNotFound; end else begin Viewer:=THelpViewer(Viewers[0]); Result:=shrSuccess; end; finally Viewers.Free; end; end; procedure THelpDatabase.RegisterItem(NewItem: THelpDBItem); begin if NewItem=nil then raise EHelpSystemException.Create('THelpDatabase.RegisterItem NewItem=nil'); if FSearchItems=nil then FSearchItems:=TList.Create; if FSearchItems.IndexOf(NewItem)<0 then FSearchItems.Add(NewItem) else NewItem.Free; end; procedure THelpDatabase.RegisterItemWithNode(Node: THelpNode); begin if Node=nil then raise EHelpSystemException.Create('THelpDatabase.RegisterItemWithNode Node=nil'); RegisterItem(THelpDBItem.Create(Node)); end; procedure THelpDatabase.RegisterFileItemWithNode(const Filename: string; Node: THelpNode); begin RegisterItem(THelpDBISourceFile.Create(Node,Filename)); end; procedure THelpDatabase.UnregisterItem(AnItem: THelpDBItem); begin if FSearchItems=nil then exit; FSearchItems.Remove(AnItem); end; function THelpDatabase.RegisteredItemCount: integer; begin if FSearchItems=nil then Result:=0 else Result:=FSearchItems.Count; end; function THelpDatabase.GetRegisteredItem(Index: integer): THelpDBItem; begin Result:=THelpDBItem(FSearchItems[Index]); end; procedure THelpDatabase.Load(Storage: TConfigStorage); begin end; procedure THelpDatabase.Save(Storage: TConfigStorage); begin end; function THelpDatabase.GetLocalizedName: string; begin Result:=ID; end; procedure THelpDatabase.Reference; begin inc(FRefCount); end; procedure THelpDatabase.Release; begin if FRefCount=0 then raise EHelpSystemException.Create('THelpDatabase.Release'); dec(FRefCount); if FRefCount=0 then Free; end; { THelpDatabases } function THelpDatabases.GetItems(Index: integer): THelpDatabase; begin Result:=THelpDatabase(FItems[Index]); end; procedure THelpDatabases.DoRegisterDatabase(ADatabase: THelpDatabase); begin ADatabase.Reference; if FItems=nil then FItems:=TList.Create; FItems.Add(ADatabase); end; procedure THelpDatabases.DoUnregisterDatabase(ADatabase: THelpDatabase); begin if FItems<>nil then FItems.Remove(ADatabase); ADatabase.Release; end; constructor THelpDatabases.Create; begin end; destructor THelpDatabases.Destroy; begin while (Count>0) do Items[Count-1].UnregisterSelf; FItems.Free; FHelpDBClasses.Free; inherited Destroy; end; function THelpDatabases.Count: integer; begin if FItems=nil then Result:=0 else Result:=FItems.Count; end; function THelpDatabases.FindDatabase(ID: THelpDatabaseID): THelpDatabase; var Index: LongInt; begin Index:=IndexOf(ID); if Index>=0 then Result:=Items[Index] else Result:=nil; end; function THelpDatabases.GetDatabase(ID: THelpDatabaseID; var HelpDB: THelpDatabase; var HelpResult: TShowHelpResult; var ErrMsg: string): boolean; begin HelpDB:=FindDatabase(ID); if HelpDB=nil then begin Result:=false; HelpResult:=shrDatabaseNotFound; ErrMsg:=Format(rsHelpHelpDatabaseNotFound, ['"', ID, '"']); end else begin HelpResult:=shrSuccess; Result:=true; ErrMsg:=''; end; end; function THelpDatabases.IndexOf(ID: THelpDatabaseID): integer; begin Result:=Count-1; while (Result>=0) and (AnsiCompareText(ID,Items[Result].ID)<>0) do dec(Result); end; function THelpDatabases.CreateUniqueDatabaseID( const WishID: string): THelpDatabaseID; var i: Integer; begin if (WishID<>'') and (FindDatabase(WishID)=nil) then begin Result:=WishID; end else begin i:=1; repeat Result:=WishID+IntToStr(i); if FindDatabase(Result)=nil then exit; inc(i); until false; end; end; function THelpDatabases.CreateHelpDatabase(const WishID: string; HelpDataBaseClass: THelpDatabaseClass; AutoRegister: boolean): THelpDatabase; begin Result:=HelpDataBaseClass.Create(CreateUniqueDatabaseID(WishID)); if AutoRegister then Result.RegisterSelf; end; function THelpDatabases.ShowTableOfContents(var ErrMsg: string ): TShowHelpResult; begin Result:=shrHelpNotFound; ErrMsg:='THelpDatabases.ShowTableOfContents not implemented'; // ToDo end; function THelpDatabases.GetBaseURLForBasePathObject(BasePathObject: TObject ): string; begin // this method will be overriden by the IDE // provide some useful defaults: if (BasePathObject is THelpBaseURLObject) then begin Result:=THelpBaseURLObject(BasePathObject).BaseURL; end else begin // otherwise fetch a filename Result:=GetBaseDirectoryForBasePathObject(BasePathObject); if Result='' then exit; Result:=FilenameToURL(Result); end; Result:=AppendPathDelim(Result); end; function THelpDatabases.GetBaseDirectoryForBasePathObject( BasePathObject: TObject): string; // returns the base file directory of the BasePathObject begin if (BasePathObject is THelpBaseURLObject) then begin Result:=THelpBaseURLObject(BasePathObject).BaseURL; if Result='' then exit; if not IsFileURL(Result) then begin Result:=''; exit; end; Result:=ExtractURLPath(Result); end else if (BasePathObject is THelpBasePathObject) then Result:=THelpBasePathObject(BasePathObject).BasePath else Result:=''; Result:=AppendPathDelim(Result); end; function THelpDatabases.FindViewer(const MimeType: string; var ErrMsg: string; var Viewer: THelpViewer): TShowHelpResult; var Viewers: TList; begin Viewer:=nil; Viewers:=HelpViewers.GetViewersSupportingMimeType(MimeType); try if (Viewers=nil) or (Viewers.Count=0) then begin ErrMsg:='Did not find a viewer for help type "'+MimeType+'"'; Result:=shrViewerNotFound; end else begin Viewer:=THelpViewer(Viewers[0]); Result:=shrSuccess; end; finally Viewers.Free; end; end; function THelpDatabases.SubstituteMacros(var s: string): boolean; begin Result:=true; end; function THelpDatabases.ShowHelpForNodes(Query: THelpQuery; Nodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; var NodeQuery: THelpNodeQuery; begin // check if several nodes found //debugln('THelpDatabases.ShowHelpForNodes A Nodes.Count=',dbgs(Nodes.Count)); NodeQuery:=nil; if (Nodes.Count>1) then begin Result:=ShowHelpSelector(Query,Nodes,ErrMsg,NodeQuery); if Result<>shrSuccess then exit; if NodeQuery=nil then exit; end else begin NodeQuery:=Nodes[0]; end; // show node if NodeQuery.Node.Owner=nil then begin Result:=shrDatabaseNotFound; ErrMsg:=Format(rsHelpHelpNodeHasNoHelpDatabase, ['"', NodeQuery.Node.Title, '"']); exit; end; Result:=NodeQuery.Node.Owner.ShowHelp(Query,nil, NodeQuery.Node,NodeQuery.QueryItem,ErrMsg); end; function THelpDatabases.ShowHelpForQuery(Query: THelpQuery; AutoFreeQuery: boolean; var ErrMsg: string): TShowHelpResult; begin try // descendants first if Query is THelpQueryPascalContexts then Result:=ShowHelpForPascalContexts(THelpQueryPascalContexts(Query),ErrMsg) else if Query is THelpQueryTOC then Result:=ShowTableOfContents(ErrMsg) else if Query is THelpQueryContext then Result:=ShowHelpForContext(THelpQueryContext(Query),ErrMsg) else if Query is THelpQueryKeyword then Result:=ShowHelpForKeyword(THelpQueryKeyword(Query),ErrMsg) else if Query is THelpQuerySourcePosition then Result:=ShowHelpForSourcePosition(THelpQuerySourcePosition(Query),ErrMsg) else if Query is THelpQueryMessage then Result:=ShowHelpForMessageLine(THelpQueryMessage(Query),ErrMsg) else if Query is THelpQueryClass then Result:=ShowHelpForClass(THelpQueryClass(Query),ErrMsg) else Result:=shrContextNotFound; finally if AutoFreeQuery then Query.Free; end; end; function THelpDatabases.ShowHelpForContext(Query: THelpQueryContext; var ErrMsg: string): TShowHelpResult; var Nodes: THelpNodeQueryList; HelpDB: THelpDatabase; begin ErrMsg:=''; Result:=shrHelpNotFound; // search node Nodes:=nil; try if Query.HelpDatabaseID<>'' then begin HelpDB:=nil; if not GetDatabase(Query.HelpDatabaseID,HelpDB,Result,ErrMsg) then exit; Result:=HelpDB.GetNodesForContext(Query.Context,Nodes,ErrMsg); if Result<>shrSuccess then exit; end else begin Result:=GetNodesForContext(Query.Context,Nodes,ErrMsg); if Result<>shrSuccess then exit; end; // check if at least one node found if (Nodes=nil) or (Nodes.Count=0) then begin Result:=shrContextNotFound; if Query.HelpDatabaseID<>'' then ErrMsg:=Format(rsHelpHelpContextNotFoundInDatabase, [IntToStr( Query.Context), '"', Query.HelpDatabaseID, '"']) else ErrMsg:=Format(rsHelpHelpContextNotFound, [IntToStr(Query.Context)]); exit; end; Result:=ShowHelpForNodes(Query,Nodes,ErrMsg); finally Nodes.Free; end; end; function THelpDatabases.ShowHelpForKeyword(Query: THelpQueryKeyword; var ErrMsg: string): TShowHelpResult; var Nodes: THelpNodeQueryList; HelpDB: THelpDatabase; begin ErrMsg:=''; Result:=shrHelpNotFound; // search node Nodes:=nil; try if Query.HelpDatabaseID<>'' then begin HelpDB:=nil; if not GetDatabase(Query.HelpDatabaseID,HelpDB,Result,ErrMsg) then exit; Result:=HelpDB.GetNodesForKeyword(Query.Keyword,Nodes,ErrMsg); if Result<>shrSuccess then exit; end else begin Result:=GetNodesForKeyword(Query.Keyword,Nodes,ErrMsg); if Result<>shrSuccess then exit; end; // check if at least one node found if (Nodes=nil) or (Nodes.Count=0) then begin Result:=shrContextNotFound; if Query.HelpDatabaseID<>'' then ErrMsg:=Format(rsHelpHelpKeywordNotFoundInDatabase, ['"',Query.Keyword, '"', '"', Query.HelpDatabaseID, '"']) else ErrMsg:=Format(rsHelpHelpKeywordNotFound, ['"',Query.Keyword,'"']); exit; end; Result:=ShowHelpForNodes(Query,Nodes,ErrMsg); finally Nodes.Free; end; end; function THelpDatabases.ShowHelpForPascalContexts( Query: THelpQueryPascalContexts; var ErrMsg: string): TShowHelpResult; var Nodes: THelpNodeQueryList; begin ErrMsg:=''; Result:=shrSuccess; debugln('THelpDatabases.ShowHelpForPascalContexts A Count=',dbgs(Query.ListOfPascalHelpContextList.Count)); // search node Nodes:=nil; try Result:=GetNodesForPascalContexts(Query.ListOfPascalHelpContextList,Nodes, ErrMsg); if Result<>shrSuccess then exit; // check if at least one node found if (Nodes=nil) or (Nodes.Count=0) then begin Result:=shrHelpNotFound; ErrMsg:=format(rsHelpNoHelpFoundForSource, [Query.SourcePosition.y, Query.SourcePosition.x, Query.Filename]); exit; end; debugln('THelpDatabases.ShowHelpForPascalContexts B Nodes.Count=',dbgs(Nodes.Count)); Result:=ShowHelpForNodes(Query,Nodes,ErrMsg); finally Nodes.Free; end; end; function THelpDatabases.ShowHelpForSourcePosition( Query: THelpQuerySourcePosition; var ErrMsg: string): TShowHelpResult; begin Result:=shrHelpNotFound; ErrMsg:='THelpDatabases.ShowHelpForPascalSource not implemented'; end; function THelpDatabases.ShowHelpForMessageLine(Query: THelpQueryMessage; var ErrMsg: string): TShowHelpResult; var Nodes: THelpNodeQueryList; begin ErrMsg:=''; Result:=shrSuccess; debugln('THelpDatabases.ShowHelpForMessageLine A Msg="',Query.WholeMessage,'"'); // search node Nodes:=nil; try Result:=GetNodesForMessage(Query.WholeMessage,Query.MessageParts,Nodes, ErrMsg); if Result<>shrSuccess then exit; // check if at least one node found if (Nodes=nil) or (Nodes.Count=0) then begin // no node found for the message is not a bug Result:=shrSuccess; ErrMsg:=''; exit; end; Result:=ShowHelpForNodes(Query,Nodes,ErrMsg); finally Nodes.Free; end; end; function THelpDatabases.ShowHelpForClass(Query: THelpQueryClass; var ErrMsg: string): TShowHelpResult; var Nodes: THelpNodeQueryList; begin ErrMsg:=''; Result:=shrSuccess; debugln('THelpDatabases.ShowHelpForClass A ',Query.TheClass.ClassName); // search node Nodes:=nil; try Result:=GetNodesForClass(Query.TheClass,Nodes,ErrMsg); if Result<>shrSuccess then exit; // check if at least one node found if (Nodes=nil) or (Nodes.Count=0) then begin // no node found for the class is not a bug Result:=shrSuccess; ErrMsg:=''; exit; end; Result:=ShowHelpForNodes(Query,Nodes,ErrMsg); finally Nodes.Free; end; end; function THelpDatabases.ShowHelpFile(const Filename, Title, MimeType: string; var ErrMsg: string): TShowHelpResult; begin Result:=ShowHelp(FilenameToURL(Filename),Title,MimeType,ErrMsg); end; function THelpDatabases.ShowHelp(const URL, Title, MimeType: string; var ErrMsg: string): TShowHelpResult; var Viewer: THelpViewer; Node: THelpNode; begin ErrMsg:=''; // get a viewer for this file Result:=FindViewer(MimeType,ErrMsg,Viewer); if Result<>shrSuccess then exit; // call viewer Node:=nil; try Node:=THelpNode.CreateURL(nil,Title,URL); Result:=Viewer.ShowNode(Node,ErrMsg); finally Node.Free; end; end; function THelpDatabases.GetNodesForKeyword(const HelpKeyword: string; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; begin Result:=shrSuccess; ErrMsg:=''; for i:=Count-1 downto 0 do begin Result:=Items[i].GetNodesForKeyword(HelpKeyword,ListOfNodes,ErrMsg); if Result<>shrSuccess then exit; end; end; function THelpDatabases.GetNodesForContext(HelpContext: THelpContext; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; begin Result:=shrSuccess; ErrMsg:=''; for i:=Count-1 downto 0 do begin Result:=Items[i].GetNodesForContext(HelpContext,ListOfNodes,ErrMsg); if Result<>shrSuccess then exit; end; end; function THelpDatabases.GetNodesForPascalContexts( ListOfPascalHelpContextList: TList; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; begin Result:=shrSuccess; ErrMsg:=''; for i:=Count-1 downto 0 do begin Result:=Items[i].GetNodesForPascalContexts(ListOfPascalHelpContextList, ListOfNodes,ErrMsg); if Result<>shrSuccess then exit; end; end; function THelpDatabases.GetNodesForClass(AClass: TClass; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; begin Result:=shrSuccess; ErrMsg:=''; for i:=Count-1 downto 0 do begin Result:=Items[i].GetNodesForClass(AClass,ListOfNodes,ErrMsg); if Result<>shrSuccess then exit; end; end; function THelpDatabases.GetNodesForMessage(const AMessage: string; MessageParts: TStrings; var ListOfNodes: THelpNodeQueryList; var ErrMsg: string): TShowHelpResult; // if ListOfNodes<>nil then new nodes will be appended // if ListOfNodes=nil and nodes exists a new list will be created var i: Integer; begin Result:=shrSuccess; ErrMsg:=''; for i:=Count-1 downto 0 do begin Result:=Items[i].GetNodesForMessage(AMessage,MessageParts,ListOfNodes, ErrMsg); if Result<>shrSuccess then exit; end; end; function THelpDatabases.ShowHelpSelector(Query: THelpQuery; Nodes: THelpNodeQueryList; var ErrMsg: string; var Selection: THelpNodeQuery): TShowHelpResult; // to override // Nodes is a list of THelpNode begin Result:=shrSelectorError; ErrMsg:='THelpDatabases.ShowHelpSelector not implemented'; end; procedure THelpDatabases.RegisterHelpDatabaseClass(NewHelpDB: THelpDatabaseClass ); begin if FHelpDBClasses=nil then FHelpDBClasses:=TList.Create; if FHelpDBClasses.IndexOf(NewHelpDB)<0 then FHelpDBClasses.Add(NewHelpDB); end; procedure THelpDatabases.UnregisterHelpDatabaseClass( AHelpDB: THelpDatabaseClass); begin if FHelpDBClasses=nil then exit; FHelpDBClasses.Remove(AHelpDB); end; function THelpDatabases.HelpDatabaseClassCount: integer; begin if FHelpDBClasses=nil then Result:=0 else Result:=FHelpDBClasses.Count; end; function THelpDatabases.GetHelpDatabaseClass(Index: integer ): THelpDatabaseClass; begin Result:=THelpDatabaseClass(FHelpDBClasses[Index]); end; procedure THelpDatabases.Load(Storage: TConfigStorage); var i: Integer; HelpDB: THelpDatabase; Path: String; begin for i:=0 to Count-1 do begin HelpDB:=Items[i]; Path:=HelpDB.ID; if (Path='') or (not IsValidIdent(Path)) then continue; Storage.AppendBasePath(Path); try HelpDB.Load(Storage); finally Storage.UndoAppendBasePath; end; end; end; procedure THelpDatabases.Save(Storage: TConfigStorage); var i: Integer; HelpDB: THelpDatabase; Path: String; begin for i:=0 to Count-1 do begin HelpDB:=Items[i]; Path:=HelpDB.ID; if (Path='') or (not IsValidIdent(Path)) then continue; Storage.AppendBasePath(Path); try HelpDB.Save(Storage); finally Storage.UndoAppendBasePath; end; end; end; { THelpViewers } function THelpViewers.GetItems(Index: integer): THelpViewer; begin Result:=THelpViewer(FItems[Index]); end; constructor THelpViewers.Create; begin FItems:=TList.Create; end; destructor THelpViewers.Destroy; begin Clear; FItems.Free; inherited Destroy; end; procedure THelpViewers.Clear; var i: Integer; begin i:=Count-1; while (i>=0) do begin if inil then FSupportedMimeTypes.Free; FSupportedMimeTypes:=nil; end; procedure THelpViewer.AddSupportedMimeType(const AMimeType: string); begin if FSupportedMimeTypes=nil then FSupportedMimeTypes:=TStringList.Create; FSupportedMimeTypes.Add(AMimeType); end; constructor THelpViewer.Create; begin FStorageName:=ClassName; end; destructor THelpViewer.Destroy; begin FSupportedMimeTypes.Free; inherited Destroy; end; function THelpViewer.SupportsTableOfContents: boolean; begin Result:=false; end; procedure THelpViewer.ShowTableOfContents(Node: THelpNode); begin raise EHelpSystemException.Create('THelpViewer.ShowTableOfContents not implemented'); end; function THelpViewer.SupportsMimeType(const AMimeType: string): boolean; begin Result:=false; if FSupportedMimeTypes<>nil then Result:=(FSupportedMimeTypes.IndexOf(AMimeType)>=0); end; function THelpViewer.ShowNode(Node: THelpNode; var ErrMsg: string ): TShowHelpResult; begin // for descendents to override Result:=shrViewerError; ErrMsg:='THelpViewer.ShowNode not implemented for this help type'; end; procedure THelpViewer.Hide; begin // override this end; procedure THelpViewer.Assign(Source: TPersistent); begin if Source is THelpViewer then begin end; inherited Assign(Source); end; procedure THelpViewer.Load(Storage: TConfigStorage); begin end; procedure THelpViewer.Save(Storage: TConfigStorage); begin end; function THelpViewer.GetLocalizedName: string; begin Result:=StorageName; end; { THelpNode } constructor THelpNode.Create(TheOwner: THelpDatabase; Node: THelpNode); begin FOwner:=TheOwner; Assign(Node); end; constructor THelpNode.Create(TheOwner: THelpDatabase; const TheTitle, TheURL, TheID: string; TheContext: THelpContext); begin FOwner:=TheOwner; FHelpType:=hntURLIDContext; FTitle:=TheTitle; FURL:=TheURL; FID:=TheID; FContext:=TheContext; end; constructor THelpNode.CreateURL(TheOwner: THelpDatabase; const TheTitle, TheURL: string); begin FOwner:=TheOwner; FHelpType:=hntURL; FTitle:=TheTitle; FURL:=TheURL; end; constructor THelpNode.CreateID(TheOwner: THelpDatabase; const TheTitle, TheID: string); begin FOwner:=TheOwner; FHelpType:=hntID; FTitle:=TheTitle; FID:=TheID; end; constructor THelpNode.CreateURLID(TheOwner: THelpDatabase; const TheTitle, TheURL, TheID: string); begin FOwner:=TheOwner; FHelpType:=hntURLID; FTitle:=TheTitle; FURL:=TheURL; FID:=TheID; end; constructor THelpNode.CreateContext(TheOwner: THelpDatabase; const TheTitle: string; TheContext: THelpContext); begin FOwner:=TheOwner; FHelpType:=hntContext; FTitle:=TheTitle; FContext:=TheContext; end; constructor THelpNode.CreateURLContext(TheOwner: THelpDatabase; const TheTitle, TheURL: string; TheContext: THelpContext); begin FOwner:=TheOwner; FHelpType:=hntURLContext; FTitle:=TheTitle; FURL:=TheURL; FContext:=TheContext; end; function THelpNode.URLValid: boolean; begin Result:=FHelpType in [hntURL,hntURLIDContext,hntURLID,hntURLContext]; end; function THelpNode.IDValid: boolean; begin Result:=FHelpType in [hntURLIDContext,hntURLID,hntID]; end; function THelpNode.ContextValid: boolean; begin Result:=FHelpType in [hntURLIDContext,hntURLContext,hntContext]; end; function THelpNode.AsString: string; begin Result:=Title; end; procedure THelpNode.Assign(Source: TPersistent); var Node: THelpNode; begin if Source is THelpNode then begin Node:=THelpNode(Source); FHelpType:=Node.HelpType; FTitle:=Node.Title; FURL:=Node.URL; FID:=Node.ID; FContext:=Node.Context; end else inherited Assign(Source); end; { THelpDBItem } constructor THelpDBItem.Create(TheNode: THelpNode); begin Node:=TheNode end; destructor THelpDBItem.Destroy; begin Node.Free; inherited Destroy; end; { TPascalHelpContextList } function TPascalHelpContextList.GetItems(Index: integer): TPascalHelpContext; begin Result:=fItems[Index]; end; procedure TPascalHelpContextList.Add(const Context: TPascalHelpContext); begin inc(FCount); ReAllocMem(fItems,SizeOf(TPascalHelpContext)*FCount); // to prevent freeing uninitialized strings, initialize the new strings to nil FillChar(fItems[FCount-1], SizeOf(TPascalHelpContext), 0); fItems[FCount-1]:=Context; end; procedure TPascalHelpContextList.Insert(Index: integer; const Context: TPascalHelpContext); begin inc(FCount); ReAllocMem(fItems,SizeOf(TPascalHelpContext)*FCount); if IndexAList.fItems[i].Descriptor then begin Result:=-1; exit; end else begin Result:=CompareText(fItems[i].Context,AList.fItems[i].Context); if Result<>0 then exit; end; inc(i); end; if Count>i then Result:=-1 else Result:=1; end; function TPascalHelpContextList.AsString: string; var i: Integer; Item: TPascalHelpContext; begin Result:=''; for i:=0 to Count-1 do begin Item:=Items[i]; case Item.Descriptor of pihcFilename: Result:=Result+Item.Context; pihcSourceName: ; pihcProperty: Result:=Result+' property '+Item.Context; pihcProcedure: Result:=Result+' procedure/function '+Item.Context; pihcParameterList: Result:=Result+Item.Context; pihcVariable: Result:=Result+' var '+Item.Context; pihcType: Result:=Result+' type '+Item.Context; pihcConst: Result:=Result+' const '+Item.Context; end; end; end; { THelpDBISourceFile } procedure THelpDBISourceFile.SetFilename(const AValue: string); begin FFilename:=AValue; end; constructor THelpDBISourceFile.Create(TheNode: THelpNode; const TheFilename: string); begin inherited Create(TheNode); FFilename:=TrimFilename(SetDirSeparators(TheFilename)); end; function THelpDBISourceFile.FileMatches(const AFilename: string): boolean; begin if (FFilename<>'') and (AFilename<>'') then Result:=CompareFilenames(GetFullFilename,AFilename)=0 else Result:=false; end; function THelpDBISourceFile.GetFullFilename: string; var BaseDir: String; ExpFilename: String; begin ExpFilename:=FFilename; if (HelpDatabases<>nil) then HelpDatabases.SubstituteMacros(ExpFilename); ExpFilename:=TrimFilename(ExpFilename); if FilenameIsAbsolute(ExpFilename) then Result:=ExpFilename else begin BaseDir:=GetBasePath; Result:=BaseDir+ExpFilename; end; end; function THelpDBISourceFile.GetBasePath: string; begin if BasePathObject=nil then Result:='' else Result:=AppendPathDelim( HelpDatabases.GetBaseDirectoryForBasePathObject(BasePathObject)); end; { THelpDBISourceDirectory } constructor THelpDBISourceDirectory.Create(TheNode: THelpNode; const TheFilename, TheFileMask: string; Recursive: boolean); begin inherited Create(TheNode,TheFilename); FFileMask:=SetDirSeparators(TheFileMask); WithSubDirectories:=Recursive; end; function THelpDBISourceDirectory.FileMatches(const AFilename: string ): boolean; var TheDirectory: String; begin Result:=false; //debugln('THelpDBISourceDirectory.FileMatches AFilename="',AFilename,'" FFilename="',FFilename,'"'); if (FFilename='') or (AFilename='') then exit; TheDirectory:=GetFullFilename; //debugln('THelpDBISourceDirectory.FileMatches TheDirectory="',TheDirectory,'" WithSubDirectories=',dbgs(WithSubDirectories)); if WithSubDirectories then begin if not FileIsInPath(AFilename,TheDirectory) then exit; end else begin if not FileIsInDirectory(AFilename,TheDirectory) then exit; end; //debugln('THelpDBISourceDirectory.FileMatches FileMask="',FileMask,'"'); if (FileMask<>'') and (not FileInFilenameMasks(ExtractFilename(AFilename),FileMask)) then exit; //debugln('THelpDBISourceDirectory.FileMatches Success'); Result:=true; end; { THelpQuery } constructor THelpQuery.Create(const TheHelpDatabaseID: THelpDatabaseID); begin FHelpDatabaseID:=TheHelpDatabaseID; end; { THelpQueryContext } constructor THelpQueryContext.Create(const TheHelpDatabaseID: THelpDatabaseID; const TheContext: THelpContext); begin inherited Create(TheHelpDatabaseID); FContext:=TheContext; end; { THelpQueryKeyword } constructor THelpQueryKeyword.Create(const TheHelpDatabaseID: THelpDatabaseID; const TheKeyWord: string); begin inherited Create(TheHelpDatabaseID); FKeyword:=TheKeyWord; end; { THelpQuerySourcePosition } constructor THelpQuerySourcePosition.Create( const TheHelpDatabaseID: THelpDatabaseID; const TheFilename: string; const SrcPos: TPoint); begin inherited Create(TheHelpDatabaseID); FFilename:=TheFilename; FSourcePosition:=SrcPos; end; { THelpQueryPascalContext } constructor THelpQueryPascalContexts.Create( const TheHelpDatabaseID: THelpDatabaseID; const TheFilename: string; const SrcPos: TPoint; ContextLists: TList); begin inherited Create(TheHelpDatabaseID,TheFilename,SrcPos); FContextLists:=ContextLists; end; { THelpQueryMessage } constructor THelpQueryMessage.Create(const TheHelpDatabaseID: THelpDatabaseID; const TheMessage: string; TheMessageParts: TStrings); begin inherited Create(TheHelpDatabaseID); FWholeMessage:=TheMessage; FMessageParts:=TheMessageParts; end; destructor THelpQueryMessage.Destroy; begin FMessageParts.Free; inherited Destroy; end; { THelpQueryClass } constructor THelpQueryClass.Create(const TheHelpDatabaseID: THelpDatabaseID; const AClass: TClass); begin inherited Create(TheHelpDatabaseID); FTheClass:=AClass; end; { THelpQueryNode } constructor THelpQueryNode.Create(const TheHelpDatabaseID: THelpDatabaseID; const TheNode: THelpNode); begin inherited Create(TheHelpDatabaseID); FNode:=TheNode; end; { THelpBasePathObject } procedure THelpBasePathObject.SetBasePath(const AValue: string); begin if FBasePath=AValue then exit; FBasePath:=AValue; end; constructor THelpBasePathObject.Create; begin end; constructor THelpBasePathObject.Create(const TheBasePath: string); begin BasePath:=TheBasePath; end; { THelpNodeQuery } constructor THelpNodeQuery.Create; begin end; constructor THelpNodeQuery.Create(TheNode: THelpNode; TheQueryItem: THelpQueryItem); begin Create; FNode:=TheNode; FQueryItem:=TheQueryItem; end; function THelpNodeQuery.IsEqual(TheNode: THelpNode; TheQueryItem: THelpQueryItem ): boolean; begin Result:=(Node=TheNode) and (QueryItem.IsEqual(TheQueryItem)) end; function THelpNodeQuery.IsEqual(NodeQuery: THelpNodeQuery): boolean; begin Result:=IsEqual(NodeQuery.Node,NodeQuery.QueryItem) end; function THelpNodeQuery.AsString: string; begin Result:=Node.AsString; if QueryItem<>nil then Result:=Result+' ('+QueryItem.AsString+')'; end; { THelpNodeQueryList } function THelpNodeQueryList.GetItems(Index: integer): THelpNodeQuery; begin Result:=THelpNodeQuery(fItems[Index]); end; procedure THelpNodeQueryList.SetItems(Index: integer; const AValue: THelpNodeQuery); begin fItems[Index]:=AValue; end; constructor THelpNodeQueryList.Create; begin fItems:=TFPList.Create; end; destructor THelpNodeQueryList.Destroy; begin Clear; fItems.Free; inherited Destroy; end; function THelpNodeQueryList.Count: integer; begin Result:=fItems.Count; end; function THelpNodeQueryList.Add(NodeQuery: THelpNodeQuery): integer; begin Result:=fItems.Add(NodeQuery); end; function THelpNodeQueryList.Add(Node: THelpNode; QueryItem: THelpQueryItem ): integer; begin Result:=Add(THelpNodeQuery.Create(Node,QueryItem)); end; procedure THelpNodeQueryList.Delete(Index: integer); begin TObject(fItems[Index]).Free; fItems.Delete(Index); end; function THelpNodeQueryList.IndexOf(NodeQuery: THelpNodeQuery): integer; begin Result:=Count; while (Result>=0) and (not Items[Result].IsEqual(NodeQuery)) do dec(Result); end; function THelpNodeQueryList.IndexOf(Node: THelpNode; QueryItem: THelpQueryItem ): integer; begin Result:=Count-1; while (Result>=0) and (not Items[Result].IsEqual(Node,QueryItem)) do dec(Result); end; procedure THelpNodeQueryList.Clear; var i: Integer; begin for i:=0 to Count-1 do TObject(fItems[i]).Free; fItems.Clear; end; { THelpQueryItem } function THelpQueryItem.IsEqual(QueryItem: THelpQueryItem): boolean; begin Result:=AsString=QueryItem.AsString; end; { THelpBaseURLObject } procedure THelpBaseURLObject.SetBaseURL(const AValue: string); begin if FBaseURL=AValue then exit; FBaseURL:=AValue; end; constructor THelpBaseURLObject.Create; begin end; constructor THelpBaseURLObject.Create(const TheBaseURL: string); begin BaseURL:=TheBaseURL; end; initialization HelpDatabases:=nil; end.