source: trunk/NewView/HelpTopic.pas@ 228

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

refactoring for language handling
  • Property svn:eol-style set to native
File size: 70.0 KB
RevLine 
[18]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
[32]16 BseDos,
17 OS2Def,
18 Classes,
19 Graphics,
[18]20 ACLString,
[32]21 HelpWindowDimensions,
22 IPFFileFormatUnit;
[18]23
24const
25 DefaultGroupIndex = 0;
26
[38]27 RTF_NewLine = #10;
28
[18]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;
[72]178
[18]179 procedure SetTitleFromMem( const p: pointer; const Len: byte );
180 // Main function for retrieving text for topic.
181 // HighlightSequences: list of sequences to highlight
182 // if nil then ignored.
183 // ShowCodes: indicates debugging: hex output of escape
184 // codes will be included
185 // ShowWordSeparators: | will be included after each dictionary
186 // word inserted
187 // Text: The output is written to here. IS NOT CLEARED FIRST.
188 // ImageOffsets: For each image that occurs in the text,
189 // the help file offset will be written to this list.
190 // HighlightMatches: if not nil, and HighlightSequences is not nil,
191 // will return offsets to each highlight match
192 procedure GetText( HighlightSequences: TList;
193 ShowCodes: boolean;
194 ShowWordSeparators: boolean;
195 Text: TAString;
196 ImageOffsets: TList;
197 HighlightMatches: TList );
198
199 // if StopAtFirstOccurrence true, returns 0 or 1
200 // if false, returns count of occurrences of word
201 function SearchForWord( DictIndex: integer;
202 StopAtFirstOccurrence: boolean ): longint;
203
204 // searches for sequences out of those listed in WordSequence
205 // Each element of WordSequence contains a pointer to an array
206 // of flags for each dictionary word, indicating whether that word
207 // is to be a possible match.
208 function SearchForWordSequences( WordSequence: TList;
209 StopAtFirstOccurrence: boolean ): longint;
210
211 procedure GetContentsWindowRect( ContentsRect: THelpWindowRect );
212
213 // search for binary data including codes
214 function SearchForData( Data: pbyte;
215 DataLen: integer ): boolean;
216
217 procedure SaveIPFEscapeCode( Var State: TParseState;
218 Var pData: pUInt8;
219 Var F: TextFile;
220 ImageOffsets: TList );
221
222 procedure SaveToIPF( Var f: TextFile;
223 ImageOffsets: TList );
224
225 Links: TList; // only valid after GetText
226
227 property ShowInContents: boolean read _ShowInContents;
228 property ContentsLevel: integer read _ContentsLevel;
229 property ContentsGroupIndex: longint read _ContentsGroupIndex;
230
231 function CountWord( DictIndex: integer ): longint;
232 function ContainsWord( DictIndex: integer ): boolean;
233
234 // Used externally
235 HelpFile: TObject;
236 Index: longint;
237
238 SearchRelevance: longint;
239 end;
240
241// Compares two topics for purposes of sorting by
242// search match relevance
243function TopicRelevanceCompare( Item1, Item2: pointer ): longint;
244
245// Compares two topics for purposes of sorting by
246// title
247function TopicTitleCompare( Item1, Item2: pointer ): longint;
248
249Implementation
250
251uses
252 SysUtils,
[127]253 NewViewConstantsUnit,
[107]254 ACLUtility,
255 ACLFileIOUtility,
[18]256 AStringUtilityUnit,
257 ACLLanguageUnit,
[38]258 StringUtilsUnit,
[140]259 CharUtilsUnit,
[18]260 SettingsUnit;
261
262const
263 IPFColors: array[ 0..15 ] of string =
264 (
265 //rrggbb
266 '', // default
267 '#0000ff', // blue
268 '#ff0000', // red
269 '#ff00ff', // pink (purple)
270 '#00ff00', // green
271 '#00ffff', // cyan
272 '#ffff00', // yellow
273 '#808000', // neutral = brown
274 '#404040', // dark gray
275 '#000080', // dark blue
276 '#800000', // dark red
277 '#800080', // dark pink (purple)
278 '#008000', // dark green
279 '#008080', // dark cyan
280 '#000000', // black
281 '#c0c0c0' // pale gray
282 );
283
284 // for ecHighlight1
285 IPFHighlight1Tags : array [ 0..6 ] of string =
286 (
287 '</i></b></u></color>', // normal
288 '<i>', // hp1 italitc
289 '<b>', // hp2 bold
290 '<b><i>', // hp3 bold italic
291 '<u>', // hp5 underline
292 '<u><i>', // hp6 underline italic
293 '<u><b>' // hp7 underline bold
294 );
295
296 // for ecHighlight2
297 IPFHighlight2Tags : array [ 0..3 ] of string =
298 (
299 '</i></b></u></color>', // normal
300 '<color blue>', // hp4 blue
301 '<color red>', // hp8 red
302 '<color purple>' // hp9 purple
303 );
304
305 BlankString: string = '';
306
307var
308 DefaultTitle: string;
309
310Procedure OnLanguageEvent( Language: TLanguageFile;
311 const Apply: boolean );
312begin
[228]313 Language.LL( Apply, DefaultTitle, 'HelpTopic' + LANGUAGE_LABEL_DELIMITER + 'DefaultTitle', '(No title)' );
[18]314end;
315
[31]316
[18]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
[38]549 Result := RTF_NewLine + Result + RTF_NewLine;
[18]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=' );
[140]566 Write( F, StrInSingleQuotes('img' + IntToStr(ImageIndex) + '.bmp') );
[18]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
[140]827// TODO
[18]828function FullDoubleQuote( const s: string ): string;
829begin
[140]830 Result := StrDoubleQuote
831 + StrEscapeAllCharsBy(s, [], CharDoubleQuote)
832 + StrDoubleQuote;
[18]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;
[127]858 T.AddString( '<blue><link ' + PARAM_LINK_URL + ' "' );
[18]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;
[38]906 ProgramInfo : TSerializableStringList;
[140]907 tmpProgramLinkParts : TStringList;
[18]908
909 OutputString: string;
910begin
911 EscapeLen := pData^;
912 EscapeCode := (pData + 1) ^;
913 OutputString := '';
914
915 case EscapeCode of
916
917 ecSetLeftMargin:
918 begin
919 CheckForAutoURL( Text, State );
920 Margin := integer( ( pData + 2 )^ );
921 GetMarginTag( Margin, State.FontState, OutputString, false );
922 end;
923
924 ecSetLeftMarginNewLine:
925 begin
926 CheckForAutoURL( Text, State );
927 Margin := integer( ( pData + 2 )^ );
928 GetMarginTag( Margin, State.FontState, OutputString, false );
929 OutputString := OutputString
[38]930 + RTF_NewLine;
[18]931 end;
932
933 ecSetLeftMarginFit:
934 begin
935 CheckForAutoURL( Text, State );
936 Margin := integer( ( pData + 2 )^ );
937 GetMarginTag( Margin, State.FontState, OutputString, true );
938 // note that this will cause following tex to be "tabbed" across to the
939 // new margin position, if not yet there.
940 // if we are already past this margin then a new line should be started.
941
942 end;
943
944 ecSetLeftMarginHere:
945 begin
946 OutputString := '<leftmargin here>';
947 end;
948
949 ecHighlight1:
950 begin
951 StyleCode := ( pData + 2 ) ^;
952 if StyleCode <= High( IPFHighlight1Tags ) then
953 OutputString := IPFHighlight1Tags[ StyleCode ];
954 if StyleCode = 0 then
955 State.ForegroundColorTag := '</color>';
956 end;
957
958 ecHighlight2:
959 begin
960 StyleCode := ( pData + 2 ) ^;
961 if StyleCode <= High( IPFHighlight2Tags ) then
962 OutputString := IPFHighlight2Tags[ StyleCode ];
963
964 if StyleCode = 0 then
965 State.ForegroundColorTag := '</color>'
966 else
967 State.ForegroundColorTag := OutputString; // only colours
968 end;
969
970 ecLinkStart:
971 begin
972 CheckForAutoURL( Text, State );
973 if CreateLink( State.LinkIndex, Link, TInternalHelpLink ) then
974 begin
975 Link.TopicIndex := pUInt16( pData + 2 )^;
976
977 if EscapeLen >= 6 then
978 begin
979 GetExtraLinkData( Link, pData + 4 );
980 end;
981 end;
982
983 // If it's not an automatic link
984 // then put code in to show it.
985 if not Link.Automatic then
986 begin
987 OutputString := '<blue>'
988 + GetBeginLink( State.LinkIndex );
989 end;
990
991 inc( State.LinkIndex );
992 end;
993
994 ecFootnoteLinkStart:
995 begin
996 CheckForAutoURL( Text, State );
997 if CreateLink( State.LinkIndex, FootnoteLink, TFootnoteHelpLink ) then
998 begin
999 FootnoteLink.TopicIndex := pUInt16( pData + 2 )^;
1000 State.FootnoteLink := FootnoteLink;
1001 end;
1002
1003 OutputString := '<blue>'
1004 + GetBeginLink( State.LinkIndex );
1005
1006 inc( State.LinkIndex );
1007 end;
1008
1009 ecStartLinkByResourceID:
1010 begin
1011 CheckForAutoURL( Text, State );
1012 if CreateLink( State.LinkIndex, LinkByResourceID, THelpLinkByResourceID ) then
1013 begin
1014 LinkByResourceID.ResourceID := pUInt16( pData + 2 )^;
1015
1016 if EscapeLen >= 6 then
1017 begin
1018 GetExtraLinkData( LinkByResourceID, pData + 4 );
1019 end;
1020 end;
1021
1022 OutputString := '<blue>'
1023 + GetBeginLink( State.LinkIndex );
1024
1025 inc( State.LinkIndex );
1026 end;
1027
1028 ecExternalLink:
1029 begin
1030 CheckForAutoURL( Text, State );
1031 // :link reftype=hd refid=... database=<filename>
1032 ExternalLinkFileIndex := ( pData + 2 )^;
[140]1033 ExternalLinkTopicID := StrPasWithLength( pchar( pData + 4 ), ( pData + 3 )^ );
[127]1034 OutputString := '<blue><link ' + PARAM_LINK_EXTERNAL + ' '
[18]1035 + IntToStr( ExternalLinkFileIndex )
1036 + ' '
1037 + ExternalLinkTopicID
1038 + '>'
1039
1040 end;
1041
1042 ecProgramLink:
1043 begin
1044 CheckForAutoURL( Text, State );
[140]1045 ProgramLink := StrPasWithLength( pchar( pData + 3 ), EscapeLen - 3 );
1046
1047 tmpProgramLinkParts := TStringList.Create;
1048 StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0);
1049 ProgramPath := tmpProgramLinkParts[0];
1050 tmpProgramLinkParts.Destroy;
1051
[18]1052 ProgramFilename := ExtractFilename( ProgramPath );
[140]1053
1054 if StrStartsWithIgnoringCase(PRGM_EXPLORER, ProgramFilename ) // web explorer?
1055 or StrStartsWithIgnoringCase(PRGM_NETSCAPE, ProgramFilename )
1056 or StrStartsWithIgnoringCase(PRGM_MOZILLA, ProgramFilename )
1057 or StrStartsWithIgnoringCase(PRGM_FIREFOX, ProgramFilename )
[18]1058 then
[66]1059 begin
[127]1060 OutputString := '<blue><link ' + PARAM_LINK_URL + ' '
[18]1061 + FullDoubleQuote( ProgramLink )
[66]1062 + '>';
1063 end
[18]1064 else
[66]1065 begin
[38]1066 ProgramInfo := TSerializableStringList.create;
1067 ProgramInfo.add(ProgramPath);
1068 ProgramInfo.add(ProgramLink);
[127]1069 OutputString := '<blue><link ' + PARAM_LINK_PROGRAM + ' '
[38]1070 + ProgramInfo.getSerializedString
1071 + '>';
1072 ProgramInfo.destroy;
[66]1073 end;
[18]1074 end;
1075
1076 ecLinkEnd:
1077 begin
1078 OutputString := GetEndLinkTags( State );
1079 if State.FootnoteLink <> nil then
1080 State.FootnoteLink := nil;
1081 end;
1082
1083 ecStartCharGraphics:
1084 begin
1085 State.FontState := fsFixed;
1086 State.InCharGraphics := true;
[38]1087 OutputString := RTF_NewLine + RTF_NewLine + '<tt><wrap no>';
[18]1088 State.Spacing := false;
1089 WordsOnLine := 0;
1090 end;
1091
1092 ecEndCharGraphics:
1093 begin
1094 State.FontState := fsNormal;
1095 State.InCharGraphics := false;
[38]1096 OutputString := '</tt><wrap yes>' + RTF_NewLine;
[18]1097 State.Spacing := true;
1098 end;
1099
1100 ecImage:
1101 begin
1102 CheckForAutoURL( Text, State );
1103 BitmapFlags := ( pData + 2 )^;
1104 BitmapOffset := pUInt32( pData + 3 )^;
1105
1106 OutputString := GetImageText( State.Alignment,
1107 BitmapOffset,
1108 BitmapFlags,
1109 ImageOffsets );
[38]1110 if State.Spacing
1111 AND (OutputString[Length(OutputString)] <> RTF_NewLine) // no space after a line break
1112 then
[18]1113 OutputString := OutputString + ' ';
1114 end;
1115
1116 ecLinkedImage:
1117 begin
1118 CheckForAutoURL( Text, State );
1119 ProcessLinkedImage( State,
1120 pData,
1121 OutputString,
1122 ImageOffsets );
1123 if State.Spacing then
1124 OutputString := OutputString + ' ';
1125
1126 // Note! Early exit, since the procedure
1127 // will update pData.
1128 Text.AddString( OutputString );
1129 exit;
1130 end;
1131
1132 ecStartLines:
1133 begin
1134 CheckForAutoURL( Text, State );
1135 // aligned text
1136 case ( pData + 2 )^ of
1137 0, // just in case - to match image alignment oddities
1138 1:
1139 begin
[38]1140 OutputString := RTF_NewLine + '<align left>';
[18]1141 State.Alignment := itaLeft;
1142 end;
1143
1144 2:
1145 begin
[38]1146 OutputString := RTF_NewLine + '<align right>';
[18]1147 State.Alignment := itaRight;
1148 end;
1149
1150 4:
1151 begin
[38]1152 OutputString := RTF_NewLine + '<align center>';
[18]1153 State.Alignment := itaCenter;
1154 end;
1155 end;
1156 OutputString := OutputString + '<wrap no>';
1157 WordsOnLine := 0;
1158 end;
1159
1160 ecEndLines:
1161 begin
1162 CheckForAutoURL( Text, State );
1163 // supposed to turn word wrap on, default font
1164 OutputString := '<align left><wrap yes>'; // I guess...
1165 State.Alignment := itaLeft;
1166 end;
1167
1168 ecForegroundColor:
1169 begin
1170 ColorCode := ( pData + 2 )^;
1171 if ColorCode = 0 then
1172 State.ForegroundColorTag := '</color>'
1173 else if ColorCode <= High( IPFColors ) then
1174 State.ForegroundColorTag := '<color ' + IPFColors[ ColorCode ] + '>';
1175 OutputString := State.ForegroundColorTag;
1176 end;
1177
1178 ecBackgroundColor:
1179 begin
1180 ColorCode := ( pData + 2 )^;
1181 if ColorCode = 0 then
1182 State.BackgroundColorTag := '</backcolor>'
1183 else if ColorCode <= High( IPFColors ) then
1184 State.BackgroundColorTag := '<backcolor ' + IPFColors[ ColorCode ] + '>';
1185 OutputString := State.BackgroundColorTag;
1186 end;
1187
1188 ecFontChange:
1189 begin
1190 FontIndex := ( pData + 2 )^;
1191 if FontIndex = 0 then
1192 begin
1193 // back to default font
1194 OutputString := '</font>';
1195 State.FontState := fsNormal;
1196 end
1197 else if FontIndex < _FontTable.Count then
1198 begin
1199 // valid font index
1200 pFontSpec := _FontTable[ FontIndex ];
1201
1202 if pFontSpec = SubstituteFixedFont then
1203 begin
1204 OutputString := '<tt>';
1205 State.FontState := fsFixed;
1206 end
1207 else
1208 begin
1209 pFontSpec := _FontTable[ FontIndex ];
[140]1210 FaceName := StrPasWithLength( pFontSpec ^. FaceName,
[18]1211 sizeof( pFontSpec ^. FaceName ) );
1212 // arbitrarily and capriciously use specified height * 2/3
1213 // as the point size - seems to correspond to what original
1214 // view wanted... note this doesn't necessarily scale
1215 // correctly, since default font could be different. whatever.
1216 PointSize := pFontSpec ^. Height * 2 div 3;
1217
1218 if PointSize < 8 then
1219 PointSize := 8;
1220 // quote font name, escape double quotes with duplicates
1221 // e.g. Bob's "Big" Font would become
1222 // "Bob's ""Big"" Font"
1223 QuotedFaceName := FullDoubleQuote( FaceName );
1224 OutputString := '<font '
1225 + QuotedFaceName
1226 + ' '
1227 + IntToStr( PointSize )
1228 + '>';
1229 {
1230 // for when (if ever) RTV allows setting font
1231 // by precise dimensions
1232 + '['
1233 + IntToStr( pFontSpec ^. Width )
1234 + 'x'
1235 + IntToStr( pFontSpec ^. Height )
1236 + ']';
1237 }
1238 State.FontState := fsCustom;
1239 end;
1240 end;
1241 end
1242 end; // case escape code of...
1243
1244 Text.AddString( OutputString );
1245
1246 inc( pData, EscapeLen );
1247end;
1248
1249// returns true if the escape code results in whitespace
1250// also updates the bits of State that relate to spacing
1251// ie. .Spacing, and .InCharGraphics (which affects whether
1252// spacing is reset at paragraph ends etc)
1253function TTopic.IPFEscapeCodeSpace( Var State: TParseState;
1254 Var pData: pUInt8 ): boolean;
1255var
1256 EscapeLen: uint8;
1257 EscapeCode: uint8;
1258
1259begin
1260 EscapeLen := pData^;
1261 EscapeCode := (pData + 1) ^;
1262
1263 result := false; // for most
1264 case EscapeCode of
1265 ecSetLeftMargin,
1266 ecSetLeftMarginNewLine,
1267 ecSetLeftMarginFit:
1268 result := true;
1269
1270 ecStartCharGraphics:
1271 begin
1272 result := true;
1273 State.InCharGraphics := true;
1274 State.Spacing := false;
1275 end;
1276
1277 ecEndCharGraphics:
1278 begin
1279 result := true;
1280 State.InCharGraphics := false;
1281 State.Spacing := true;
1282 end;
1283
1284 ecImage:
1285 result := State.Spacing;
1286
1287 ecLinkedImage:
1288 result := State.Spacing;
1289
1290 ecStartLines:
1291 begin
1292 result := true;
1293 State.Spacing := false;
1294 end;
1295
1296 ecEndLines:
1297 begin
1298 result := true;
1299 // supposed to turn word wrap on, default font
1300 State.Spacing := true;
1301 end;
1302 end; // case escape code of...
1303
1304 inc( pData, EscapeLen );
1305end;
1306
1307procedure TTopic.EnsureSlotsLoaded;
1308var
1309 i: longint;
1310 pSlotNumber: puint16;
1311 SlotNumber: uint16;
1312 SlotHeader: TSlotHeader;
1313 Slot: THelpTopicSlot;
1314begin
1315 if _Slots = nil then
1316 begin
1317 try
1318 _Slots := TList.Create;
1319
1320 // Read slot data
1321 pSlotNumber := _pSlotNumbers;
1322
1323 for i := 0 to _NumSlots - 1 do
1324 begin
1325 SlotNumber := pSlotNumber^;
1326
1327 // Seek to start of slot
1328 try
1329 MySeek( _FileHandle,
1330 _pSlotOffsets^[ SlotNumber ] );
1331 except
1332 // not a valid offset
1333 raise EHelpFileException.Create( ErrorCorruptHelpFile );
1334 end;
1335
1336 // Read header
1337 if not MyRead( _FileHandle,
1338 Addr( SlotHeader ),
1339 sizeof( SlotHeader ) ) then
1340 // couldn't read slot header
1341 raise EHelpFileException.Create( ErrorCorruptHelpFile );
1342
1343 // Create slot object
1344 Slot := THelpTopicSlot.Create;
1345
1346 Slot.LocalDictSize := SlotHeader.nLocalDict;
1347 Slot.Size := SlotHeader.ntext;
1348
1349 // Allocate and read slot dictionary
1350 ReadFileBlock( _FileHandle,
1351 Slot.pLocalDictionary,
1352 SlotHeader.localDictPos,
1353 uint32( Slot.LocalDictSize ) * sizeof( uint16 ) );
1354
1355 // Allocate and read slot data (text)
1356 ReadFileBlock( _FileHandle,
1357 Slot.pData,
1358 _pSlotOffsets^[ SlotNumber ] + sizeof( TSlotHeader ),
1359 Slot.Size );
1360
1361 _Slots.Add( Slot );
1362
1363 inc( pSlotNumber, sizeof( UInt16 ) );
1364 end;
1365 except
1366 on E: EHelpFileException do
1367 begin
1368 DestroyListAndObjects( _Slots );
1369 raise;
1370 end;
1371 end;
1372 end;
1373end;
1374
1375// returns a global dict index.
1376// or, -1 for a whitespace item.
1377// or, -2 for end of text.
1378function TTopic.GetNextIPFTextItem( Var SlotIndex: longint;
1379 Var pData: pUInt8;
1380 Var State: TParseState ): longint;
1381var
1382 Slot: THelpTopicSlot;
1383 pSlotEnd: pUInt8;
1384
1385 LocalDictIndex: uint8;
1386begin
1387 while SlotIndex < _NumSlots do
1388 begin
1389 Slot := _Slots[ SlotIndex ];
1390 pSlotEnd := Slot.pData + Slot.Size;
1391
1392 while pData < pSlotEnd do
1393 begin
1394 LocalDictIndex := pData^;
1395 inc( pData );
1396
1397 if LocalDictIndex < Slot.LocalDictSize then
1398 begin
1399 // Normal word lookup
1400 result := Slot.pLocalDictionary^[ LocalDictIndex ];
1401 exit;
1402 end;
1403
1404 // special code
1405 case LocalDictIndex of
1406 IPF_END_PARA:
1407 begin
1408 result := -1;
1409 if not State.InCharGraphics then
1410 State.Spacing := true;
1411 exit;
1412 end;
1413
1414 IPF_CENTER:
1415 begin
1416 result := -1;
1417 exit;
1418 end;
1419
1420 IPF_INVERT_SPACING:
1421 begin
1422 State.Spacing := not State.Spacing;
1423 end;
1424
1425 IPF_LINEBREAK:
1426 begin
1427 result := -1;
1428 if not State.InCharGraphics then
1429 State.Spacing := true;
1430 exit;
1431 end;
1432
1433 IPF_SPACE:
1434 begin
1435 result := -1;
1436 exit;
1437 end;
1438
1439 IPF_ESC:
1440 begin
1441 // escape sequence
1442 if IPFEscapeCodeSpace( State, pData ) then
1443 result := -1;
1444 end;
1445 end;
1446 end; // while in slot...
1447 inc( SlotIndex );
1448 end;
1449 Result := -2;
1450end;
1451
1452// Checks to see if the given word (at pData)
1453// starts one of the given sequences, by looking forward
1454// If found, returns the length of the sequence.
1455function TTopic.CheckForSequence( WordSequences: TList;
1456 SlotIndex: longint;
1457 pData: pUint8;
1458 State: TParseState;
1459 GlobalDictIndex: longint;
1460 ): longint;
1461var
1462 WordSequence: TList;
1463 SequenceStepIndex: longint;
1464 pSequenceStepWords: Uint32ArrayPointer;
1465
1466 SequenceIndex: longint;
1467
1468 SlotIndexTemp: longint;
1469 pDataTemp: pUint8;
1470 StateTemp: TParseState;
1471// s : string;
1472 DictIndex: longint;
1473begin
1474 result := 0; // if we don't find a match.
1475
1476 for SequenceIndex := 0 to WordSequences.Count - 1 do
1477 begin
1478 WordSequence := WordSequences[ SequenceIndex ];
1479 pSequenceStepWords := WordSequence[ 0 ];
1480
1481 if pSequenceStepWords^[ GlobalDictIndex ] > 0 then
1482 begin
1483 // matched first step in this sequence. Look ahead...
1484
1485 SequenceStepIndex := 0;
1486
1487 pDataTemp := pData;
1488 SlotIndexTemp := SlotIndex;
1489 StateTemp := State;
1490 while true do
1491 begin
1492 inc( SequenceStepIndex );
1493 if SequenceStepIndex = WordSequence.Count then
1494 begin
1495 // have a match for the sequence, insert start highlight
1496 Result := WordSequence.Count;
1497 break;
1498 end;
1499
1500 // get words for next step in sequence
1501 pSequenceStepWords := WordSequence[ SequenceStepIndex ];
1502
1503 DictIndex := GetNextIPFTextItem( SlotIndexTemp,
1504 pDataTemp,
1505 StateTemp );
1506 if DictIndex = -2 then
1507 begin
1508 // end of text - abort
1509 break;
1510 end;
1511
1512 if DictIndex = -1 then
1513 begin
1514 // whitespace - abort
1515 // for multi-word phrase searching - count this and subsequent whitespace...
1516 break;
1517 end;
1518
1519 // s := pstring( _GlobalDictionary[ DictIndex ] )^; // for debug only
[140]1520 if not StrIsEmptyOrSpaces( pstring( _GlobalDictionary[ DictIndex ] )^ ) then
[18]1521 begin
1522 if pSequenceStepWords^[ DictIndex ] = 0 then
1523 begin
1524 // word doesn't match - abort
1525 break;
1526 end;
1527 end;
1528
1529 end; // while
1530
1531 end;
1532 // else - doesn't match first step, do nothing
1533 end; // for sequenceindex ...
1534end;
1535
1536// Main translation function. Turns the IPF data into
1537// a text string. Translates formatting codes into tags
1538// as for Rich Text Viewer.
1539// Uses TAString for speed without length limits
1540// - string is too short
1541// - PChar is slow to concatenate (unless you keep track of the insert point)
1542// - AnsiString is slow
1543procedure TTopic.GetText( HighlightSequences: TList;
1544 // each element is a TList
1545 // containing a sequence of possible words
1546 // each element of each sequence
1547 // is an array of flags for the dictionary
1548 // indicating if the word is a allowed match at that step
1549 // a match is any sequence that matches one or more words at each step.
1550 ShowCodes: boolean;
1551 ShowWordSeparators: boolean;
1552 Text: TAString;
1553 ImageOffsets: TList;
1554 HighlightMatches: TList );
1555var
1556 SlotIndex: integer;
1557 Slot: THelpTopicSlot;
1558 pData: pUInt8;
1559 pSlotEnd: pUInt8;
1560
1561 GlobalDictIndex: uint32;
1562
1563 WordsOnLine: longint;
1564
1565 StringToAdd: string;
1566 LocalDictIndex: uint8;
1567
1568 State: TParseState;
1569
1570 EscapeLen: uint8;
1571 i: longint;
1572
1573 SequenceStepIndex: longint;
1574begin
1575 if Links = nil then
1576 Links := TList.Create;
1577
1578 if HighlightMatches <> nil then
1579 HighlightMatches.Clear;
1580
1581 // Text.Clear;
1582 ImageOffsets.Clear;
1583
1584 try
1585 EnsureSlotsLoaded;
1586 except
1587 on E: EHelpFileException do
1588 begin
1589 Text.AddString( e.Message );
1590 exit;
1591 end;
1592 end;
1593
1594 WordsOnLine := 0;
1595
1596 State.LinkIndex := 0;
1597 State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
1598 State.InCharGraphics := false;
1599 State.Spacing := true;
1600 State.ForegroundColorTag := '</color>';
1601 State.BackgroundColorTag := '</backcolor>';
1602
1603 State.StartOfTextBlock := -1;
1604 State.TextBlock := TAString.Create;
1605
1606 State.FootnoteLink := nil;
1607
1608 Text.AddString( '<leftmargin 1>' );
1609
1610 SequenceStepIndex := 0;
1611
1612 for SlotIndex := 0 to _NumSlots - 1 do
1613 begin
1614 if not State.InCharGraphics then
1615 State.Spacing := true; // this is just a guess as to the exact view behaviour.
1616 // inf.txt indicates that spacing is reset to true at
1617 // slot (cell) start, but that doesn't seem to be the
1618 // case when in character graphics... hey ho.
1619
1620 Slot := _Slots[ SlotIndex ];
1621
1622 pData := Slot.pData;
1623
1624 pSlotEnd := pData + Slot.Size;
1625
1626 State.Alignment := itaLeft;
1627
1628 while pData < pSlotEnd do
1629 begin
1630 LocalDictIndex := pData^;
1631 inc( pData );
1632
1633 if LocalDictIndex < Slot.LocalDictSize then
1634 begin
1635 // Normal word lookup
1636 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
1637
1638 if ShowWordSeparators then
1639 Text.AddString( '{' + IntToStr( GlobalDictIndex )+ '}' );
1640
1641 // normal lookup
1642 if GlobalDictIndex < _GlobalDictionary.Count then
1643 StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
1644 else
1645 StringToAdd := '';
1646
[140]1647 if StrIsEmptyOrSpaces( StringToAdd ) then
[18]1648 begin
1649 // spaces only...
1650 CheckForAutoURL( Text, State );
1651 end
1652 else
1653 begin
1654 // really is a word, not a space.
1655
1656 // store string into "word"
1657 if State.TextBlock.Length = 0 then
1658 // store start of block
1659 State.StartOfTextBlock := Text.Length;
1660
1661 State.TextBlock.AddString( StringToAdd );
1662
1663 SubstituteAngleBrackets( StringToAdd );
1664
1665 if HighlightSequences <> nil then
1666 begin
1667 if SequenceStepIndex > 0 then
1668 begin
1669 // currently highlighting a sequence.
1670 dec( SequenceStepIndex );
1671 if SequenceStepIndex = 0 then
1672 begin
1673 // now finished, insert end highlight
1674 StringToAdd := StringToAdd
1675 + State.BackgroundColorTag;
1676
1677 end;
1678 end
1679 else
1680 begin
1681 // not yet in a sequence, searching.
1682 SequenceStepIndex :=
1683 CheckForSequence( HighlightSequences,
1684 SlotIndex,
1685 pData,
1686 State,
1687 GlobalDictIndex );
1688
1689 if SequenceStepIndex > 0 then
1690 begin
1691 // this word starts a sequence!
1692 if HighlightMatches <> nil then
1693 HighlightMatches.Add( pointer( Text.Length ) );
1694 StringToAdd := '<backcolor #'
1695 + IntToHex( Settings.Colors[ SearchHighlightTextColorIndex ], 6 )
1696 + '>'
1697 + StringToAdd;
1698 dec( SequenceStepIndex );
1699 if SequenceStepIndex = 0 then
1700 // and ends it.
1701 StringToAdd := StringToAdd
1702 + State.BackgroundColorTag;
1703 end;
1704
1705 end;
1706 end; // if processing sequence
1707 inc( WordsOnLine );
1708 end;
1709
1710 Text.AddString( StringToAdd );
1711
1712 if State.FootnoteLink <> nil then
1713 begin
1714 State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
1715 if State.Spacing then
1716 begin
1717 State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
1718 end;
1719 end;
1720
1721 if State.Spacing then
1722 begin
1723 CheckForAutoURL( Text, State );
1724
1725 Text.AddString( ' ' );
1726 end;
1727 end
1728 else
1729 begin
1730 // special code
1731
1732 if ShowCodes then
1733 begin
1734 Text.AddString( '[' + IntToHex( LocalDictIndex, 2 ) );
1735 if LocalDictIndex = IPF_ESC then
1736 begin
1737 EscapeLen := pData^;
1738 for i := 1 to EscapeLen - 1 do
1739 begin
1740 Text.AddString( ' '
1741 + IntToHex( ( pData + i )^, 2 ) );
1742 end;
1743
1744 end;
1745 Text.AddString( ']' );
1746 end;
1747
1748 case LocalDictIndex of
1749 IPF_END_PARA:
1750 begin
1751 if SlotIndex = 0 then
1752 if pData - 1 = Slot.pData then
1753 // ignore first FA, not needed with RichTextView
1754 continue;
1755
1756 CheckForAutoURL( Text, State );
1757 if State.Alignment = itaCenterOnePara then
1758 begin
1759 State.Alignment := itaLeft;
1760 Text.AddString( '<align left>' );
1761 end;
[38]1762 Text.AddString(RTF_NewLine);
[18]1763
1764 if WordsOnLine > 0 then
[38]1765 Text.AddString(RTF_NewLine);
[18]1766
1767 if not State.InCharGraphics then
1768 State.Spacing := true;
1769
1770 WordsOnLine := 0;
1771 end;
1772
1773 IPF_CENTER:
1774 begin
1775 CheckForAutoURL( Text, State );
[38]1776 Text.addString( RTF_NewLine + '<align center>' );
[18]1777 State.Alignment := itaCenterOnePara;
1778 end;
1779
1780 IPF_INVERT_SPACING:
1781 begin
1782 State.Spacing := not State.Spacing;
1783 end;
1784
1785 IPF_LINEBREAK:
1786 begin
1787 CheckForAutoURL( Text, State );
1788
1789 if State.Alignment = itaCenterOnePara then
1790 begin
1791 State.Alignment := itaLeft;
1792 Text.AddString( '<align left>' );
1793 end;
[38]1794 Text.AddString( RTF_NewLine );
[18]1795 if not State.InCharGraphics then
1796 State.Spacing := true;
1797 WordsOnLine := 0;
1798 end;
1799
1800 IPF_SPACE:
1801 begin
1802 CheckForAutoURL( Text, State );
1803 if State.Spacing then
[38]1804 Text.AddString( ' ' );
[18]1805 end;
1806
1807 IPF_ESC:
1808 begin
1809 // escape sequence
1810 TranslateIPFEscapeCode( State,
1811 pData,
1812 Text,
1813 WordsOnLine,
1814 ImageOffsets );
1815
1816 end;
1817
1818 end; // case code of...
1819 end;
1820 end; // for slotindex = ...
1821 end;
1822 State.TextBlock.Destroy;
1823
1824end;
1825
1826function TTopic.SearchForWord( DictIndex: integer;
1827 StopAtFirstOccurrence: boolean )
1828 : longint;
1829var
1830 SlotIndex: integer;
1831 Slot: THelpTopicSlot;
1832 pData: pUInt8;
1833 pSlotEnd: pUInt8;
1834
1835 EscapeLen: longint;
1836
1837 GlobalDictIndex: uint32;
1838
1839 LocalDictIndex: uint8;
1840begin
1841 EnsureSlotsLoaded;
1842
1843 Result := 0;
1844 for SlotIndex := 0 to _NumSlots - 1 do
1845 begin
1846 Slot := _Slots[ SlotIndex ];
1847
1848 pData := Slot.pData;
1849
1850 pSlotEnd := pData + Slot.Size;
1851
1852 while pData < pSlotEnd do
1853 begin
1854 LocalDictIndex := pData^;
1855
1856 if LocalDictIndex < Slot.LocalDictSize then
1857 begin
1858 // Normal word lookup
1859 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
1860
1861 if GlobalDictIndex = DictIndex then
1862 begin
1863 inc( result );
1864 if StopAtFirstOccurrence then
1865 exit;
1866 end;
1867 end
1868 else
1869 begin
1870 // special code
1871 if LocalDictIndex = $ff then
1872 begin
1873 // escape string, skip it
1874 EscapeLen := ( pData + 1 ) ^;
1875 inc( pData, EscapeLen );
1876 end;
1877 end;
1878
1879 inc( pData );
1880 end; // for slotindex = ...
1881 end;
1882end;
1883
1884// Search for a sequence of bytes, including in escape codes
1885// this is for debugging to allow finding specific sequences
1886function TTopic.SearchForData( Data: pbyte;
1887 DataLen: integer ): boolean;
1888var
1889 SlotIndex: integer;
1890 Slot: THelpTopicSlot;
1891 pData: pUInt8;
1892 pSlotEnd: pUInt8;
1893
1894 pHold: pUint8;
1895 pSearch: pUint8;
1896begin
1897 EnsureSlotsLoaded;
1898
1899 for SlotIndex := 0 to _NumSlots - 1 do
1900 begin
1901 Slot := _Slots[ SlotIndex ];
1902
1903 pSearch := Data;
1904 pHold := Slot.pData;
1905 pData := Slot.pData;
1906 pSlotEnd := Slot.pData + Slot.Size;
1907
1908 while pHold < pSlotEnd do
1909 begin
1910 if pData^ = pSearch^ then
1911 begin
1912 // byte matches
1913 inc( pData );
1914 inc( pSearch );
1915 if ( pSearch >= Data + DataLen ) then
1916 begin
1917 // matches
1918 result := true;
1919 exit;
1920 end
1921 end
1922 else
1923 begin
1924 // no match
1925 pSearch := Data;
1926 inc( pHold );
1927 pData := pHold;
1928 end;
1929 end; // for slotindex = ...
1930 end;
1931
1932 result := false; // not found
1933end;
1934
1935function TTopic.SearchForWordSequences( WordSequence: TList;
1936 StopAtFirstOccurrence: boolean )
1937 : longint;
1938var
1939 SlotIndex: integer;
1940 Slot: THelpTopicSlot;
1941 pData: pUInt8;
1942 pSlotEnd: pUInt8;
1943
1944 EscapeLen: longint;
1945
1946 GlobalDictIndex: uint32;
1947 IsWord: boolean;
1948 WordRelevance: uint32;
1949
1950 CurrentMatchRelevance: uint32; // total relevances for words matched so far
1951 // in the current sequence
1952
1953// CurrentMatch: string; // useful for debugging only
1954 LocalDictIndex: uint8;
1955
1956 SequenceIndex: longint;
1957 SequenceStartSlotIndex: longint;
1958 pSequenceStartData: pUInt8;
1959
1960 pStepWordRelevances: UInt32ArrayPointer; // word relevances for the current step in the sequence
1961
1962 // get the current slot start and end pointers
1963 procedure GetSlot;
1964 begin
1965 Slot := self._Slots[ SlotIndex ];
1966 pData := Slot.pData;
1967 pSlotEnd := pData + Slot.Size;
1968 end;
1969
1970 // get pointer to the current set of word relevances
1971 procedure GetStepFlags;
1972 begin
1973 pStepWordRelevances := WordSequence[ SequenceIndex ];
1974 end;
1975
1976 // store the current point as start of a sequence
1977 procedure StoreStartOfSequence;
1978 begin
1979 SequenceIndex := 0;
1980 SequenceStartSlotIndex := SlotIndex;
1981 pSequenceStartData := pData;
1982 CurrentMatchRelevance := 0;
1983// CurrentMatch := '';
1984 GetStepFlags;
1985 end;
1986
1987begin
1988 Result := 0;
1989
1990 EnsureSlotsLoaded;
1991
1992 if _NumSlots = 0 then
1993 // thar's nowt in yon topic, cannae be a match laid
1994 exit;
1995
1996 SlotIndex := 0;
1997
1998 GetSlot;
1999
2000 StoreStartOfSequence;
2001
2002 while true do
2003 begin
2004 LocalDictIndex := pData^;
2005 IsWord := false;
2006 if LocalDictIndex < Slot.LocalDictSize then
2007 begin
2008 IsWord := true;
2009 // Normal word lookup, so get the global dict idnex before we
2010 // (potentially) move to next slot
2011 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
2012 end;
2013
2014 inc( pData );
2015 if pData >= pSlotEnd then
2016 begin
2017 // reached end of slot, next please
2018 inc( SlotIndex );
2019 if SlotIndex < _NumSlots then
2020 GetSlot;
2021 // else - there is nothing more to search
2022 // but we need to check this last item
2023 end;
2024
2025 if IsWord then
2026 begin
2027 // Normal word lookup
2028 WordRelevance := 0;
2029
2030 if GlobalDictIndex < _GlobalDictionary.Count then
[140]2031 if not StrIsEmptyOrSpaces( pstring( _GlobalDictionary[ GlobalDictIndex ] )^ ) then;
[18]2032 WordRelevance := pStepWordRelevances[ GlobalDictIndex ];
2033
2034 if WordRelevance > 0 then
2035 begin
2036 // Found a matching word
2037 inc( CurrentMatchRelevance, WordRelevance );
2038// debug:
2039// CurrentMatch := CurrentMatch +
2040// pstring( _GlobalDictionary[ GlobalDictIndex ] )^;
2041
2042 if SequenceIndex = 0 then
2043 begin
2044 // remember next start point
2045 SequenceStartSlotIndex := SlotIndex;
2046 pSequenceStartData := pData;
2047 end;
2048
2049 inc( SequenceIndex );
2050
2051 if SequenceIndex < WordSequence.Count then
2052 begin
2053 // get next set of flags.
2054 GetStepFlags;
2055 end
2056 else
2057 begin
2058 // found a complete sequence. Cool!
2059
2060 inc( result, CurrentMatchRelevance );
2061
2062 if StopAtFirstOccurrence then
2063 exit;
2064
2065 // start looking from the beginning of the sequence again.
2066 StoreStartOfSequence;
2067 end;
2068 end
2069 else
2070 begin
2071 // not a match at this point, restart search
2072 if SequenceIndex > 0 then
2073 begin
2074 // we had matched one or more steps already,
2075 // back to start of sequence AND back to
2076 // point we started matching from (+1)
2077 SequenceIndex := 0;
2078 CurrentMatchRelevance := 0;
2079// CurrentMatch := '';
2080 SlotIndex := SequenceStartSlotIndex;
2081 GetSlot;
2082 pData := pSequenceStartData;
2083 GetStepFlags;
2084 end
2085 else
2086 begin
2087 // haven't matched anything yet.
2088 // update start of sequence
2089 SequenceStartSlotIndex := SlotIndex;
2090 pSequenceStartData := pData;
2091 end;
2092 end;
2093 end
2094 else
2095 begin
2096 // special code
2097 if LocalDictIndex = $ff then
2098 begin
2099 // escape string, skip it
2100 EscapeLen := pData ^;
2101 inc( pData, EscapeLen );
2102 end;
2103 end;
2104
2105 if SlotIndex >= _NumSlots then
2106 begin
2107 // finished searching topic
2108 break;
2109 end;
2110
2111 // next item
2112 end;
2113end;
2114
2115
2116function TTopic.CountWord( DictIndex: integer ): longint;
2117begin
2118 Result := SearchForWord( DictIndex, false );
2119end;
2120
2121function TTopic.ContainsWord( DictIndex: integer ): boolean;
2122begin
2123 Result := SearchForWord( DictIndex, true ) > 0;
2124end;
2125
2126// Gets the window dimensions specified by this topic's
2127// contents header
2128procedure TTopic.GetContentsWindowRect( ContentsRect: THelpWindowRect );
2129var
2130 extendedinfo: TExtendedTOCEntry;
2131 XY: THelpXYPair;
2132 p: pbyte;
2133
2134 Flags: byte;
2135begin
2136 Flags := _pTOCEntry ^.flags;
2137 p := pByte( _pTOCEntry + sizeof( TTOCEntryStart ) );
2138
2139 ContentsRect.Left := 0;
2140 ContentsRect.Bottom := 0;
2141 ContentsRect.Width := 100;
2142 ContentsRect.Height := 100;
2143
2144 if ( Flags and TOCEntryExtended ) > 0 then
2145 begin
2146 // have more details available...
2147 ExtendedInfo.w1 := p^;
2148 ExtendedInfo.w2 := ( p+1) ^;
2149 inc( p, sizeof( ExtendedInfo ) );
2150
2151 if ( ExtendedInfo.w1 and 1 ) > 0 then
2152 begin
2153 // read origin
2154 XY := pHelpXYPair( p )^;
2155 inc( p, sizeof( XY ) );
2156 ReadHelpPosition( XY, ContentsRect );
2157 end;
2158 if ( ExtendedInfo.w1 and 2 ) > 0 then
2159 begin
2160 // read size
2161 XY := pHelpXYPair( p )^;
2162 inc( p, sizeof( XY ) );
2163 ReadHelpSize( XY, ContentsRect );
2164 end;
2165 end;
2166end;
2167
2168const
2169 IPFColorNames: array[ 0..15 ] of string =
2170 (
2171 'default',
2172 'blue',
2173 'red',
2174 'pink',
2175 'green',
2176 'cyan',
2177 'yellow',
2178 'neutral',
2179// 'brown', ??
2180 'darkgray',
2181 'darkblue',
2182 'darkred',
2183 'darkpink',
2184 'darkgreen',
2185 'darkcyan',
2186 'black',
2187 'palegray'
2188 );
2189
2190Procedure SaveExtraLinkData( Link: TWindowedHelpLink;
2191 pData: pUInt8 );
2192var
2193 LinkFlags1: uint8;
2194 LinkFlags2: uint8;
2195 LinkDataIndex: longint;
2196 pLinkXY: pHelpXYPair;
2197 pLinkData: pUInt8;
2198begin
2199 LinkFlags1 := ( pData + 0 ) ^;
2200 LinkFlags2 := ( pData + 1 ) ^;
2201
2202 pLinkData := pData + 2;
2203
2204 if ( LinkFlags1 and 1 ) > 0 then
2205 begin
2206 // position specified
2207 pLinkXY := pHelpXYPair( pLinkData );
2208 inc( pLinkData, sizeof( THelpXYPair ) );
2209 end;
2210
2211 if ( LinkFlags1 and 2 ) > 0 then
2212 begin
2213 // size specified
2214 pLinkXY := pHelpXYPair( pLinkData );
2215 inc( pLinkData, sizeof( THelpXYPair ) );
2216 end;
2217
2218 if ( LinkFlags1 and 8 ) > 0 then
2219 begin
2220 // window controls specified - skip
2221 inc( pLinkData, 2 );
2222 end;
2223
2224 if ( LinkFlags2 and 4 ) > 0 then
2225 begin
2226 // group specified
2227 Link.GroupIndex := pUInt16( pLinkData )^;
2228 inc( LinkDataIndex, sizeof( uint16 ) );
2229 end;
2230
2231 if ( LinkFlags1 and 64 ) > 0 then
2232 begin
2233 Link.Automatic := true;
2234 end;
2235
2236 if ( LinkFlags1 and 4 ) > 0 then
2237 Link.ViewPort := true;
2238
2239 if ( LinkFlags2 and 2 ) > 0 then
2240 Link.Dependent := true;
2241
2242 if ( LinkFlags1 and 128 ) > 0 then
2243 Link.Split := true;
2244
2245 // cant be bothered with the others.
2246end;
2247
2248procedure TTopic.SaveIPFEscapeCode( Var State: TParseState;
2249 Var pData: pUInt8;
2250 Var F: TextFile;
2251 ImageOffsets: TList );
2252var
2253 EscapeLen: uint8;
2254 EscapeCode: uint8;
2255
2256 Margin: integer;
2257
2258 BitmapOffset: longword;
2259 BitmapFlags: uint8;
2260
2261 ColorCode: uint8;
2262 StyleCode: uint8;
2263
2264 FontIndex: uint8;
2265 pFontSpec: pTHelpFontSpec;
2266
2267 FaceName: string;
2268
2269 ExternalLinkFileIndex: uint8;
2270 ExternalLinkTopicID: string;
2271
2272 ProgramLink: string;
2273 ProgramPath: string;
[140]2274 tmpProgramLinkParts : TStringList;
[18]2275
2276 OutputString: string;
2277begin
2278 EscapeLen := pData^;
2279 EscapeCode := (pData + 1) ^;
2280 OutputString := '';
2281
2282 case EscapeCode of
2283
2284 ecSetLeftMargin:
2285 begin
2286 Margin := integer( ( pData + 2 )^ );
2287 GetMarginTag( Margin, State.FontState, OutputString, false );
2288 end;
2289
2290 ecSetLeftMarginNewLine:
2291 begin
2292 Margin := integer( ( pData + 2 )^ );
2293 GetMarginTag( Margin, State.FontState, OutputString, false );
2294 OutputString := OutputString
[38]2295 + RTF_NewLine;
[18]2296 end;
2297
2298 ecSetLeftMarginFit:
2299 begin
2300 Margin := integer( ( pData + 2 )^ );
2301 GetMarginTag( Margin, State.FontState, OutputString, true );
2302 // note that this will cause following tex to be "tabbed" across to the
2303 // new margin position, if not yet there.
2304 // if we are already past this margin then a new line should be started.
2305
2306 end;
2307
2308 ecSetLeftMarginHere:
2309 begin
2310 OutputString := '<leftmargin here>';
2311 end;
2312
2313 ecHighlight1: // hp1,2,3, 5,6,7
2314 begin
2315 StyleCode := ( pData + 2 ) ^;
2316 if StyleCode > 3 then
2317 StyleCode := StyleCode + 1; // 4, 8 and 9 are expressed in highlight2 code
2318
2319 if StyleCode > 0 then
2320 Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
2321 else
2322 Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
2323 State.StyleCode := StyleCode;
2324 end;
2325
2326 ecHighlight2: // hp4, 8, 9
2327 begin
2328 StyleCode := ( pData + 2 ) ^;
2329 case StyleCode of
2330 1: StyleCode := 4;
2331 2: StyleCode := 8;
2332 3: StyleCode := 9;
2333 end;
2334
2335 if StyleCode > 0 then
2336 Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
2337 else
2338 Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
2339 State.StyleCode := StyleCode;
2340 end;
2341
2342 ecLinkStart:
2343 begin
2344 Write( F, ':link reftype=hd' ); // link to heading
2345
2346 Write( F, ' refid=' + IntToStr( pUInt16( pData + 2 )^ ) );
2347
2348 {
2349 if EscapeLen >= 6 then
2350 begin
2351 GetExtraLinkData( Link, pData + 4 );
2352 end;}
2353
2354// if Link.Automatic then
2355// Write( F, ' auto' );
2356
2357 Write( F, '.' );
2358
2359 inc( State.LinkIndex );
2360 end;
2361
2362 ecFootnoteLinkStart:
2363 begin
2364 Write( F, ':link reftype=fn refid=fn'
2365 + IntToStr( pUInt16( pData + 2 )^ )
2366 + '.' );
2367 inc( State.LinkIndex );
2368 end;
2369
2370 ecStartLinkByResourceID:
2371 begin
2372 Write( F, ':link reftype=hd res='
2373 + IntToStr( pUInt16( pData + 2 )^ )
2374 + '.' );
2375
2376 inc( State.LinkIndex );
2377 end;
2378
2379 ecExternalLink:
2380 begin
2381 ExternalLinkFileIndex := ( pData + 2 )^;
[140]2382 ExternalLinkTopicID := StrPasWithLength( pchar( pData + 4 ), ( pData + 3 )^ );
[18]2383 Write( F, ':link reftype=hd '
[140]2384 + ' refid=' + StrInSingleQuotes( ExternalLinkTopicID )
2385 + ' database=' + StrInSingleQuotes( _ReferencedFiles[ ExternalLinkFileIndex ] )
[18]2386 + '.' );
2387
2388 end;
2389
2390 ecProgramLink:
2391 begin
[140]2392 ProgramLink := StrPasWithLength( pchar( pData + 3 ), EscapeLen - 3 );
2393
2394 tmpProgramLinkParts := TStringList.Create;
2395 StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0);
2396 ProgramPath := tmpProgramLinkParts[0];
2397 tmpProgramLinkParts.Destroy;
2398
[18]2399 Write( F, ':link reftype=launch'
[140]2400 + ' object=' + StrInSingleQuotes( ProgramPath )
2401 + ' data=' + StrInSingleQuotes( ProgramLink )
[18]2402 + '.' );
2403 end;
2404
2405 ecLinkEnd:
2406 begin
2407 Write( F, ':elink.' );
2408 if State.FootnoteLink <> nil then
2409 State.FootnoteLink := nil;
2410 end;
2411
2412 ecStartCharGraphics:
2413 begin
2414 State.FontState := fsFixed;
2415 State.InCharGraphics := true;
2416 WriteLn( F, '' );
2417 WriteLn( F, ':cgraphic.' );
2418 State.Spacing := false;
2419 end;
2420
2421 ecEndCharGraphics:
2422 begin
2423 State.FontState := fsNormal;
2424 State.InCharGraphics := false;
2425 WriteLn( F, '' );
2426 WriteLn( F, ':ecgraphic.' );
2427 State.Spacing := true;
2428 end;
2429
2430 ecImage:
2431 begin
2432 BitmapFlags := ( pData + 2 )^;
2433 BitmapOffset := pUInt32( pData + 3 )^;
2434
2435 SaveImageText( BitmapOffset, BitmapFlags, F, ImageOffsets );
2436
2437 if State.Spacing then
2438 Write( F, ' ' );
2439 end;
2440
2441 ecLinkedImage:
2442 begin
2443 SaveLinkedImage( pData, F, ImageOffsets );
2444 // Note! Early exit, since the procedure
2445 // will update pData.
2446 exit;
2447 end;
2448
2449 ecStartLines:
2450 begin
2451 WriteLn( F, '' );
2452 // aligned text
2453 case ( pData + 2 )^ of
2454 0, // just in case - to match image alignment oddities
2455 1:
2456 begin
2457 WriteLn( F, ':lines.' );
2458 State.Alignment := itaLeft;
2459 end;
2460
2461 2:
2462 begin
2463 WriteLn( F, ':lines align=right.' );
2464 State.Alignment := itaRight;
2465 end;
2466
2467 4:
2468 begin
2469 WriteLn( F, ':lines align=center.' );
2470 State.Alignment := itaCenter;
2471 end;
2472 end;
2473 end;
2474
2475 ecEndLines:
2476 begin
2477 // supposed to turn word wrap on, default font
2478 WriteLn( F, '' );
2479 WriteLn( F, ':elines.' );
2480 State.Alignment := itaLeft;
2481 end;
2482
2483 ecForegroundColor:
2484 begin
2485 ColorCode := ( pData + 2 )^;
2486
2487 if ColorCode < High( IPFColorNames ) then
2488 Write( F, ':color fc=' + IPFColorNames[ ColorCode ] + '.' );
2489 end;
2490
2491 ecBackgroundColor:
2492 begin
2493 ColorCode := ( pData + 2 )^;
2494 if ColorCode < High( IPFColorNames ) then
2495 Write( F, ':color bc=' + IPFColorNames[ ColorCode ] + '.' );
2496 end;
2497
2498 ecFontChange:
2499 begin
2500 FontIndex := ( pData + 2 )^;
2501 if FontIndex = 0 then
2502 begin
2503 // back to default font
2504 Write( F, ':font facename=default.' );
2505 State.FontState := fsNormal;
2506 end
2507 else if FontIndex < _FontTable.Count then
2508 begin
2509 // valid font index
2510 pFontSpec := _FontTable[ FontIndex ];
2511
2512 if pFontSpec = SubstituteFixedFont then
2513 begin
2514 // oops.
2515 OutputString := '<tt>';
2516 State.FontState := fsFixed;
2517 end
2518 else
2519 begin
2520 pFontSpec := _FontTable[ FontIndex ];
[140]2521 FaceName := StrPasWithLength( pFontSpec ^. FaceName,
[18]2522 sizeof( pFontSpec ^. FaceName ) );
2523 Write( F,
[140]2524 ':font facename=' + StrInSingleQuotes( FaceName )
[18]2525 + ' size=' + IntToStr( pFontSpec ^. Height )
2526 + 'x' + IntToStr( pFontSpec ^. Width )
2527 + '.' );
2528 State.FontState := fsCustom;
2529 end;
2530 end;
2531 end
2532 end; // case escape code of...
2533
2534 // Write( F, OutputString );
2535
2536 inc( pData, EscapeLen );
2537end;
2538
2539procedure TTopic.SaveToIPF( Var f: TextFile;
2540 ImageOffsets: TList );
2541var
2542 SlotIndex: integer;
2543 Slot: THelpTopicSlot;
2544 pData: pUInt8;
2545 pSlotEnd: pUInt8;
2546
2547 GlobalDictIndex: uint32;
2548
2549 StringToAdd: string;
2550 LocalDictIndex: uint8;
2551
2552 State: TParseState;
2553
2554 SequenceStepIndex: longint;
2555
2556 LineLen: longint;
2557 c: char;
2558begin
2559 EnsureSlotsLoaded;
2560
2561 State.LinkIndex := 0;
2562 State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
2563 State.InCharGraphics := false;
2564 State.Spacing := true;
2565 State.ForegroundColorTag := '</color>';
2566 State.BackgroundColorTag := '</backcolor>';
2567
2568 State.StartOfTextBlock := -1;
2569 State.TextBlock := TAString.Create;
2570
2571 State.FootnoteLink := nil;
2572
2573 State.StyleCode := 0;
2574
2575 SequenceStepIndex := 0;
2576
2577 LineLen := 0;
2578
2579 for SlotIndex := 0 to _NumSlots - 1 do
2580 begin
2581 if not State.InCharGraphics then
2582 State.Spacing := true; // this is just a guess as to the exact view behaviour.
2583 // inf.txt indicates that spacing is reset to true at
2584 // slot (cell) start, but that doesn't seem to be the
2585 // case when in character graphics... hey ho.
2586
2587 Slot := _Slots[ SlotIndex ];
2588
2589 pData := Slot.pData;
2590
2591 pSlotEnd := pData + Slot.Size;
2592
2593 State.Alignment := itaLeft;
2594
2595 while pData < pSlotEnd do
2596 begin
2597 LocalDictIndex := pData^;
2598 inc( pData );
2599
2600 if LocalDictIndex < Slot.LocalDictSize then
2601 begin
2602 // Normal word lookup
2603 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
2604
2605 // normal lookup
2606 if GlobalDictIndex < _GlobalDictionary.Count then
2607 StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
2608 else
2609 StringToAdd := '';
2610
2611 if Length( StringToAdd ) = 1 then
2612 begin
2613 // could be symbol
2614 c := StringToAdd[ 1 ];
2615 case C of
2616 '&': StringToAdd := '&amp.';
2617 '''': StringToAdd := '&apos.';
2618// '*': StringToAdd := '&asterisk.';
2619 '@': StringToAdd := '&atsign.';
2620 '\': StringToAdd := '&bsl.';
2621 '^': StringToAdd := '&caret.';
2622 '"': StringToAdd := '&osq.';
2623 ':': StringToAdd := '&colon.';
2624 '.': StringToAdd := '&per.';
2625 end;
2626 end;
2627
2628 inc( LineLen, Length( StringToAdd ) );
2629 if ( LineLen > 80 ) and ( not State.InCharGraphics ) then
2630 begin
2631 WriteLn( F );
2632 LineLen := 0;
2633 end;
2634
2635 Write( F, StringToAdd );
2636{
2637 if State.FootnoteLink <> nil then
2638 begin
2639 State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
2640 if State.Spacing then
2641 begin
2642 State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
2643 end;
2644 end;
2645 }
2646 if State.Spacing then
2647 begin
2648 Write( F, ' ' );
2649 inc( LineLen );
2650 end;
2651 end
2652 else
2653 begin
2654 // special code
2655
2656 case LocalDictIndex of
2657 IPF_END_PARA:
2658 begin
2659 WriteLn( F, '' );
2660 Write( F, ':p.' );
2661 LineLen := 3;
2662
2663 if not State.InCharGraphics then
2664 State.Spacing := true;
2665 end;
2666
2667 IPF_CENTER:
2668 begin
2669 WriteLn( F, '' );
2670 Write( F, '.ce ' ); // remainder of this line is centered.
2671 LineLen := 4;
2672 State.Alignment := itaCenterOnePara;
2673 end;
2674
2675 IPF_INVERT_SPACING:
2676 begin
2677 State.Spacing := not State.Spacing;
2678 end;
2679
2680 IPF_LINEBREAK:
2681 begin
2682 WriteLn( F, '' );
2683 if not State.InCharGraphics then
2684 WriteLn( F, '.br ' ); // break must be the only thing on the line
2685
2686 LineLen := 0;
2687 if not State.InCharGraphics then
2688 State.Spacing := true;
2689 end;
2690
2691 IPF_SPACE:
2692 begin
2693 if State.Spacing then
2694 Write( F, ' ' )
2695 else
2696 Write( F, ' ' );
2697 end;
2698
2699 IPF_ESC:
2700 begin
2701 // escape sequence
2702 SaveIPFEscapeCode( State,
2703 pData,
2704 F,
2705 ImageOffsets );
2706 end;
2707
2708 end; // case code of...
2709 end;
2710 end; // for slotindex = ...
2711 end;
2712 State.TextBlock.Destroy;
2713
2714end;
2715
2716// Compares two topics for purposes of sorting by
2717// search match relevance
2718function TopicRelevanceCompare( Item1, Item2: pointer ): longint;
2719var
2720 Topic1, Topic2: TTopic;
2721begin
2722 Topic1 := Item1;
2723 Topic2 := Item2;
2724
2725 if Topic1.SearchRelevance > Topic2.SearchRelevance then
2726 Result := -1
2727 else if Topic1.SearchRelevance < Topic2.SearchRelevance then
2728 Result := 1
2729 else
2730 Result := 0;
2731end;
2732
2733// Compares two topics for purposes of sorting by
2734// title
2735function TopicTitleCompare( Item1, Item2: pointer ): longint;
2736begin
2737 Result := CompareText( TTopic( Item1 )._Title^,
2738 TTopic( Item2 )._Title^ );
2739end;
2740
2741Initialization
2742 RegisterProcForLanguages( OnLanguageEvent );
2743End.
Note: See TracBrowser for help on using the repository browser.