source: trunk/NewView/HelpTopic.pas@ 32

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

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