source: trunk/NewView/HelpTopic.pas@ 72

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

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