source: trunk/NewView/HelpTopic.pas@ 371

Last change on this file since 371 was 371, checked in by RBRi, 15 years ago

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