source: branches/2.19_branch/NewView/HelpTopic.pas@ 291

Last change on this file since 291 was 290, checked in by RBRi, 17 years ago

+ debug support
  • Property svn:eol-style set to native
File size: 70.1 KB
Line 
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
16 BseDos,
17 OS2Def,
18 Classes,
19 Graphics,
20 ACLString,
21 HelpWindowDimensions,
22 IPFFileFormatUnit;
23
24const
25 DefaultGroupIndex = 0;
26
27 RTF_NewLine = #10;
28
29 // placeholder for font table entry, indiciating user fixed font should be substituted
30 SubstituteFixedFont: pointer = 1;
31
32Type
33 THelpLink = class
34 HelpFile: TObject; // file this link is within
35
36 // Even though it doesn't do anything,
37 // we have to have a constructor to allow
38 // virtual constructors to work
39 constructor Create; virtual;
40 end;
41
42 THelpTopicSlot = class
43 pData: pUInt8;
44 Size: longint;
45 pLocalDictionary: UInt16ArrayPointer;
46 LocalDictSize: uint8;
47 destructor Destroy; override;
48 end;
49
50 THelpLinkClass = class of THelpLink;
51
52 TFootnoteHelpLink = class( THelpLink )
53 TopicIndex: longint;
54 Title: string; // from text within link
55 end;
56
57 TWindowedHelpLink = class( THelpLink )
58 GroupIndex: longint; // DefaultGroupIndex if not specified.
59 // Note: Overrides contents group index of topic
60 Automatic: boolean; // link should be automatically followed on topic display
61 Split: boolean; // link should open the window within the parent
62 ViewPort: boolean; // link should always open a new window
63 Dependent: boolean; // window opened by link should be closed
64 // when current topic is closed
65 Rect: THelpWindowRect; // Display window with this rectangle.
66 // Note: overrides contents rect
67 constructor Create; override;
68 destructor Destroy; override;
69 end;
70
71 TInternalHelpLink = class( TWindowedHelpLink )
72 TopicIndex: longint;
73 end;
74
75 THelpLinkByResourceID = class( TWindowedHelpLink )
76 ResourceID: longint;
77 end;
78
79 SlotArray = array[ 0..0 ] of THelpTopicSlot;
80
81 pSlotArray = ^SlotArray;
82
83 TFontState = ( fsNormal, fsFixed, fsCustom );
84
85 TIPFTextAlignment = ( itaLeft, itaRight, itaCenter, itaCenterOnePara );
86
87 TParseState = record
88 Alignment: TIPFTextAlignment;
89 ForegroundColorTag: string;
90 BackgroundColorTag: string;
91 Spacing: boolean;
92 FontState: TFontState;
93 InCharGraphics: boolean;
94 LinkIndex: longint;
95
96 StartOfTextBlock: longint;
97 TextBlock: TAString;
98 FootnoteLink: TFootnoteHelpLink;
99
100 StyleCode: longint;
101 end;
102
103
104 TTopic = class
105 protected
106 _FileHandle: HFILE;
107
108 _pTOCEntry: pTTOCEntryStart;
109 _pSlotOffsets: UInt32ArrayPointer;
110 _Slots: TList;
111 _pSlotNumbers: puint16;
112 _NumSlots: longint;
113 _Title: pstring;
114 _GlobalDictionary: TList;
115
116 _ShowInContents: boolean;
117 _ContentsLevel: integer;
118 _ContentsGroupIndex: longint;
119
120 _FontTable: TList;
121
122 _ReferencedFiles: TStrings;
123
124 procedure SetTitle( const NewValue: string );
125 function GetTitle: string;
126 function GetTitlePtr: pstring;
127
128 // Returns the tag texts for the given bitmap ref
129 function GetImageText( CurrentAlignment: TIPFTextAlignment;
130 BitmapOffset: longint;
131 BitmapFlags: longint;
132 ImageOffsets: TList ): string;
133
134 Procedure ProcessLinkedImage( Var State: TParseState;
135 Var pData: pByte;
136 Var OutputString: string;
137 ImageOffsets: TList );
138 procedure TranslateIPFEscapeCode( Var State: TParseState;
139 Var pData: pUInt8;
140 Text: TAString;
141 Var WordsOnLine: longint;
142 ImageOffsets: TList );
143
144 function CreateLink( Var LinkIndex: longint;
145 Var Link: THelpLink;
146 LinkClass: THelpLinkClass ): boolean;
147
148 procedure EnsureSlotsLoaded;
149
150 // returns true if the escape code at pData results in whitespace.
151 function IPFEscapeCodeSpace( Var State: TParseState;
152 Var pData: pUInt8 ): boolean;
153
154 function GetNextIPFTextItem( Var SlotIndex: longint;
155 Var pData: pUInt8;
156 Var State: TParseState ): longint;
157
158 function CheckForSequence( WordSequences: TList;
159 SlotIndex: longint;
160 pData: pUint8;
161 State: TParseState;
162
163 GlobalDictIndex: longint;
164 ): longint;
165
166 public
167 constructor Create( FileHandle: HFILE;
168 pSlotOffsets: UInt32ArrayPointer;
169 Dictionary: TList;
170 pTOCEntry: pTTOCEntryStart;
171 FontTable: TList;
172 ReferencedFiles: TStrings );
173
174 destructor destroy; override;
175
176 property Title: string read GetTitle write SetTitle;
177 property TitlePtr: pstring read GetTitlePtr;
178
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,
253 NewViewConstantsUnit,
254 ACLUtility,
255 ACLFileIOUtility,
256 AStringUtilityUnit,
257 ACLLanguageUnit,
258 StringUtilsUnit,
259 CharUtilsUnit,
260 SettingsUnit,
261 DebugUnit;
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
318
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
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
551 Result := RTF_NewLine + Result + RTF_NewLine;
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=' );
568 Write( F, StrInSingleQuotes('img' + IntToStr(ImageIndex) + '.bmp') );
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
829// TODO
830function FullDoubleQuote( const s: string ): string;
831begin
832 Result := StrDoubleQuote
833 + StrEscapeAllCharsBy(s, [], CharDoubleQuote)
834 + StrDoubleQuote;
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;
860 T.AddString( '<blue><link ' + PARAM_LINK_URL + ' "' );
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;
908 ProgramInfo : TSerializableStringList;
909 tmpProgramLinkParts : TStringList;
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
932 + RTF_NewLine;
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>' + GetBeginLink(State.LinkIndex);
990 end;
991
992 inc( State.LinkIndex );
993 end;
994
995 ecFootnoteLinkStart:
996 begin
997 CheckForAutoURL( Text, State );
998 if CreateLink( State.LinkIndex, FootnoteLink, TFootnoteHelpLink ) then
999 begin
1000 FootnoteLink.TopicIndex := pUInt16( pData + 2 )^;
1001 State.FootnoteLink := FootnoteLink;
1002 end;
1003
1004 OutputString := '<blue>'
1005 + GetBeginLink( State.LinkIndex );
1006
1007 inc( State.LinkIndex );
1008 end;
1009
1010 ecStartLinkByResourceID:
1011 begin
1012 CheckForAutoURL( Text, State );
1013 if CreateLink( State.LinkIndex, LinkByResourceID, THelpLinkByResourceID ) then
1014 begin
1015 LinkByResourceID.ResourceID := pUInt16( pData + 2 )^;
1016
1017 if EscapeLen >= 6 then
1018 begin
1019 GetExtraLinkData( LinkByResourceID, pData + 4 );
1020 end;
1021 end;
1022
1023 OutputString := '<blue>'
1024 + GetBeginLink( State.LinkIndex );
1025
1026 inc( State.LinkIndex );
1027 end;
1028
1029 ecExternalLink:
1030 begin
1031 CheckForAutoURL( Text, State );
1032 // :link reftype=hd refid=... database=<filename>
1033 ExternalLinkFileIndex := ( pData + 2 )^;
1034 ExternalLinkTopicID := StrPasWithLength( pchar( pData + 4 ), ( pData + 3 )^ );
1035 OutputString := '<blue><link ' + PARAM_LINK_EXTERNAL + ' '
1036 + IntToStr( ExternalLinkFileIndex )
1037 + ' '
1038 + ExternalLinkTopicID
1039 + '>'
1040 end;
1041
1042 ecProgramLink:
1043 begin
1044 CheckForAutoURL( Text, State );
1045 ProgramLink := StrPasWithLength( pchar( pData + 3 ), EscapeLen - 3 );
1046
1047 tmpProgramLinkParts := TStringList.Create;
1048 StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0);
1049 ProgramPath := tmpProgramLinkParts[0];
1050 tmpProgramLinkParts.Destroy;
1051
1052 ProgramFilename := ExtractFilename( ProgramPath );
1053
1054 if StrStartsWithIgnoringCase(ProgramFilename, PRGM_EXPLORER) // web explorer?
1055 or StrStartsWithIgnoringCase(ProgramFilename, PRGM_NETSCAPE)
1056 or StrStartsWithIgnoringCase(ProgramFilename, PRGM_MOZILLA)
1057 or StrStartsWithIgnoringCase(ProgramFilename, PRGM_FIREFOX)
1058 then
1059 begin
1060 OutputString := '<blue><link ' + PARAM_LINK_URL + ' '
1061 + FullDoubleQuote(StrSubstringFrom(ProgramLink, Length(ProgramPath) + 2))
1062 + '>';
1063 end
1064 else
1065 begin
1066 ProgramInfo := TSerializableStringList.create;
1067 ProgramInfo.add(ProgramPath);
1068 ProgramInfo.add(StrSubstringFrom(ProgramLink, Length(ProgramPath) + 2));
1069 OutputString := '<blue><link ' + PARAM_LINK_PROGRAM + ' '
1070 + ProgramInfo.getSerializedString
1071 + '>';
1072 ProgramInfo.destroy;
1073 end;
1074 end;
1075
1076 ecLinkEnd:
1077 begin
1078 OutputString := GetEndLinkTags( State );
1079 if State.FootnoteLink <> nil then
1080 State.FootnoteLink := nil;
1081 end;
1082
1083 ecStartCharGraphics:
1084 begin
1085 State.FontState := fsFixed;
1086 State.InCharGraphics := true;
1087 OutputString := RTF_NewLine + RTF_NewLine + '<tt><wrap no>';
1088 State.Spacing := false;
1089 WordsOnLine := 0;
1090 end;
1091
1092 ecEndCharGraphics:
1093 begin
1094 State.FontState := fsNormal;
1095 State.InCharGraphics := false;
1096 OutputString := '</tt><wrap yes>' + RTF_NewLine;
1097 State.Spacing := true;
1098 end;
1099
1100 ecImage:
1101 begin
1102 CheckForAutoURL( Text, State );
1103 BitmapFlags := ( pData + 2 )^;
1104 BitmapOffset := pUInt32( pData + 3 )^;
1105
1106 OutputString := GetImageText( State.Alignment,
1107 BitmapOffset,
1108 BitmapFlags,
1109 ImageOffsets );
1110 if State.Spacing
1111 AND (OutputString[Length(OutputString)] <> RTF_NewLine) // no space after a line break
1112 then
1113 OutputString := OutputString + ' ';
1114 end;
1115
1116 ecLinkedImage:
1117 begin
1118 CheckForAutoURL( Text, State );
1119 ProcessLinkedImage( State,
1120 pData,
1121 OutputString,
1122 ImageOffsets );
1123 if State.Spacing then
1124 OutputString := OutputString + ' ';
1125
1126 // Note! Early exit, since the procedure
1127 // will update pData.
1128 Text.AddString( OutputString );
1129 exit;
1130 end;
1131
1132 ecStartLines:
1133 begin
1134 CheckForAutoURL( Text, State );
1135 // aligned text
1136 case ( pData + 2 )^ of
1137 0, // just in case - to match image alignment oddities
1138 1:
1139 begin
1140 OutputString := RTF_NewLine + '<align left>';
1141 State.Alignment := itaLeft;
1142 end;
1143
1144 2:
1145 begin
1146 OutputString := RTF_NewLine + '<align right>';
1147 State.Alignment := itaRight;
1148 end;
1149
1150 4:
1151 begin
1152 OutputString := RTF_NewLine + '<align center>';
1153 State.Alignment := itaCenter;
1154 end;
1155 end;
1156 OutputString := OutputString + '<wrap no>';
1157 WordsOnLine := 0;
1158 end;
1159
1160 ecEndLines:
1161 begin
1162 CheckForAutoURL( Text, State );
1163 // supposed to turn word wrap on, default font
1164 OutputString := '<align left><wrap yes>'; // I guess...
1165 State.Alignment := itaLeft;
1166 end;
1167
1168 ecForegroundColor:
1169 begin
1170 ColorCode := ( pData + 2 )^;
1171 if ColorCode = 0 then
1172 State.ForegroundColorTag := '</color>'
1173 else if ColorCode <= High( IPFColors ) then
1174 State.ForegroundColorTag := '<color ' + IPFColors[ ColorCode ] + '>';
1175 OutputString := State.ForegroundColorTag;
1176 end;
1177
1178 ecBackgroundColor:
1179 begin
1180 ColorCode := ( pData + 2 )^;
1181 if ColorCode = 0 then
1182 State.BackgroundColorTag := '</backcolor>'
1183 else if ColorCode <= High( IPFColors ) then
1184 State.BackgroundColorTag := '<backcolor ' + IPFColors[ ColorCode ] + '>';
1185 OutputString := State.BackgroundColorTag;
1186 end;
1187
1188 ecFontChange:
1189 begin
1190 FontIndex := ( pData + 2 )^;
1191 if FontIndex = 0 then
1192 begin
1193 // back to default font
1194 OutputString := '</font>';
1195 State.FontState := fsNormal;
1196 end
1197 else if FontIndex < _FontTable.Count then
1198 begin
1199 // valid font index
1200 pFontSpec := _FontTable[ FontIndex ];
1201
1202 if pFontSpec = SubstituteFixedFont then
1203 begin
1204 OutputString := '<tt>';
1205 State.FontState := fsFixed;
1206 end
1207 else
1208 begin
1209 pFontSpec := _FontTable[ FontIndex ];
1210 FaceName := StrPasWithLength( pFontSpec ^. FaceName,
1211 sizeof( pFontSpec ^. FaceName ) );
1212 // arbitrarily and capriciously use specified height * 2/3
1213 // as the point size - seems to correspond to what original
1214 // view wanted... note this doesn't necessarily scale
1215 // correctly, since default font could be different. whatever.
1216 PointSize := pFontSpec ^. Height * 2 div 3;
1217
1218 if PointSize < 8 then
1219 PointSize := 8;
1220 // quote font name, escape double quotes with duplicates
1221 // e.g. Bob's "Big" Font would become
1222 // "Bob's ""Big"" Font"
1223 QuotedFaceName := FullDoubleQuote( FaceName );
1224 OutputString := '<font '
1225 + QuotedFaceName
1226 + ' '
1227 + IntToStr( PointSize )
1228 + '>';
1229 {
1230 // for when (if ever) RTV allows setting font
1231 // by precise dimensions
1232 + '['
1233 + IntToStr( pFontSpec ^. Width )
1234 + 'x'
1235 + IntToStr( pFontSpec ^. Height )
1236 + ']';
1237 }
1238 State.FontState := fsCustom;
1239 end;
1240 end;
1241 end
1242 end; // case escape code of...
1243
1244 Text.AddString( OutputString );
1245
1246 inc( pData, EscapeLen );
1247end;
1248
1249// returns true if the escape code results in whitespace
1250// also updates the bits of State that relate to spacing
1251// ie. .Spacing, and .InCharGraphics (which affects whether
1252// spacing is reset at paragraph ends etc)
1253function TTopic.IPFEscapeCodeSpace( Var State: TParseState;
1254 Var pData: pUInt8 ): boolean;
1255var
1256 EscapeLen: uint8;
1257 EscapeCode: uint8;
1258
1259begin
1260 EscapeLen := pData^;
1261 EscapeCode := (pData + 1) ^;
1262
1263 result := false; // for most
1264 case EscapeCode of
1265 ecSetLeftMargin,
1266 ecSetLeftMarginNewLine,
1267 ecSetLeftMarginFit:
1268 result := true;
1269
1270 ecStartCharGraphics:
1271 begin
1272 result := true;
1273 State.InCharGraphics := true;
1274 State.Spacing := false;
1275 end;
1276
1277 ecEndCharGraphics:
1278 begin
1279 result := true;
1280 State.InCharGraphics := false;
1281 State.Spacing := true;
1282 end;
1283
1284 ecImage:
1285 result := State.Spacing;
1286
1287 ecLinkedImage:
1288 result := State.Spacing;
1289
1290 ecStartLines:
1291 begin
1292 result := true;
1293 State.Spacing := false;
1294 end;
1295
1296 ecEndLines:
1297 begin
1298 result := true;
1299 // supposed to turn word wrap on, default font
1300 State.Spacing := true;
1301 end;
1302 end; // case escape code of...
1303
1304 inc( pData, EscapeLen );
1305end;
1306
1307procedure TTopic.EnsureSlotsLoaded;
1308var
1309 i: longint;
1310 pSlotNumber: puint16;
1311 SlotNumber: uint16;
1312 SlotHeader: TSlotHeader;
1313 Slot: THelpTopicSlot;
1314begin
1315 if _Slots = nil then
1316 begin
1317 try
1318 _Slots := TList.Create;
1319
1320 // Read slot data
1321 pSlotNumber := _pSlotNumbers;
1322
1323 for i := 0 to _NumSlots - 1 do
1324 begin
1325 SlotNumber := pSlotNumber^;
1326
1327 // Seek to start of slot
1328 try
1329 MySeek( _FileHandle,
1330 _pSlotOffsets^[ SlotNumber ] );
1331 except
1332 // not a valid offset
1333 raise EHelpFileException.Create( ErrorCorruptHelpFile );
1334 end;
1335
1336 // Read header
1337 if not MyRead( _FileHandle,
1338 Addr( SlotHeader ),
1339 sizeof( SlotHeader ) ) then
1340 // couldn't read slot header
1341 raise EHelpFileException.Create( ErrorCorruptHelpFile );
1342
1343 // Create slot object
1344 Slot := THelpTopicSlot.Create;
1345
1346 Slot.LocalDictSize := SlotHeader.nLocalDict;
1347 Slot.Size := SlotHeader.ntext;
1348
1349 // Allocate and read slot dictionary
1350 ReadFileBlock( _FileHandle,
1351 Slot.pLocalDictionary,
1352 SlotHeader.localDictPos,
1353 uint32( Slot.LocalDictSize ) * sizeof( uint16 ) );
1354
1355 // Allocate and read slot data (text)
1356 ReadFileBlock( _FileHandle,
1357 Slot.pData,
1358 _pSlotOffsets^[ SlotNumber ] + sizeof( TSlotHeader ),
1359 Slot.Size );
1360
1361 _Slots.Add( Slot );
1362
1363 inc( pSlotNumber, sizeof( UInt16 ) );
1364 end;
1365 except
1366 on E: EHelpFileException do
1367 begin
1368 DestroyListAndObjects( _Slots );
1369 raise;
1370 end;
1371 end;
1372 end;
1373end;
1374
1375// returns a global dict index.
1376// or, -1 for a whitespace item.
1377// or, -2 for end of text.
1378function TTopic.GetNextIPFTextItem( Var SlotIndex: longint;
1379 Var pData: pUInt8;
1380 Var State: TParseState ): longint;
1381var
1382 Slot: THelpTopicSlot;
1383 pSlotEnd: pUInt8;
1384
1385 LocalDictIndex: uint8;
1386begin
1387 while SlotIndex < _NumSlots do
1388 begin
1389 Slot := _Slots[ SlotIndex ];
1390 pSlotEnd := Slot.pData + Slot.Size;
1391
1392 while pData < pSlotEnd do
1393 begin
1394 LocalDictIndex := pData^;
1395 inc( pData );
1396
1397 if LocalDictIndex < Slot.LocalDictSize then
1398 begin
1399 // Normal word lookup
1400 result := Slot.pLocalDictionary^[ LocalDictIndex ];
1401 exit;
1402 end;
1403
1404 // special code
1405 case LocalDictIndex of
1406 IPF_END_PARA:
1407 begin
1408 result := -1;
1409 if not State.InCharGraphics then
1410 State.Spacing := true;
1411 exit;
1412 end;
1413
1414 IPF_CENTER:
1415 begin
1416 result := -1;
1417 exit;
1418 end;
1419
1420 IPF_INVERT_SPACING:
1421 begin
1422 State.Spacing := not State.Spacing;
1423 end;
1424
1425 IPF_LINEBREAK:
1426 begin
1427 result := -1;
1428 if not State.InCharGraphics then
1429 State.Spacing := true;
1430 exit;
1431 end;
1432
1433 IPF_SPACE:
1434 begin
1435 result := -1;
1436 exit;
1437 end;
1438
1439 IPF_ESC:
1440 begin
1441 // escape sequence
1442 if IPFEscapeCodeSpace( State, pData ) then
1443 result := -1;
1444 end;
1445 end;
1446 end; // while in slot...
1447 inc( SlotIndex );
1448 end;
1449 Result := -2;
1450end;
1451
1452// Checks to see if the given word (at pData)
1453// starts one of the given sequences, by looking forward
1454// If found, returns the length of the sequence.
1455function TTopic.CheckForSequence( WordSequences: TList;
1456 SlotIndex: longint;
1457 pData: pUint8;
1458 State: TParseState;
1459 GlobalDictIndex: longint;
1460 ): longint;
1461var
1462 WordSequence: TList;
1463 SequenceStepIndex: longint;
1464 pSequenceStepWords: Uint32ArrayPointer;
1465
1466 SequenceIndex: longint;
1467
1468 SlotIndexTemp: longint;
1469 pDataTemp: pUint8;
1470 StateTemp: TParseState;
1471// s : string;
1472 DictIndex: longint;
1473begin
1474 result := 0; // if we don't find a match.
1475
1476 for SequenceIndex := 0 to WordSequences.Count - 1 do
1477 begin
1478 WordSequence := WordSequences[ SequenceIndex ];
1479 pSequenceStepWords := WordSequence[ 0 ];
1480
1481 if pSequenceStepWords^[ GlobalDictIndex ] > 0 then
1482 begin
1483 // matched first step in this sequence. Look ahead...
1484
1485 SequenceStepIndex := 0;
1486
1487 pDataTemp := pData;
1488 SlotIndexTemp := SlotIndex;
1489 StateTemp := State;
1490 while true do
1491 begin
1492 inc( SequenceStepIndex );
1493 if SequenceStepIndex = WordSequence.Count then
1494 begin
1495 // have a match for the sequence, insert start highlight
1496 Result := WordSequence.Count;
1497 break;
1498 end;
1499
1500 // get words for next step in sequence
1501 pSequenceStepWords := WordSequence[ SequenceStepIndex ];
1502
1503 DictIndex := GetNextIPFTextItem( SlotIndexTemp,
1504 pDataTemp,
1505 StateTemp );
1506 if DictIndex = -2 then
1507 begin
1508 // end of text - abort
1509 break;
1510 end;
1511
1512 if DictIndex = -1 then
1513 begin
1514 // whitespace - abort
1515 // for multi-word phrase searching - count this and subsequent whitespace...
1516 break;
1517 end;
1518
1519 // s := pstring( _GlobalDictionary[ DictIndex ] )^; // for debug only
1520 if not StrIsEmptyOrSpaces( pstring( _GlobalDictionary[ DictIndex ] )^ ) then
1521 begin
1522 if pSequenceStepWords^[ DictIndex ] = 0 then
1523 begin
1524 // word doesn't match - abort
1525 break;
1526 end;
1527 end;
1528
1529 end; // while
1530
1531 end;
1532 // else - doesn't match first step, do nothing
1533 end; // for sequenceindex ...
1534end;
1535
1536// Main translation function. Turns the IPF data into
1537// a text string. Translates formatting codes into tags
1538// as for Rich Text Viewer.
1539// Uses TAString for speed without length limits
1540// - string is too short
1541// - PChar is slow to concatenate (unless you keep track of the insert point)
1542// - AnsiString is slow
1543procedure TTopic.GetText( HighlightSequences: TList;
1544 // each element is a TList
1545 // containing a sequence of possible words
1546 // each element of each sequence
1547 // is an array of flags for the dictionary
1548 // indicating if the word is a allowed match at that step
1549 // a match is any sequence that matches one or more words at each step.
1550 ShowCodes: boolean;
1551 ShowWordSeparators: boolean;
1552 Text: TAString;
1553 ImageOffsets: TList;
1554 HighlightMatches: TList );
1555var
1556 SlotIndex: integer;
1557 Slot: THelpTopicSlot;
1558 pData: pUInt8;
1559 pSlotEnd: pUInt8;
1560
1561 GlobalDictIndex: uint32;
1562
1563 WordsOnLine: longint;
1564
1565 StringToAdd: string;
1566 LocalDictIndex: uint8;
1567
1568 State: TParseState;
1569
1570 EscapeLen: uint8;
1571 i: longint;
1572
1573 SequenceStepIndex: longint;
1574begin
1575 if Links = nil then
1576 Links := TList.Create;
1577
1578 if HighlightMatches <> nil then
1579 HighlightMatches.Clear;
1580
1581 // Text.Clear;
1582 ImageOffsets.Clear;
1583
1584 try
1585 EnsureSlotsLoaded;
1586 except
1587 on E: EHelpFileException do
1588 begin
1589 Text.AddString( e.Message );
1590 exit;
1591 end;
1592 end;
1593
1594 WordsOnLine := 0;
1595
1596 State.LinkIndex := 0;
1597 State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
1598 State.InCharGraphics := false;
1599 State.Spacing := true;
1600 State.ForegroundColorTag := '</color>';
1601 State.BackgroundColorTag := '</backcolor>';
1602
1603 State.StartOfTextBlock := -1;
1604 State.TextBlock := TAString.Create;
1605
1606 State.FootnoteLink := nil;
1607
1608 Text.AddString( '<leftmargin 1>' );
1609
1610 SequenceStepIndex := 0;
1611
1612 for SlotIndex := 0 to _NumSlots - 1 do
1613 begin
1614 if not State.InCharGraphics then
1615 State.Spacing := true; // this is just a guess as to the exact view behaviour.
1616 // inf.txt indicates that spacing is reset to true at
1617 // slot (cell) start, but that doesn't seem to be the
1618 // case when in character graphics... hey ho.
1619
1620 Slot := _Slots[ SlotIndex ];
1621
1622 pData := Slot.pData;
1623
1624 pSlotEnd := pData + Slot.Size;
1625
1626 State.Alignment := itaLeft;
1627
1628 while pData < pSlotEnd do
1629 begin
1630 LocalDictIndex := pData^;
1631 inc( pData );
1632
1633 if LocalDictIndex < Slot.LocalDictSize then
1634 begin
1635 // Normal word lookup
1636 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
1637
1638 if ShowWordSeparators then
1639 Text.AddString( '{' + IntToStr( GlobalDictIndex )+ '}' );
1640
1641 // normal lookup
1642 if GlobalDictIndex < _GlobalDictionary.Count then
1643 StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
1644 else
1645 StringToAdd := '';
1646
1647 if StrIsEmptyOrSpaces( StringToAdd ) then
1648 begin
1649 // spaces only...
1650 CheckForAutoURL( Text, State );
1651 end
1652 else
1653 begin
1654 // really is a word, not a space.
1655
1656 // store string into "word"
1657 if State.TextBlock.Length = 0 then
1658 // store start of block
1659 State.StartOfTextBlock := Text.Length;
1660
1661 State.TextBlock.AddString( StringToAdd );
1662
1663 SubstituteAngleBrackets( StringToAdd );
1664
1665 if HighlightSequences <> nil then
1666 begin
1667 if SequenceStepIndex > 0 then
1668 begin
1669 // currently highlighting a sequence.
1670 dec( SequenceStepIndex );
1671 if SequenceStepIndex = 0 then
1672 begin
1673 // now finished, insert end highlight
1674 StringToAdd := StringToAdd
1675 + State.BackgroundColorTag;
1676
1677 end;
1678 end
1679 else
1680 begin
1681 // not yet in a sequence, searching.
1682 SequenceStepIndex :=
1683 CheckForSequence( HighlightSequences,
1684 SlotIndex,
1685 pData,
1686 State,
1687 GlobalDictIndex );
1688
1689 if SequenceStepIndex > 0 then
1690 begin
1691 // this word starts a sequence!
1692 if HighlightMatches <> nil then
1693 HighlightMatches.Add( pointer( Text.Length ) );
1694 StringToAdd := '<backcolor #'
1695 + IntToHex( Settings.Colors[ SearchHighlightTextColorIndex ], 6 )
1696 + '>'
1697 + StringToAdd;
1698 dec( SequenceStepIndex );
1699 if SequenceStepIndex = 0 then
1700 // and ends it.
1701 StringToAdd := StringToAdd
1702 + State.BackgroundColorTag;
1703 end;
1704
1705 end;
1706 end; // if processing sequence
1707 inc( WordsOnLine );
1708 end;
1709
1710 Text.AddString( StringToAdd );
1711
1712 if State.FootnoteLink <> nil then
1713 begin
1714 State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
1715 if State.Spacing then
1716 begin
1717 State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
1718 end;
1719 end;
1720
1721 if State.Spacing then
1722 begin
1723 CheckForAutoURL( Text, State );
1724
1725 Text.AddString( ' ' );
1726 end;
1727 end
1728 else
1729 begin
1730 // special code
1731
1732 if ShowCodes then
1733 begin
1734 Text.AddString( '[' + IntToHex( LocalDictIndex, 2 ) );
1735 if LocalDictIndex = IPF_ESC then
1736 begin
1737 EscapeLen := pData^;
1738 for i := 1 to EscapeLen - 1 do
1739 begin
1740 Text.AddString( ' '
1741 + IntToHex( ( pData + i )^, 2 ) );
1742 end;
1743
1744 end;
1745 Text.AddString( ']' );
1746 end;
1747
1748 case LocalDictIndex of
1749 IPF_END_PARA:
1750 begin
1751 if SlotIndex = 0 then
1752 if pData - 1 = Slot.pData then
1753 // ignore first FA, not needed with RichTextView
1754 continue;
1755
1756 CheckForAutoURL( Text, State );
1757 if State.Alignment = itaCenterOnePara then
1758 begin
1759 State.Alignment := itaLeft;
1760 Text.AddString( '<align left>' );
1761 end;
1762 Text.AddString(RTF_NewLine);
1763
1764 if WordsOnLine > 0 then
1765 Text.AddString(RTF_NewLine);
1766
1767 if not State.InCharGraphics then
1768 State.Spacing := true;
1769
1770 WordsOnLine := 0;
1771 end;
1772
1773 IPF_CENTER:
1774 begin
1775 CheckForAutoURL( Text, State );
1776 Text.addString( RTF_NewLine + '<align center>' );
1777 State.Alignment := itaCenterOnePara;
1778 end;
1779
1780 IPF_INVERT_SPACING:
1781 begin
1782 State.Spacing := not State.Spacing;
1783 end;
1784
1785 IPF_LINEBREAK:
1786 begin
1787 CheckForAutoURL( Text, State );
1788
1789 if State.Alignment = itaCenterOnePara then
1790 begin
1791 State.Alignment := itaLeft;
1792 Text.AddString( '<align left>' );
1793 end;
1794 Text.AddString( RTF_NewLine );
1795 if not State.InCharGraphics then
1796 State.Spacing := true;
1797 WordsOnLine := 0;
1798 end;
1799
1800 IPF_SPACE:
1801 begin
1802 CheckForAutoURL( Text, State );
1803 if State.Spacing then
1804 Text.AddString( ' ' );
1805 end;
1806
1807 IPF_ESC:
1808 begin
1809 // escape sequence
1810 TranslateIPFEscapeCode( State,
1811 pData,
1812 Text,
1813 WordsOnLine,
1814 ImageOffsets );
1815
1816 end;
1817
1818 end; // case code of...
1819 end;
1820 end; // for slotindex = ...
1821 end;
1822 State.TextBlock.Destroy;
1823
1824end;
1825
1826function TTopic.SearchForWord( DictIndex: integer;
1827 StopAtFirstOccurrence: boolean )
1828 : longint;
1829var
1830 SlotIndex: integer;
1831 Slot: THelpTopicSlot;
1832 pData: pUInt8;
1833 pSlotEnd: pUInt8;
1834
1835 EscapeLen: longint;
1836
1837 GlobalDictIndex: uint32;
1838
1839 LocalDictIndex: uint8;
1840begin
1841 EnsureSlotsLoaded;
1842
1843 Result := 0;
1844 for SlotIndex := 0 to _NumSlots - 1 do
1845 begin
1846 Slot := _Slots[ SlotIndex ];
1847
1848 pData := Slot.pData;
1849
1850 pSlotEnd := pData + Slot.Size;
1851
1852 while pData < pSlotEnd do
1853 begin
1854 LocalDictIndex := pData^;
1855
1856 if LocalDictIndex < Slot.LocalDictSize then
1857 begin
1858 // Normal word lookup
1859 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
1860
1861 if GlobalDictIndex = DictIndex then
1862 begin
1863 inc( result );
1864 if StopAtFirstOccurrence then
1865 exit;
1866 end;
1867 end
1868 else
1869 begin
1870 // special code
1871 if LocalDictIndex = $ff then
1872 begin
1873 // escape string, skip it
1874 EscapeLen := ( pData + 1 ) ^;
1875 inc( pData, EscapeLen );
1876 end;
1877 end;
1878
1879 inc( pData );
1880 end; // for slotindex = ...
1881 end;
1882end;
1883
1884// Search for a sequence of bytes, including in escape codes
1885// this is for debugging to allow finding specific sequences
1886function TTopic.SearchForData( Data: pbyte;
1887 DataLen: integer ): boolean;
1888var
1889 SlotIndex: integer;
1890 Slot: THelpTopicSlot;
1891 pData: pUInt8;
1892 pSlotEnd: pUInt8;
1893
1894 pHold: pUint8;
1895 pSearch: pUint8;
1896begin
1897 EnsureSlotsLoaded;
1898
1899 for SlotIndex := 0 to _NumSlots - 1 do
1900 begin
1901 Slot := _Slots[ SlotIndex ];
1902
1903 pSearch := Data;
1904 pHold := Slot.pData;
1905 pData := Slot.pData;
1906 pSlotEnd := Slot.pData + Slot.Size;
1907
1908 while pHold < pSlotEnd do
1909 begin
1910 if pData^ = pSearch^ then
1911 begin
1912 // byte matches
1913 inc( pData );
1914 inc( pSearch );
1915 if ( pSearch >= Data + DataLen ) then
1916 begin
1917 // matches
1918 result := true;
1919 exit;
1920 end
1921 end
1922 else
1923 begin
1924 // no match
1925 pSearch := Data;
1926 inc( pHold );
1927 pData := pHold;
1928 end;
1929 end; // for slotindex = ...
1930 end;
1931
1932 result := false; // not found
1933end;
1934
1935function TTopic.SearchForWordSequences( WordSequence: TList;
1936 StopAtFirstOccurrence: boolean )
1937 : longint;
1938var
1939 SlotIndex: integer;
1940 Slot: THelpTopicSlot;
1941 pData: pUInt8;
1942 pSlotEnd: pUInt8;
1943
1944 EscapeLen: longint;
1945
1946 GlobalDictIndex: uint32;
1947 IsWord: boolean;
1948 WordRelevance: uint32;
1949
1950 CurrentMatchRelevance: uint32; // total relevances for words matched so far
1951 // in the current sequence
1952
1953// CurrentMatch: string; // useful for debugging only
1954 LocalDictIndex: uint8;
1955
1956 SequenceIndex: longint;
1957 SequenceStartSlotIndex: longint;
1958 pSequenceStartData: pUInt8;
1959
1960 pStepWordRelevances: UInt32ArrayPointer; // word relevances for the current step in the sequence
1961
1962 // get the current slot start and end pointers
1963 procedure GetSlot;
1964 begin
1965 Slot := self._Slots[ SlotIndex ];
1966 pData := Slot.pData;
1967 pSlotEnd := pData + Slot.Size;
1968 end;
1969
1970 // get pointer to the current set of word relevances
1971 procedure GetStepFlags;
1972 begin
1973 pStepWordRelevances := WordSequence[ SequenceIndex ];
1974 end;
1975
1976 // store the current point as start of a sequence
1977 procedure StoreStartOfSequence;
1978 begin
1979 SequenceIndex := 0;
1980 SequenceStartSlotIndex := SlotIndex;
1981 pSequenceStartData := pData;
1982 CurrentMatchRelevance := 0;
1983// CurrentMatch := '';
1984 GetStepFlags;
1985 end;
1986
1987begin
1988 Result := 0;
1989
1990 EnsureSlotsLoaded;
1991
1992 if _NumSlots = 0 then
1993 // thar's nowt in yon topic, cannae be a match laid
1994 exit;
1995
1996 SlotIndex := 0;
1997
1998 GetSlot;
1999
2000 StoreStartOfSequence;
2001
2002 while true do
2003 begin
2004 LocalDictIndex := pData^;
2005 IsWord := false;
2006 if LocalDictIndex < Slot.LocalDictSize then
2007 begin
2008 IsWord := true;
2009 // Normal word lookup, so get the global dict idnex before we
2010 // (potentially) move to next slot
2011 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
2012 end;
2013
2014 inc( pData );
2015 if pData >= pSlotEnd then
2016 begin
2017 // reached end of slot, next please
2018 inc( SlotIndex );
2019 if SlotIndex < _NumSlots then
2020 GetSlot;
2021 // else - there is nothing more to search
2022 // but we need to check this last item
2023 end;
2024
2025 if IsWord then
2026 begin
2027 // Normal word lookup
2028 WordRelevance := 0;
2029
2030 if GlobalDictIndex < _GlobalDictionary.Count then
2031 if not StrIsEmptyOrSpaces( pstring( _GlobalDictionary[ GlobalDictIndex ] )^ ) then;
2032 WordRelevance := pStepWordRelevances[ GlobalDictIndex ];
2033
2034 if WordRelevance > 0 then
2035 begin
2036 // Found a matching word
2037 inc( CurrentMatchRelevance, WordRelevance );
2038// debug:
2039// CurrentMatch := CurrentMatch +
2040// pstring( _GlobalDictionary[ GlobalDictIndex ] )^;
2041
2042 if SequenceIndex = 0 then
2043 begin
2044 // remember next start point
2045 SequenceStartSlotIndex := SlotIndex;
2046 pSequenceStartData := pData;
2047 end;
2048
2049 inc( SequenceIndex );
2050
2051 if SequenceIndex < WordSequence.Count then
2052 begin
2053 // get next set of flags.
2054 GetStepFlags;
2055 end
2056 else
2057 begin
2058 // found a complete sequence. Cool!
2059
2060 inc( result, CurrentMatchRelevance );
2061
2062 if StopAtFirstOccurrence then
2063 exit;
2064
2065 // start looking from the beginning of the sequence again.
2066 StoreStartOfSequence;
2067 end;
2068 end
2069 else
2070 begin
2071 // not a match at this point, restart search
2072 if SequenceIndex > 0 then
2073 begin
2074 // we had matched one or more steps already,
2075 // back to start of sequence AND back to
2076 // point we started matching from (+1)
2077 SequenceIndex := 0;
2078 CurrentMatchRelevance := 0;
2079// CurrentMatch := '';
2080 SlotIndex := SequenceStartSlotIndex;
2081 GetSlot;
2082 pData := pSequenceStartData;
2083 GetStepFlags;
2084 end
2085 else
2086 begin
2087 // haven't matched anything yet.
2088 // update start of sequence
2089 SequenceStartSlotIndex := SlotIndex;
2090 pSequenceStartData := pData;
2091 end;
2092 end;
2093 end
2094 else
2095 begin
2096 // special code
2097 if LocalDictIndex = $ff then
2098 begin
2099 // escape string, skip it
2100 EscapeLen := pData ^;
2101 inc( pData, EscapeLen );
2102 end;
2103 end;
2104
2105 if SlotIndex >= _NumSlots then
2106 begin
2107 // finished searching topic
2108 break;
2109 end;
2110
2111 // next item
2112 end;
2113end;
2114
2115
2116function TTopic.CountWord( DictIndex: integer ): longint;
2117begin
2118 Result := SearchForWord( DictIndex, false );
2119end;
2120
2121function TTopic.ContainsWord( DictIndex: integer ): boolean;
2122begin
2123 Result := SearchForWord( DictIndex, true ) > 0;
2124end;
2125
2126// Gets the window dimensions specified by this topic's
2127// contents header
2128procedure TTopic.GetContentsWindowRect( ContentsRect: THelpWindowRect );
2129var
2130 extendedinfo: TExtendedTOCEntry;
2131 XY: THelpXYPair;
2132 p: pbyte;
2133
2134 Flags: byte;
2135begin
2136 Flags := _pTOCEntry ^.flags;
2137 p := pByte( _pTOCEntry + sizeof( TTOCEntryStart ) );
2138
2139 ContentsRect.Left := 0;
2140 ContentsRect.Bottom := 0;
2141 ContentsRect.Width := 100;
2142 ContentsRect.Height := 100;
2143
2144 if ( Flags and TOCEntryExtended ) > 0 then
2145 begin
2146 // have more details available...
2147 ExtendedInfo.w1 := p^;
2148 ExtendedInfo.w2 := ( p+1) ^;
2149 inc( p, sizeof( ExtendedInfo ) );
2150
2151 if ( ExtendedInfo.w1 and 1 ) > 0 then
2152 begin
2153 // read origin
2154 XY := pHelpXYPair( p )^;
2155 inc( p, sizeof( XY ) );
2156 ReadHelpPosition( XY, ContentsRect );
2157 end;
2158 if ( ExtendedInfo.w1 and 2 ) > 0 then
2159 begin
2160 // read size
2161 XY := pHelpXYPair( p )^;
2162 inc( p, sizeof( XY ) );
2163 ReadHelpSize( XY, ContentsRect );
2164 end;
2165 end;
2166end;
2167
2168const
2169 IPFColorNames: array[ 0..15 ] of string =
2170 (
2171 'default',
2172 'blue',
2173 'red',
2174 'pink',
2175 'green',
2176 'cyan',
2177 'yellow',
2178 'neutral',
2179// 'brown', ??
2180 'darkgray',
2181 'darkblue',
2182 'darkred',
2183 'darkpink',
2184 'darkgreen',
2185 'darkcyan',
2186 'black',
2187 'palegray'
2188 );
2189
2190Procedure SaveExtraLinkData( Link: TWindowedHelpLink;
2191 pData: pUInt8 );
2192var
2193 LinkFlags1: uint8;
2194 LinkFlags2: uint8;
2195 LinkDataIndex: longint;
2196 pLinkXY: pHelpXYPair;
2197 pLinkData: pUInt8;
2198begin
2199 LinkFlags1 := ( pData + 0 ) ^;
2200 LinkFlags2 := ( pData + 1 ) ^;
2201
2202 pLinkData := pData + 2;
2203
2204 if ( LinkFlags1 and 1 ) > 0 then
2205 begin
2206 // position specified
2207 pLinkXY := pHelpXYPair( pLinkData );
2208 inc( pLinkData, sizeof( THelpXYPair ) );
2209 end;
2210
2211 if ( LinkFlags1 and 2 ) > 0 then
2212 begin
2213 // size specified
2214 pLinkXY := pHelpXYPair( pLinkData );
2215 inc( pLinkData, sizeof( THelpXYPair ) );
2216 end;
2217
2218 if ( LinkFlags1 and 8 ) > 0 then
2219 begin
2220 // window controls specified - skip
2221 inc( pLinkData, 2 );
2222 end;
2223
2224 if ( LinkFlags2 and 4 ) > 0 then
2225 begin
2226 // group specified
2227 Link.GroupIndex := pUInt16( pLinkData )^;
2228 inc( LinkDataIndex, sizeof( uint16 ) );
2229 end;
2230
2231 if ( LinkFlags1 and 64 ) > 0 then
2232 begin
2233 Link.Automatic := true;
2234 end;
2235
2236 if ( LinkFlags1 and 4 ) > 0 then
2237 Link.ViewPort := true;
2238
2239 if ( LinkFlags2 and 2 ) > 0 then
2240 Link.Dependent := true;
2241
2242 if ( LinkFlags1 and 128 ) > 0 then
2243 Link.Split := true;
2244
2245 // cant be bothered with the others.
2246end;
2247
2248procedure TTopic.SaveIPFEscapeCode( Var State: TParseState;
2249 Var pData: pUInt8;
2250 Var F: TextFile;
2251 ImageOffsets: TList );
2252var
2253 EscapeLen: uint8;
2254 EscapeCode: uint8;
2255
2256 Margin: integer;
2257
2258 BitmapOffset: longword;
2259 BitmapFlags: uint8;
2260
2261 ColorCode: uint8;
2262 StyleCode: uint8;
2263
2264 FontIndex: uint8;
2265 pFontSpec: pTHelpFontSpec;
2266
2267 FaceName: string;
2268
2269 ExternalLinkFileIndex: uint8;
2270 ExternalLinkTopicID: string;
2271
2272 ProgramLink: string;
2273 ProgramPath: string;
2274 tmpProgramLinkParts : TStringList;
2275
2276 OutputString: string;
2277begin
2278 EscapeLen := pData^;
2279 EscapeCode := (pData + 1) ^;
2280 OutputString := '';
2281
2282 case EscapeCode of
2283
2284 ecSetLeftMargin:
2285 begin
2286 Margin := integer( ( pData + 2 )^ );
2287 GetMarginTag( Margin, State.FontState, OutputString, false );
2288 end;
2289
2290 ecSetLeftMarginNewLine:
2291 begin
2292 Margin := integer( ( pData + 2 )^ );
2293 GetMarginTag( Margin, State.FontState, OutputString, false );
2294 OutputString := OutputString
2295 + RTF_NewLine;
2296 end;
2297
2298 ecSetLeftMarginFit:
2299 begin
2300 Margin := integer( ( pData + 2 )^ );
2301 GetMarginTag( Margin, State.FontState, OutputString, true );
2302 // note that this will cause following tex to be "tabbed" across to the
2303 // new margin position, if not yet there.
2304 // if we are already past this margin then a new line should be started.
2305
2306 end;
2307
2308 ecSetLeftMarginHere:
2309 begin
2310 OutputString := '<leftmargin here>';
2311 end;
2312
2313 ecHighlight1: // hp1,2,3, 5,6,7
2314 begin
2315 StyleCode := ( pData + 2 ) ^;
2316 if StyleCode > 3 then
2317 StyleCode := StyleCode + 1; // 4, 8 and 9 are expressed in highlight2 code
2318
2319 if StyleCode > 0 then
2320 Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
2321 else
2322 Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
2323 State.StyleCode := StyleCode;
2324 end;
2325
2326 ecHighlight2: // hp4, 8, 9
2327 begin
2328 StyleCode := ( pData + 2 ) ^;
2329 case StyleCode of
2330 1: StyleCode := 4;
2331 2: StyleCode := 8;
2332 3: StyleCode := 9;
2333 end;
2334
2335 if StyleCode > 0 then
2336 Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
2337 else
2338 Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
2339 State.StyleCode := StyleCode;
2340 end;
2341
2342 ecLinkStart:
2343 begin
2344 Write( F, ':link reftype=hd' ); // link to heading
2345
2346 Write( F, ' refid=' + IntToStr( pUInt16( pData + 2 )^ ) );
2347
2348 {
2349 if EscapeLen >= 6 then
2350 begin
2351 GetExtraLinkData( Link, pData + 4 );
2352 end;}
2353
2354// if Link.Automatic then
2355// Write( F, ' auto' );
2356
2357 Write( F, '.' );
2358
2359 inc( State.LinkIndex );
2360 end;
2361
2362 ecFootnoteLinkStart:
2363 begin
2364 Write( F, ':link reftype=fn refid=fn'
2365 + IntToStr( pUInt16( pData + 2 )^ )
2366 + '.' );
2367 inc( State.LinkIndex );
2368 end;
2369
2370 ecStartLinkByResourceID:
2371 begin
2372 Write( F, ':link reftype=hd res='
2373 + IntToStr( pUInt16( pData + 2 )^ )
2374 + '.' );
2375
2376 inc( State.LinkIndex );
2377 end;
2378
2379 ecExternalLink:
2380 begin
2381 ExternalLinkFileIndex := ( pData + 2 )^;
2382 ExternalLinkTopicID := StrPasWithLength( pchar( pData + 4 ), ( pData + 3 )^ );
2383 Write( F, ':link reftype=hd '
2384 + ' refid=' + StrInSingleQuotes( ExternalLinkTopicID )
2385 + ' database=' + StrInSingleQuotes( _ReferencedFiles[ ExternalLinkFileIndex ] )
2386 + '.' );
2387
2388 end;
2389
2390 ecProgramLink:
2391 begin
2392 ProgramLink := StrPasWithLength( pchar( pData + 3 ), EscapeLen - 3 );
2393
2394 tmpProgramLinkParts := TStringList.Create;
2395 StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0);
2396 ProgramPath := tmpProgramLinkParts[0];
2397 tmpProgramLinkParts.Destroy;
2398
2399 Write( F, ':link reftype=launch'
2400 + ' object=' + StrInSingleQuotes( ProgramPath )
2401 + ' data=' + StrInSingleQuotes( ProgramLink )
2402 + '.' );
2403 end;
2404
2405 ecLinkEnd:
2406 begin
2407 Write( F, ':elink.' );
2408 if State.FootnoteLink <> nil then
2409 State.FootnoteLink := nil;
2410 end;
2411
2412 ecStartCharGraphics:
2413 begin
2414 State.FontState := fsFixed;
2415 State.InCharGraphics := true;
2416 WriteLn( F, '' );
2417 WriteLn( F, ':cgraphic.' );
2418 State.Spacing := false;
2419 end;
2420
2421 ecEndCharGraphics:
2422 begin
2423 State.FontState := fsNormal;
2424 State.InCharGraphics := false;
2425 WriteLn( F, '' );
2426 WriteLn( F, ':ecgraphic.' );
2427 State.Spacing := true;
2428 end;
2429
2430 ecImage:
2431 begin
2432 BitmapFlags := ( pData + 2 )^;
2433 BitmapOffset := pUInt32( pData + 3 )^;
2434
2435 SaveImageText( BitmapOffset, BitmapFlags, F, ImageOffsets );
2436
2437 if State.Spacing then
2438 Write( F, ' ' );
2439 end;
2440
2441 ecLinkedImage:
2442 begin
2443 SaveLinkedImage( pData, F, ImageOffsets );
2444 // Note! Early exit, since the procedure
2445 // will update pData.
2446 exit;
2447 end;
2448
2449 ecStartLines:
2450 begin
2451 WriteLn( F, '' );
2452 // aligned text
2453 case ( pData + 2 )^ of
2454 0, // just in case - to match image alignment oddities
2455 1:
2456 begin
2457 WriteLn( F, ':lines.' );
2458 State.Alignment := itaLeft;
2459 end;
2460
2461 2:
2462 begin
2463 WriteLn( F, ':lines align=right.' );
2464 State.Alignment := itaRight;
2465 end;
2466
2467 4:
2468 begin
2469 WriteLn( F, ':lines align=center.' );
2470 State.Alignment := itaCenter;
2471 end;
2472 end;
2473 end;
2474
2475 ecEndLines:
2476 begin
2477 // supposed to turn word wrap on, default font
2478 WriteLn( F, '' );
2479 WriteLn( F, ':elines.' );
2480 State.Alignment := itaLeft;
2481 end;
2482
2483 ecForegroundColor:
2484 begin
2485 ColorCode := ( pData + 2 )^;
2486
2487 if ColorCode < High( IPFColorNames ) then
2488 Write( F, ':color fc=' + IPFColorNames[ ColorCode ] + '.' );
2489 end;
2490
2491 ecBackgroundColor:
2492 begin
2493 ColorCode := ( pData + 2 )^;
2494 if ColorCode < High( IPFColorNames ) then
2495 Write( F, ':color bc=' + IPFColorNames[ ColorCode ] + '.' );
2496 end;
2497
2498 ecFontChange:
2499 begin
2500 FontIndex := ( pData + 2 )^;
2501 if FontIndex = 0 then
2502 begin
2503 // back to default font
2504 Write( F, ':font facename=default.' );
2505 State.FontState := fsNormal;
2506 end
2507 else if FontIndex < _FontTable.Count then
2508 begin
2509 // valid font index
2510 pFontSpec := _FontTable[ FontIndex ];
2511
2512 if pFontSpec = SubstituteFixedFont then
2513 begin
2514 // oops.
2515 OutputString := '<tt>';
2516 State.FontState := fsFixed;
2517 end
2518 else
2519 begin
2520 pFontSpec := _FontTable[ FontIndex ];
2521 FaceName := StrPasWithLength( pFontSpec ^. FaceName,
2522 sizeof( pFontSpec ^. FaceName ) );
2523 Write( F,
2524 ':font facename=' + StrInSingleQuotes( FaceName )
2525 + ' size=' + IntToStr( pFontSpec ^. Height )
2526 + 'x' + IntToStr( pFontSpec ^. Width )
2527 + '.' );
2528 State.FontState := fsCustom;
2529 end;
2530 end;
2531 end
2532 end; // case escape code of...
2533
2534 // Write( F, OutputString );
2535
2536 inc( pData, EscapeLen );
2537end;
2538
2539procedure TTopic.SaveToIPF( Var f: TextFile;
2540 ImageOffsets: TList );
2541var
2542 SlotIndex: integer;
2543 Slot: THelpTopicSlot;
2544 pData: pUInt8;
2545 pSlotEnd: pUInt8;
2546
2547 GlobalDictIndex: uint32;
2548
2549 StringToAdd: string;
2550 LocalDictIndex: uint8;
2551
2552 State: TParseState;
2553
2554 SequenceStepIndex: longint;
2555
2556 LineLen: longint;
2557 c: char;
2558begin
2559 EnsureSlotsLoaded;
2560
2561 State.LinkIndex := 0;
2562 State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
2563 State.InCharGraphics := false;
2564 State.Spacing := true;
2565 State.ForegroundColorTag := '</color>';
2566 State.BackgroundColorTag := '</backcolor>';
2567
2568 State.StartOfTextBlock := -1;
2569 State.TextBlock := TAString.Create;
2570
2571 State.FootnoteLink := nil;
2572
2573 State.StyleCode := 0;
2574
2575 SequenceStepIndex := 0;
2576
2577 LineLen := 0;
2578
2579 for SlotIndex := 0 to _NumSlots - 1 do
2580 begin
2581 if not State.InCharGraphics then
2582 State.Spacing := true; // this is just a guess as to the exact view behaviour.
2583 // inf.txt indicates that spacing is reset to true at
2584 // slot (cell) start, but that doesn't seem to be the
2585 // case when in character graphics... hey ho.
2586
2587 Slot := _Slots[ SlotIndex ];
2588
2589 pData := Slot.pData;
2590
2591 pSlotEnd := pData + Slot.Size;
2592
2593 State.Alignment := itaLeft;
2594
2595 while pData < pSlotEnd do
2596 begin
2597 LocalDictIndex := pData^;
2598 inc( pData );
2599
2600 if LocalDictIndex < Slot.LocalDictSize then
2601 begin
2602 // Normal word lookup
2603 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
2604
2605 // normal lookup
2606 if GlobalDictIndex < _GlobalDictionary.Count then
2607 StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
2608 else
2609 StringToAdd := '';
2610
2611 if Length( StringToAdd ) = 1 then
2612 begin
2613 // could be symbol
2614 c := StringToAdd[ 1 ];
2615 case C of
2616 '&': StringToAdd := '&amp.';
2617 '''': StringToAdd := '&apos.';
2618// '*': StringToAdd := '&asterisk.';
2619 '@': StringToAdd := '&atsign.';
2620 '\': StringToAdd := '&bsl.';
2621 '^': StringToAdd := '&caret.';
2622 '"': StringToAdd := '&osq.';
2623 ':': StringToAdd := '&colon.';
2624 '.': StringToAdd := '&per.';
2625 end;
2626 end;
2627
2628 inc( LineLen, Length( StringToAdd ) );
2629 if ( LineLen > 80 ) and ( not State.InCharGraphics ) then
2630 begin
2631 WriteLn( F );
2632 LineLen := 0;
2633 end;
2634
2635 Write( F, StringToAdd );
2636{
2637 if State.FootnoteLink <> nil then
2638 begin
2639 State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
2640 if State.Spacing then
2641 begin
2642 State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
2643 end;
2644 end;
2645 }
2646 if State.Spacing then
2647 begin
2648 Write( F, ' ' );
2649 inc( LineLen );
2650 end;
2651 end
2652 else
2653 begin
2654 // special code
2655
2656 case LocalDictIndex of
2657 IPF_END_PARA:
2658 begin
2659 WriteLn( F, '' );
2660 Write( F, ':p.' );
2661 LineLen := 3;
2662
2663 if not State.InCharGraphics then
2664 State.Spacing := true;
2665 end;
2666
2667 IPF_CENTER:
2668 begin
2669 WriteLn( F, '' );
2670 Write( F, '.ce ' ); // remainder of this line is centered.
2671 LineLen := 4;
2672 State.Alignment := itaCenterOnePara;
2673 end;
2674
2675 IPF_INVERT_SPACING:
2676 begin
2677 State.Spacing := not State.Spacing;
2678 end;
2679
2680 IPF_LINEBREAK:
2681 begin
2682 WriteLn( F, '' );
2683 if not State.InCharGraphics then
2684 WriteLn( F, '.br ' ); // break must be the only thing on the line
2685
2686 LineLen := 0;
2687 if not State.InCharGraphics then
2688 State.Spacing := true;
2689 end;
2690
2691 IPF_SPACE:
2692 begin
2693 if State.Spacing then
2694 Write( F, ' ' )
2695 else
2696 Write( F, ' ' );
2697 end;
2698
2699 IPF_ESC:
2700 begin
2701 // escape sequence
2702 SaveIPFEscapeCode( State,
2703 pData,
2704 F,
2705 ImageOffsets );
2706 end;
2707
2708 end; // case code of...
2709 end;
2710 end; // for slotindex = ...
2711 end;
2712 State.TextBlock.Destroy;
2713
2714end;
2715
2716// Compares two topics for purposes of sorting by
2717// search match relevance
2718function TopicRelevanceCompare( Item1, Item2: pointer ): longint;
2719var
2720 Topic1, Topic2: TTopic;
2721begin
2722 Topic1 := Item1;
2723 Topic2 := Item2;
2724
2725 if Topic1.SearchRelevance > Topic2.SearchRelevance then
2726 Result := -1
2727 else if Topic1.SearchRelevance < Topic2.SearchRelevance then
2728 Result := 1
2729 else
2730 Result := 0;
2731end;
2732
2733// Compares two topics for purposes of sorting by
2734// title
2735function TopicTitleCompare( Item1, Item2: pointer ): longint;
2736begin
2737 Result := CompareText( TTopic( Item1 )._Title^,
2738 TTopic( Item2 )._Title^ );
2739end;
2740
2741Initialization
2742 RegisterProcForLanguages( OnLanguageEvent );
2743End.
Note: See TracBrowser for help on using the repository browser.