source: trunk/NewView/HelpTopic.pas@ 164

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

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