source: trunk/NewView/HelpTopic.pas@ 66

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

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