source: trunk/NewView/HelpTopic.pas@ 61

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

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