Context Navigation

source: branches/2.19.1/NewView/HelpTopic.pas@ 265

Last change on this file since 265 was 140, checked in by RBRi, 18 years ago
more refactoring
Property svn:eol-style set to `native`
File size: 70.0 KB

Line
1	Unit HelpTopic;
2
3	// NewView - a new OS/2 Help Viewer
4	// Copyright 2003 Aaron Lawrence (aaronl at consultant dot com)
5	// This software is released under the Gnu Public License - see readme.txt
6
7	Interface
8
9	// This is it - the monster which decodes IPF data.
10	// It's created with a reference to the contents data defining it.
11	// It gets relevant pointers out of that. When GetText is called
12	// it decodes the data and spits out formatted text to suit
13	// RichTextView.
14
15	uses
16	BseDos,
17	OS2Def,
18	Classes,
19	Graphics,
20	ACLString,
21	HelpWindowDimensions,
22	IPFFileFormatUnit;
23
24	const
25	DefaultGroupIndex = 0;
26
27	RTF_NewLine = #10;
28
29	// placeholder for font table entry, indiciating user fixed font should be substituted
30	SubstituteFixedFont: pointer = 1;
31
32	Type
33	THelpLink = class
34	HelpFile: TObject; // file this link is within
35
36	// Even though it doesn't do anything,
37	// we have to have a constructor to allow
38	// virtual constructors to work
39	constructor Create; virtual;
40	end;
41
42	THelpTopicSlot = class
43	pData: pUInt8;
44	Size: longint;
45	pLocalDictionary: UInt16ArrayPointer;
46	LocalDictSize: uint8;
47	destructor Destroy; override;
48	end;
49
50	THelpLinkClass = class of THelpLink;
51
52	TFootnoteHelpLink = class( THelpLink )
53	TopicIndex: longint;
54	Title: string; // from text within link
55	end;
56
57	TWindowedHelpLink = class( THelpLink )
58	GroupIndex: longint; // DefaultGroupIndex if not specified.
59	// Note: Overrides contents group index of topic
60	Automatic: boolean; // link should be automatically followed on topic display
61	Split: boolean; // link should open the window within the parent
62	ViewPort: boolean; // link should always open a new window
63	Dependent: boolean; // window opened by link should be closed
64	// when current topic is closed
65	Rect: THelpWindowRect; // Display window with this rectangle.
66	// Note: overrides contents rect
67	constructor Create; override;
68	destructor Destroy; override;
69	end;
70
71	TInternalHelpLink = class( TWindowedHelpLink )
72	TopicIndex: longint;
73	end;
74
75	THelpLinkByResourceID = class( TWindowedHelpLink )
76	ResourceID: longint;
77	end;
78
79	SlotArray = array[ 0..0 ] of THelpTopicSlot;
80
81	pSlotArray = ^SlotArray;
82
83	TFontState = ( fsNormal, fsFixed, fsCustom );
84
85	TIPFTextAlignment = ( itaLeft, itaRight, itaCenter, itaCenterOnePara );
86
87	TParseState = record
88	Alignment: TIPFTextAlignment;
89	ForegroundColorTag: string;
90	BackgroundColorTag: string;
91	Spacing: boolean;
92	FontState: TFontState;
93	InCharGraphics: boolean;
94	LinkIndex: longint;
95
96	StartOfTextBlock: longint;
97	TextBlock: TAString;
98	FootnoteLink: TFootnoteHelpLink;
99
100	StyleCode: longint;
101	end;
102
103
104	TTopic = class
105	protected
106	_FileHandle: HFILE;
107
108	_pTOCEntry: pTTOCEntryStart;
109	_pSlotOffsets: UInt32ArrayPointer;
110	_Slots: TList;
111	_pSlotNumbers: puint16;
112	_NumSlots: longint;
113	_Title: pstring;
114	_GlobalDictionary: TList;
115
116	_ShowInContents: boolean;
117	_ContentsLevel: integer;
118	_ContentsGroupIndex: longint;
119
120	_FontTable: TList;
121
122	_ReferencedFiles: TStrings;
123
124	procedure SetTitle( const NewValue: string );
125	function GetTitle: string;
126	function GetTitlePtr: pstring;
127
128	// Returns the tag texts for the given bitmap ref
129	function GetImageText( CurrentAlignment: TIPFTextAlignment;
130	BitmapOffset: longint;
131	BitmapFlags: longint;
132	ImageOffsets: TList ): string;
133
134	Procedure ProcessLinkedImage( Var State: TParseState;
135	Var pData: pByte;
136	Var OutputString: string;
137	ImageOffsets: TList );
138	procedure TranslateIPFEscapeCode( Var State: TParseState;
139	Var pData: pUInt8;
140	Text: TAString;
141	Var WordsOnLine: longint;
142	ImageOffsets: TList );
143
144	function CreateLink( Var LinkIndex: longint;
145	Var Link: THelpLink;
146	LinkClass: THelpLinkClass ): boolean;
147
148	procedure EnsureSlotsLoaded;
149
150	// returns true if the escape code at pData results in whitespace.
151	function IPFEscapeCodeSpace( Var State: TParseState;
152	Var pData: pUInt8 ): boolean;
153
154	function GetNextIPFTextItem( Var SlotIndex: longint;
155	Var pData: pUInt8;
156	Var State: TParseState ): longint;
157
158	function CheckForSequence( WordSequences: TList;
159	SlotIndex: longint;
160	pData: pUint8;
161	State: TParseState;
162
163	GlobalDictIndex: longint;
164	): longint;
165
166	public
167	constructor Create( FileHandle: HFILE;
168	pSlotOffsets: UInt32ArrayPointer;
169	Dictionary: TList;
170	pTOCEntry: pTTOCEntryStart;
171	FontTable: TList;
172	ReferencedFiles: TStrings );
173
174	destructor destroy; override;
175
176	property Title: string read GetTitle write SetTitle;
177	property TitlePtr: pstring read GetTitlePtr;
178
179	procedure SetTitleFromMem( const p: pointer; const Len: byte );
180	// Main function for retrieving text for topic.
181	// HighlightSequences: list of sequences to highlight
182	// if nil then ignored.
183	// ShowCodes: indicates debugging: hex output of escape
184	// codes will be included
185	// ShowWordSeparators: \| will be included after each dictionary
186	// word inserted
187	// Text: The output is written to here. IS NOT CLEARED FIRST.
188	// ImageOffsets: For each image that occurs in the text,
189	// the help file offset will be written to this list.
190	// HighlightMatches: if not nil, and HighlightSequences is not nil,
191	// will return offsets to each highlight match
192	procedure GetText( HighlightSequences: TList;
193	ShowCodes: boolean;
194	ShowWordSeparators: boolean;
195	Text: TAString;
196	ImageOffsets: TList;
197	HighlightMatches: TList );
198
199	// if StopAtFirstOccurrence true, returns 0 or 1
200	// if false, returns count of occurrences of word
201	function SearchForWord( DictIndex: integer;
202	StopAtFirstOccurrence: boolean ): longint;
203
204	// searches for sequences out of those listed in WordSequence
205	// Each element of WordSequence contains a pointer to an array
206	// of flags for each dictionary word, indicating whether that word
207	// is to be a possible match.
208	function SearchForWordSequences( WordSequence: TList;
209	StopAtFirstOccurrence: boolean ): longint;
210
211	procedure GetContentsWindowRect( ContentsRect: THelpWindowRect );
212
213	// search for binary data including codes
214	function SearchForData( Data: pbyte;
215	DataLen: integer ): boolean;
216
217	procedure SaveIPFEscapeCode( Var State: TParseState;
218	Var pData: pUInt8;
219	Var F: TextFile;
220	ImageOffsets: TList );
221
222	procedure SaveToIPF( Var f: TextFile;
223	ImageOffsets: TList );
224
225	Links: TList; // only valid after GetText
226
227	property ShowInContents: boolean read _ShowInContents;
228	property ContentsLevel: integer read _ContentsLevel;
229	property ContentsGroupIndex: longint read _ContentsGroupIndex;
230
231	function CountWord( DictIndex: integer ): longint;
232	function ContainsWord( DictIndex: integer ): boolean;
233
234	// Used externally
235	HelpFile: TObject;
236	Index: longint;
237
238	SearchRelevance: longint;
239	end;
240
241	// Compares two topics for purposes of sorting by
242	// search match relevance
243	function TopicRelevanceCompare( Item1, Item2: pointer ): longint;
244
245	// Compares two topics for purposes of sorting by
246	// title
247	function TopicTitleCompare( Item1, Item2: pointer ): longint;
248
249	Implementation
250
251	uses
252	SysUtils,
253	NewViewConstantsUnit,
254	ACLUtility,
255	ACLFileIOUtility,
256	AStringUtilityUnit,
257	ACLLanguageUnit,
258	StringUtilsUnit,
259	CharUtilsUnit,
260	SettingsUnit;
261
262	const
263	IPFColors: array[ 0..15 ] of string =
264	(
265	//rrggbb
266	'', // default
267	'#0000ff', // blue
268	'#ff0000', // red
269	'#ff00ff', // pink (purple)
270	'#00ff00', // green
271	'#00ffff', // cyan
272	'#ffff00', // yellow
273	'#808000', // neutral = brown
274	'#404040', // dark gray
275	'#000080', // dark blue
276	'#800000', // dark red
277	'#800080', // dark pink (purple)
278	'#008000', // dark green
279	'#008080', // dark cyan
280	'#000000', // black
281	'#c0c0c0' // pale gray
282	);
283
284	// for ecHighlight1
285	IPFHighlight1Tags : array [ 0..6 ] of string =
286	(
287	'</i></b></u></color>', // normal
288	'<i>', // hp1 italitc
289	'<b>', // hp2 bold
290	'<b><i>', // hp3 bold italic
291	'<u>', // hp5 underline
292	'<u><i>', // hp6 underline italic
293	'<u><b>' // hp7 underline bold
294	);
295
296	// for ecHighlight2
297	IPFHighlight2Tags : array [ 0..3 ] of string =
298	(
299	'</i></b></u></color>', // normal
300	'<color blue>', // hp4 blue
301	'<color red>', // hp8 red
302	'<color purple>' // hp9 purple
303	);
304
305	BlankString: string = '';
306
307	var
308	DefaultTitle: string;
309
310	Procedure OnLanguageEvent( Language: TLanguageFile;
311	const Apply: boolean );
312	begin
313	Language.Prefix := 'HelpTopic.';
314	Language.LL( Apply, DefaultTitle, 'DefaultTitle', '(No title)' );
315	end;
316
317
318	function GetBeginLink( LinkIndex: longint ): string;
319	begin
320	Result := '<link '
321	+ IntToStr( LinkIndex )
322	+ '>'
323	end;
324
325	function GetEndLinkTags( const State: TParseState ): string;
326	begin
327	Result := '</link>'
328	+ State.ForegroundColorTag;
329	end;
330
331
332	// Even though it doesn't do anything,
333	// we have to have a constructor to allow
334	// virtual constructors to work
335	constructor THelpLink.Create;
336	begin
337	end;
338
339	constructor TWindowedHelpLink.Create;
340	begin
341	GroupIndex := DefaultGroupIndex;
342	Automatic := false;
343	ViewPort := false;
344	Dependent := false;
345
346	Rect := THelpWindowRect.Create;
347	end;
348
349	destructor TWindowedHelpLink.Destroy;
350	begin
351	Rect.Destroy;
352	end;
353
354	destructor THelpTopicSlot.Destroy;
355	begin
356	DeallocateMemory( pData );
357	DeallocateMemory( pLocalDictionary );
358	end;
359
360	constructor TTopic.Create( FileHandle: HFILE;
361	pSlotOffsets: UInt32ArrayPointer;
362	Dictionary: TList;
363	pTOCEntry: pTTOCEntryStart;
364	FontTable: TList;
365	ReferencedFiles: TStrings );
366	var
367	pExtendedInfo: pExtendedTOCEntry;
368	titleLen: integer;
369	XY: THelpXYPair;
370	p: pbyte;
371
372	Flags: byte;
373
374	begin
375	_FileHandle := FileHandle;
376	_pSlotOffsets := pSlotOffsets;
377
378	_Title := nil;
379	_GlobalDictionary := Dictionary;
380	_ContentsGroupIndex := 0;
381
382	_pTOCEntry := pTOCEntry;
383	_NumSlots := pTOCEntry ^. numslots;
384
385	Flags := _pTOCEntry ^. flags;
386	p := pUInt8( _pTOCEntry ) + sizeof( TTOCEntryStart );
387
388	if ( Flags and TOCEntryExtended ) > 0 then
389	begin
390	pExtendedInfo := pExtendedTOCEntry( p );
391	inc( p, sizeof( TExtendedTOCEntry ) );
392
393	if ( pExtendedInfo^.w1 and 1 ) > 0 then
394	// skip position
395	inc( p, sizeof( XY ) );
396
397	if ( pExtendedInfo^.w1 and 2 ) > 0 then
398	// skip size
399	inc( p, sizeof( XY ) );
400
401	if ( pExtendedInfo^.w1 and 8 ) > 0 then
402	// skip window controls
403	inc( p, 2 );
404
405	if ( pExtendedInfo^.w1 and $40 ) > 0 then
406	// skip something else, unknown... style? 2 bytes
407	inc( p, 2 );
408
409	if ( pExtendedInfo^.w2 and 4 ) > 0 then
410	begin
411	_ContentsGroupIndex := pUInt16( p )^;
412	// read group
413	inc( p, sizeof( uint16 ) );
414	end;
415	end;
416
417	// skip slot numbers for now.
418	_pSlotNumbers := puint16( p );
419	inc( p, _NumSlots * sizeof( uint16 ) );
420
421	titleLen := _pTOCEntry ^.length
422	- ( longword( p ) - longword( _pTOCEntry ) );
423
424	// Read title
425	if TitleLen > 0 then
426	SetTitleFromMem( p, TitleLen )
427	else
428	Title := DefaultTitle;
429
430	_ContentsLevel := ( Flags and $f );
431	_ShowInContents := Flags and TOCEntryHidden = 0;
432	if _ContentsLevel = 0 then
433	_ShowInContents := false; // hmmm....
434
435	_FontTable := FontTable;
436	_ReferencedFiles := ReferencedFiles;
437	end;
438
439	destructor TTopic.Destroy;
440	begin
441	DestroyListAndObjects( Links );
442	FreePString( _Title );
443	DestroyListAndObjects( _Slots );
444	end;
445
446	procedure TTopic.SetTitle( const NewValue: string );
447	begin
448	FreePString( _Title );
449	_Title := NewPString( NewValue );
450	end;
451
452	procedure TTopic.SetTitleFromMem( const p: pointer; const Len: byte );
453	begin
454	FreePString( _Title );
455	GetMem( _Title, Len + 1 );
456	_Title^[ 0 ] := char( Len );
457	MemCopy( p, _Title + 1, Len );
458	end;
459
460	function TTopic.GetTitle: string;
461	begin
462	Result := _Title^;
463	end;
464
465	function TTopic.GetTitlePtr: pstring;
466	begin
467	Result := _Title;
468	end;
469
470	// Replace < and > characters with doubles << and >>
471	// for compatibility with richtextview.
472	// This works in place, assuming that instances of > or < are
473	// actually rare. In practice, IPF normally would insert these
474	// two characters as distinct words, but I don't want to assume that.
475	procedure SubstituteAngleBrackets( Var s: string );
476	var
477	i: integer;
478	begin
479	i := 1;
480	while i <= Length( S ) do
481	begin
482	case S[ i ] of
483	'<':
484	begin
485	Insert( '<', s, i );
486	inc( i );
487	end;
488
489	'>':
490	begin
491	Insert( '>', s, i );
492	inc( i );
493	end;
494	end;
495	inc( i );
496	end;
497	end;
498
499	function TTopic.GetImageText( CurrentAlignment: TIPFTextAlignment;
500	BitmapOffset: longint;
501	BitmapFlags: longint;
502	ImageOffsets: TList ): string;
503	var
504	BitmapIndex: longint;
505	OriginalAlignTag: string;
506	ImageTag: string;
507	AlignTag: string;
508	begin
509	BitmapIndex := ImageOffsets.IndexOf( pointer( BitmapOffset ) );
510	if BitmapIndex = -1 then
511	BitmapIndex := ImageOffsets.Add( pointer( BitmapOffset ) );
512
513	ImageTag := '<image '
514	+ IntToStr( BitmapIndex )
515	+ '>';
516
517	if ( BitmapFlags and $08 ) > 0 then
518	begin
519	// stretch to fit - not implemented
520	end;
521
522	// aligned
523	case CurrentAlignment of
524	itaLeft:
525	OriginalAlignTag := '<align left>';
526	itaRight:
527	OriginalAlignTag := '<align right>';
528	itaCenter,
529	itaCenterOnePara:
530	OriginalAlignTag := '<align center>';
531	end;
532
533	case BitmapFlags and 7 of
534	0, // curious - should not occur? does in dbexpert.hlp
535	1: // left
536	AlignTag := '<align left>';
537	2: // right
538	AlignTag := '<align right>';
539	4,5: // centre (4 is official, 5 seems to occur too)
540	AlignTag := '<align center>';
541	end;
542
543	Result := AlignTag
544	+ ImageTag
545	+ OriginalAlignTag;
546
547	if ( BitmapFlags and $10 ) = 0 then
548	begin
549	// NOT runin, new lines before and after
550	Result := RTF_NewLine + Result + RTF_NewLine;
551	end;
552
553	end;
554
555	Procedure SaveImageText( BitmapOffset: longint;
556	BitmapFlags: longint;
557	Var F: TextFile;
558	ImageOffsets: TList );
559	var
560	ImageIndex: longint;
561	begin
562	ImageIndex := ImageOffsets.IndexOf( pointer( BitmapOffset ) );
563	if ImageIndex = -1 then
564	ImageIndex := ImageOffsets.Add( pointer( BitmapOffset ) );
565
566	Write( F, ':artwork name=' );
567	Write( F, StrInSingleQuotes('img' + IntToStr(ImageIndex) + '.bmp') );
568
569	case BitmapFlags and 7 of
570	2: // right
571	Write( F, ' align=right' );
572	4,5: // centre (4 is official, 5 seems to occur too)
573	Write( F, ' align=center' );
574	end;
575
576	if ( BitmapFlags and $10 ) > 0 then
577	begin
578	// runin
579	Write( F, ' runin' );
580	end;
581
582	// fit ...
583	Write( F, '.' );
584	end;
585
586	Procedure TTopic.ProcessLinkedImage( Var State: TParseState;
587	Var pData: pByte;
588	Var OutputString: string;
589	ImageOffsets: TList );
590	var
591	EscapeLen: uint8;
592	EscapeCode: uint8;
593	SubEscapeCode: uint8;
594	BitmapOffset: longword;
595	BitmapFlags: uint8;
596	Link: TInternalHelpLink;
597	LinkTopicIndex: uint16;
598	begin
599	LinkTopicIndex := -1;
600	while true do
601	begin
602	EscapeLen := pData^;
603	SubEscapeCode := ( pData + 2 )^;
604	case SubEscapeCode of
605	HPART_DEFINE:
606	begin
607	BitmapFlags := ( pData + 3 )^;
608	BitmapOffset := pUInt32( pData + 4 )^;
609	end;
610
611	HPART_HDREF: // define whole bitmap topic link?
612	begin
613	LinkTopicIndex := pUInt16( pData + 3 )^;
614	end;
615	end;
616	inc( pData, EscapeLen );
617
618	// Now pData points at next code or item
619	if pData^ <> IPF_ESC then
620	// not an escape code, done
621	break;
622	EscapeCode := (pData + 2) ^;
623	if EscapeCode <> ecLinkedImage then
624	// not a hyperlink code, done
625	break;
626	// another linked image code is coming up.
627	SubEscapeCode := ( pData + 3 )^;
628	if SubEscapeCode = HPART_DEFINE then
629	// started another linked image.
630	break;
631	inc( pData ); // move pointer to escape code len.
632	end;
633
634	OutputString := GetImageText( State.Alignment,
635	BitmapOffset,
636	BitmapFlags,
637	ImageOffsets );
638
639	// Don't make it a link if we didn't find a
640	// overall link code, i.e. degrade gracefully.
641	if LinkTopicIndex > -1 then
642	begin
643	if CreateLink( State.LinkIndex, Link, TInternalHelpLink ) then
644	begin
645	Link.TopicIndex := LinkTopicIndex;
646	end;
647
648	OutputString := GetBeginLink( State.LinkIndex )
649	+ OutputString
650	+ GetEndLinkTags( State );
651
652	inc( State.LinkIndex );
653	end;
654
655	end;
656
657	Procedure SaveLinkedImage( Var pData: pByte;
658	Var F: TextFile;
659	ImageOffsets: TList );
660	var
661	EscapeLen: uint8;
662	EscapeCode: uint8;
663	SubEscapeCode: uint8;
664	BitmapOffset: longword;
665	BitmapFlags: uint8;
666	LinkTopicIndex: uint16;
667	begin
668	LinkTopicIndex := -1;
669	while true do
670	begin
671	EscapeLen := pData^;
672	SubEscapeCode := ( pData + 2 )^;
673	case SubEscapeCode of
674	HPART_DEFINE:
675	begin
676	BitmapFlags := ( pData + 3 )^;
677	BitmapOffset := pUInt32( pData + 4 )^;
678	end;
679
680	HPART_HDREF: // define whole bitmap topic link?
681	begin
682	LinkTopicIndex := pUInt16( pData + 3 )^;
683	end;
684	end;
685	inc( pData, EscapeLen );
686
687	// Now pData points at next code or item
688	if pData^ <> IPF_ESC then
689	// not an escape code, done
690	break;
691	EscapeCode := (pData + 2) ^;
692	if EscapeCode <> ecLinkedImage then
693	// not a hyperlink code, done
694	break;
695	// another linked image code is coming up.
696	SubEscapeCode := ( pData + 3 )^;
697	if SubEscapeCode = HPART_DEFINE then
698	// started another linked image.
699	break;
700	inc( pData ); // move pointer to escape code len.
701	end;
702
703	SaveImageText( BitmapOffset,
704	BitmapFlags,
705	F,
706	ImageOffsets );
707
708	// Don't make it a link if we didn't find a
709	// overall link code, i.e. degrade gracefully.
710	if LinkTopicIndex > -1 then
711	begin
712	WriteLn( F, '' );
713	WriteLn( F, ':artlink.' );
714	Write( F, ':link reftype=hd' );
715	Write( F, ' refid=' + IntToStr( LinkTopicIndex ) );
716	WriteLn( F, '.' );
717	WriteLn( F, ':eartlink.' );
718	end;
719
720	end;
721
722	Procedure GetExtraLinkData( Link: TWindowedHelpLink;
723	pData: pUInt8 );
724	var
725	LinkFlags1: uint8;
726	LinkFlags2: uint8;
727	LinkDataIndex: longint;
728	pLinkXY: pHelpXYPair;
729	pLinkData: pUInt8;
730	begin
731	LinkFlags1 := ( pData + 0 ) ^;
732	LinkFlags2 := ( pData + 1 ) ^;
733
734	pLinkData := pData + 2;
735
736	if ( LinkFlags1 and 1 ) > 0 then
737	begin
738	// position specified
739	pLinkXY := pHelpXYPair( pLinkData );
740	ReadHelpPosition( pLinkXY^, Link.Rect );
741	inc( pLinkData, sizeof( THelpXYPair ) );
742	end;
743
744	if ( LinkFlags1 and 2 ) > 0 then
745	begin
746	// size specified
747	pLinkXY := pHelpXYPair( pLinkData );
748	ReadHelpSize( pLinkXY^, Link.Rect );
749	inc( pLinkData, sizeof( THelpXYPair ) );
750	end;
751
752	if ( LinkFlags1 and 8 ) > 0 then
753	begin
754	// window controls specified - skip
755	inc( pLinkData, 2 );
756	end;
757
758	if ( LinkFlags2 and 4 ) > 0 then
759	begin
760	// group specified
761	Link.GroupIndex := pUInt16( pLinkData )^;
762	inc( LinkDataIndex, sizeof( uint16 ) );
763	end;
764
765	if ( LinkFlags1 and 64 ) > 0 then
766	begin
767	Link.Automatic := true;
768	end;
769
770	if ( LinkFlags1 and 4 ) > 0 then
771	Link.ViewPort := true;
772
773	if ( LinkFlags2 and 2 ) > 0 then
774	Link.Dependent := true;
775
776	if ( LinkFlags1 and 128 ) > 0 then
777	Link.Split := true;
778
779	// cant be bothered with the others.
780	end;
781
782	// If the given link has already been decoded
783	// ie. the topic has been displayed before,
784	// then return the already decoded link & return false
785	// Otherwise, create a new link object & return true
786	function TTopic.CreateLink( Var LinkIndex: longint;
787	Var Link: THelpLink;
788	LinkClass: THelpLinkClass ): boolean;
789	begin
790	if LinkIndex >= Links.Count then
791	begin
792	Link := LinkClass.Create;
793	Link.HelpFile := HelpFile;
794	Links.Add( Link );
795	Result := true;
796	end
797	else
798	begin
799	Link := Links[ LinkIndex ];
800	Result := false;
801	end;
802	end;
803
804	const
805	// size of the original View's default font
806	AverageViewCharWidth = 8;
807
808	procedure GetMarginTag( const Margin: longint;
809	FontState: TFontState;
810	Var MarginString: string;
811	BreakIfPast: boolean );
812	begin
813	MarginString := '<leftmargin ';
814	if FontState <> fsCustom then
815	// for standard fonts, scale margins to match font
816	MarginString := MarginString + IntToStr( Margin )
817	else
818	// for custom fonts, since the IPF margins were always in
819	// terms of the standard font size, set the margin to a width based on that.
820	MarginString := MarginString + IntToStr( Margin * AverageViewCharWidth ) + ' pixels';
821
822	if BreakIfPast then
823	MarginString := MarginString + ' breakifpast';
824
825	MarginString := MarginString + '>';
826	end;
827
828	// TODO
829	function FullDoubleQuote( const s: string ): string;
830	begin
831	Result := StrDoubleQuote
832	+ StrEscapeAllCharsBy(s, [], CharDoubleQuote)
833	+ StrDoubleQuote;
834	end;
835
836	// End URL, if it has been started. Go back and insert the start tag,
837	// and add the end tag.
838	procedure CheckForAutoURL( Text: TAString;
839	var State: TParseState );
840	var
841	T: TAstring;
842	begin
843	if State.StartOfTextBlock = -1 then
844	// haven't got any text yet
845	exit;
846
847	TrimPunctuation( State.TextBlock );
848
849	if not IsURL( State.TextBlock ) then
850	begin
851	// not a URL we know
852	State.TextBlock.Clear;
853	exit;
854	end;
855
856	// It's a URL. Insert link at start of URL
857
858	T := TAstring.Create;
859	T.AddString( '<blue><link ' + PARAM_LINK_URL + ' "' );
860	T.Add( State.TextBlock );
861	T.AddString( '">' );
862
863	Text.Insert( State.StartOfTextBlock, T );
864
865	T.Destroy;
866
867	Text.AddString( GetEndLinkTags( State ) );
868
869	State.TextBlock.Clear;
870	State.StartOfTextBlock := -1;
871	end;
872
873	procedure TTopic.TranslateIPFEscapeCode( Var State: TParseState;
874	Var pData: pUInt8;
875	Text: TAString;
876	Var WordsOnLine: longint;
877	ImageOffsets: TList );
878	var
879	EscapeLen: uint8;
880	EscapeCode: uint8;
881
882	Link: TInternalHelpLink;
883	FootnoteLink: TFootnoteHelpLink;
884	LinkByResourceID: THelpLinkByResourceID;
885
886	Margin: integer;
887
888	BitmapOffset: longword;
889	BitmapFlags: uint8;
890
891	ColorCode: uint8;
892	StyleCode: uint8;
893
894	FontIndex: uint8;
895	pFontSpec: pTHelpFontSpec;
896
897	FaceName: string;
898	PointSize: longint;
899	QuotedFaceName: string;
900
901	ExternalLinkFileIndex: uint8;
902	ExternalLinkTopicID: string;
903
904	ProgramLink: string;
905	ProgramPath: string;
906	ProgramFilename: string;
907	ProgramInfo : TSerializableStringList;
908	tmpProgramLinkParts : TStringList;
909
910	OutputString: string;
911	begin
912	EscapeLen := pData^;
913	EscapeCode := (pData + 1) ^;
914	OutputString := '';
915
916	case EscapeCode of
917
918	ecSetLeftMargin:
919	begin
920	CheckForAutoURL( Text, State );
921	Margin := integer( ( pData + 2 )^ );
922	GetMarginTag( Margin, State.FontState, OutputString, false );
923	end;
924
925	ecSetLeftMarginNewLine:
926	begin
927	CheckForAutoURL( Text, State );
928	Margin := integer( ( pData + 2 )^ );
929	GetMarginTag( Margin, State.FontState, OutputString, false );
930	OutputString := OutputString
931	+ RTF_NewLine;
932	end;
933
934	ecSetLeftMarginFit:
935	begin
936	CheckForAutoURL( Text, State );
937	Margin := integer( ( pData + 2 )^ );
938	GetMarginTag( Margin, State.FontState, OutputString, true );
939	// note that this will cause following tex to be "tabbed" across to the
940	// new margin position, if not yet there.
941	// if we are already past this margin then a new line should be started.
942
943	end;
944
945	ecSetLeftMarginHere:
946	begin
947	OutputString := '<leftmargin here>';
948	end;
949
950	ecHighlight1:
951	begin
952	StyleCode := ( pData + 2 ) ^;
953	if StyleCode <= High( IPFHighlight1Tags ) then
954	OutputString := IPFHighlight1Tags[ StyleCode ];
955	if StyleCode = 0 then
956	State.ForegroundColorTag := '</color>';
957	end;
958
959	ecHighlight2:
960	begin
961	StyleCode := ( pData + 2 ) ^;
962	if StyleCode <= High( IPFHighlight2Tags ) then
963	OutputString := IPFHighlight2Tags[ StyleCode ];
964
965	if StyleCode = 0 then
966	State.ForegroundColorTag := '</color>'
967	else
968	State.ForegroundColorTag := OutputString; // only colours
969	end;
970
971	ecLinkStart:
972	begin
973	CheckForAutoURL( Text, State );
974	if CreateLink( State.LinkIndex, Link, TInternalHelpLink ) then
975	begin
976	Link.TopicIndex := pUInt16( pData + 2 )^;
977
978	if EscapeLen >= 6 then
979	begin
980	GetExtraLinkData( Link, pData + 4 );
981	end;
982	end;
983
984	// If it's not an automatic link
985	// then put code in to show it.
986	if not Link.Automatic then
987	begin
988	OutputString := '<blue>'
989	+ GetBeginLink( State.LinkIndex );
990	end;
991
992	inc( State.LinkIndex );
993	end;
994
995	ecFootnoteLinkStart:
996	begin
997	CheckForAutoURL( Text, State );
998	if CreateLink( State.LinkIndex, FootnoteLink, TFootnoteHelpLink ) then
999	begin
1000	FootnoteLink.TopicIndex := pUInt16( pData + 2 )^;
1001	State.FootnoteLink := FootnoteLink;
1002	end;
1003
1004	OutputString := '<blue>'
1005	+ GetBeginLink( State.LinkIndex );
1006
1007	inc( State.LinkIndex );
1008	end;
1009
1010	ecStartLinkByResourceID:
1011	begin
1012	CheckForAutoURL( Text, State );
1013	if CreateLink( State.LinkIndex, LinkByResourceID, THelpLinkByResourceID ) then
1014	begin
1015	LinkByResourceID.ResourceID := pUInt16( pData + 2 )^;
1016
1017	if EscapeLen >= 6 then
1018	begin
1019	GetExtraLinkData( LinkByResourceID, pData + 4 );
1020	end;
1021	end;
1022
1023	OutputString := '<blue>'
1024	+ GetBeginLink( State.LinkIndex );
1025
1026	inc( State.LinkIndex );
1027	end;
1028
1029	ecExternalLink:
1030	begin
1031	CheckForAutoURL( Text, State );
1032	// :link reftype=hd refid=... database=<filename>
1033	ExternalLinkFileIndex := ( pData + 2 )^;
1034	ExternalLinkTopicID := StrPasWithLength( pchar( pData + 4 ), ( pData + 3 )^ );
1035	OutputString := '<blue><link ' + PARAM_LINK_EXTERNAL + ' '
1036	+ IntToStr( ExternalLinkFileIndex )
1037	+ ' '
1038	+ ExternalLinkTopicID
1039	+ '>'
1040
1041	end;
1042
1043	ecProgramLink:
1044	begin
1045	CheckForAutoURL( Text, State );
1046	ProgramLink := StrPasWithLength( pchar( pData + 3 ), EscapeLen - 3 );
1047
1048	tmpProgramLinkParts := TStringList.Create;
1049	StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0);
1050	ProgramPath := tmpProgramLinkParts[0];
1051	tmpProgramLinkParts.Destroy;
1052
1053	ProgramFilename := ExtractFilename( ProgramPath );
1054
1055	if StrStartsWithIgnoringCase(PRGM_EXPLORER, ProgramFilename ) // web explorer?
1056	or StrStartsWithIgnoringCase(PRGM_NETSCAPE, ProgramFilename )
1057	or StrStartsWithIgnoringCase(PRGM_MOZILLA, ProgramFilename )
1058	or StrStartsWithIgnoringCase(PRGM_FIREFOX, ProgramFilename )
1059	then
1060	begin
1061	OutputString := '<blue><link ' + PARAM_LINK_URL + ' '
1062	+ FullDoubleQuote( ProgramLink )
1063	+ '>';
1064	end
1065	else
1066	begin
1067	ProgramInfo := TSerializableStringList.create;
1068	ProgramInfo.add(ProgramPath);
1069	ProgramInfo.add(ProgramLink);
1070	OutputString := '<blue><link ' + PARAM_LINK_PROGRAM + ' '
1071	+ ProgramInfo.getSerializedString
1072	+ '>';
1073	ProgramInfo.destroy;
1074	end;
1075	end;
1076
1077	ecLinkEnd:
1078	begin
1079	OutputString := GetEndLinkTags( State );
1080	if State.FootnoteLink <> nil then
1081	State.FootnoteLink := nil;
1082	end;
1083
1084	ecStartCharGraphics:
1085	begin
1086	State.FontState := fsFixed;
1087	State.InCharGraphics := true;
1088	OutputString := RTF_NewLine + RTF_NewLine + '<tt><wrap no>';
1089	State.Spacing := false;
1090	WordsOnLine := 0;
1091	end;
1092
1093	ecEndCharGraphics:
1094	begin
1095	State.FontState := fsNormal;
1096	State.InCharGraphics := false;
1097	OutputString := '</tt><wrap yes>' + RTF_NewLine;
1098	State.Spacing := true;
1099	end;
1100
1101	ecImage:
1102	begin
1103	CheckForAutoURL( Text, State );
1104	BitmapFlags := ( pData + 2 )^;
1105	BitmapOffset := pUInt32( pData + 3 )^;
1106
1107	OutputString := GetImageText( State.Alignment,
1108	BitmapOffset,
1109	BitmapFlags,
1110	ImageOffsets );
1111	if State.Spacing
1112	AND (OutputString[Length(OutputString)] <> RTF_NewLine) // no space after a line break
1113	then
1114	OutputString := OutputString + ' ';
1115	end;
1116
1117	ecLinkedImage:
1118	begin
1119	CheckForAutoURL( Text, State );
1120	ProcessLinkedImage( State,
1121	pData,
1122	OutputString,
1123	ImageOffsets );
1124	if State.Spacing then
1125	OutputString := OutputString + ' ';
1126
1127	// Note! Early exit, since the procedure
1128	// will update pData.
1129	Text.AddString( OutputString );
1130	exit;
1131	end;
1132
1133	ecStartLines:
1134	begin
1135	CheckForAutoURL( Text, State );
1136	// aligned text
1137	case ( pData + 2 )^ of
1138	0, // just in case - to match image alignment oddities
1139	1:
1140	begin
1141	OutputString := RTF_NewLine + '<align left>';
1142	State.Alignment := itaLeft;
1143	end;
1144
1145	2:
1146	begin
1147	OutputString := RTF_NewLine + '<align right>';
1148	State.Alignment := itaRight;
1149	end;
1150
1151	4:
1152	begin
1153	OutputString := RTF_NewLine + '<align center>';
1154	State.Alignment := itaCenter;
1155	end;
1156	end;
1157	OutputString := OutputString + '<wrap no>';
1158	WordsOnLine := 0;
1159	end;
1160
1161	ecEndLines:
1162	begin
1163	CheckForAutoURL( Text, State );
1164	// supposed to turn word wrap on, default font
1165	OutputString := '<align left><wrap yes>'; // I guess...
1166	State.Alignment := itaLeft;
1167	end;
1168
1169	ecForegroundColor:
1170	begin
1171	ColorCode := ( pData + 2 )^;
1172	if ColorCode = 0 then
1173	State.ForegroundColorTag := '</color>'
1174	else if ColorCode <= High( IPFColors ) then
1175	State.ForegroundColorTag := '<color ' + IPFColors[ ColorCode ] + '>';
1176	OutputString := State.ForegroundColorTag;
1177	end;
1178
1179	ecBackgroundColor:
1180	begin
1181	ColorCode := ( pData + 2 )^;
1182	if ColorCode = 0 then
1183	State.BackgroundColorTag := '</backcolor>'
1184	else if ColorCode <= High( IPFColors ) then
1185	State.BackgroundColorTag := '<backcolor ' + IPFColors[ ColorCode ] + '>';
1186	OutputString := State.BackgroundColorTag;
1187	end;
1188
1189	ecFontChange:
1190	begin
1191	FontIndex := ( pData + 2 )^;
1192	if FontIndex = 0 then
1193	begin
1194	// back to default font
1195	OutputString := '</font>';
1196	State.FontState := fsNormal;
1197	end
1198	else if FontIndex < _FontTable.Count then
1199	begin
1200	// valid font index
1201	pFontSpec := _FontTable[ FontIndex ];
1202
1203	if pFontSpec = SubstituteFixedFont then
1204	begin
1205	OutputString := '<tt>';
1206	State.FontState := fsFixed;
1207	end
1208	else
1209	begin
1210	pFontSpec := _FontTable[ FontIndex ];
1211	FaceName := StrPasWithLength( pFontSpec ^. FaceName,
1212	sizeof( pFontSpec ^. FaceName ) );
1213	// arbitrarily and capriciously use specified height * 2/3
1214	// as the point size - seems to correspond to what original
1215	// view wanted... note this doesn't necessarily scale
1216	// correctly, since default font could be different. whatever.
1217	PointSize := pFontSpec ^. Height * 2 div 3;
1218
1219	if PointSize < 8 then
1220	PointSize := 8;
1221	// quote font name, escape double quotes with duplicates
1222	// e.g. Bob's "Big" Font would become
1223	// "Bob's ""Big"" Font"
1224	QuotedFaceName := FullDoubleQuote( FaceName );
1225	OutputString := '<font '
1226	+ QuotedFaceName
1227	+ ' '
1228	+ IntToStr( PointSize )
1229	+ '>';
1230	{
1231	// for when (if ever) RTV allows setting font
1232	// by precise dimensions
1233	+ '['
1234	+ IntToStr( pFontSpec ^. Width )
1235	+ 'x'
1236	+ IntToStr( pFontSpec ^. Height )
1237	+ ']';
1238	}
1239	State.FontState := fsCustom;
1240	end;
1241	end;
1242	end
1243	end; // case escape code of...
1244
1245	Text.AddString( OutputString );
1246
1247	inc( pData, EscapeLen );
1248	end;
1249
1250	// returns true if the escape code results in whitespace
1251	// also updates the bits of State that relate to spacing
1252	// ie. .Spacing, and .InCharGraphics (which affects whether
1253	// spacing is reset at paragraph ends etc)
1254	function TTopic.IPFEscapeCodeSpace( Var State: TParseState;
1255	Var pData: pUInt8 ): boolean;
1256	var
1257	EscapeLen: uint8;
1258	EscapeCode: uint8;
1259
1260	begin
1261	EscapeLen := pData^;
1262	EscapeCode := (pData + 1) ^;
1263
1264	result := false; // for most
1265	case EscapeCode of
1266	ecSetLeftMargin,
1267	ecSetLeftMarginNewLine,
1268	ecSetLeftMarginFit:
1269	result := true;
1270
1271	ecStartCharGraphics:
1272	begin
1273	result := true;
1274	State.InCharGraphics := true;
1275	State.Spacing := false;
1276	end;
1277
1278	ecEndCharGraphics:
1279	begin
1280	result := true;
1281	State.InCharGraphics := false;
1282	State.Spacing := true;
1283	end;
1284
1285	ecImage:
1286	result := State.Spacing;
1287
1288	ecLinkedImage:
1289	result := State.Spacing;
1290
1291	ecStartLines:
1292	begin
1293	result := true;
1294	State.Spacing := false;
1295	end;
1296
1297	ecEndLines:
1298	begin
1299	result := true;
1300	// supposed to turn word wrap on, default font
1301	State.Spacing := true;
1302	end;
1303	end; // case escape code of...
1304
1305	inc( pData, EscapeLen );
1306	end;
1307
1308	procedure TTopic.EnsureSlotsLoaded;
1309	var
1310	i: longint;
1311	pSlotNumber: puint16;
1312	SlotNumber: uint16;
1313	SlotHeader: TSlotHeader;
1314	Slot: THelpTopicSlot;
1315	begin
1316	if _Slots = nil then
1317	begin
1318	try
1319	_Slots := TList.Create;
1320
1321	// Read slot data
1322	pSlotNumber := _pSlotNumbers;
1323
1324	for i := 0 to _NumSlots - 1 do
1325	begin
1326	SlotNumber := pSlotNumber^;
1327
1328	// Seek to start of slot
1329	try
1330	MySeek( _FileHandle,
1331	_pSlotOffsets^[ SlotNumber ] );
1332	except
1333	// not a valid offset
1334	raise EHelpFileException.Create( ErrorCorruptHelpFile );
1335	end;
1336
1337	// Read header
1338	if not MyRead( _FileHandle,
1339	Addr( SlotHeader ),
1340	sizeof( SlotHeader ) ) then
1341	// couldn't read slot header
1342	raise EHelpFileException.Create( ErrorCorruptHelpFile );
1343
1344	// Create slot object
1345	Slot := THelpTopicSlot.Create;
1346
1347	Slot.LocalDictSize := SlotHeader.nLocalDict;
1348	Slot.Size := SlotHeader.ntext;
1349
1350	// Allocate and read slot dictionary
1351	ReadFileBlock( _FileHandle,
1352	Slot.pLocalDictionary,
1353	SlotHeader.localDictPos,
1354	uint32( Slot.LocalDictSize ) * sizeof( uint16 ) );
1355
1356	// Allocate and read slot data (text)
1357	ReadFileBlock( _FileHandle,
1358	Slot.pData,
1359	_pSlotOffsets^[ SlotNumber ] + sizeof( TSlotHeader ),
1360	Slot.Size );
1361
1362	_Slots.Add( Slot );
1363
1364	inc( pSlotNumber, sizeof( UInt16 ) );
1365	end;
1366	except
1367	on E: EHelpFileException do
1368	begin
1369	DestroyListAndObjects( _Slots );
1370	raise;
1371	end;
1372	end;
1373	end;
1374	end;
1375
1376	// returns a global dict index.
1377	// or, -1 for a whitespace item.
1378	// or, -2 for end of text.
1379	function TTopic.GetNextIPFTextItem( Var SlotIndex: longint;
1380	Var pData: pUInt8;
1381	Var State: TParseState ): longint;
1382	var
1383	Slot: THelpTopicSlot;
1384	pSlotEnd: pUInt8;
1385
1386	LocalDictIndex: uint8;
1387	begin
1388	while SlotIndex < _NumSlots do
1389	begin
1390	Slot := _Slots[ SlotIndex ];
1391	pSlotEnd := Slot.pData + Slot.Size;
1392
1393	while pData < pSlotEnd do
1394	begin
1395	LocalDictIndex := pData^;
1396	inc( pData );
1397
1398	if LocalDictIndex < Slot.LocalDictSize then
1399	begin
1400	// Normal word lookup
1401	result := Slot.pLocalDictionary^[ LocalDictIndex ];
1402	exit;
1403	end;
1404
1405	// special code
1406	case LocalDictIndex of
1407	IPF_END_PARA:
1408	begin
1409	result := -1;
1410	if not State.InCharGraphics then
1411	State.Spacing := true;
1412	exit;
1413	end;
1414
1415	IPF_CENTER:
1416	begin
1417	result := -1;
1418	exit;
1419	end;
1420
1421	IPF_INVERT_SPACING:
1422	begin
1423	State.Spacing := not State.Spacing;
1424	end;
1425
1426	IPF_LINEBREAK:
1427	begin
1428	result := -1;
1429	if not State.InCharGraphics then
1430	State.Spacing := true;
1431	exit;
1432	end;
1433
1434	IPF_SPACE:
1435	begin
1436	result := -1;
1437	exit;
1438	end;
1439
1440	IPF_ESC:
1441	begin
1442	// escape sequence
1443	if IPFEscapeCodeSpace( State, pData ) then
1444	result := -1;
1445	end;
1446	end;
1447	end; // while in slot...
1448	inc( SlotIndex );
1449	end;
1450	Result := -2;
1451	end;
1452
1453	// Checks to see if the given word (at pData)
1454	// starts one of the given sequences, by looking forward
1455	// If found, returns the length of the sequence.
1456	function TTopic.CheckForSequence( WordSequences: TList;
1457	SlotIndex: longint;
1458	pData: pUint8;
1459	State: TParseState;
1460	GlobalDictIndex: longint;
1461	): longint;
1462	var
1463	WordSequence: TList;
1464	SequenceStepIndex: longint;
1465	pSequenceStepWords: Uint32ArrayPointer;
1466
1467	SequenceIndex: longint;
1468
1469	SlotIndexTemp: longint;
1470	pDataTemp: pUint8;
1471	StateTemp: TParseState;
1472	// s : string;
1473	DictIndex: longint;
1474	begin
1475	result := 0; // if we don't find a match.
1476
1477	for SequenceIndex := 0 to WordSequences.Count - 1 do
1478	begin
1479	WordSequence := WordSequences[ SequenceIndex ];
1480	pSequenceStepWords := WordSequence[ 0 ];
1481
1482	if pSequenceStepWords^[ GlobalDictIndex ] > 0 then
1483	begin
1484	// matched first step in this sequence. Look ahead...
1485
1486	SequenceStepIndex := 0;
1487
1488	pDataTemp := pData;
1489	SlotIndexTemp := SlotIndex;
1490	StateTemp := State;
1491	while true do
1492	begin
1493	inc( SequenceStepIndex );
1494	if SequenceStepIndex = WordSequence.Count then
1495	begin
1496	// have a match for the sequence, insert start highlight
1497	Result := WordSequence.Count;
1498	break;
1499	end;
1500
1501	// get words for next step in sequence
1502	pSequenceStepWords := WordSequence[ SequenceStepIndex ];
1503
1504	DictIndex := GetNextIPFTextItem( SlotIndexTemp,
1505	pDataTemp,
1506	StateTemp );
1507	if DictIndex = -2 then
1508	begin
1509	// end of text - abort
1510	break;
1511	end;
1512
1513	if DictIndex = -1 then
1514	begin
1515	// whitespace - abort
1516	// for multi-word phrase searching - count this and subsequent whitespace...
1517	break;
1518	end;
1519
1520	// s := pstring( _GlobalDictionary[ DictIndex ] )^; // for debug only
1521	if not StrIsEmptyOrSpaces( pstring( _GlobalDictionary[ DictIndex ] )^ ) then
1522	begin
1523	if pSequenceStepWords^[ DictIndex ] = 0 then
1524	begin
1525	// word doesn't match - abort
1526	break;
1527	end;
1528	end;
1529
1530	end; // while
1531
1532	end;
1533	// else - doesn't match first step, do nothing
1534	end; // for sequenceindex ...
1535	end;
1536
1537	// Main translation function. Turns the IPF data into
1538	// a text string. Translates formatting codes into tags
1539	// as for Rich Text Viewer.
1540	// Uses TAString for speed without length limits
1541	// - string is too short
1542	// - PChar is slow to concatenate (unless you keep track of the insert point)
1543	// - AnsiString is slow
1544	procedure TTopic.GetText( HighlightSequences: TList;
1545	// each element is a TList
1546	// containing a sequence of possible words
1547	// each element of each sequence
1548	// is an array of flags for the dictionary
1549	// indicating if the word is a allowed match at that step
1550	// a match is any sequence that matches one or more words at each step.
1551	ShowCodes: boolean;
1552	ShowWordSeparators: boolean;
1553	Text: TAString;
1554	ImageOffsets: TList;
1555	HighlightMatches: TList );
1556	var
1557	SlotIndex: integer;
1558	Slot: THelpTopicSlot;
1559	pData: pUInt8;
1560	pSlotEnd: pUInt8;
1561
1562	GlobalDictIndex: uint32;
1563
1564	WordsOnLine: longint;
1565
1566	StringToAdd: string;
1567	LocalDictIndex: uint8;
1568
1569	State: TParseState;
1570
1571	EscapeLen: uint8;
1572	i: longint;
1573
1574	SequenceStepIndex: longint;
1575	begin
1576	if Links = nil then
1577	Links := TList.Create;
1578
1579	if HighlightMatches <> nil then
1580	HighlightMatches.Clear;
1581
1582	// Text.Clear;
1583	ImageOffsets.Clear;
1584
1585	try
1586	EnsureSlotsLoaded;
1587	except
1588	on E: EHelpFileException do
1589	begin
1590	Text.AddString( e.Message );
1591	exit;
1592	end;
1593	end;
1594
1595	WordsOnLine := 0;
1596
1597	State.LinkIndex := 0;
1598	State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
1599	State.InCharGraphics := false;
1600	State.Spacing := true;
1601	State.ForegroundColorTag := '</color>';
1602	State.BackgroundColorTag := '</backcolor>';
1603
1604	State.StartOfTextBlock := -1;
1605	State.TextBlock := TAString.Create;
1606
1607	State.FootnoteLink := nil;
1608
1609	Text.AddString( '<leftmargin 1>' );
1610
1611	SequenceStepIndex := 0;
1612
1613	for SlotIndex := 0 to _NumSlots - 1 do
1614	begin
1615	if not State.InCharGraphics then
1616	State.Spacing := true; // this is just a guess as to the exact view behaviour.
1617	// inf.txt indicates that spacing is reset to true at
1618	// slot (cell) start, but that doesn't seem to be the
1619	// case when in character graphics... hey ho.
1620
1621	Slot := _Slots[ SlotIndex ];
1622
1623	pData := Slot.pData;
1624
1625	pSlotEnd := pData + Slot.Size;
1626
1627	State.Alignment := itaLeft;
1628
1629	while pData < pSlotEnd do
1630	begin
1631	LocalDictIndex := pData^;
1632	inc( pData );
1633
1634	if LocalDictIndex < Slot.LocalDictSize then
1635	begin
1636	// Normal word lookup
1637	GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
1638
1639	if ShowWordSeparators then
1640	Text.AddString( '{' + IntToStr( GlobalDictIndex )+ '}' );
1641
1642	// normal lookup
1643	if GlobalDictIndex < _GlobalDictionary.Count then
1644	StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
1645	else
1646	StringToAdd := '';
1647
1648	if StrIsEmptyOrSpaces( StringToAdd ) then
1649	begin
1650	// spaces only...
1651	CheckForAutoURL( Text, State );
1652	end
1653	else
1654	begin
1655	// really is a word, not a space.
1656
1657	// store string into "word"
1658	if State.TextBlock.Length = 0 then
1659	// store start of block
1660	State.StartOfTextBlock := Text.Length;
1661
1662	State.TextBlock.AddString( StringToAdd );
1663
1664	SubstituteAngleBrackets( StringToAdd );
1665
1666	if HighlightSequences <> nil then
1667	begin
1668	if SequenceStepIndex > 0 then
1669	begin
1670	// currently highlighting a sequence.
1671	dec( SequenceStepIndex );
1672	if SequenceStepIndex = 0 then
1673	begin
1674	// now finished, insert end highlight
1675	StringToAdd := StringToAdd
1676	+ State.BackgroundColorTag;
1677
1678	end;
1679	end
1680	else
1681	begin
1682	// not yet in a sequence, searching.
1683	SequenceStepIndex :=
1684	CheckForSequence( HighlightSequences,
1685	SlotIndex,
1686	pData,
1687	State,
1688	GlobalDictIndex );
1689
1690	if SequenceStepIndex > 0 then
1691	begin
1692	// this word starts a sequence!
1693	if HighlightMatches <> nil then
1694	HighlightMatches.Add( pointer( Text.Length ) );
1695	StringToAdd := '<backcolor #'
1696	+ IntToHex( Settings.Colors[ SearchHighlightTextColorIndex ], 6 )
1697	+ '>'
1698	+ StringToAdd;
1699	dec( SequenceStepIndex );
1700	if SequenceStepIndex = 0 then
1701	// and ends it.
1702	StringToAdd := StringToAdd
1703	+ State.BackgroundColorTag;
1704	end;
1705
1706	end;
1707	end; // if processing sequence
1708	inc( WordsOnLine );
1709	end;
1710
1711	Text.AddString( StringToAdd );
1712
1713	if State.FootnoteLink <> nil then
1714	begin
1715	State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
1716	if State.Spacing then
1717	begin
1718	State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
1719	end;
1720	end;
1721
1722	if State.Spacing then
1723	begin
1724	CheckForAutoURL( Text, State );
1725
1726	Text.AddString( ' ' );
1727	end;
1728	end
1729	else
1730	begin
1731	// special code
1732
1733	if ShowCodes then
1734	begin
1735	Text.AddString( '[' + IntToHex( LocalDictIndex, 2 ) );
1736	if LocalDictIndex = IPF_ESC then
1737	begin
1738	EscapeLen := pData^;
1739	for i := 1 to EscapeLen - 1 do
1740	begin
1741	Text.AddString( ' '
1742	+ IntToHex( ( pData + i )^, 2 ) );
1743	end;
1744
1745	end;
1746	Text.AddString( ']' );
1747	end;
1748
1749	case LocalDictIndex of
1750	IPF_END_PARA:
1751	begin
1752	if SlotIndex = 0 then
1753	if pData - 1 = Slot.pData then
1754	// ignore first FA, not needed with RichTextView
1755	continue;
1756
1757	CheckForAutoURL( Text, State );
1758	if State.Alignment = itaCenterOnePara then
1759	begin
1760	State.Alignment := itaLeft;
1761	Text.AddString( '<align left>' );
1762	end;
1763	Text.AddString(RTF_NewLine);
1764
1765	if WordsOnLine > 0 then
1766	Text.AddString(RTF_NewLine);
1767
1768	if not State.InCharGraphics then
1769	State.Spacing := true;
1770
1771	WordsOnLine := 0;
1772	end;
1773
1774	IPF_CENTER:
1775	begin
1776	CheckForAutoURL( Text, State );
1777	Text.addString( RTF_NewLine + '<align center>' );
1778	State.Alignment := itaCenterOnePara;
1779	end;
1780
1781	IPF_INVERT_SPACING:
1782	begin
1783	State.Spacing := not State.Spacing;
1784	end;
1785
1786	IPF_LINEBREAK:
1787	begin
1788	CheckForAutoURL( Text, State );
1789
1790	if State.Alignment = itaCenterOnePara then
1791	begin
1792	State.Alignment := itaLeft;
1793	Text.AddString( '<align left>' );
1794	end;
1795	Text.AddString( RTF_NewLine );
1796	if not State.InCharGraphics then
1797	State.Spacing := true;
1798	WordsOnLine := 0;
1799	end;
1800
1801	IPF_SPACE:
1802	begin
1803	CheckForAutoURL( Text, State );
1804	if State.Spacing then
1805	Text.AddString( ' ' );
1806	end;
1807
1808	IPF_ESC:
1809	begin
1810	// escape sequence
1811	TranslateIPFEscapeCode( State,
1812	pData,
1813	Text,
1814	WordsOnLine,
1815	ImageOffsets );
1816
1817	end;
1818
1819	end; // case code of...
1820	end;
1821	end; // for slotindex = ...
1822	end;
1823	State.TextBlock.Destroy;
1824
1825	end;
1826
1827	function TTopic.SearchForWord( DictIndex: integer;
1828	StopAtFirstOccurrence: boolean )
1829	: longint;
1830	var
1831	SlotIndex: integer;
1832	Slot: THelpTopicSlot;
1833	pData: pUInt8;
1834	pSlotEnd: pUInt8;
1835
1836	EscapeLen: longint;
1837
1838	GlobalDictIndex: uint32;
1839
1840	LocalDictIndex: uint8;
1841	begin
1842	EnsureSlotsLoaded;
1843
1844	Result := 0;
1845	for SlotIndex := 0 to _NumSlots - 1 do
1846	begin
1847	Slot := _Slots[ SlotIndex ];
1848
1849	pData := Slot.pData;
1850
1851	pSlotEnd := pData + Slot.Size;
1852
1853	while pData < pSlotEnd do
1854	begin
1855	LocalDictIndex := pData^;
1856
1857	if LocalDictIndex < Slot.LocalDictSize then
1858	begin
1859	// Normal word lookup
1860	GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
1861
1862	if GlobalDictIndex = DictIndex then
1863	begin
1864	inc( result );
1865	if StopAtFirstOccurrence then
1866	exit;
1867	end;
1868	end
1869	else
1870	begin
1871	// special code
1872	if LocalDictIndex = $ff then
1873	begin
1874	// escape string, skip it
1875	EscapeLen := ( pData + 1 ) ^;
1876	inc( pData, EscapeLen );
1877	end;
1878	end;
1879
1880	inc( pData );
1881	end; // for slotindex = ...
1882	end;
1883	end;
1884
1885	// Search for a sequence of bytes, including in escape codes
1886	// this is for debugging to allow finding specific sequences
1887	function TTopic.SearchForData( Data: pbyte;
1888	DataLen: integer ): boolean;
1889	var
1890	SlotIndex: integer;
1891	Slot: THelpTopicSlot;
1892	pData: pUInt8;
1893	pSlotEnd: pUInt8;
1894
1895	pHold: pUint8;
1896	pSearch: pUint8;
1897	begin
1898	EnsureSlotsLoaded;
1899
1900	for SlotIndex := 0 to _NumSlots - 1 do
1901	begin
1902	Slot := _Slots[ SlotIndex ];
1903
1904	pSearch := Data;
1905	pHold := Slot.pData;
1906	pData := Slot.pData;
1907	pSlotEnd := Slot.pData + Slot.Size;
1908
1909	while pHold < pSlotEnd do
1910	begin
1911	if pData^ = pSearch^ then
1912	begin
1913	// byte matches
1914	inc( pData );
1915	inc( pSearch );
1916	if ( pSearch >= Data + DataLen ) then
1917	begin
1918	// matches
1919	result := true;
1920	exit;
1921	end
1922	end
1923	else
1924	begin
1925	// no match
1926	pSearch := Data;
1927	inc( pHold );
1928	pData := pHold;
1929	end;
1930	end; // for slotindex = ...
1931	end;
1932
1933	result := false; // not found
1934	end;
1935
1936	function TTopic.SearchForWordSequences( WordSequence: TList;
1937	StopAtFirstOccurrence: boolean )
1938	: longint;
1939	var
1940	SlotIndex: integer;
1941	Slot: THelpTopicSlot;
1942	pData: pUInt8;
1943	pSlotEnd: pUInt8;
1944
1945	EscapeLen: longint;
1946
1947	GlobalDictIndex: uint32;
1948	IsWord: boolean;
1949	WordRelevance: uint32;
1950
1951	CurrentMatchRelevance: uint32; // total relevances for words matched so far
1952	// in the current sequence
1953
1954	// CurrentMatch: string; // useful for debugging only
1955	LocalDictIndex: uint8;
1956
1957	SequenceIndex: longint;
1958	SequenceStartSlotIndex: longint;
1959	pSequenceStartData: pUInt8;
1960
1961	pStepWordRelevances: UInt32ArrayPointer; // word relevances for the current step in the sequence
1962
1963	// get the current slot start and end pointers
1964	procedure GetSlot;
1965	begin
1966	Slot := self._Slots[ SlotIndex ];
1967	pData := Slot.pData;
1968	pSlotEnd := pData + Slot.Size;
1969	end;
1970
1971	// get pointer to the current set of word relevances
1972	procedure GetStepFlags;
1973	begin
1974	pStepWordRelevances := WordSequence[ SequenceIndex ];
1975	end;
1976
1977	// store the current point as start of a sequence
1978	procedure StoreStartOfSequence;
1979	begin
1980	SequenceIndex := 0;
1981	SequenceStartSlotIndex := SlotIndex;
1982	pSequenceStartData := pData;
1983	CurrentMatchRelevance := 0;
1984	// CurrentMatch := '';
1985	GetStepFlags;
1986	end;
1987
1988	begin
1989	Result := 0;
1990
1991	EnsureSlotsLoaded;
1992
1993	if _NumSlots = 0 then
1994	// thar's nowt in yon topic, cannae be a match laid
1995	exit;
1996
1997	SlotIndex := 0;
1998
1999	GetSlot;
2000
2001	StoreStartOfSequence;
2002
2003	while true do
2004	begin
2005	LocalDictIndex := pData^;
2006	IsWord := false;
2007	if LocalDictIndex < Slot.LocalDictSize then
2008	begin
2009	IsWord := true;
2010	// Normal word lookup, so get the global dict idnex before we
2011	// (potentially) move to next slot
2012	GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
2013	end;
2014
2015	inc( pData );
2016	if pData >= pSlotEnd then
2017	begin
2018	// reached end of slot, next please
2019	inc( SlotIndex );
2020	if SlotIndex < _NumSlots then
2021	GetSlot;
2022	// else - there is nothing more to search
2023	// but we need to check this last item
2024	end;
2025
2026	if IsWord then
2027	begin
2028	// Normal word lookup
2029	WordRelevance := 0;
2030
2031	if GlobalDictIndex < _GlobalDictionary.Count then
2032	if not StrIsEmptyOrSpaces( pstring( _GlobalDictionary[ GlobalDictIndex ] )^ ) then;
2033	WordRelevance := pStepWordRelevances[ GlobalDictIndex ];
2034
2035	if WordRelevance > 0 then
2036	begin
2037	// Found a matching word
2038	inc( CurrentMatchRelevance, WordRelevance );
2039	// debug:
2040	// CurrentMatch := CurrentMatch +
2041	// pstring( _GlobalDictionary[ GlobalDictIndex ] )^;
2042
2043	if SequenceIndex = 0 then
2044	begin
2045	// remember next start point
2046	SequenceStartSlotIndex := SlotIndex;
2047	pSequenceStartData := pData;
2048	end;
2049
2050	inc( SequenceIndex );
2051
2052	if SequenceIndex < WordSequence.Count then
2053	begin
2054	// get next set of flags.
2055	GetStepFlags;
2056	end
2057	else
2058	begin
2059	// found a complete sequence. Cool!
2060
2061	inc( result, CurrentMatchRelevance );
2062
2063	if StopAtFirstOccurrence then
2064	exit;
2065
2066	// start looking from the beginning of the sequence again.
2067	StoreStartOfSequence;
2068	end;
2069	end
2070	else
2071	begin
2072	// not a match at this point, restart search
2073	if SequenceIndex > 0 then
2074	begin
2075	// we had matched one or more steps already,
2076	// back to start of sequence AND back to
2077	// point we started matching from (+1)
2078	SequenceIndex := 0;
2079	CurrentMatchRelevance := 0;
2080	// CurrentMatch := '';
2081	SlotIndex := SequenceStartSlotIndex;
2082	GetSlot;
2083	pData := pSequenceStartData;
2084	GetStepFlags;
2085	end
2086	else
2087	begin
2088	// haven't matched anything yet.
2089	// update start of sequence
2090	SequenceStartSlotIndex := SlotIndex;
2091	pSequenceStartData := pData;
2092	end;
2093	end;
2094	end
2095	else
2096	begin
2097	// special code
2098	if LocalDictIndex = $ff then
2099	begin
2100	// escape string, skip it
2101	EscapeLen := pData ^;
2102	inc( pData, EscapeLen );
2103	end;
2104	end;
2105
2106	if SlotIndex >= _NumSlots then
2107	begin
2108	// finished searching topic
2109	break;
2110	end;
2111
2112	// next item
2113	end;
2114	end;
2115
2116
2117	function TTopic.CountWord( DictIndex: integer ): longint;
2118	begin
2119	Result := SearchForWord( DictIndex, false );
2120	end;
2121
2122	function TTopic.ContainsWord( DictIndex: integer ): boolean;
2123	begin
2124	Result := SearchForWord( DictIndex, true ) > 0;
2125	end;
2126
2127	// Gets the window dimensions specified by this topic's
2128	// contents header
2129	procedure TTopic.GetContentsWindowRect( ContentsRect: THelpWindowRect );
2130	var
2131	extendedinfo: TExtendedTOCEntry;
2132	XY: THelpXYPair;
2133	p: pbyte;
2134
2135	Flags: byte;
2136	begin
2137	Flags := _pTOCEntry ^.flags;
2138	p := pByte( _pTOCEntry + sizeof( TTOCEntryStart ) );
2139
2140	ContentsRect.Left := 0;
2141	ContentsRect.Bottom := 0;
2142	ContentsRect.Width := 100;
2143	ContentsRect.Height := 100;
2144
2145	if ( Flags and TOCEntryExtended ) > 0 then
2146	begin
2147	// have more details available...
2148	ExtendedInfo.w1 := p^;
2149	ExtendedInfo.w2 := ( p+1) ^;
2150	inc( p, sizeof( ExtendedInfo ) );
2151
2152	if ( ExtendedInfo.w1 and 1 ) > 0 then
2153	begin
2154	// read origin
2155	XY := pHelpXYPair( p )^;
2156	inc( p, sizeof( XY ) );
2157	ReadHelpPosition( XY, ContentsRect );
2158	end;
2159	if ( ExtendedInfo.w1 and 2 ) > 0 then
2160	begin
2161	// read size
2162	XY := pHelpXYPair( p )^;
2163	inc( p, sizeof( XY ) );
2164	ReadHelpSize( XY, ContentsRect );
2165	end;
2166	end;
2167	end;
2168
2169	const
2170	IPFColorNames: array[ 0..15 ] of string =
2171	(
2172	'default',
2173	'blue',
2174	'red',
2175	'pink',
2176	'green',
2177	'cyan',
2178	'yellow',
2179	'neutral',
2180	// 'brown', ??
2181	'darkgray',
2182	'darkblue',
2183	'darkred',
2184	'darkpink',
2185	'darkgreen',
2186	'darkcyan',
2187	'black',
2188	'palegray'
2189	);
2190
2191	Procedure SaveExtraLinkData( Link: TWindowedHelpLink;
2192	pData: pUInt8 );
2193	var
2194	LinkFlags1: uint8;
2195	LinkFlags2: uint8;
2196	LinkDataIndex: longint;
2197	pLinkXY: pHelpXYPair;
2198	pLinkData: pUInt8;
2199	begin
2200	LinkFlags1 := ( pData + 0 ) ^;
2201	LinkFlags2 := ( pData + 1 ) ^;
2202
2203	pLinkData := pData + 2;
2204
2205	if ( LinkFlags1 and 1 ) > 0 then
2206	begin
2207	// position specified
2208	pLinkXY := pHelpXYPair( pLinkData );
2209	inc( pLinkData, sizeof( THelpXYPair ) );
2210	end;
2211
2212	if ( LinkFlags1 and 2 ) > 0 then
2213	begin
2214	// size specified
2215	pLinkXY := pHelpXYPair( pLinkData );
2216	inc( pLinkData, sizeof( THelpXYPair ) );
2217	end;
2218
2219	if ( LinkFlags1 and 8 ) > 0 then
2220	begin
2221	// window controls specified - skip
2222	inc( pLinkData, 2 );
2223	end;
2224
2225	if ( LinkFlags2 and 4 ) > 0 then
2226	begin
2227	// group specified
2228	Link.GroupIndex := pUInt16( pLinkData )^;
2229	inc( LinkDataIndex, sizeof( uint16 ) );
2230	end;
2231
2232	if ( LinkFlags1 and 64 ) > 0 then
2233	begin
2234	Link.Automatic := true;
2235	end;
2236
2237	if ( LinkFlags1 and 4 ) > 0 then
2238	Link.ViewPort := true;
2239
2240	if ( LinkFlags2 and 2 ) > 0 then
2241	Link.Dependent := true;
2242
2243	if ( LinkFlags1 and 128 ) > 0 then
2244	Link.Split := true;
2245
2246	// cant be bothered with the others.
2247	end;
2248
2249	procedure TTopic.SaveIPFEscapeCode( Var State: TParseState;
2250	Var pData: pUInt8;
2251	Var F: TextFile;
2252	ImageOffsets: TList );
2253	var
2254	EscapeLen: uint8;
2255	EscapeCode: uint8;
2256
2257	Margin: integer;
2258
2259	BitmapOffset: longword;
2260	BitmapFlags: uint8;
2261
2262	ColorCode: uint8;
2263	StyleCode: uint8;
2264
2265	FontIndex: uint8;
2266	pFontSpec: pTHelpFontSpec;
2267
2268	FaceName: string;
2269
2270	ExternalLinkFileIndex: uint8;
2271	ExternalLinkTopicID: string;
2272
2273	ProgramLink: string;
2274	ProgramPath: string;
2275	tmpProgramLinkParts : TStringList;
2276
2277	OutputString: string;
2278	begin
2279	EscapeLen := pData^;
2280	EscapeCode := (pData + 1) ^;
2281	OutputString := '';
2282
2283	case EscapeCode of
2284
2285	ecSetLeftMargin:
2286	begin
2287	Margin := integer( ( pData + 2 )^ );
2288	GetMarginTag( Margin, State.FontState, OutputString, false );
2289	end;
2290
2291	ecSetLeftMarginNewLine:
2292	begin
2293	Margin := integer( ( pData + 2 )^ );
2294	GetMarginTag( Margin, State.FontState, OutputString, false );
2295	OutputString := OutputString
2296	+ RTF_NewLine;
2297	end;
2298
2299	ecSetLeftMarginFit:
2300	begin
2301	Margin := integer( ( pData + 2 )^ );
2302	GetMarginTag( Margin, State.FontState, OutputString, true );
2303	// note that this will cause following tex to be "tabbed" across to the
2304	// new margin position, if not yet there.
2305	// if we are already past this margin then a new line should be started.
2306
2307	end;
2308
2309	ecSetLeftMarginHere:
2310	begin
2311	OutputString := '<leftmargin here>';
2312	end;
2313
2314	ecHighlight1: // hp1,2,3, 5,6,7
2315	begin
2316	StyleCode := ( pData + 2 ) ^;
2317	if StyleCode > 3 then
2318	StyleCode := StyleCode + 1; // 4, 8 and 9 are expressed in highlight2 code
2319
2320	if StyleCode > 0 then
2321	Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
2322	else
2323	Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
2324	State.StyleCode := StyleCode;
2325	end;
2326
2327	ecHighlight2: // hp4, 8, 9
2328	begin
2329	StyleCode := ( pData + 2 ) ^;
2330	case StyleCode of
2331	1: StyleCode := 4;
2332	2: StyleCode := 8;
2333	3: StyleCode := 9;
2334	end;
2335
2336	if StyleCode > 0 then
2337	Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
2338	else
2339	Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
2340	State.StyleCode := StyleCode;
2341	end;
2342
2343	ecLinkStart:
2344	begin
2345	Write( F, ':link reftype=hd' ); // link to heading
2346
2347	Write( F, ' refid=' + IntToStr( pUInt16( pData + 2 )^ ) );
2348
2349	{
2350	if EscapeLen >= 6 then
2351	begin
2352	GetExtraLinkData( Link, pData + 4 );
2353	end;}
2354
2355	// if Link.Automatic then
2356	// Write( F, ' auto' );
2357
2358	Write( F, '.' );
2359
2360	inc( State.LinkIndex );
2361	end;
2362
2363	ecFootnoteLinkStart:
2364	begin
2365	Write( F, ':link reftype=fn refid=fn'
2366	+ IntToStr( pUInt16( pData + 2 )^ )
2367	+ '.' );
2368	inc( State.LinkIndex );
2369	end;
2370
2371	ecStartLinkByResourceID:
2372	begin
2373	Write( F, ':link reftype=hd res='
2374	+ IntToStr( pUInt16( pData + 2 )^ )
2375	+ '.' );
2376
2377	inc( State.LinkIndex );
2378	end;
2379
2380	ecExternalLink:
2381	begin
2382	ExternalLinkFileIndex := ( pData + 2 )^;
2383	ExternalLinkTopicID := StrPasWithLength( pchar( pData + 4 ), ( pData + 3 )^ );
2384	Write( F, ':link reftype=hd '
2385	+ ' refid=' + StrInSingleQuotes( ExternalLinkTopicID )
2386	+ ' database=' + StrInSingleQuotes( _ReferencedFiles[ ExternalLinkFileIndex ] )
2387	+ '.' );
2388
2389	end;
2390
2391	ecProgramLink:
2392	begin
2393	ProgramLink := StrPasWithLength( pchar( pData + 3 ), EscapeLen - 3 );
2394
2395	tmpProgramLinkParts := TStringList.Create;
2396	StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0);
2397	ProgramPath := tmpProgramLinkParts[0];
2398	tmpProgramLinkParts.Destroy;
2399
2400	Write( F, ':link reftype=launch'
2401	+ ' object=' + StrInSingleQuotes( ProgramPath )
2402	+ ' data=' + StrInSingleQuotes( ProgramLink )
2403	+ '.' );
2404	end;
2405
2406	ecLinkEnd:
2407	begin
2408	Write( F, ':elink.' );
2409	if State.FootnoteLink <> nil then
2410	State.FootnoteLink := nil;
2411	end;
2412
2413	ecStartCharGraphics:
2414	begin
2415	State.FontState := fsFixed;
2416	State.InCharGraphics := true;
2417	WriteLn( F, '' );
2418	WriteLn( F, ':cgraphic.' );
2419	State.Spacing := false;
2420	end;
2421
2422	ecEndCharGraphics:
2423	begin
2424	State.FontState := fsNormal;
2425	State.InCharGraphics := false;
2426	WriteLn( F, '' );
2427	WriteLn( F, ':ecgraphic.' );
2428	State.Spacing := true;
2429	end;
2430
2431	ecImage:
2432	begin
2433	BitmapFlags := ( pData + 2 )^;
2434	BitmapOffset := pUInt32( pData + 3 )^;
2435
2436	SaveImageText( BitmapOffset, BitmapFlags, F, ImageOffsets );
2437
2438	if State.Spacing then
2439	Write( F, ' ' );
2440	end;
2441
2442	ecLinkedImage:
2443	begin
2444	SaveLinkedImage( pData, F, ImageOffsets );
2445	// Note! Early exit, since the procedure
2446	// will update pData.
2447	exit;
2448	end;
2449
2450	ecStartLines:
2451	begin
2452	WriteLn( F, '' );
2453	// aligned text
2454	case ( pData + 2 )^ of
2455	0, // just in case - to match image alignment oddities
2456	1:
2457	begin
2458	WriteLn( F, ':lines.' );
2459	State.Alignment := itaLeft;
2460	end;
2461
2462	2:
2463	begin
2464	WriteLn( F, ':lines align=right.' );
2465	State.Alignment := itaRight;
2466	end;
2467
2468	4:
2469	begin
2470	WriteLn( F, ':lines align=center.' );
2471	State.Alignment := itaCenter;
2472	end;
2473	end;
2474	end;
2475
2476	ecEndLines:
2477	begin
2478	// supposed to turn word wrap on, default font
2479	WriteLn( F, '' );
2480	WriteLn( F, ':elines.' );
2481	State.Alignment := itaLeft;
2482	end;
2483
2484	ecForegroundColor:
2485	begin
2486	ColorCode := ( pData + 2 )^;
2487
2488	if ColorCode < High( IPFColorNames ) then
2489	Write( F, ':color fc=' + IPFColorNames[ ColorCode ] + '.' );
2490	end;
2491
2492	ecBackgroundColor:
2493	begin
2494	ColorCode := ( pData + 2 )^;
2495	if ColorCode < High( IPFColorNames ) then
2496	Write( F, ':color bc=' + IPFColorNames[ ColorCode ] + '.' );
2497	end;
2498
2499	ecFontChange:
2500	begin
2501	FontIndex := ( pData + 2 )^;
2502	if FontIndex = 0 then
2503	begin
2504	// back to default font
2505	Write( F, ':font facename=default.' );
2506	State.FontState := fsNormal;
2507	end
2508	else if FontIndex < _FontTable.Count then
2509	begin
2510	// valid font index
2511	pFontSpec := _FontTable[ FontIndex ];
2512
2513	if pFontSpec = SubstituteFixedFont then
2514	begin
2515	// oops.
2516	OutputString := '<tt>';
2517	State.FontState := fsFixed;
2518	end
2519	else
2520	begin
2521	pFontSpec := _FontTable[ FontIndex ];
2522	FaceName := StrPasWithLength( pFontSpec ^. FaceName,
2523	sizeof( pFontSpec ^. FaceName ) );
2524	Write( F,
2525	':font facename=' + StrInSingleQuotes( FaceName )
2526	+ ' size=' + IntToStr( pFontSpec ^. Height )
2527	+ 'x' + IntToStr( pFontSpec ^. Width )
2528	+ '.' );
2529	State.FontState := fsCustom;
2530	end;
2531	end;
2532	end
2533	end; // case escape code of...
2534
2535	// Write( F, OutputString );
2536
2537	inc( pData, EscapeLen );
2538	end;
2539
2540	procedure TTopic.SaveToIPF( Var f: TextFile;
2541	ImageOffsets: TList );
2542	var
2543	SlotIndex: integer;
2544	Slot: THelpTopicSlot;
2545	pData: pUInt8;
2546	pSlotEnd: pUInt8;
2547
2548	GlobalDictIndex: uint32;
2549
2550	StringToAdd: string;
2551	LocalDictIndex: uint8;
2552
2553	State: TParseState;
2554
2555	SequenceStepIndex: longint;
2556
2557	LineLen: longint;
2558	c: char;
2559	begin
2560	EnsureSlotsLoaded;
2561
2562	State.LinkIndex := 0;
2563	State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
2564	State.InCharGraphics := false;
2565	State.Spacing := true;
2566	State.ForegroundColorTag := '</color>';
2567	State.BackgroundColorTag := '</backcolor>';
2568
2569	State.StartOfTextBlock := -1;
2570	State.TextBlock := TAString.Create;
2571
2572	State.FootnoteLink := nil;
2573
2574	State.StyleCode := 0;
2575
2576	SequenceStepIndex := 0;
2577
2578	LineLen := 0;
2579
2580	for SlotIndex := 0 to _NumSlots - 1 do
2581	begin
2582	if not State.InCharGraphics then
2583	State.Spacing := true; // this is just a guess as to the exact view behaviour.
2584	// inf.txt indicates that spacing is reset to true at
2585	// slot (cell) start, but that doesn't seem to be the
2586	// case when in character graphics... hey ho.
2587
2588	Slot := _Slots[ SlotIndex ];
2589
2590	pData := Slot.pData;
2591
2592	pSlotEnd := pData + Slot.Size;
2593
2594	State.Alignment := itaLeft;
2595
2596	while pData < pSlotEnd do
2597	begin
2598	LocalDictIndex := pData^;
2599	inc( pData );
2600
2601	if LocalDictIndex < Slot.LocalDictSize then
2602	begin
2603	// Normal word lookup
2604	GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
2605
2606	// normal lookup
2607	if GlobalDictIndex < _GlobalDictionary.Count then
2608	StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
2609	else
2610	StringToAdd := '';
2611
2612	if Length( StringToAdd ) = 1 then
2613	begin
2614	// could be symbol
2615	c := StringToAdd[ 1 ];
2616	case C of
2617	'&': StringToAdd := '&amp.';
2618	'''': StringToAdd := '&apos.';
2619	// '*': StringToAdd := '&asterisk.';
2620	'@': StringToAdd := '&atsign.';
2621	'\': StringToAdd := '&bsl.';
2622	'^': StringToAdd := '&caret.';
2623	'"': StringToAdd := '&osq.';
2624	':': StringToAdd := '&colon.';
2625	'.': StringToAdd := '&per.';
2626	end;
2627	end;
2628
2629	inc( LineLen, Length( StringToAdd ) );
2630	if ( LineLen > 80 ) and ( not State.InCharGraphics ) then
2631	begin
2632	WriteLn( F );
2633	LineLen := 0;
2634	end;
2635
2636	Write( F, StringToAdd );
2637	{
2638	if State.FootnoteLink <> nil then
2639	begin
2640	State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
2641	if State.Spacing then
2642	begin
2643	State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
2644	end;
2645	end;
2646	}
2647	if State.Spacing then
2648	begin
2649	Write( F, ' ' );
2650	inc( LineLen );
2651	end;
2652	end
2653	else
2654	begin
2655	// special code
2656
2657	case LocalDictIndex of
2658	IPF_END_PARA:
2659	begin
2660	WriteLn( F, '' );
2661	Write( F, ':p.' );
2662	LineLen := 3;
2663
2664	if not State.InCharGraphics then
2665	State.Spacing := true;
2666	end;
2667
2668	IPF_CENTER:
2669	begin
2670	WriteLn( F, '' );
2671	Write( F, '.ce ' ); // remainder of this line is centered.
2672	LineLen := 4;
2673	State.Alignment := itaCenterOnePara;
2674	end;
2675
2676	IPF_INVERT_SPACING:
2677	begin
2678	State.Spacing := not State.Spacing;
2679	end;
2680
2681	IPF_LINEBREAK:
2682	begin
2683	WriteLn( F, '' );
2684	if not State.InCharGraphics then
2685	WriteLn( F, '.br ' ); // break must be the only thing on the line
2686
2687	LineLen := 0;
2688	if not State.InCharGraphics then
2689	State.Spacing := true;
2690	end;
2691
2692	IPF_SPACE:
2693	begin
2694	if State.Spacing then
2695	Write( F, ' ' )
2696	else
2697	Write( F, ' ' );
2698	end;
2699
2700	IPF_ESC:
2701	begin
2702	// escape sequence
2703	SaveIPFEscapeCode( State,
2704	pData,
2705	F,
2706	ImageOffsets );
2707	end;
2708
2709	end; // case code of...
2710	end;
2711	end; // for slotindex = ...
2712	end;
2713	State.TextBlock.Destroy;
2714
2715	end;
2716
2717	// Compares two topics for purposes of sorting by
2718	// search match relevance
2719	function TopicRelevanceCompare( Item1, Item2: pointer ): longint;
2720	var
2721	Topic1, Topic2: TTopic;
2722	begin
2723	Topic1 := Item1;
2724	Topic2 := Item2;
2725
2726	if Topic1.SearchRelevance > Topic2.SearchRelevance then
2727	Result := -1
2728	else if Topic1.SearchRelevance < Topic2.SearchRelevance then
2729	Result := 1
2730	else
2731	Result := 0;
2732	end;
2733
2734	// Compares two topics for purposes of sorting by
2735	// title
2736	function TopicTitleCompare( Item1, Item2: pointer ): longint;
2737	begin
2738	Result := CompareText( TTopic( Item1 )._Title^,
2739	TTopic( Item2 )._Title^ );
2740	end;
2741
2742	Initialization
2743	RegisterProcForLanguages( OnLanguageEvent );
2744	End.

Note: See TracBrowser for help on using the repository browser.

Download in other formats: