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

Last change on this file since 360 was 333, checked in by RBRi, 17 years ago

search bug fix; more logging
  • 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 tmpWordSequence: TList;
1463 tmpSequenceStepIndex: 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 tmpWordSequence := WordSequences[ SequenceIndex ];
1479 pSequenceStepWords := tmpWordSequence[ 0 ];
1480
1481 if pSequenceStepWords^[ GlobalDictIndex ] > 0 then
1482 begin
1483 // matched first step in this sequence. Look ahead...
1484 tmpSequenceStepIndex := 1;
1485
1486 pDataTemp := pData;
1487 SlotIndexTemp := SlotIndex;
1488 StateTemp := State;
1489
1490 while true do
1491 begin
1492 if tmpSequenceStepIndex = tmpWordSequence.Count then
1493 begin
1494 // have a match for the sequence; time to leave
1495 Result := tmpWordSequence.Count;
1496 break;
1497 end;
1498
1499 // get words for next step in sequence
1500 pSequenceStepWords := tmpWordSequence[ tmpSequenceStepIndex ];
1501
1502 DictIndex := GetNextIPFTextItem( SlotIndexTemp, pDataTemp, StateTemp );
1503 if DictIndex = -2 then
1504 begin
1505 // end of text - abort
1506 break;
1507 end;
1508
1509 if DictIndex = -1 then
1510 begin
1511 // whitespace - abort
1512 // for multi-word phrase searching - count this and subsequent whitespace...
1513 break;
1514 end;
1515
1516 // s := pstring( _GlobalDictionary[ DictIndex ] )^; // for debug only
1517
1518
1519 // ignore whitespace
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
1528 // match; next one
1529 inc(tmpSequenceStepIndex);
1530 end;
1531
1532 end; // while
1533
1534 end;
1535 // else - doesn't match first step, do nothing
1536 end; // for sequenceindex ...
1537end;
1538
1539
1540// Main translation function. Turns the IPF data into
1541// a text string. Translates formatting codes into tags
1542// as for Rich Text Viewer.
1543// Uses TAString for speed without length limits
1544// - string is too short
1545// - PChar is slow to concatenate (unless you keep track of the insert point)
1546// - AnsiString is slow
1547procedure TTopic.GetText( HighlightSequences: TList;
1548 // each element is a TList
1549 // containing a sequence of possible words
1550 // each element of each sequence
1551 // is an array of flags for the dictionary
1552 // indicating if the word is a allowed match at that step
1553 // a match is any sequence that matches one or more words at each step.
1554 ShowCodes: boolean;
1555 ShowWordSeparators: boolean;
1556 Text: TAString;
1557 ImageOffsets: TList;
1558 HighlightMatches: TList );
1559var
1560 SlotIndex: integer;
1561 Slot: THelpTopicSlot;
1562 pData: pUInt8;
1563 pSlotEnd: pUInt8;
1564
1565 GlobalDictIndex: uint32;
1566
1567 WordsOnLine: longint;
1568
1569 StringToAdd: string;
1570 LocalDictIndex: uint8;
1571
1572 State: TParseState;
1573
1574 EscapeLen: uint8;
1575 i: longint;
1576
1577 SequenceStepIndex: longint;
1578begin
1579 if Links = nil then
1580 Links := TList.Create;
1581
1582 if HighlightMatches <> nil then
1583 HighlightMatches.Clear;
1584
1585 // Text.Clear;
1586 ImageOffsets.Clear;
1587
1588 try
1589 EnsureSlotsLoaded;
1590 except
1591 on E: EHelpFileException do
1592 begin
1593 Text.AddString( e.Message );
1594 exit;
1595 end;
1596 end;
1597
1598 WordsOnLine := 0;
1599
1600 State.LinkIndex := 0;
1601 State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
1602 State.InCharGraphics := false;
1603 State.Spacing := true;
1604 State.ForegroundColorTag := '</color>';
1605 State.BackgroundColorTag := '</backcolor>';
1606
1607 State.StartOfTextBlock := -1;
1608 State.TextBlock := TAString.Create;
1609
1610 State.FootnoteLink := nil;
1611
1612 Text.AddString( '<leftmargin 1>' );
1613
1614 SequenceStepIndex := 0;
1615
1616 for SlotIndex := 0 to _NumSlots - 1 do
1617 begin
1618 if not State.InCharGraphics then
1619 State.Spacing := true; // this is just a guess as to the exact view behaviour.
1620 // inf.txt indicates that spacing is reset to true at
1621 // slot (cell) start, but that doesn't seem to be the
1622 // case when in character graphics... hey ho.
1623
1624 Slot := _Slots[ SlotIndex ];
1625
1626 pData := Slot.pData;
1627
1628 pSlotEnd := pData + Slot.Size;
1629
1630 State.Alignment := itaLeft;
1631
1632 while pData < pSlotEnd do
1633 begin
1634 LocalDictIndex := pData^;
1635 inc( pData );
1636
1637 if LocalDictIndex < Slot.LocalDictSize then
1638 begin
1639 // Normal word lookup
1640 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
1641
1642 if ShowWordSeparators then
1643 begin
1644 Text.AddString( '{' + IntToStr( GlobalDictIndex )+ '}' );
1645 end;
1646
1647 // normal lookup
1648 if GlobalDictIndex < _GlobalDictionary.Count then
1649 StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
1650 else
1651 StringToAdd := '';
1652
1653 if StrIsEmptyOrSpaces( StringToAdd ) then
1654 begin
1655 // spaces only...
1656 CheckForAutoURL( Text, State );
1657 end
1658 else
1659 begin
1660 // really is a word, not a space.
1661
1662 // store string into "word"
1663 if State.TextBlock.Length = 0 then
1664 begin
1665 // store start of block
1666 State.StartOfTextBlock := Text.Length;
1667 end;
1668
1669 State.TextBlock.AddString( StringToAdd );
1670
1671 SubstituteAngleBrackets( StringToAdd );
1672
1673 if HighlightSequences <> nil then
1674 begin
1675 if SequenceStepIndex > 0 then
1676 begin
1677 // currently highlighting a sequence.
1678 dec( SequenceStepIndex );
1679 if SequenceStepIndex = 0 then
1680 begin
1681 // now finished, insert end highlight
1682 StringToAdd := StringToAdd + State.BackgroundColorTag;
1683 end;
1684 end
1685 else
1686 begin
1687 // not yet in a sequence, searching.
1688 SequenceStepIndex :=
1689 CheckForSequence( HighlightSequences,
1690 SlotIndex,
1691 pData,
1692 State,
1693 GlobalDictIndex );
1694
1695 if SequenceStepIndex > 0 then
1696 begin
1697 // this word starts a sequence!
1698 if HighlightMatches <> nil then
1699 HighlightMatches.Add( pointer( Text.Length ) );
1700 StringToAdd := '<backcolor #'
1701 + IntToHex( Settings.Colors[ SearchHighlightTextColorIndex ], 6 )
1702 + '>'
1703 + StringToAdd;
1704 dec( SequenceStepIndex );
1705 if SequenceStepIndex = 0 then
1706 // and ends it.
1707 StringToAdd := StringToAdd + State.BackgroundColorTag;
1708 end;
1709
1710 end;
1711 end; // if processing sequence
1712 inc( WordsOnLine );
1713 end;
1714
1715 Text.AddString( StringToAdd );
1716
1717 if State.FootnoteLink <> nil then
1718 begin
1719 State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
1720 if State.Spacing then
1721 begin
1722 State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
1723 end;
1724 end;
1725
1726 if State.Spacing then
1727 begin
1728 CheckForAutoURL( Text, State );
1729
1730 Text.AddString( ' ' );
1731 end;
1732 end
1733 else
1734 begin
1735 // special code
1736
1737 if ShowCodes then
1738 begin
1739 Text.AddString( '[' + IntToHex( LocalDictIndex, 2 ) );
1740 if LocalDictIndex = IPF_ESC then
1741 begin
1742 EscapeLen := pData^;
1743 for i := 1 to EscapeLen - 1 do
1744 begin
1745 Text.AddString( ' '
1746 + IntToHex( ( pData + i )^, 2 ) );
1747 end;
1748
1749 end;
1750 Text.AddString( ']' );
1751 end;
1752
1753 case LocalDictIndex of
1754 IPF_END_PARA:
1755 begin
1756 if SlotIndex = 0 then
1757 if pData - 1 = Slot.pData then
1758 // ignore first FA, not needed with RichTextView
1759 continue;
1760
1761 CheckForAutoURL( Text, State );
1762 if State.Alignment = itaCenterOnePara then
1763 begin
1764 State.Alignment := itaLeft;
1765 Text.AddString( '<align left>' );
1766 end;
1767 Text.AddString(RTF_NewLine);
1768
1769 if WordsOnLine > 0 then
1770 Text.AddString(RTF_NewLine);
1771
1772 if not State.InCharGraphics then
1773 State.Spacing := true;
1774
1775 WordsOnLine := 0;
1776 end;
1777
1778 IPF_CENTER:
1779 begin
1780 CheckForAutoURL( Text, State );
1781 Text.addString( RTF_NewLine + '<align center>' );
1782 State.Alignment := itaCenterOnePara;
1783 end;
1784
1785 IPF_INVERT_SPACING:
1786 begin
1787 State.Spacing := not State.Spacing;
1788 end;
1789
1790 IPF_LINEBREAK:
1791 begin
1792 CheckForAutoURL( Text, State );
1793
1794 if State.Alignment = itaCenterOnePara then
1795 begin
1796 State.Alignment := itaLeft;
1797 Text.AddString( '<align left>' );
1798 end;
1799 Text.AddString( RTF_NewLine );
1800 if not State.InCharGraphics then
1801 State.Spacing := true;
1802 WordsOnLine := 0;
1803 end;
1804
1805 IPF_SPACE:
1806 begin
1807 CheckForAutoURL( Text, State );
1808 if State.Spacing then
1809 Text.AddString( ' ' );
1810 end;
1811
1812 IPF_ESC:
1813 begin
1814 // escape sequence
1815 TranslateIPFEscapeCode( State,
1816 pData,
1817 Text,
1818 WordsOnLine,
1819 ImageOffsets );
1820
1821 end;
1822
1823 end; // case code of...
1824 end;
1825 end; // for slotindex = ...
1826 end;
1827 State.TextBlock.Destroy;
1828end;
1829
1830
1831function TTopic.SearchForWord( DictIndex: integer;
1832 StopAtFirstOccurrence: boolean )
1833 : longint;
1834var
1835 SlotIndex: integer;
1836 Slot: THelpTopicSlot;
1837 pData: pUInt8;
1838 pSlotEnd: pUInt8;
1839
1840 EscapeLen: longint;
1841
1842 GlobalDictIndex: uint32;
1843
1844 LocalDictIndex: uint8;
1845begin
1846 EnsureSlotsLoaded;
1847
1848 Result := 0;
1849 for SlotIndex := 0 to _NumSlots - 1 do
1850 begin
1851 Slot := _Slots[ SlotIndex ];
1852
1853 pData := Slot.pData;
1854
1855 pSlotEnd := pData + Slot.Size;
1856
1857 while pData < pSlotEnd do
1858 begin
1859 LocalDictIndex := pData^;
1860
1861 if LocalDictIndex < Slot.LocalDictSize then
1862 begin
1863 // Normal word lookup
1864 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
1865
1866 if GlobalDictIndex = DictIndex then
1867 begin
1868 inc( result );
1869 if StopAtFirstOccurrence then
1870 exit;
1871 end;
1872 end
1873 else
1874 begin
1875 // special code
1876 if LocalDictIndex = $ff then
1877 begin
1878 // escape string, skip it
1879 EscapeLen := ( pData + 1 ) ^;
1880 inc( pData, EscapeLen );
1881 end;
1882 end;
1883
1884 inc( pData );
1885 end; // for slotindex = ...
1886 end;
1887end;
1888
1889// Search for a sequence of bytes, including in escape codes
1890// this is for debugging to allow finding specific sequences
1891function TTopic.SearchForData( Data: pbyte;
1892 DataLen: integer ): boolean;
1893var
1894 SlotIndex: integer;
1895 Slot: THelpTopicSlot;
1896 pData: pUInt8;
1897 pSlotEnd: pUInt8;
1898
1899 pHold: pUint8;
1900 pSearch: pUint8;
1901begin
1902 EnsureSlotsLoaded;
1903
1904 for SlotIndex := 0 to _NumSlots - 1 do
1905 begin
1906 Slot := _Slots[ SlotIndex ];
1907
1908 pSearch := Data;
1909 pHold := Slot.pData;
1910 pData := Slot.pData;
1911 pSlotEnd := Slot.pData + Slot.Size;
1912
1913 while pHold < pSlotEnd do
1914 begin
1915 if pData^ = pSearch^ then
1916 begin
1917 // byte matches
1918 inc( pData );
1919 inc( pSearch );
1920 if ( pSearch >= Data + DataLen ) then
1921 begin
1922 // matches
1923 result := true;
1924 exit;
1925 end
1926 end
1927 else
1928 begin
1929 // no match
1930 pSearch := Data;
1931 inc( pHold );
1932 pData := pHold;
1933 end;
1934 end; // for slotindex = ...
1935 end;
1936
1937 result := false; // not found
1938end;
1939
1940function TTopic.SearchForWordSequences( WordSequence: TList;
1941 StopAtFirstOccurrence: boolean )
1942 : longint;
1943var
1944 SlotIndex: integer;
1945 Slot: THelpTopicSlot;
1946 pData: pUInt8;
1947 pSlotEnd: pUInt8;
1948
1949 EscapeLen: longint;
1950
1951 GlobalDictIndex: uint32;
1952 IsWord: boolean;
1953 WordRelevance: uint32;
1954
1955 CurrentMatchRelevance: uint32; // total relevances for words matched so far
1956 // in the current sequence
1957
1958// CurrentMatch: string; // useful for debugging only
1959 LocalDictIndex: uint8;
1960
1961 SequenceIndex: longint;
1962 SequenceStartSlotIndex: longint;
1963 pSequenceStartData: pUInt8;
1964
1965 pStepWordRelevances: UInt32ArrayPointer; // word relevances for the current step in the sequence
1966
1967 // get the current slot start and end pointers
1968 procedure GetSlot;
1969 begin
1970 Slot := self._Slots[ SlotIndex ];
1971 pData := Slot.pData;
1972 pSlotEnd := pData + Slot.Size;
1973 end;
1974
1975 // get pointer to the current set of word relevances
1976 procedure GetStepFlags;
1977 begin
1978 pStepWordRelevances := WordSequence[ SequenceIndex ];
1979 end;
1980
1981 // store the current point as start of a sequence
1982 procedure StoreStartOfSequence;
1983 begin
1984 SequenceIndex := 0;
1985 SequenceStartSlotIndex := SlotIndex;
1986 pSequenceStartData := pData;
1987 CurrentMatchRelevance := 0;
1988// CurrentMatch := '';
1989 GetStepFlags;
1990 end;
1991
1992begin
1993 Result := 0;
1994
1995 EnsureSlotsLoaded;
1996
1997 if _NumSlots = 0 then
1998 // thar's nowt in yon topic, cannae be a match laid
1999 exit;
2000
2001 SlotIndex := 0;
2002
2003 GetSlot;
2004
2005 StoreStartOfSequence;
2006
2007 while true do
2008 begin
2009 LocalDictIndex := pData^;
2010 IsWord := false;
2011 if LocalDictIndex < Slot.LocalDictSize then
2012 begin
2013 IsWord := true;
2014 // Normal word lookup, so get the global dict idnex before we
2015 // (potentially) move to next slot
2016 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
2017 end;
2018
2019 inc( pData );
2020 if pData >= pSlotEnd then
2021 begin
2022 // reached end of slot, next please
2023 inc( SlotIndex );
2024 if SlotIndex < _NumSlots then
2025 GetSlot;
2026 // else - there is nothing more to search
2027 // but we need to check this last item
2028 end;
2029
2030 if IsWord then
2031 begin
2032 // Normal word lookup
2033 WordRelevance := 0;
2034
2035 if GlobalDictIndex < _GlobalDictionary.Count then
2036 if not StrIsEmptyOrSpaces( pstring( _GlobalDictionary[ GlobalDictIndex ] )^ ) then;
2037 WordRelevance := pStepWordRelevances[ GlobalDictIndex ];
2038
2039 if WordRelevance > 0 then
2040 begin
2041 // Found a matching word
2042 inc( CurrentMatchRelevance, WordRelevance );
2043// debug:
2044// CurrentMatch := CurrentMatch +
2045// pstring( _GlobalDictionary[ GlobalDictIndex ] )^;
2046
2047 if SequenceIndex = 0 then
2048 begin
2049 // remember next start point
2050 SequenceStartSlotIndex := SlotIndex;
2051 pSequenceStartData := pData;
2052 end;
2053
2054 inc( SequenceIndex );
2055
2056 if SequenceIndex < WordSequence.Count then
2057 begin
2058 // get next set of flags.
2059 GetStepFlags;
2060 end
2061 else
2062 begin
2063 // found a complete sequence. Cool!
2064
2065 inc( result, CurrentMatchRelevance );
2066
2067 if StopAtFirstOccurrence then
2068 exit;
2069
2070 // start looking from the beginning of the sequence again.
2071 StoreStartOfSequence;
2072 end;
2073 end
2074 else
2075 begin
2076 // not a match at this point, restart search
2077 if SequenceIndex > 0 then
2078 begin
2079 // we had matched one or more steps already,
2080 // back to start of sequence AND back to
2081 // point we started matching from (+1)
2082 SequenceIndex := 0;
2083 CurrentMatchRelevance := 0;
2084// CurrentMatch := '';
2085 SlotIndex := SequenceStartSlotIndex;
2086 GetSlot;
2087 pData := pSequenceStartData;
2088 GetStepFlags;
2089 end
2090 else
2091 begin
2092 // haven't matched anything yet.
2093 // update start of sequence
2094 SequenceStartSlotIndex := SlotIndex;
2095 pSequenceStartData := pData;
2096 end;
2097 end;
2098 end
2099 else
2100 begin
2101 // special code
2102 if LocalDictIndex = $ff then
2103 begin
2104 // escape string, skip it
2105 EscapeLen := pData ^;
2106 inc( pData, EscapeLen );
2107 end;
2108 end;
2109
2110 if SlotIndex >= _NumSlots then
2111 begin
2112 // finished searching topic
2113 break;
2114 end;
2115
2116 // next item
2117 end;
2118end;
2119
2120
2121function TTopic.CountWord( DictIndex: integer ): longint;
2122begin
2123 Result := SearchForWord( DictIndex, false );
2124end;
2125
2126function TTopic.ContainsWord( DictIndex: integer ): boolean;
2127begin
2128 Result := SearchForWord( DictIndex, true ) > 0;
2129end;
2130
2131// Gets the window dimensions specified by this topic's
2132// contents header
2133procedure TTopic.GetContentsWindowRect( ContentsRect: THelpWindowRect );
2134var
2135 extendedinfo: TExtendedTOCEntry;
2136 XY: THelpXYPair;
2137 p: pbyte;
2138
2139 Flags: byte;
2140begin
2141 Flags := _pTOCEntry ^.flags;
2142 p := pByte( _pTOCEntry + sizeof( TTOCEntryStart ) );
2143
2144 ContentsRect.Left := 0;
2145 ContentsRect.Bottom := 0;
2146 ContentsRect.Width := 100;
2147 ContentsRect.Height := 100;
2148
2149 if ( Flags and TOCEntryExtended ) > 0 then
2150 begin
2151 // have more details available...
2152 ExtendedInfo.w1 := p^;
2153 ExtendedInfo.w2 := ( p+1) ^;
2154 inc( p, sizeof( ExtendedInfo ) );
2155
2156 if ( ExtendedInfo.w1 and 1 ) > 0 then
2157 begin
2158 // read origin
2159 XY := pHelpXYPair( p )^;
2160 inc( p, sizeof( XY ) );
2161 ReadHelpPosition( XY, ContentsRect );
2162 end;
2163 if ( ExtendedInfo.w1 and 2 ) > 0 then
2164 begin
2165 // read size
2166 XY := pHelpXYPair( p )^;
2167 inc( p, sizeof( XY ) );
2168 ReadHelpSize( XY, ContentsRect );
2169 end;
2170 end;
2171end;
2172
2173const
2174 IPFColorNames: array[ 0..15 ] of string =
2175 (
2176 'default',
2177 'blue',
2178 'red',
2179 'pink',
2180 'green',
2181 'cyan',
2182 'yellow',
2183 'neutral',
2184// 'brown', ??
2185 'darkgray',
2186 'darkblue',
2187 'darkred',
2188 'darkpink',
2189 'darkgreen',
2190 'darkcyan',
2191 'black',
2192 'palegray'
2193 );
2194
2195Procedure SaveExtraLinkData( Link: TWindowedHelpLink;
2196 pData: pUInt8 );
2197var
2198 LinkFlags1: uint8;
2199 LinkFlags2: uint8;
2200 LinkDataIndex: longint;
2201 pLinkXY: pHelpXYPair;
2202 pLinkData: pUInt8;
2203begin
2204 LinkFlags1 := ( pData + 0 ) ^;
2205 LinkFlags2 := ( pData + 1 ) ^;
2206
2207 pLinkData := pData + 2;
2208
2209 if ( LinkFlags1 and 1 ) > 0 then
2210 begin
2211 // position specified
2212 pLinkXY := pHelpXYPair( pLinkData );
2213 inc( pLinkData, sizeof( THelpXYPair ) );
2214 end;
2215
2216 if ( LinkFlags1 and 2 ) > 0 then
2217 begin
2218 // size specified
2219 pLinkXY := pHelpXYPair( pLinkData );
2220 inc( pLinkData, sizeof( THelpXYPair ) );
2221 end;
2222
2223 if ( LinkFlags1 and 8 ) > 0 then
2224 begin
2225 // window controls specified - skip
2226 inc( pLinkData, 2 );
2227 end;
2228
2229 if ( LinkFlags2 and 4 ) > 0 then
2230 begin
2231 // group specified
2232 Link.GroupIndex := pUInt16( pLinkData )^;
2233 inc( LinkDataIndex, sizeof( uint16 ) );
2234 end;
2235
2236 if ( LinkFlags1 and 64 ) > 0 then
2237 begin
2238 Link.Automatic := true;
2239 end;
2240
2241 if ( LinkFlags1 and 4 ) > 0 then
2242 Link.ViewPort := true;
2243
2244 if ( LinkFlags2 and 2 ) > 0 then
2245 Link.Dependent := true;
2246
2247 if ( LinkFlags1 and 128 ) > 0 then
2248 Link.Split := true;
2249
2250 // cant be bothered with the others.
2251end;
2252
2253procedure TTopic.SaveIPFEscapeCode( Var State: TParseState;
2254 Var pData: pUInt8;
2255 Var F: TextFile;
2256 ImageOffsets: TList );
2257var
2258 EscapeLen: uint8;
2259 EscapeCode: uint8;
2260
2261 Margin: integer;
2262
2263 BitmapOffset: longword;
2264 BitmapFlags: uint8;
2265
2266 ColorCode: uint8;
2267 StyleCode: uint8;
2268
2269 FontIndex: uint8;
2270 pFontSpec: pTHelpFontSpec;
2271
2272 FaceName: string;
2273
2274 ExternalLinkFileIndex: uint8;
2275 ExternalLinkTopicID: string;
2276
2277 ProgramLink: string;
2278 ProgramPath: string;
2279 tmpProgramLinkParts : TStringList;
2280
2281 OutputString: string;
2282begin
2283 EscapeLen := pData^;
2284 EscapeCode := (pData + 1) ^;
2285 OutputString := '';
2286
2287 case EscapeCode of
2288
2289 ecSetLeftMargin:
2290 begin
2291 Margin := integer( ( pData + 2 )^ );
2292 GetMarginTag( Margin, State.FontState, OutputString, false );
2293 end;
2294
2295 ecSetLeftMarginNewLine:
2296 begin
2297 Margin := integer( ( pData + 2 )^ );
2298 GetMarginTag( Margin, State.FontState, OutputString, false );
2299 OutputString := OutputString
2300 + RTF_NewLine;
2301 end;
2302
2303 ecSetLeftMarginFit:
2304 begin
2305 Margin := integer( ( pData + 2 )^ );
2306 GetMarginTag( Margin, State.FontState, OutputString, true );
2307 // note that this will cause following tex to be "tabbed" across to the
2308 // new margin position, if not yet there.
2309 // if we are already past this margin then a new line should be started.
2310
2311 end;
2312
2313 ecSetLeftMarginHere:
2314 begin
2315 OutputString := '<leftmargin here>';
2316 end;
2317
2318 ecHighlight1: // hp1,2,3, 5,6,7
2319 begin
2320 StyleCode := ( pData + 2 ) ^;
2321 if StyleCode > 3 then
2322 StyleCode := StyleCode + 1; // 4, 8 and 9 are expressed in highlight2 code
2323
2324 if StyleCode > 0 then
2325 Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
2326 else
2327 Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
2328 State.StyleCode := StyleCode;
2329 end;
2330
2331 ecHighlight2: // hp4, 8, 9
2332 begin
2333 StyleCode := ( pData + 2 ) ^;
2334 case StyleCode of
2335 1: StyleCode := 4;
2336 2: StyleCode := 8;
2337 3: StyleCode := 9;
2338 end;
2339
2340 if StyleCode > 0 then
2341 Write( F, ':hp' + IntToStr( StyleCode ) + '.' )
2342 else
2343 Write( F, ':ehp' + IntToStr( State.StyleCode ) + '.' );
2344 State.StyleCode := StyleCode;
2345 end;
2346
2347 ecLinkStart:
2348 begin
2349 Write( F, ':link reftype=hd' ); // link to heading
2350
2351 Write( F, ' refid=' + IntToStr( pUInt16( pData + 2 )^ ) );
2352
2353 {
2354 if EscapeLen >= 6 then
2355 begin
2356 GetExtraLinkData( Link, pData + 4 );
2357 end;}
2358
2359// if Link.Automatic then
2360// Write( F, ' auto' );
2361
2362 Write( F, '.' );
2363
2364 inc( State.LinkIndex );
2365 end;
2366
2367 ecFootnoteLinkStart:
2368 begin
2369 Write( F, ':link reftype=fn refid=fn'
2370 + IntToStr( pUInt16( pData + 2 )^ )
2371 + '.' );
2372 inc( State.LinkIndex );
2373 end;
2374
2375 ecStartLinkByResourceID:
2376 begin
2377 Write( F, ':link reftype=hd res='
2378 + IntToStr( pUInt16( pData + 2 )^ )
2379 + '.' );
2380
2381 inc( State.LinkIndex );
2382 end;
2383
2384 ecExternalLink:
2385 begin
2386 ExternalLinkFileIndex := ( pData + 2 )^;
2387 ExternalLinkTopicID := StrPasWithLength( pchar( pData + 4 ), ( pData + 3 )^ );
2388 Write( F, ':link reftype=hd '
2389 + ' refid=' + StrInSingleQuotes( ExternalLinkTopicID )
2390 + ' database=' + StrInSingleQuotes( _ReferencedFiles[ ExternalLinkFileIndex ] )
2391 + '.' );
2392
2393 end;
2394
2395 ecProgramLink:
2396 begin
2397 ProgramLink := StrPasWithLength( pchar( pData + 3 ), EscapeLen - 3 );
2398
2399 tmpProgramLinkParts := TStringList.Create;
2400 StrExtractStrings(tmpProgramLinkParts, ProgramLink, [' '], #0);
2401 ProgramPath := tmpProgramLinkParts[0];
2402 tmpProgramLinkParts.Destroy;
2403
2404 Write( F, ':link reftype=launch'
2405 + ' object=' + StrInSingleQuotes( ProgramPath )
2406 + ' data=' + StrInSingleQuotes( ProgramLink )
2407 + '.' );
2408 end;
2409
2410 ecLinkEnd:
2411 begin
2412 Write( F, ':elink.' );
2413 if State.FootnoteLink <> nil then
2414 State.FootnoteLink := nil;
2415 end;
2416
2417 ecStartCharGraphics:
2418 begin
2419 State.FontState := fsFixed;
2420 State.InCharGraphics := true;
2421 WriteLn( F, '' );
2422 WriteLn( F, ':cgraphic.' );
2423 State.Spacing := false;
2424 end;
2425
2426 ecEndCharGraphics:
2427 begin
2428 State.FontState := fsNormal;
2429 State.InCharGraphics := false;
2430 WriteLn( F, '' );
2431 WriteLn( F, ':ecgraphic.' );
2432 State.Spacing := true;
2433 end;
2434
2435 ecImage:
2436 begin
2437 BitmapFlags := ( pData + 2 )^;
2438 BitmapOffset := pUInt32( pData + 3 )^;
2439
2440 SaveImageText( BitmapOffset, BitmapFlags, F, ImageOffsets );
2441
2442 if State.Spacing then
2443 Write( F, ' ' );
2444 end;
2445
2446 ecLinkedImage:
2447 begin
2448 SaveLinkedImage( pData, F, ImageOffsets );
2449 // Note! Early exit, since the procedure
2450 // will update pData.
2451 exit;
2452 end;
2453
2454 ecStartLines:
2455 begin
2456 WriteLn( F, '' );
2457 // aligned text
2458 case ( pData + 2 )^ of
2459 0, // just in case - to match image alignment oddities
2460 1:
2461 begin
2462 WriteLn( F, ':lines.' );
2463 State.Alignment := itaLeft;
2464 end;
2465
2466 2:
2467 begin
2468 WriteLn( F, ':lines align=right.' );
2469 State.Alignment := itaRight;
2470 end;
2471
2472 4:
2473 begin
2474 WriteLn( F, ':lines align=center.' );
2475 State.Alignment := itaCenter;
2476 end;
2477 end;
2478 end;
2479
2480 ecEndLines:
2481 begin
2482 // supposed to turn word wrap on, default font
2483 WriteLn( F, '' );
2484 WriteLn( F, ':elines.' );
2485 State.Alignment := itaLeft;
2486 end;
2487
2488 ecForegroundColor:
2489 begin
2490 ColorCode := ( pData + 2 )^;
2491
2492 if ColorCode < High( IPFColorNames ) then
2493 Write( F, ':color fc=' + IPFColorNames[ ColorCode ] + '.' );
2494 end;
2495
2496 ecBackgroundColor:
2497 begin
2498 ColorCode := ( pData + 2 )^;
2499 if ColorCode < High( IPFColorNames ) then
2500 Write( F, ':color bc=' + IPFColorNames[ ColorCode ] + '.' );
2501 end;
2502
2503 ecFontChange:
2504 begin
2505 FontIndex := ( pData + 2 )^;
2506 if FontIndex = 0 then
2507 begin
2508 // back to default font
2509 Write( F, ':font facename=default.' );
2510 State.FontState := fsNormal;
2511 end
2512 else if FontIndex < _FontTable.Count then
2513 begin
2514 // valid font index
2515 pFontSpec := _FontTable[ FontIndex ];
2516
2517 if pFontSpec = SubstituteFixedFont then
2518 begin
2519 // oops.
2520 OutputString := '<tt>';
2521 State.FontState := fsFixed;
2522 end
2523 else
2524 begin
2525 pFontSpec := _FontTable[ FontIndex ];
2526 FaceName := StrPasWithLength( pFontSpec ^. FaceName,
2527 sizeof( pFontSpec ^. FaceName ) );
2528 Write( F,
2529 ':font facename=' + StrInSingleQuotes( FaceName )
2530 + ' size=' + IntToStr( pFontSpec ^. Height )
2531 + 'x' + IntToStr( pFontSpec ^. Width )
2532 + '.' );
2533 State.FontState := fsCustom;
2534 end;
2535 end;
2536 end
2537 end; // case escape code of...
2538
2539 // Write( F, OutputString );
2540
2541 inc( pData, EscapeLen );
2542end;
2543
2544procedure TTopic.SaveToIPF( Var f: TextFile;
2545 ImageOffsets: TList );
2546var
2547 SlotIndex: integer;
2548 Slot: THelpTopicSlot;
2549 pData: pUInt8;
2550 pSlotEnd: pUInt8;
2551
2552 GlobalDictIndex: uint32;
2553
2554 StringToAdd: string;
2555 LocalDictIndex: uint8;
2556
2557 State: TParseState;
2558
2559 SequenceStepIndex: longint;
2560
2561 LineLen: longint;
2562 c: char;
2563begin
2564 EnsureSlotsLoaded;
2565
2566 State.LinkIndex := 0;
2567 State.FontState := fsNormal; // ? Not sure... this could be reset at start of slot
2568 State.InCharGraphics := false;
2569 State.Spacing := true;
2570 State.ForegroundColorTag := '</color>';
2571 State.BackgroundColorTag := '</backcolor>';
2572
2573 State.StartOfTextBlock := -1;
2574 State.TextBlock := TAString.Create;
2575
2576 State.FootnoteLink := nil;
2577
2578 State.StyleCode := 0;
2579
2580 SequenceStepIndex := 0;
2581
2582 LineLen := 0;
2583
2584 for SlotIndex := 0 to _NumSlots - 1 do
2585 begin
2586 if not State.InCharGraphics then
2587 State.Spacing := true; // this is just a guess as to the exact view behaviour.
2588 // inf.txt indicates that spacing is reset to true at
2589 // slot (cell) start, but that doesn't seem to be the
2590 // case when in character graphics... hey ho.
2591
2592 Slot := _Slots[ SlotIndex ];
2593
2594 pData := Slot.pData;
2595
2596 pSlotEnd := pData + Slot.Size;
2597
2598 State.Alignment := itaLeft;
2599
2600 while pData < pSlotEnd do
2601 begin
2602 LocalDictIndex := pData^;
2603 inc( pData );
2604
2605 if LocalDictIndex < Slot.LocalDictSize then
2606 begin
2607 // Normal word lookup
2608 GlobalDictIndex := Slot.pLocalDictionary^[ LocalDictIndex ];
2609
2610 // normal lookup
2611 if GlobalDictIndex < _GlobalDictionary.Count then
2612 StringToAdd := pstring( _GlobalDictionary[ GlobalDictIndex ] )^
2613 else
2614 StringToAdd := '';
2615
2616 if Length( StringToAdd ) = 1 then
2617 begin
2618 // could be symbol
2619 c := StringToAdd[ 1 ];
2620 case C of
2621 '&': StringToAdd := '&amp.';
2622 '''': StringToAdd := '&apos.';
2623// '*': StringToAdd := '&asterisk.';
2624 '@': StringToAdd := '&atsign.';
2625 '\': StringToAdd := '&bsl.';
2626 '^': StringToAdd := '&caret.';
2627 '"': StringToAdd := '&osq.';
2628 ':': StringToAdd := '&colon.';
2629 '.': StringToAdd := '&per.';
2630 end;
2631 end;
2632
2633 inc( LineLen, Length( StringToAdd ) );
2634 if ( LineLen > 80 ) and ( not State.InCharGraphics ) then
2635 begin
2636 WriteLn( F );
2637 LineLen := 0;
2638 end;
2639
2640 Write( F, StringToAdd );
2641{
2642 if State.FootnoteLink <> nil then
2643 begin
2644 State.FootnoteLink.Title := State.FootnoteLink.Title + StringToAdd;
2645 if State.Spacing then
2646 begin
2647 State.FootnoteLink.Title := State.FootnoteLink.Title + ' ';
2648 end;
2649 end;
2650 }
2651 if State.Spacing then
2652 begin
2653 Write( F, ' ' );
2654 inc( LineLen );
2655 end;
2656 end
2657 else
2658 begin
2659 // special code
2660
2661 case LocalDictIndex of
2662 IPF_END_PARA:
2663 begin
2664 WriteLn( F, '' );
2665 Write( F, ':p.' );
2666 LineLen := 3;
2667
2668 if not State.InCharGraphics then
2669 State.Spacing := true;
2670 end;
2671
2672 IPF_CENTER:
2673 begin
2674 WriteLn( F, '' );
2675 Write( F, '.ce ' ); // remainder of this line is centered.
2676 LineLen := 4;
2677 State.Alignment := itaCenterOnePara;
2678 end;
2679
2680 IPF_INVERT_SPACING:
2681 begin
2682 State.Spacing := not State.Spacing;
2683 end;
2684
2685 IPF_LINEBREAK:
2686 begin
2687 WriteLn( F, '' );
2688 if not State.InCharGraphics then
2689 WriteLn( F, '.br ' ); // break must be the only thing on the line
2690
2691 LineLen := 0;
2692 if not State.InCharGraphics then
2693 State.Spacing := true;
2694 end;
2695
2696 IPF_SPACE:
2697 begin
2698 if State.Spacing then
2699 Write( F, ' ' )
2700 else
2701 Write( F, ' ' );
2702 end;
2703
2704 IPF_ESC:
2705 begin
2706 // escape sequence
2707 SaveIPFEscapeCode( State,
2708 pData,
2709 F,
2710 ImageOffsets );
2711 end;
2712
2713 end; // case code of...
2714 end;
2715 end; // for slotindex = ...
2716 end;
2717 State.TextBlock.Destroy;
2718
2719end;
2720
2721// Compares two topics for purposes of sorting by
2722// search match relevance
2723function TopicRelevanceCompare( Item1, Item2: pointer ): longint;
2724var
2725 Topic1, Topic2: TTopic;
2726begin
2727 Topic1 := Item1;
2728 Topic2 := Item2;
2729
2730 if Topic1.SearchRelevance > Topic2.SearchRelevance then
2731 Result := -1
2732 else if Topic1.SearchRelevance < Topic2.SearchRelevance then
2733 Result := 1
2734 else
2735 Result := 0;
2736end;
2737
2738// Compares two topics for purposes of sorting by
2739// title
2740function TopicTitleCompare( Item1, Item2: pointer ): longint;
2741begin
2742 Result := CompareText( TTopic( Item1 )._Title^,
2743 TTopic( Item2 )._Title^ );
2744end;
2745
2746Initialization
2747 RegisterProcForLanguages( OnLanguageEvent );
2748End.
Note: See TracBrowser for help on using the repository browser.