source: trunk/NewView/HelpTopic.pas@ 400

Last change on this file since 400 was 380, checked in by RBRi, 9 years ago

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