source: trunk/NewView/HelpTopic.pas@ 18

Last change on this file since 18 was 18, checked in by RBRi, 19 years ago

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