123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062 |
- {
- $Id$
- This file is part of the Free Pascal Integrated Development Environment
- Copyright (c) 1998 by Berczi Gabor
- Help support & Borland OA .HLP reader objects and routines
- See the file COPYING.FPC, 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.
- **********************************************************************}
- {$R-}
- unit WHelp;
- interface
- uses
- {$ifdef Win32}
- { placed here to avoid TRect to be found in windows unit
- for win32 target whereas its found in objects unit for other targets PM }
- windows,
- {$endif Win32}
- Objects,
- WUtils;
- const
- hscLineBreak = #0;
- hscLink = #2;
- hscLineStart = #3;
- hscCode = #5;
- hscCenter = #10;
- hscRight = #11;
- hscNamedMark = #12;
- hscTextAttr = #13;
- hscTextColor = #14;
- hscNormText = #15;
- hscInImage = #16;
- type
- THelpCtx = longint;
- TRecord = packed record
- SClass : word;
- Size : word;
- Data : pointer;
- end;
- PIndexEntry = ^TIndexEntry;
- TIndexEntry = packed record
- Tag : PString;
- HelpCtx : THelpCtx;
- FileID : word;
- end;
- PKeywordDescriptor = ^TKeywordDescriptor;
- TKeywordDescriptor = packed record
- FileID : word;
- Context : THelpCtx;
- end;
- PKeywordDescriptors = ^TKeywordDescriptors;
- TKeywordDescriptors = array[0..MaxBytes div sizeof(TKeywordDescriptor)-1] of TKeywordDescriptor;
- PTopic = ^TTopic;
- TTopic = object
- HelpCtx : THelpCtx;
- FileOfs : longint;
- TextSize : sw_word;
- Text : PByteArray;
- LinkCount : sw_word;
- Links : PKeywordDescriptors;
- LastAccess : longint;
- FileID : word;
- Param : PString;
- StartNamedMark: integer;
- NamedMarks : PUnsortedStringCollection;
- ExtData : pointer;
- ExtDataSize : longint;
- function LinkSize: sw_word;
- function GetNamedMarkIndex(const MarkName: string): sw_integer;
- end;
- PTopicCollection = ^TTopicCollection;
- TTopicCollection = object(TSortedCollection)
- function At(Index: sw_Integer): PTopic;
- procedure FreeItem(Item: Pointer); virtual;
- function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
- function SearchTopic(AHelpCtx: THelpCtx): PTopic;
- end;
- PIndexEntryCollection = ^TIndexEntryCollection;
- TIndexEntryCollection = object(TSortedCollection)
- function At(Index: Sw_Integer): PIndexEntry;
- procedure FreeItem(Item: Pointer); virtual;
- function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
- end;
- PUnsortedIndexEntryCollection = ^TUnsortedIndexEntryCollection;
- TUnsortedIndexEntryCollection = object(TCollection)
- function At(Index: Sw_Integer): PIndexEntry;
- procedure FreeItem(Item: Pointer); virtual;
- end;
- PHelpFile = ^THelpFile;
- THelpFile = object(TObject)
- ID : word;
- Topics : PTopicCollection;
- IndexEntries : PUnsortedIndexEntryCollection;
- constructor Init(AID: word);
- function LoadTopic(HelpCtx: THelpCtx): PTopic; virtual;
- procedure AddTopic(HelpCtx: THelpCtx; Pos: longint; const Param: string;
- ExtData: pointer; ExtDataSize: longint);
- procedure AddIndexEntry(const Text: string; AHelpCtx: THelpCtx);
- destructor Done; virtual;
- public
- function LoadIndex: boolean; virtual;
- function SearchTopic(HelpCtx: THelpCtx): PTopic; virtual;
- function ReadTopic(T: PTopic): boolean; virtual;
- private
- procedure MaintainTopicCache;
- end;
- PHelpFileCollection = PCollection;
- PHelpFacility = ^THelpFacility;
- THelpFacility = object(TObject)
- HelpFiles: PHelpFileCollection;
- IndexTabSize: sw_integer;
- constructor Init;
- function AddFile(const FileName, Param: string): PHelpFile;
- function AddHelpFile(H: PHelpFile): boolean;
- function LoadTopic(SourceFileID: word; Context: THelpCtx): PTopic; virtual;
- function TopicSearch(Keyword: string; var FileID: word; var Context: THelpCtx): boolean; virtual;
- function BuildIndexTopic: PTopic; virtual;
- destructor Done; virtual;
- private
- LastID: word;
- function SearchFile(ID: byte): PHelpFile;
- function SearchTopicInHelpFile(F: PHelpFile; Context: THelpCtx): PTopic;
- function SearchTopicOwner(SourceFileID: word; Context: THelpCtx): PHelpFile;
- end;
- THelpFileOpenProc = function(const FileName,Param: string;Index : longint): PHelpFile;
- PHelpFileType = ^THelpFileType;
- THelpFileType = record
- OpenProc : THelpFileOpenProc;
- end;
- const TopicCacheSize : sw_integer = 10;
- HelpStreamBufSize : sw_integer = 4096;
- HelpFacility : PHelpFacility = nil;
- MaxHelpTopicSize : sw_word = {$ifdef FPC}3*65520{$else}65520{$endif};
- function NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string;
- ExtData: pointer; ExtDataSize: longint): PTopic;
- procedure DisposeTopic(P: PTopic);
- procedure RenderTopic(Lines: PUnsortedStringCollection; T: PTopic);
- procedure BuildTopic(Lines: PUnsortedStringCollection; T: PTopic);
- procedure AddLinkToTopic(T: PTopic; AFileID: word; ACtx: THelpCtx);
- function NewIndexEntry(Tag: string; FileID: word; HelpCtx: THelpCtx): PIndexEntry;
- procedure DisposeIndexEntry(P: PIndexEntry);
- procedure DisposeRecord(var R: TRecord);
- procedure RegisterHelpFileType(AOpenProc: THelpFileOpenProc);
- function GetHelpFileTypeCount: integer;
- procedure GetHelpFileType(Index: sw_integer; var HT: THelpFileType);
- procedure DoneHelpFilesTypes;
- implementation
- uses
- {$ifdef Unix}
- {$ifdef VER1_0}
- linux,
- {$else}
- unix,
- {$endif}
- {$endif Unix}
- {$IFDEF OS2}
- DosCalls,
- {$ENDIF OS2}
- Strings,
- WConsts;
- type
- PHelpFileTypeCollection = ^THelpFileTypeCollection;
- THelpFileTypeCollection = object(TCollection)
- function At(Index: sw_Integer): PHelpFileType;
- procedure FreeItem(Item: Pointer); virtual;
- end;
- const
- HelpFileTypes : PHelpFileTypeCollection = nil;
- function NewHelpFileType(AOpenProc: THelpFileOpenProc): PHelpFileType;
- var P: PHelpFileType;
- begin
- New(P);
- with P^ do begin OpenProc:=AOpenProc; end;
- NewHelpFileType:=P;
- end;
- procedure DisposeHelpFileType(P: PHelpFileType);
- begin
- if Assigned(P) then
- Dispose(P);
- end;
- procedure DoneHelpFilesTypes;
- begin
- if Assigned(HelpFileTypes) then
- Dispose(HelpFileTypes, Done);
- end;
- function THelpFileTypeCollection.At(Index: sw_Integer): PHelpFileType;
- begin
- At:=inherited At(Index);
- end;
- procedure THelpFileTypeCollection.FreeItem(Item: Pointer);
- begin
- if Assigned(Item) then
- DisposeHelpFileType(Item);
- end;
- procedure RegisterHelpFileType(AOpenProc: THelpFileOpenProc);
- begin
- if not Assigned(HelpFileTypes) then
- New(HelpFileTypes, Init(10,10));
- HelpFileTypes^.Insert(NewHelpFileType(AOpenProc));
- end;
- function GetHelpFileTypeCount: integer;
- var Count: integer;
- begin
- if not Assigned(HelpFileTypes) then
- Count:=0
- else
- Count:=HelpFileTypes^.Count;
- GetHelpFileTypeCount:=Count;
- end;
- procedure GetHelpFileType(Index: sw_integer; var HT: THelpFileType);
- begin
- HT:=HelpFileTypes^.At(Index)^;
- end;
- Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
- {$IFDEF OS2}
- const
- QSV_MS_COUNT = 14;
- var
- L: longint;
- begin
- DosQuerySysInfo (QSV_MS_COUNT, QSV_MS_COUNT, L, 4);
- GetDosTicks := L div 55;
- end;
- {$ENDIF}
- {$IFDEF Unix}
- var
- tv : TimeVal;
- tz : TimeZone;
- begin
- GetTimeOfDay(tv); {Timezone no longer used?}
- GetDosTicks:=((tv.Sec mod 86400) div 60)*1092+((tv.Sec mod 60)*1000000+tv.USec) div 54945;
- end;
- {$endif Unix}
- {$ifdef Win32}
- begin
- GetDosTicks:=(Windows.GetTickCount*5484) div 100;
- end;
- {$endif Win32}
- {$ifdef go32v2}
- begin
- GetDosTicks:=MemL[$40:$6c];
- end;
- {$endif go32v2}
- {$ifdef TP}
- begin
- GetDosTicks:=MemL[$40:$6c];
- end;
- {$endif go32v2}
- procedure DisposeRecord(var R: TRecord);
- begin
- with R do
- if (Size>0) and (Data<>nil) then FreeMem(Data, Size);
- FillChar(R, SizeOf(R), 0);
- end;
- function NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string;
- ExtData: pointer; ExtDataSize: longint): PTopic;
- var P: PTopic;
- begin
- New(P); FillChar(P^,SizeOf(P^), 0);
- P^.HelpCtx:=HelpCtx; P^.FileOfs:=Pos; P^.FileID:=FileID;
- P^.Param:=NewStr(Param);
- if Assigned(ExtData) and (ExtDataSize>0) then
- begin
- P^.ExtDataSize:=ExtDataSize;
- GetMem(P^.ExtData,ExtDataSize);
- Move(ExtData^,P^.ExtData^,ExtDataSize);
- end;
- New(P^.NamedMarks, Init(100,100));
- NewTopic:=P;
- end;
- procedure DisposeTopic(P: PTopic);
- begin
- if P<>nil then
- begin
- if (P^.TextSize>0) and (P^.Text<>nil) then
- FreeMem(P^.Text,P^.TextSize);
- P^.Text:=nil;
- if {(P^.LinkCount>0) and }(P^.Links<>nil) then
- FreeMem(P^.Links,P^.LinkSize);
- P^.Links:=nil;
- if P^.Param<>nil then DisposeStr(P^.Param); P^.Param:=nil;
- if Assigned(P^.ExtData) then
- FreeMem(P^.ExtData{$ifndef FPC},P^.ExtDataSize{$endif});
- if Assigned(P^.NamedMarks) then Dispose(P^.NamedMarks, Done); P^.NamedMarks:=nil;
- Dispose(P);
- end;
- end;
- function CloneTopic(T: PTopic): PTopic;
- var NT: PTopic;
- procedure CloneMark(P: PString); {$ifndef FPC}far;{$endif}
- begin
- NT^.NamedMarks^.InsertStr(GetStr(P));
- end;
- begin
- New(NT);
- Move(T^,NT^,SizeOf(NT^));
- if NT^.Text<>nil then
- begin GetMem(NT^.Text,NT^.TextSize); Move(T^.Text^,NT^.Text^,NT^.TextSize); end;
- if NT^.Links<>nil then
- begin
- GetMem(NT^.Links,NT^.LinkSize);
- Move(T^.Links^,NT^.Links^,NT^.LinkSize);
- end;
- if NT^.Param<>nil then
- NT^.Param:=NewStr(T^.Param^);
- if Assigned(T^.NamedMarks) then
- begin
- New(NT^.NamedMarks, Init(T^.NamedMarks^.Count,10));
- T^.NamedMarks^.ForEach(@CloneMark);
- end;
- NT^.ExtDataSize:=T^.ExtDataSize;
- if Assigned(T^.ExtData) and (T^.ExtDataSize>0) then
- begin
- GetMem(NT^.ExtData,NT^.ExtDataSize);
- Move(T^.ExtData^,NT^.ExtData^,NT^.ExtDataSize);
- end;
- CloneTopic:=NT;
- end;
- procedure RenderTopic(Lines: PUnsortedStringCollection; T: PTopic);
- var Size,CurPtr,I,MSize: sw_word;
- S: string;
- begin
- CurPtr:=0;
- for I:=0 to Lines^.Count-1 do
- begin
- S:=GetStr(Lines^.At(I));
- Size:=length(S)+1;
- Inc(CurPtr,Size);
- end;
- Size:=CurPtr;
- T^.TextSize:=Size; GetMem(T^.Text,T^.TextSize);
- CurPtr:=0;
- for I:=0 to Lines^.Count-1 do
- begin
- S:=GetStr(Lines^.At(I)); Size:=length(S); MSize:=Size;
- if CurPtr+Size>=T^.TextSize then
- MSize:=T^.TextSize-CurPtr;
- Move(S[1],PByteArray(T^.Text)^[CurPtr],MSize);
- if MSize<>Size then
- Break;
- Inc(CurPtr,Size);
- PByteArray(T^.Text)^[CurPtr]:=ord(hscLineBreak);
- Inc(CurPtr);
- if CurPtr>=T^.TextSize then Break;
- end;
- end;
- procedure BuildTopic(Lines: PUnsortedStringCollection; T: PTopic);
- var Size,CurPtr,MSize: sw_word;
- I: sw_integer;
- S: string;
- begin
- CurPtr:=0;
- for I:=0 to Lines^.Count-1 do
- begin
- S:=GetStr(Lines^.At(I));
- Size:=length(S);
- Inc(CurPtr,Size);
- end;
- Size:=CurPtr;
- T^.TextSize:=Size; GetMem(T^.Text,T^.TextSize);
- CurPtr:=0;
- for I:=0 to Lines^.Count-1 do
- begin
- S:=GetStr(Lines^.At(I)); Size:=length(S); MSize:=Size;
- if Size>0 then
- begin
- if CurPtr+Size>=T^.TextSize then
- MSize:=T^.TextSize-CurPtr;
- Move(S[1],PByteArray(T^.Text)^[CurPtr],MSize);
- if MSize<>Size then
- Break;
- Inc(CurPtr,Size);
- end;
- if CurPtr>=T^.TextSize then Break;
- end;
- end;
- procedure AddLinkToTopic(T: PTopic; AFileID: word; ACtx: THelpCtx);
- var NewSize: word;
- NewPtr: pointer;
- begin
- NewSize:=longint(T^.LinkCount+1)*sizeof(T^.Links^[0]);
- GetMem(NewPtr,NewSize);
- if Assigned(T^.Links) then
- begin
- Move(T^.Links^,NewPtr^,T^.LinkSize);
- FreeMem(T^.Links,T^.LinkSize);
- end;
- T^.Links:=NewPtr;
- with T^.Links^[T^.LinkCount] do
- begin
- FileID:=AFileID;
- Context:=ACtx;
- end;
- Inc(T^.LinkCount);
- end;
- function NewIndexEntry(Tag: string; FileID: word; HelpCtx: THelpCtx): PIndexEntry;
- var P: PIndexEntry;
- begin
- New(P); FillChar(P^,SizeOf(P^), 0);
- P^.Tag:=NewStr(Tag); P^.FileID:=FileID; P^.HelpCtx:=HelpCtx;
- NewIndexEntry:=P;
- end;
- procedure DisposeIndexEntry(P: PIndexEntry);
- begin
- if P<>nil then
- begin
- if P^.Tag<>nil then DisposeStr(P^.Tag);
- Dispose(P);
- end;
- end;
- function TTopic.LinkSize: sw_word;
- begin
- LinkSize:=LinkCount*SizeOf(Links^[0]);
- end;
- function TTopic.GetNamedMarkIndex(const MarkName: string): sw_integer;
- var I,Index: sw_integer;
- begin
- Index:=-1;
- if Assigned(NamedMarks) then
- for I:=0 to NamedMarks^.Count-1 do
- if CompareText(GetStr(NamedMarks^.At(I)),MarkName)=0 then
- begin
- Index:=I;
- Break;
- end;
- GetNamedMarkIndex:=Index;
- end;
- function TTopicCollection.At(Index: sw_Integer): PTopic;
- begin
- At:=inherited At(Index);
- end;
- procedure TTopicCollection.FreeItem(Item: Pointer);
- begin
- if Item<>nil then DisposeTopic(Item);
- end;
- function TTopicCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
- var K1: PTopic absolute Key1;
- K2: PTopic absolute Key2;
- R: Sw_integer;
- begin
- if K1^.HelpCtx<K2^.HelpCtx then R:=-1 else
- if K1^.HelpCtx>K2^.HelpCtx then R:= 1 else
- R:=0;
- Compare:=R;
- end;
- function TTopicCollection.SearchTopic(AHelpCtx: THelpCtx): PTopic;
- var T: TTopic;
- P: PTopic;
- Index: sw_integer;
- begin
- T.HelpCtx:=AHelpCtx;
- if Search(@T,Index) then
- P:=At(Index)
- else
- P:=nil;
- SearchTopic:=P;
- end;
- function TIndexEntryCollection.At(Index: Sw_Integer): PIndexEntry;
- begin
- At:=inherited At(Index);
- end;
- procedure TIndexEntryCollection.FreeItem(Item: Pointer);
- begin
- if Item<>nil then DisposeIndexEntry(Item);
- end;
- function TUnsortedIndexEntryCollection.At(Index: Sw_Integer): PIndexEntry;
- begin
- At:=inherited At(Index);
- end;
- procedure TUnsortedIndexEntryCollection.FreeItem(Item: Pointer);
- begin
- if Item<>nil then DisposeIndexEntry(Item);
- end;
- function TIndexEntryCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
- var K1: PIndexEntry absolute Key1;
- K2: PIndexEntry absolute Key2;
- R: Sw_integer;
- S1,S2: string;
- T1,T2 : PTopic;
- begin
- S1:=UpcaseStr(K1^.Tag^); S2:=UpcaseStr(K2^.Tag^);
- if S1<S2 then
- begin
- Compare:=-1;
- exit;
- end;
- if S1>S2 then
- begin
- Compare:=1;
- exit;
- end;
- if assigned(HelpFacility) then
- begin
- { Try to read the title of the topic }
- T1:=HelpFacility^.LoadTopic(K1^.FileID,K1^.HelpCtx);
- T2:=HelpFacility^.LoadTopic(K2^.FileID,K2^.HelpCtx);
- if assigned(T1^.Text) and assigned(T2^.Text) then
- r:=strcomp(pchar(T1^.Text),pchar(T2^.Text))
- else
- r:=0;
- if r>0 then
- begin
- Compare:=1;
- exit;
- end;
- if r<0 then
- begin
- Compare:=-1;
- exit;
- end;
- end;
- if K1^.FileID<K2^.FileID then R:=-1
- else if K1^.FileID>K2^.FileID then R:= 1
- else
- R:=0;
- Compare:=R;
- end;
- constructor THelpFile.Init(AID: word);
- begin
- inherited Init;
- ID:=AID;
- New(Topics, Init(2000,1000));
- New(IndexEntries, Init(2000,1000));
- end;
- procedure THelpFile.AddTopic(HelpCtx: THelpCtx; Pos: longint; const Param: string; ExtData: pointer; ExtDataSize: longint);
- begin
- Topics^.Insert(NewTopic(ID,HelpCtx,Pos,Param,ExtData,ExtDataSize));
- end;
- procedure THelpFile.AddIndexEntry(const Text: string; AHelpCtx: THelpCtx);
- begin
- IndexEntries^.Insert(NewIndexEntry(Text,ID,AHelpCtx));
- end;
- function THelpFile.LoadTopic(HelpCtx: THelpCtx): PTopic;
- var T: PTopic;
- begin
- T:=SearchTopic(HelpCtx);
- if (T<>nil) then
- if T^.Text=nil then
- begin
- MaintainTopicCache;
- if ReadTopic(T)=false then
- T:=nil;
- if (T<>nil) and (T^.Text=nil) then T:=nil;
- end;
- if T<>nil then
- begin
- T^.LastAccess:=GetDosTicks;
- T:=CloneTopic(T);
- end;
- LoadTopic:=T;
- end;
- function THelpFile.LoadIndex: boolean;
- begin
- Abstract;
- LoadIndex:=false; { remove warning }
- end;
- function THelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
- var T: PTopic;
- begin
- T:=Topics^.SearchTopic(HelpCtx);
- SearchTopic:=T;
- end;
- function THelpFile.ReadTopic(T: PTopic): boolean;
- begin
- Abstract;
- ReadTopic:=false; { remove warning }
- end;
- procedure THelpFile.MaintainTopicCache;
- var Count: sw_integer;
- MinLRU: longint;
- procedure CountThem(P: PTopic); {$ifndef FPC}far;{$endif}
- begin if (P^.Text<>nil) or (P^.Links<>nil) then Inc(Count); end;
- procedure SearchLRU(P: PTopic); {$ifndef FPC}far;{$endif}
- begin if P^.LastAccess<MinLRU then begin MinLRU:=P^.LastAccess; end; end;
- var P: PTopic;
- begin
- Count:=0; Topics^.ForEach(@CountThem);
- if (Count>=TopicCacheSize) then
- begin
- MinLRU:=MaxLongint; P:=nil; Topics^.ForEach(@SearchLRU);
- if P<>nil then
- begin
- FreeMem(P^.Text,P^.TextSize); P^.TextSize:=0; P^.Text:=nil;
- FreeMem(P^.Links,P^.LinkSize); P^.LinkCount:=0; P^.Links:=nil;
- end;
- end;
- end;
- destructor THelpFile.Done;
- begin
- if Topics<>nil then Dispose(Topics, Done);
- if IndexEntries<>nil then Dispose(IndexEntries, Done);
- inherited Done;
- end;
- constructor THelpFacility.Init;
- begin
- inherited Init;
- New(HelpFiles, Init(10,10));
- IndexTabSize:=40;
- end;
- function THelpFacility.AddFile(const FileName, Param: string): PHelpFile;
- var H: PHelpFile;
- OK: boolean;
- I: integer;
- HT: THelpFileType;
- begin
- OK:=false; H:=nil;
- for I:=0 to GetHelpFileTypeCount-1 do
- begin
- GetHelpFileType(I,HT);
- H:=HT.OpenProc(FileName,Param,LastID+1);
- if Assigned(H) then
- Break;
- end;
- if Assigned(H) then
- OK:=AddHelpFile(H);
- if (not OK) and Assigned(H) then begin Dispose(H, Done); H:=nil; end;
- AddFile:=H;
- end;
- function THelpFacility.AddHelpFile(H: PHelpFile): boolean;
- begin
- if H<>nil then
- begin
- HelpFiles^.Insert(H);
- Inc(LastID);
- { H^.ID:=LastID; now already set by OpenProc PM }
- end;
- AddHelpFile:=H<>nil;
- end;
- function THelpFacility.SearchTopicOwner(SourceFileID: word; Context: THelpCtx): PHelpFile;
- var P: PTopic;
- HelpFile: PHelpFile;
- function Search(F: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
- begin
- P:=SearchTopicInHelpFile(F,Context); if P<>nil then HelpFile:=F;
- Search:=P<>nil;
- end;
- begin
- HelpFile:=nil;
- if SourceFileID=0 then P:=nil else
- begin
- HelpFile:=SearchFile(SourceFileID);
- P:=SearchTopicInHelpFile(HelpFile,Context);
- end;
- if P=nil then HelpFiles^.FirstThat(@Search);
- if P=nil then HelpFile:=nil;
- SearchTopicOwner:=HelpFile;
- end;
- function THelpFacility.LoadTopic(SourceFileID: word; Context: THelpCtx): PTopic;
- var P: PTopic;
- H: PHelpFile;
- begin
- if (SourceFileID=0) and (Context=0) then
- P:=BuildIndexTopic else
- begin
- H:=SearchTopicOwner(SourceFileID,Context);
- if (H=nil) then P:=nil else
- P:=H^.LoadTopic(Context);
- end;
- LoadTopic:=P;
- end;
- function THelpFacility.TopicSearch(Keyword: string; var FileID: word; var Context: THelpCtx): boolean;
- function ScanHelpFile(H: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
- function Search(P: PIndexEntry): boolean; {$ifndef FPC}far;{$endif}
- begin
- Search:=copy(UpcaseStr(P^.Tag^),1,length(Keyword))=Keyword;
- end;
- var P: PIndexEntry;
- begin
- H^.LoadIndex;
- P:=H^.IndexEntries^.FirstThat(@Search);
- if P<>nil then begin FileID:=H^.ID; Context:=P^.HelpCtx; end;
- ScanHelpFile:=P<>nil;
- end;
- begin
- Keyword:=UpcaseStr(Keyword);
- TopicSearch:=HelpFiles^.FirstThat(@ScanHelpFile)<>nil;
- end;
- function THelpFacility.BuildIndexTopic: PTopic;
- var T: PTopic;
- Keywords: PIndexEntryCollection;
- Lines: PUnsortedStringCollection;
- procedure InsertKeywordsOfFile(H: PHelpFile); {$ifndef FPC}far;{$endif}
- function InsertKeywords(P: PIndexEntry): boolean; {$ifndef FPC}far;{$endif}
- begin
- Keywords^.Insert(P);
- InsertKeywords:=Keywords^.Count>=MaxCollectionSize;
- end;
- begin
- H^.LoadIndex;
- if Keywords^.Count<MaxCollectionSize then
- H^.IndexEntries^.FirstThat(@InsertKeywords);
- end;
- procedure AddLine(S: string);
- begin
- if S='' then S:=' ';
- Lines^.Insert(NewStr(S));
- end;
- var Line: string;
- procedure FlushLine;
- begin
- if Line<>'' then AddLine(Line); Line:='';
- end;
- var KWCount,NLFlag: sw_integer;
- LastFirstChar: char;
- procedure NewSection(FirstChar: char);
- begin
- if FirstChar<=#64 then FirstChar:=#32;
- FlushLine;
- AddLine('');
- AddLine(FirstChar);
- AddLine('');
- LastFirstChar:=FirstChar;
- NLFlag:=0;
- end;
- function FormatAlias(Alias: string): string;
- var StartP,EndP: sw_integer;
- begin
- repeat
- StartP:=Pos(' ',Alias);
- if StartP>0 then
- begin
- EndP:=StartP;
- while (EndP+1<=length(Alias)) and (Alias[EndP+1]=' ') do Inc(EndP);
- Alias:=copy(Alias,1,StartP-1)+' | '+copy(Alias,EndP+1,High(Alias));
- end;
- until StartP=0;
- if Assigned(HelpFacility) then
- if length(Alias)>IndexTabSize-4 then
- Alias:=Trim(copy(Alias,1,IndexTabSize-4-2))+'..';
- FormatAlias:=Alias;
- end;
- procedure AddKeyword(KWS: string);
- begin
- Inc(KWCount); if KWCount=1 then NLFlag:=0;
- if (KWCount=1) or
- ( (Upcase(KWS[1])<>LastFirstChar) and ( (LastFirstChar>#64) or (KWS[1]>#64) ) ) then
- NewSection(Upcase(KWS[1]));
- KWS:=FormatAlias(KWS);
- if (NLFlag mod 2)=0
- then Line:=' '+#2+KWS+#2
- else begin
- Line:=RExpand(Line,IndexTabSize)+#2+KWS+#2;
- FlushLine;
- end;
- Inc(NLFlag);
- end;
- var KW: PIndexEntry;
- I,p : sw_integer;
- IsMultiple : boolean;
- St,LastTag : String;
- begin
- New(Keywords, Init(5000,5000));
- HelpFiles^.ForEach(@InsertKeywordsOfFile);
- New(Lines, Init((Keywords^.Count div 2)+100,1000));
- T:=NewTopic(0,0,0,'',nil,0);
- if HelpFiles^.Count=0 then
- begin
- AddLine('');
- AddLine(' '+msg_nohelpfilesinstalled)
- end else
- begin
- AddLine(' '+msg_helpindex);
- KWCount:=0; Line:='';
- T^.LinkCount:=Min(Keywords^.Count,MaxBytes div sizeof(T^.Links^[0])-1);
- GetMem(T^.Links,T^.LinkSize);
- LastTag:='';
- for I:=0 to T^.LinkCount-1 do
- begin
- KW:=Keywords^.At(I);
- IsMultiple:=(LastTag=KW^.Tag^) or
- ((I<T^.LinkCount-1) and (KW^.Tag^=Keywords^.At(I+1)^.Tag^));
- if IsMultiple then
- Begin
- St:=Trim(strpas(pchar(HelpFacility^.LoadTopic(KW^.FileID,KW^.HelpCtx)^.Text)));
- { Remove all special chars }
- for p:=1 to Length(st) do
- if ord(st[p])<=16 then
- st[p]:=' ';
- p:=pos(KW^.Tag^,St);
- if (p=1) then
- AddKeyword(St)
- else
- AddKeyword(KW^.Tag^+' '+St);
- End
- else
- AddKeyword(KW^.Tag^);
- LastTag:=KW^.Tag^;
- T^.Links^[I].Context:=longint(KW^.HelpCtx);
- T^.Links^[I].FileID:=KW^.FileID;
- end;
- FlushLine;
- AddLine('');
- end;
- RenderTopic(Lines,T);
- Dispose(Lines, Done);
- Keywords^.DeleteAll; Dispose(Keywords, Done);
- BuildIndexTopic:=T;
- end;
- function THelpFacility.SearchFile(ID: byte): PHelpFile;
- function Match(P: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
- begin
- Match:=(P^.ID=ID);
- end;
- begin
- SearchFile:=HelpFiles^.FirstThat(@Match);
- end;
- function THelpFacility.SearchTopicInHelpFile(F: PHelpFile; Context: THelpCtx): PTopic;
- var P: PTopic;
- begin
- if F=nil then P:=nil else
- P:=F^.SearchTopic(Context);
- SearchTopicInHelpFile:=P;
- end;
- destructor THelpFacility.Done;
- begin
- inherited Done;
- Dispose(HelpFiles, Done);
- end;
- END.
- {
- $Log$
- Revision 1.4 2001-10-02 16:31:20 pierre
- * avoid crashes in topic text compares
- Revision 1.3 2001/10/01 00:24:09 pierre
- * fix several help problems
- Revision 1.2 2001/09/18 11:33:53 pierre
- * fix Previous Help Topic
- Revision 1.1 2001/08/04 11:30:25 peter
- * ide works now with both compiler versions
- Revision 1.1.2.6 2001/03/20 00:20:44 pierre
- * fix some memory leaks + several small enhancements
- Revision 1.1.2.5 2000/11/27 12:06:51 pierre
- New bunch of Gabor fixes
- Revision 1.1.2.4 2000/11/16 23:13:06 pierre
- + support for ANSI substitutes to HTML images in HTML viewer
- Revision 1.1.2.3 2000/11/14 09:08:51 marco
- * First batch IDE renamefest
- Revision 1.1.2.2 2000/11/12 19:48:20 hajny
- * OS/2 implementation of GetDosTicks added
- Revision 1.1.2.1 2000/09/18 13:20:56 pierre
- New bunch of Gabor changes
- Revision 1.1 2000/07/13 09:48:37 michael
- + Initial import
- Revision 1.26 2000/07/03 08:54:54 pierre
- * Some enhancements for WinHelp support by G abor
- Revision 1.25 2000/06/26 07:29:23 pierre
- * new bunch of Gabor's changes
- Revision 1.24 2000/06/22 09:07:14 pierre
- * Gabor changes: see fixes.txt
- Revision 1.23 2000/06/16 08:50:44 pierre
- + new bunch of Gabor's changes
- Revision 1.22 2000/05/31 20:42:02 pierre
- * fixthe TRect problem by 'using' windows before objects
- Revision 1.21 2000/05/30 07:18:33 pierre
- + colors for HTML help by Gabor
- Revision 1.20 2000/05/29 10:44:59 pierre
- + New bunch of Gabor's changes: see fixes.txt
- Revision 1.19 2000/04/25 08:42:35 pierre
- * New Gabor changes : see fixes.txt
- Revision 1.18 2000/04/18 11:42:38 pierre
- lot of Gabor changes : see fixes.txt
- Revision 1.17 2000/02/07 11:47:25 pierre
- * Remove 64Kb limitation for FPC by Gabor
- Revision 1.16 2000/01/03 14:59:03 marco
- * Fixed Linux code that got time of day. Removed Timezone parameter
- Revision 1.15 1999/08/16 18:25:29 peter
- * Adjusting the selection when the editor didn't contain any line.
- * Reserved word recognition redesigned, but this didn't affect the overall
- syntax highlight speed remarkably (at least not on my Amd-K6/350).
- The syntax scanner loop is a bit slow but the main problem is the
- recognition of special symbols. Switching off symbol processing boosts
- the performance up to ca. 200%...
- * The editor didn't allow copying (for ex to clipboard) of a single character
- * 'File|Save as' caused permanently run-time error 3. Not any more now...
- * Compiler Messages window (actually the whole desktop) did not act on any
- keypress when compilation failed and thus the window remained visible
- + Message windows are now closed upon pressing Esc
- + At 'Run' the IDE checks whether any sources are modified, and recompiles
- only when neccessary
- + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
- + LineSelect (Ctrl+K+L) implemented
- * The IDE had problems closing help windows before saving the desktop
- Revision 1.14 1999/07/18 16:26:42 florian
- * IDE compiles with for Win32 and basic things are working
- Revision 1.13 1999/04/13 10:47:51 daniel
- * Fixed for Linux
- Revision 1.12 1999/04/07 21:56:00 peter
- + object support for browser
- * html help fixes
- * more desktop saving things
- * NODEBUG directive to exclude debugger
- Revision 1.11 1999/03/16 12:38:16 peter
- * tools macro fixes
- + tph writer
- + first things for resource files
- Revision 1.10 1999/03/08 14:58:19 peter
- + prompt with dialogs for tools
- Revision 1.9 1999/03/03 16:44:05 pierre
- * TPH reader fix from Peter
- Revision 1.8 1999/03/01 15:42:11 peter
- + Added dummy entries for functions not yet implemented
- * MenuBar didn't update itself automatically on command-set changes
- * Fixed Debugging/Profiling options dialog
- * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
- set
- * efBackSpaceUnindents works correctly
- + 'Messages' window implemented
- + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
- + Added TP message-filter support (for ex. you can call GREP thru
- GREP2MSG and view the result in the messages window - just like in TP)
- * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
- so topic search didn't work...
- * In FPHELP.PAS there were still context-variables defined as word instead
- of THelpCtx
- * StdStatusKeys() was missing from the statusdef for help windows
- + Topic-title for index-table can be specified when adding a HTML-files
- Revision 1.6 1999/02/20 15:18:35 peter
- + ctrl-c capture with confirm dialog
- + ascii table in the tools menu
- + heapviewer
- * empty file fixed
- * fixed callback routines in fpdebug to have far for tp7
- Revision 1.5 1999/02/19 15:43:22 peter
- * compatibility fixes for FV
- Revision 1.4 1999/02/18 13:44:37 peter
- * search fixed
- + backward search
- * help fixes
- * browser updates
- Revision 1.3 1999/02/08 10:37:46 peter
- + html helpviewer
- Revision 1.2 1998/12/28 15:47:56 peter
- + Added user screen support, display & window
- + Implemented Editor,Mouse Options dialog
- + Added location of .INI and .CFG file
- + Option (INI) file managment implemented (see bottom of Options Menu)
- + Switches updated
- + Run program
- Revision 1.4 1998/12/22 10:39:55 peter
- + options are now written/read
- + find and replace routines
- }
|