source: trunk/NewView/HelpTopic.pas@ 31

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

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