whelp.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062
  1. {
  2. $Id$
  3. This file is part of the Free Pascal Integrated Development Environment
  4. Copyright (c) 1998 by Berczi Gabor
  5. Help support & Borland OA .HLP reader objects and routines
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$R-}
  13. unit WHelp;
  14. interface
  15. uses
  16. {$ifdef Win32}
  17. { placed here to avoid TRect to be found in windows unit
  18. for win32 target whereas its found in objects unit for other targets PM }
  19. windows,
  20. {$endif Win32}
  21. Objects,
  22. WUtils;
  23. const
  24. hscLineBreak = #0;
  25. hscLink = #2;
  26. hscLineStart = #3;
  27. hscCode = #5;
  28. hscCenter = #10;
  29. hscRight = #11;
  30. hscNamedMark = #12;
  31. hscTextAttr = #13;
  32. hscTextColor = #14;
  33. hscNormText = #15;
  34. hscInImage = #16;
  35. type
  36. THelpCtx = longint;
  37. TRecord = packed record
  38. SClass : word;
  39. Size : word;
  40. Data : pointer;
  41. end;
  42. PIndexEntry = ^TIndexEntry;
  43. TIndexEntry = packed record
  44. Tag : PString;
  45. HelpCtx : THelpCtx;
  46. FileID : word;
  47. end;
  48. PKeywordDescriptor = ^TKeywordDescriptor;
  49. TKeywordDescriptor = packed record
  50. FileID : word;
  51. Context : THelpCtx;
  52. end;
  53. PKeywordDescriptors = ^TKeywordDescriptors;
  54. TKeywordDescriptors = array[0..MaxBytes div sizeof(TKeywordDescriptor)-1] of TKeywordDescriptor;
  55. PTopic = ^TTopic;
  56. TTopic = object
  57. HelpCtx : THelpCtx;
  58. FileOfs : longint;
  59. TextSize : sw_word;
  60. Text : PByteArray;
  61. LinkCount : sw_word;
  62. Links : PKeywordDescriptors;
  63. LastAccess : longint;
  64. FileID : word;
  65. Param : PString;
  66. StartNamedMark: integer;
  67. NamedMarks : PUnsortedStringCollection;
  68. ExtData : pointer;
  69. ExtDataSize : longint;
  70. function LinkSize: sw_word;
  71. function GetNamedMarkIndex(const MarkName: string): sw_integer;
  72. end;
  73. PTopicCollection = ^TTopicCollection;
  74. TTopicCollection = object(TSortedCollection)
  75. function At(Index: sw_Integer): PTopic;
  76. procedure FreeItem(Item: Pointer); virtual;
  77. function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
  78. function SearchTopic(AHelpCtx: THelpCtx): PTopic;
  79. end;
  80. PIndexEntryCollection = ^TIndexEntryCollection;
  81. TIndexEntryCollection = object(TSortedCollection)
  82. function At(Index: Sw_Integer): PIndexEntry;
  83. procedure FreeItem(Item: Pointer); virtual;
  84. function Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
  85. end;
  86. PUnsortedIndexEntryCollection = ^TUnsortedIndexEntryCollection;
  87. TUnsortedIndexEntryCollection = object(TCollection)
  88. function At(Index: Sw_Integer): PIndexEntry;
  89. procedure FreeItem(Item: Pointer); virtual;
  90. end;
  91. PHelpFile = ^THelpFile;
  92. THelpFile = object(TObject)
  93. ID : word;
  94. Topics : PTopicCollection;
  95. IndexEntries : PUnsortedIndexEntryCollection;
  96. constructor Init(AID: word);
  97. function LoadTopic(HelpCtx: THelpCtx): PTopic; virtual;
  98. procedure AddTopic(HelpCtx: THelpCtx; Pos: longint; const Param: string;
  99. ExtData: pointer; ExtDataSize: longint);
  100. procedure AddIndexEntry(const Text: string; AHelpCtx: THelpCtx);
  101. destructor Done; virtual;
  102. public
  103. function LoadIndex: boolean; virtual;
  104. function SearchTopic(HelpCtx: THelpCtx): PTopic; virtual;
  105. function ReadTopic(T: PTopic): boolean; virtual;
  106. private
  107. procedure MaintainTopicCache;
  108. end;
  109. PHelpFileCollection = PCollection;
  110. PHelpFacility = ^THelpFacility;
  111. THelpFacility = object(TObject)
  112. HelpFiles: PHelpFileCollection;
  113. IndexTabSize: sw_integer;
  114. constructor Init;
  115. function AddFile(const FileName, Param: string): PHelpFile;
  116. function AddHelpFile(H: PHelpFile): boolean;
  117. function LoadTopic(SourceFileID: word; Context: THelpCtx): PTopic; virtual;
  118. function TopicSearch(Keyword: string; var FileID: word; var Context: THelpCtx): boolean; virtual;
  119. function BuildIndexTopic: PTopic; virtual;
  120. destructor Done; virtual;
  121. private
  122. LastID: word;
  123. function SearchFile(ID: byte): PHelpFile;
  124. function SearchTopicInHelpFile(F: PHelpFile; Context: THelpCtx): PTopic;
  125. function SearchTopicOwner(SourceFileID: word; Context: THelpCtx): PHelpFile;
  126. end;
  127. THelpFileOpenProc = function(const FileName,Param: string;Index : longint): PHelpFile;
  128. PHelpFileType = ^THelpFileType;
  129. THelpFileType = record
  130. OpenProc : THelpFileOpenProc;
  131. end;
  132. const TopicCacheSize : sw_integer = 10;
  133. HelpStreamBufSize : sw_integer = 4096;
  134. HelpFacility : PHelpFacility = nil;
  135. MaxHelpTopicSize : sw_word = {$ifdef FPC}3*65520{$else}65520{$endif};
  136. function NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string;
  137. ExtData: pointer; ExtDataSize: longint): PTopic;
  138. procedure DisposeTopic(P: PTopic);
  139. procedure RenderTopic(Lines: PUnsortedStringCollection; T: PTopic);
  140. procedure BuildTopic(Lines: PUnsortedStringCollection; T: PTopic);
  141. procedure AddLinkToTopic(T: PTopic; AFileID: word; ACtx: THelpCtx);
  142. function NewIndexEntry(Tag: string; FileID: word; HelpCtx: THelpCtx): PIndexEntry;
  143. procedure DisposeIndexEntry(P: PIndexEntry);
  144. procedure DisposeRecord(var R: TRecord);
  145. procedure RegisterHelpFileType(AOpenProc: THelpFileOpenProc);
  146. function GetHelpFileTypeCount: integer;
  147. procedure GetHelpFileType(Index: sw_integer; var HT: THelpFileType);
  148. procedure DoneHelpFilesTypes;
  149. implementation
  150. uses
  151. {$ifdef Unix}
  152. {$ifdef VER1_0}
  153. linux,
  154. {$else}
  155. unix,
  156. {$endif}
  157. {$endif Unix}
  158. {$IFDEF OS2}
  159. DosCalls,
  160. {$ENDIF OS2}
  161. Strings,
  162. WConsts;
  163. type
  164. PHelpFileTypeCollection = ^THelpFileTypeCollection;
  165. THelpFileTypeCollection = object(TCollection)
  166. function At(Index: sw_Integer): PHelpFileType;
  167. procedure FreeItem(Item: Pointer); virtual;
  168. end;
  169. const
  170. HelpFileTypes : PHelpFileTypeCollection = nil;
  171. function NewHelpFileType(AOpenProc: THelpFileOpenProc): PHelpFileType;
  172. var P: PHelpFileType;
  173. begin
  174. New(P);
  175. with P^ do begin OpenProc:=AOpenProc; end;
  176. NewHelpFileType:=P;
  177. end;
  178. procedure DisposeHelpFileType(P: PHelpFileType);
  179. begin
  180. if Assigned(P) then
  181. Dispose(P);
  182. end;
  183. procedure DoneHelpFilesTypes;
  184. begin
  185. if Assigned(HelpFileTypes) then
  186. Dispose(HelpFileTypes, Done);
  187. end;
  188. function THelpFileTypeCollection.At(Index: sw_Integer): PHelpFileType;
  189. begin
  190. At:=inherited At(Index);
  191. end;
  192. procedure THelpFileTypeCollection.FreeItem(Item: Pointer);
  193. begin
  194. if Assigned(Item) then
  195. DisposeHelpFileType(Item);
  196. end;
  197. procedure RegisterHelpFileType(AOpenProc: THelpFileOpenProc);
  198. begin
  199. if not Assigned(HelpFileTypes) then
  200. New(HelpFileTypes, Init(10,10));
  201. HelpFileTypes^.Insert(NewHelpFileType(AOpenProc));
  202. end;
  203. function GetHelpFileTypeCount: integer;
  204. var Count: integer;
  205. begin
  206. if not Assigned(HelpFileTypes) then
  207. Count:=0
  208. else
  209. Count:=HelpFileTypes^.Count;
  210. GetHelpFileTypeCount:=Count;
  211. end;
  212. procedure GetHelpFileType(Index: sw_integer; var HT: THelpFileType);
  213. begin
  214. HT:=HelpFileTypes^.At(Index)^;
  215. end;
  216. Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
  217. {$IFDEF OS2}
  218. const
  219. QSV_MS_COUNT = 14;
  220. var
  221. L: longint;
  222. begin
  223. DosQuerySysInfo (QSV_MS_COUNT, QSV_MS_COUNT, L, 4);
  224. GetDosTicks := L div 55;
  225. end;
  226. {$ENDIF}
  227. {$IFDEF Unix}
  228. var
  229. tv : TimeVal;
  230. tz : TimeZone;
  231. begin
  232. GetTimeOfDay(tv); {Timezone no longer used?}
  233. GetDosTicks:=((tv.Sec mod 86400) div 60)*1092+((tv.Sec mod 60)*1000000+tv.USec) div 54945;
  234. end;
  235. {$endif Unix}
  236. {$ifdef Win32}
  237. begin
  238. GetDosTicks:=(Windows.GetTickCount*5484) div 100;
  239. end;
  240. {$endif Win32}
  241. {$ifdef go32v2}
  242. begin
  243. GetDosTicks:=MemL[$40:$6c];
  244. end;
  245. {$endif go32v2}
  246. {$ifdef TP}
  247. begin
  248. GetDosTicks:=MemL[$40:$6c];
  249. end;
  250. {$endif go32v2}
  251. procedure DisposeRecord(var R: TRecord);
  252. begin
  253. with R do
  254. if (Size>0) and (Data<>nil) then FreeMem(Data, Size);
  255. FillChar(R, SizeOf(R), 0);
  256. end;
  257. function NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string;
  258. ExtData: pointer; ExtDataSize: longint): PTopic;
  259. var P: PTopic;
  260. begin
  261. New(P); FillChar(P^,SizeOf(P^), 0);
  262. P^.HelpCtx:=HelpCtx; P^.FileOfs:=Pos; P^.FileID:=FileID;
  263. P^.Param:=NewStr(Param);
  264. if Assigned(ExtData) and (ExtDataSize>0) then
  265. begin
  266. P^.ExtDataSize:=ExtDataSize;
  267. GetMem(P^.ExtData,ExtDataSize);
  268. Move(ExtData^,P^.ExtData^,ExtDataSize);
  269. end;
  270. New(P^.NamedMarks, Init(100,100));
  271. NewTopic:=P;
  272. end;
  273. procedure DisposeTopic(P: PTopic);
  274. begin
  275. if P<>nil then
  276. begin
  277. if (P^.TextSize>0) and (P^.Text<>nil) then
  278. FreeMem(P^.Text,P^.TextSize);
  279. P^.Text:=nil;
  280. if {(P^.LinkCount>0) and }(P^.Links<>nil) then
  281. FreeMem(P^.Links,P^.LinkSize);
  282. P^.Links:=nil;
  283. if P^.Param<>nil then DisposeStr(P^.Param); P^.Param:=nil;
  284. if Assigned(P^.ExtData) then
  285. FreeMem(P^.ExtData{$ifndef FPC},P^.ExtDataSize{$endif});
  286. if Assigned(P^.NamedMarks) then Dispose(P^.NamedMarks, Done); P^.NamedMarks:=nil;
  287. Dispose(P);
  288. end;
  289. end;
  290. function CloneTopic(T: PTopic): PTopic;
  291. var NT: PTopic;
  292. procedure CloneMark(P: PString); {$ifndef FPC}far;{$endif}
  293. begin
  294. NT^.NamedMarks^.InsertStr(GetStr(P));
  295. end;
  296. begin
  297. New(NT);
  298. Move(T^,NT^,SizeOf(NT^));
  299. if NT^.Text<>nil then
  300. begin GetMem(NT^.Text,NT^.TextSize); Move(T^.Text^,NT^.Text^,NT^.TextSize); end;
  301. if NT^.Links<>nil then
  302. begin
  303. GetMem(NT^.Links,NT^.LinkSize);
  304. Move(T^.Links^,NT^.Links^,NT^.LinkSize);
  305. end;
  306. if NT^.Param<>nil then
  307. NT^.Param:=NewStr(T^.Param^);
  308. if Assigned(T^.NamedMarks) then
  309. begin
  310. New(NT^.NamedMarks, Init(T^.NamedMarks^.Count,10));
  311. T^.NamedMarks^.ForEach(@CloneMark);
  312. end;
  313. NT^.ExtDataSize:=T^.ExtDataSize;
  314. if Assigned(T^.ExtData) and (T^.ExtDataSize>0) then
  315. begin
  316. GetMem(NT^.ExtData,NT^.ExtDataSize);
  317. Move(T^.ExtData^,NT^.ExtData^,NT^.ExtDataSize);
  318. end;
  319. CloneTopic:=NT;
  320. end;
  321. procedure RenderTopic(Lines: PUnsortedStringCollection; T: PTopic);
  322. var Size,CurPtr,I,MSize: sw_word;
  323. S: string;
  324. begin
  325. CurPtr:=0;
  326. for I:=0 to Lines^.Count-1 do
  327. begin
  328. S:=GetStr(Lines^.At(I));
  329. Size:=length(S)+1;
  330. Inc(CurPtr,Size);
  331. end;
  332. Size:=CurPtr;
  333. T^.TextSize:=Size; GetMem(T^.Text,T^.TextSize);
  334. CurPtr:=0;
  335. for I:=0 to Lines^.Count-1 do
  336. begin
  337. S:=GetStr(Lines^.At(I)); Size:=length(S); MSize:=Size;
  338. if CurPtr+Size>=T^.TextSize then
  339. MSize:=T^.TextSize-CurPtr;
  340. Move(S[1],PByteArray(T^.Text)^[CurPtr],MSize);
  341. if MSize<>Size then
  342. Break;
  343. Inc(CurPtr,Size);
  344. PByteArray(T^.Text)^[CurPtr]:=ord(hscLineBreak);
  345. Inc(CurPtr);
  346. if CurPtr>=T^.TextSize then Break;
  347. end;
  348. end;
  349. procedure BuildTopic(Lines: PUnsortedStringCollection; T: PTopic);
  350. var Size,CurPtr,MSize: sw_word;
  351. I: sw_integer;
  352. S: string;
  353. begin
  354. CurPtr:=0;
  355. for I:=0 to Lines^.Count-1 do
  356. begin
  357. S:=GetStr(Lines^.At(I));
  358. Size:=length(S);
  359. Inc(CurPtr,Size);
  360. end;
  361. Size:=CurPtr;
  362. T^.TextSize:=Size; GetMem(T^.Text,T^.TextSize);
  363. CurPtr:=0;
  364. for I:=0 to Lines^.Count-1 do
  365. begin
  366. S:=GetStr(Lines^.At(I)); Size:=length(S); MSize:=Size;
  367. if Size>0 then
  368. begin
  369. if CurPtr+Size>=T^.TextSize then
  370. MSize:=T^.TextSize-CurPtr;
  371. Move(S[1],PByteArray(T^.Text)^[CurPtr],MSize);
  372. if MSize<>Size then
  373. Break;
  374. Inc(CurPtr,Size);
  375. end;
  376. if CurPtr>=T^.TextSize then Break;
  377. end;
  378. end;
  379. procedure AddLinkToTopic(T: PTopic; AFileID: word; ACtx: THelpCtx);
  380. var NewSize: word;
  381. NewPtr: pointer;
  382. begin
  383. NewSize:=longint(T^.LinkCount+1)*sizeof(T^.Links^[0]);
  384. GetMem(NewPtr,NewSize);
  385. if Assigned(T^.Links) then
  386. begin
  387. Move(T^.Links^,NewPtr^,T^.LinkSize);
  388. FreeMem(T^.Links,T^.LinkSize);
  389. end;
  390. T^.Links:=NewPtr;
  391. with T^.Links^[T^.LinkCount] do
  392. begin
  393. FileID:=AFileID;
  394. Context:=ACtx;
  395. end;
  396. Inc(T^.LinkCount);
  397. end;
  398. function NewIndexEntry(Tag: string; FileID: word; HelpCtx: THelpCtx): PIndexEntry;
  399. var P: PIndexEntry;
  400. begin
  401. New(P); FillChar(P^,SizeOf(P^), 0);
  402. P^.Tag:=NewStr(Tag); P^.FileID:=FileID; P^.HelpCtx:=HelpCtx;
  403. NewIndexEntry:=P;
  404. end;
  405. procedure DisposeIndexEntry(P: PIndexEntry);
  406. begin
  407. if P<>nil then
  408. begin
  409. if P^.Tag<>nil then DisposeStr(P^.Tag);
  410. Dispose(P);
  411. end;
  412. end;
  413. function TTopic.LinkSize: sw_word;
  414. begin
  415. LinkSize:=LinkCount*SizeOf(Links^[0]);
  416. end;
  417. function TTopic.GetNamedMarkIndex(const MarkName: string): sw_integer;
  418. var I,Index: sw_integer;
  419. begin
  420. Index:=-1;
  421. if Assigned(NamedMarks) then
  422. for I:=0 to NamedMarks^.Count-1 do
  423. if CompareText(GetStr(NamedMarks^.At(I)),MarkName)=0 then
  424. begin
  425. Index:=I;
  426. Break;
  427. end;
  428. GetNamedMarkIndex:=Index;
  429. end;
  430. function TTopicCollection.At(Index: sw_Integer): PTopic;
  431. begin
  432. At:=inherited At(Index);
  433. end;
  434. procedure TTopicCollection.FreeItem(Item: Pointer);
  435. begin
  436. if Item<>nil then DisposeTopic(Item);
  437. end;
  438. function TTopicCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
  439. var K1: PTopic absolute Key1;
  440. K2: PTopic absolute Key2;
  441. R: Sw_integer;
  442. begin
  443. if K1^.HelpCtx<K2^.HelpCtx then R:=-1 else
  444. if K1^.HelpCtx>K2^.HelpCtx then R:= 1 else
  445. R:=0;
  446. Compare:=R;
  447. end;
  448. function TTopicCollection.SearchTopic(AHelpCtx: THelpCtx): PTopic;
  449. var T: TTopic;
  450. P: PTopic;
  451. Index: sw_integer;
  452. begin
  453. T.HelpCtx:=AHelpCtx;
  454. if Search(@T,Index) then
  455. P:=At(Index)
  456. else
  457. P:=nil;
  458. SearchTopic:=P;
  459. end;
  460. function TIndexEntryCollection.At(Index: Sw_Integer): PIndexEntry;
  461. begin
  462. At:=inherited At(Index);
  463. end;
  464. procedure TIndexEntryCollection.FreeItem(Item: Pointer);
  465. begin
  466. if Item<>nil then DisposeIndexEntry(Item);
  467. end;
  468. function TUnsortedIndexEntryCollection.At(Index: Sw_Integer): PIndexEntry;
  469. begin
  470. At:=inherited At(Index);
  471. end;
  472. procedure TUnsortedIndexEntryCollection.FreeItem(Item: Pointer);
  473. begin
  474. if Item<>nil then DisposeIndexEntry(Item);
  475. end;
  476. function TIndexEntryCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
  477. var K1: PIndexEntry absolute Key1;
  478. K2: PIndexEntry absolute Key2;
  479. R: Sw_integer;
  480. S1,S2: string;
  481. T1,T2 : PTopic;
  482. begin
  483. S1:=UpcaseStr(K1^.Tag^); S2:=UpcaseStr(K2^.Tag^);
  484. if S1<S2 then
  485. begin
  486. Compare:=-1;
  487. exit;
  488. end;
  489. if S1>S2 then
  490. begin
  491. Compare:=1;
  492. exit;
  493. end;
  494. if assigned(HelpFacility) then
  495. begin
  496. { Try to read the title of the topic }
  497. T1:=HelpFacility^.LoadTopic(K1^.FileID,K1^.HelpCtx);
  498. T2:=HelpFacility^.LoadTopic(K2^.FileID,K2^.HelpCtx);
  499. if assigned(T1^.Text) and assigned(T2^.Text) then
  500. r:=strcomp(pchar(T1^.Text),pchar(T2^.Text))
  501. else
  502. r:=0;
  503. if r>0 then
  504. begin
  505. Compare:=1;
  506. exit;
  507. end;
  508. if r<0 then
  509. begin
  510. Compare:=-1;
  511. exit;
  512. end;
  513. end;
  514. if K1^.FileID<K2^.FileID then R:=-1
  515. else if K1^.FileID>K2^.FileID then R:= 1
  516. else
  517. R:=0;
  518. Compare:=R;
  519. end;
  520. constructor THelpFile.Init(AID: word);
  521. begin
  522. inherited Init;
  523. ID:=AID;
  524. New(Topics, Init(2000,1000));
  525. New(IndexEntries, Init(2000,1000));
  526. end;
  527. procedure THelpFile.AddTopic(HelpCtx: THelpCtx; Pos: longint; const Param: string; ExtData: pointer; ExtDataSize: longint);
  528. begin
  529. Topics^.Insert(NewTopic(ID,HelpCtx,Pos,Param,ExtData,ExtDataSize));
  530. end;
  531. procedure THelpFile.AddIndexEntry(const Text: string; AHelpCtx: THelpCtx);
  532. begin
  533. IndexEntries^.Insert(NewIndexEntry(Text,ID,AHelpCtx));
  534. end;
  535. function THelpFile.LoadTopic(HelpCtx: THelpCtx): PTopic;
  536. var T: PTopic;
  537. begin
  538. T:=SearchTopic(HelpCtx);
  539. if (T<>nil) then
  540. if T^.Text=nil then
  541. begin
  542. MaintainTopicCache;
  543. if ReadTopic(T)=false then
  544. T:=nil;
  545. if (T<>nil) and (T^.Text=nil) then T:=nil;
  546. end;
  547. if T<>nil then
  548. begin
  549. T^.LastAccess:=GetDosTicks;
  550. T:=CloneTopic(T);
  551. end;
  552. LoadTopic:=T;
  553. end;
  554. function THelpFile.LoadIndex: boolean;
  555. begin
  556. Abstract;
  557. LoadIndex:=false; { remove warning }
  558. end;
  559. function THelpFile.SearchTopic(HelpCtx: THelpCtx): PTopic;
  560. var T: PTopic;
  561. begin
  562. T:=Topics^.SearchTopic(HelpCtx);
  563. SearchTopic:=T;
  564. end;
  565. function THelpFile.ReadTopic(T: PTopic): boolean;
  566. begin
  567. Abstract;
  568. ReadTopic:=false; { remove warning }
  569. end;
  570. procedure THelpFile.MaintainTopicCache;
  571. var Count: sw_integer;
  572. MinLRU: longint;
  573. procedure CountThem(P: PTopic); {$ifndef FPC}far;{$endif}
  574. begin if (P^.Text<>nil) or (P^.Links<>nil) then Inc(Count); end;
  575. procedure SearchLRU(P: PTopic); {$ifndef FPC}far;{$endif}
  576. begin if P^.LastAccess<MinLRU then begin MinLRU:=P^.LastAccess; end; end;
  577. var P: PTopic;
  578. begin
  579. Count:=0; Topics^.ForEach(@CountThem);
  580. if (Count>=TopicCacheSize) then
  581. begin
  582. MinLRU:=MaxLongint; P:=nil; Topics^.ForEach(@SearchLRU);
  583. if P<>nil then
  584. begin
  585. FreeMem(P^.Text,P^.TextSize); P^.TextSize:=0; P^.Text:=nil;
  586. FreeMem(P^.Links,P^.LinkSize); P^.LinkCount:=0; P^.Links:=nil;
  587. end;
  588. end;
  589. end;
  590. destructor THelpFile.Done;
  591. begin
  592. if Topics<>nil then Dispose(Topics, Done);
  593. if IndexEntries<>nil then Dispose(IndexEntries, Done);
  594. inherited Done;
  595. end;
  596. constructor THelpFacility.Init;
  597. begin
  598. inherited Init;
  599. New(HelpFiles, Init(10,10));
  600. IndexTabSize:=40;
  601. end;
  602. function THelpFacility.AddFile(const FileName, Param: string): PHelpFile;
  603. var H: PHelpFile;
  604. OK: boolean;
  605. I: integer;
  606. HT: THelpFileType;
  607. begin
  608. OK:=false; H:=nil;
  609. for I:=0 to GetHelpFileTypeCount-1 do
  610. begin
  611. GetHelpFileType(I,HT);
  612. H:=HT.OpenProc(FileName,Param,LastID+1);
  613. if Assigned(H) then
  614. Break;
  615. end;
  616. if Assigned(H) then
  617. OK:=AddHelpFile(H);
  618. if (not OK) and Assigned(H) then begin Dispose(H, Done); H:=nil; end;
  619. AddFile:=H;
  620. end;
  621. function THelpFacility.AddHelpFile(H: PHelpFile): boolean;
  622. begin
  623. if H<>nil then
  624. begin
  625. HelpFiles^.Insert(H);
  626. Inc(LastID);
  627. { H^.ID:=LastID; now already set by OpenProc PM }
  628. end;
  629. AddHelpFile:=H<>nil;
  630. end;
  631. function THelpFacility.SearchTopicOwner(SourceFileID: word; Context: THelpCtx): PHelpFile;
  632. var P: PTopic;
  633. HelpFile: PHelpFile;
  634. function Search(F: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
  635. begin
  636. P:=SearchTopicInHelpFile(F,Context); if P<>nil then HelpFile:=F;
  637. Search:=P<>nil;
  638. end;
  639. begin
  640. HelpFile:=nil;
  641. if SourceFileID=0 then P:=nil else
  642. begin
  643. HelpFile:=SearchFile(SourceFileID);
  644. P:=SearchTopicInHelpFile(HelpFile,Context);
  645. end;
  646. if P=nil then HelpFiles^.FirstThat(@Search);
  647. if P=nil then HelpFile:=nil;
  648. SearchTopicOwner:=HelpFile;
  649. end;
  650. function THelpFacility.LoadTopic(SourceFileID: word; Context: THelpCtx): PTopic;
  651. var P: PTopic;
  652. H: PHelpFile;
  653. begin
  654. if (SourceFileID=0) and (Context=0) then
  655. P:=BuildIndexTopic else
  656. begin
  657. H:=SearchTopicOwner(SourceFileID,Context);
  658. if (H=nil) then P:=nil else
  659. P:=H^.LoadTopic(Context);
  660. end;
  661. LoadTopic:=P;
  662. end;
  663. function THelpFacility.TopicSearch(Keyword: string; var FileID: word; var Context: THelpCtx): boolean;
  664. function ScanHelpFile(H: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
  665. function Search(P: PIndexEntry): boolean; {$ifndef FPC}far;{$endif}
  666. begin
  667. Search:=copy(UpcaseStr(P^.Tag^),1,length(Keyword))=Keyword;
  668. end;
  669. var P: PIndexEntry;
  670. begin
  671. H^.LoadIndex;
  672. P:=H^.IndexEntries^.FirstThat(@Search);
  673. if P<>nil then begin FileID:=H^.ID; Context:=P^.HelpCtx; end;
  674. ScanHelpFile:=P<>nil;
  675. end;
  676. begin
  677. Keyword:=UpcaseStr(Keyword);
  678. TopicSearch:=HelpFiles^.FirstThat(@ScanHelpFile)<>nil;
  679. end;
  680. function THelpFacility.BuildIndexTopic: PTopic;
  681. var T: PTopic;
  682. Keywords: PIndexEntryCollection;
  683. Lines: PUnsortedStringCollection;
  684. procedure InsertKeywordsOfFile(H: PHelpFile); {$ifndef FPC}far;{$endif}
  685. function InsertKeywords(P: PIndexEntry): boolean; {$ifndef FPC}far;{$endif}
  686. begin
  687. Keywords^.Insert(P);
  688. InsertKeywords:=Keywords^.Count>=MaxCollectionSize;
  689. end;
  690. begin
  691. H^.LoadIndex;
  692. if Keywords^.Count<MaxCollectionSize then
  693. H^.IndexEntries^.FirstThat(@InsertKeywords);
  694. end;
  695. procedure AddLine(S: string);
  696. begin
  697. if S='' then S:=' ';
  698. Lines^.Insert(NewStr(S));
  699. end;
  700. var Line: string;
  701. procedure FlushLine;
  702. begin
  703. if Line<>'' then AddLine(Line); Line:='';
  704. end;
  705. var KWCount,NLFlag: sw_integer;
  706. LastFirstChar: char;
  707. procedure NewSection(FirstChar: char);
  708. begin
  709. if FirstChar<=#64 then FirstChar:=#32;
  710. FlushLine;
  711. AddLine('');
  712. AddLine(FirstChar);
  713. AddLine('');
  714. LastFirstChar:=FirstChar;
  715. NLFlag:=0;
  716. end;
  717. function FormatAlias(Alias: string): string;
  718. var StartP,EndP: sw_integer;
  719. begin
  720. repeat
  721. StartP:=Pos(' ',Alias);
  722. if StartP>0 then
  723. begin
  724. EndP:=StartP;
  725. while (EndP+1<=length(Alias)) and (Alias[EndP+1]=' ') do Inc(EndP);
  726. Alias:=copy(Alias,1,StartP-1)+' | '+copy(Alias,EndP+1,High(Alias));
  727. end;
  728. until StartP=0;
  729. if Assigned(HelpFacility) then
  730. if length(Alias)>IndexTabSize-4 then
  731. Alias:=Trim(copy(Alias,1,IndexTabSize-4-2))+'..';
  732. FormatAlias:=Alias;
  733. end;
  734. procedure AddKeyword(KWS: string);
  735. begin
  736. Inc(KWCount); if KWCount=1 then NLFlag:=0;
  737. if (KWCount=1) or
  738. ( (Upcase(KWS[1])<>LastFirstChar) and ( (LastFirstChar>#64) or (KWS[1]>#64) ) ) then
  739. NewSection(Upcase(KWS[1]));
  740. KWS:=FormatAlias(KWS);
  741. if (NLFlag mod 2)=0
  742. then Line:=' '+#2+KWS+#2
  743. else begin
  744. Line:=RExpand(Line,IndexTabSize)+#2+KWS+#2;
  745. FlushLine;
  746. end;
  747. Inc(NLFlag);
  748. end;
  749. var KW: PIndexEntry;
  750. I,p : sw_integer;
  751. IsMultiple : boolean;
  752. St,LastTag : String;
  753. begin
  754. New(Keywords, Init(5000,5000));
  755. HelpFiles^.ForEach(@InsertKeywordsOfFile);
  756. New(Lines, Init((Keywords^.Count div 2)+100,1000));
  757. T:=NewTopic(0,0,0,'',nil,0);
  758. if HelpFiles^.Count=0 then
  759. begin
  760. AddLine('');
  761. AddLine(' '+msg_nohelpfilesinstalled)
  762. end else
  763. begin
  764. AddLine(' '+msg_helpindex);
  765. KWCount:=0; Line:='';
  766. T^.LinkCount:=Min(Keywords^.Count,MaxBytes div sizeof(T^.Links^[0])-1);
  767. GetMem(T^.Links,T^.LinkSize);
  768. LastTag:='';
  769. for I:=0 to T^.LinkCount-1 do
  770. begin
  771. KW:=Keywords^.At(I);
  772. IsMultiple:=(LastTag=KW^.Tag^) or
  773. ((I<T^.LinkCount-1) and (KW^.Tag^=Keywords^.At(I+1)^.Tag^));
  774. if IsMultiple then
  775. Begin
  776. St:=Trim(strpas(pchar(HelpFacility^.LoadTopic(KW^.FileID,KW^.HelpCtx)^.Text)));
  777. { Remove all special chars }
  778. for p:=1 to Length(st) do
  779. if ord(st[p])<=16 then
  780. st[p]:=' ';
  781. p:=pos(KW^.Tag^,St);
  782. if (p=1) then
  783. AddKeyword(St)
  784. else
  785. AddKeyword(KW^.Tag^+' '+St);
  786. End
  787. else
  788. AddKeyword(KW^.Tag^);
  789. LastTag:=KW^.Tag^;
  790. T^.Links^[I].Context:=longint(KW^.HelpCtx);
  791. T^.Links^[I].FileID:=KW^.FileID;
  792. end;
  793. FlushLine;
  794. AddLine('');
  795. end;
  796. RenderTopic(Lines,T);
  797. Dispose(Lines, Done);
  798. Keywords^.DeleteAll; Dispose(Keywords, Done);
  799. BuildIndexTopic:=T;
  800. end;
  801. function THelpFacility.SearchFile(ID: byte): PHelpFile;
  802. function Match(P: PHelpFile): boolean; {$ifndef FPC}far;{$endif}
  803. begin
  804. Match:=(P^.ID=ID);
  805. end;
  806. begin
  807. SearchFile:=HelpFiles^.FirstThat(@Match);
  808. end;
  809. function THelpFacility.SearchTopicInHelpFile(F: PHelpFile; Context: THelpCtx): PTopic;
  810. var P: PTopic;
  811. begin
  812. if F=nil then P:=nil else
  813. P:=F^.SearchTopic(Context);
  814. SearchTopicInHelpFile:=P;
  815. end;
  816. destructor THelpFacility.Done;
  817. begin
  818. inherited Done;
  819. Dispose(HelpFiles, Done);
  820. end;
  821. END.
  822. {
  823. $Log$
  824. Revision 1.4 2001-10-02 16:31:20 pierre
  825. * avoid crashes in topic text compares
  826. Revision 1.3 2001/10/01 00:24:09 pierre
  827. * fix several help problems
  828. Revision 1.2 2001/09/18 11:33:53 pierre
  829. * fix Previous Help Topic
  830. Revision 1.1 2001/08/04 11:30:25 peter
  831. * ide works now with both compiler versions
  832. Revision 1.1.2.6 2001/03/20 00:20:44 pierre
  833. * fix some memory leaks + several small enhancements
  834. Revision 1.1.2.5 2000/11/27 12:06:51 pierre
  835. New bunch of Gabor fixes
  836. Revision 1.1.2.4 2000/11/16 23:13:06 pierre
  837. + support for ANSI substitutes to HTML images in HTML viewer
  838. Revision 1.1.2.3 2000/11/14 09:08:51 marco
  839. * First batch IDE renamefest
  840. Revision 1.1.2.2 2000/11/12 19:48:20 hajny
  841. * OS/2 implementation of GetDosTicks added
  842. Revision 1.1.2.1 2000/09/18 13:20:56 pierre
  843. New bunch of Gabor changes
  844. Revision 1.1 2000/07/13 09:48:37 michael
  845. + Initial import
  846. Revision 1.26 2000/07/03 08:54:54 pierre
  847. * Some enhancements for WinHelp support by G abor
  848. Revision 1.25 2000/06/26 07:29:23 pierre
  849. * new bunch of Gabor's changes
  850. Revision 1.24 2000/06/22 09:07:14 pierre
  851. * Gabor changes: see fixes.txt
  852. Revision 1.23 2000/06/16 08:50:44 pierre
  853. + new bunch of Gabor's changes
  854. Revision 1.22 2000/05/31 20:42:02 pierre
  855. * fixthe TRect problem by 'using' windows before objects
  856. Revision 1.21 2000/05/30 07:18:33 pierre
  857. + colors for HTML help by Gabor
  858. Revision 1.20 2000/05/29 10:44:59 pierre
  859. + New bunch of Gabor's changes: see fixes.txt
  860. Revision 1.19 2000/04/25 08:42:35 pierre
  861. * New Gabor changes : see fixes.txt
  862. Revision 1.18 2000/04/18 11:42:38 pierre
  863. lot of Gabor changes : see fixes.txt
  864. Revision 1.17 2000/02/07 11:47:25 pierre
  865. * Remove 64Kb limitation for FPC by Gabor
  866. Revision 1.16 2000/01/03 14:59:03 marco
  867. * Fixed Linux code that got time of day. Removed Timezone parameter
  868. Revision 1.15 1999/08/16 18:25:29 peter
  869. * Adjusting the selection when the editor didn't contain any line.
  870. * Reserved word recognition redesigned, but this didn't affect the overall
  871. syntax highlight speed remarkably (at least not on my Amd-K6/350).
  872. The syntax scanner loop is a bit slow but the main problem is the
  873. recognition of special symbols. Switching off symbol processing boosts
  874. the performance up to ca. 200%...
  875. * The editor didn't allow copying (for ex to clipboard) of a single character
  876. * 'File|Save as' caused permanently run-time error 3. Not any more now...
  877. * Compiler Messages window (actually the whole desktop) did not act on any
  878. keypress when compilation failed and thus the window remained visible
  879. + Message windows are now closed upon pressing Esc
  880. + At 'Run' the IDE checks whether any sources are modified, and recompiles
  881. only when neccessary
  882. + BlockRead and BlockWrite (Ctrl+K+R/W) implemented in TCodeEditor
  883. + LineSelect (Ctrl+K+L) implemented
  884. * The IDE had problems closing help windows before saving the desktop
  885. Revision 1.14 1999/07/18 16:26:42 florian
  886. * IDE compiles with for Win32 and basic things are working
  887. Revision 1.13 1999/04/13 10:47:51 daniel
  888. * Fixed for Linux
  889. Revision 1.12 1999/04/07 21:56:00 peter
  890. + object support for browser
  891. * html help fixes
  892. * more desktop saving things
  893. * NODEBUG directive to exclude debugger
  894. Revision 1.11 1999/03/16 12:38:16 peter
  895. * tools macro fixes
  896. + tph writer
  897. + first things for resource files
  898. Revision 1.10 1999/03/08 14:58:19 peter
  899. + prompt with dialogs for tools
  900. Revision 1.9 1999/03/03 16:44:05 pierre
  901. * TPH reader fix from Peter
  902. Revision 1.8 1999/03/01 15:42:11 peter
  903. + Added dummy entries for functions not yet implemented
  904. * MenuBar didn't update itself automatically on command-set changes
  905. * Fixed Debugging/Profiling options dialog
  906. * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
  907. set
  908. * efBackSpaceUnindents works correctly
  909. + 'Messages' window implemented
  910. + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros
  911. + Added TP message-filter support (for ex. you can call GREP thru
  912. GREP2MSG and view the result in the messages window - just like in TP)
  913. * A 'var' was missing from the param-list of THelpFacility.TopicSearch,
  914. so topic search didn't work...
  915. * In FPHELP.PAS there were still context-variables defined as word instead
  916. of THelpCtx
  917. * StdStatusKeys() was missing from the statusdef for help windows
  918. + Topic-title for index-table can be specified when adding a HTML-files
  919. Revision 1.6 1999/02/20 15:18:35 peter
  920. + ctrl-c capture with confirm dialog
  921. + ascii table in the tools menu
  922. + heapviewer
  923. * empty file fixed
  924. * fixed callback routines in fpdebug to have far for tp7
  925. Revision 1.5 1999/02/19 15:43:22 peter
  926. * compatibility fixes for FV
  927. Revision 1.4 1999/02/18 13:44:37 peter
  928. * search fixed
  929. + backward search
  930. * help fixes
  931. * browser updates
  932. Revision 1.3 1999/02/08 10:37:46 peter
  933. + html helpviewer
  934. Revision 1.2 1998/12/28 15:47:56 peter
  935. + Added user screen support, display & window
  936. + Implemented Editor,Mouse Options dialog
  937. + Added location of .INI and .CFG file
  938. + Option (INI) file managment implemented (see bottom of Options Menu)
  939. + Switches updated
  940. + Run program
  941. Revision 1.4 1998/12/22 10:39:55 peter
  942. + options are now written/read
  943. + find and replace routines
  944. }