source: trunk/NewView/HelpTopic.pas@ 127

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

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