Browse Source

+ New bunch of Gabor's changes: see fixes.txt

pierre 25 years ago
parent
commit
369efe46ed

+ 18 - 0
ide/text/fixes.txt

@@ -1,3 +1,21 @@
+Gabors's log to 29/5/2000 commits
+========================= Already fixed ================================
+
+ [*] TOAHelpFile.Init contained a bug, which caused an invalid pointer
+     operation when the help file version was incorrect (it resulted in
+     fatal exit)
+ [*] the cursor position in TSymbolScopeView was independant of the current
+     horizontal scroll offset
+ [*] the value of string constant wasn't displayed correctly in the symbol
+     browser (they were typecasted to PStrings, however they are PChars now)
+ [*] partial syntax highlight messed up CodeComplete
+ [*] the HTML link scanner wasn't aware of bookmark links
+
+========================== Other improvements ============================
+
+ [+] added support for TP5.5 format help files
+ [+] added support for HTML bookmarks in the help system
+ [+] fix calls into browcol turned into hooks (for future use in CodeInsight)
 Gabor's log 1/5/2000 commits
 ========================= Already fixed ================================
 

+ 6 - 3
ide/text/fp.pas

@@ -1,7 +1,7 @@
 {
     $Id$
     This file is part of the Free Pascal Integrated Development Environment
-    Copyright (c) 1998 by Berczi Gabor
+    Copyright (c) 1998-2000 by Berczi Gabor
 
     Main program of the IDE
 
@@ -42,7 +42,7 @@ uses
   FPIDE,FPCalc,FPCompile,
   FPIni,FPViews,FPConst,FPVars,FPUtils,FPHelp,FPSwitch,FPUsrScr,
   FPTools,{$ifndef NODEBUG}FPDebug,{$endif}FPTemplt,FPCatch,FPRedir,FPDesk,
-  FPSymbol,FPCodTmp,FPCodCmp;
+  FPCodTmp,FPCodCmp;
 
 
 procedure ProcessParams(BeforeINI: boolean);
@@ -248,7 +248,10 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.45  2000-05-02 08:42:26  pierre
+  Revision 1.46  2000-05-29 10:44:56  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.45  2000/05/02 08:42:26  pierre
    * new set of Gabor changes: see fixes.txt
 
   Revision 1.44  2000/04/25 08:42:32  pierre

+ 9 - 3
ide/text/fpcompil.pas

@@ -96,7 +96,7 @@ uses
   CompHook, Compiler, systems, browcol, switches,
   WEditor,
   FPString,FPRedir,FPDesk,FPUsrScr,FPHelp,
-  FPIde,FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
+  FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
 
 {$ifndef NOOBJREG}
 const
@@ -695,6 +695,9 @@ begin
   do_stop:=@CompilerStop;
   do_comment:=@CompilerComment;
 {$endif TP}
+  do_initsymbolinfo:=InitBrowserCol;
+  do_donesymbolinfo:=DoneBrowserCol;
+  do_extractsymbolinfo:=CreateBrowserCol;
 { Compile ! }
 {$ifdef redircompiler}
   ChangeRedirOut(FPOutFileName,false);
@@ -712,7 +715,7 @@ begin
     FileName:='-B '+FileName;
   { tokens are created and distroed by compiler.compile !! PM }
   DoneTokens;
-  FpIntF.Compile(FileName);
+  FpIntF.Compile(FileName,SwitchesPath);
   { tokens are created and distroed by compiler.compile !! PM }
   InitTokens;
   if LinkAfter and IsExe and
@@ -900,7 +903,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.57  2000-05-02 08:42:27  pierre
+  Revision 1.58  2000-05-29 10:44:56  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.57  2000/05/02 08:42:27  pierre
    * new set of Gabor changes: see fixes.txt
 
   Revision 1.56  2000/04/25 08:42:32  pierre

+ 11 - 5
ide/text/fphelp.pas

@@ -267,21 +267,24 @@ procedure InitHelpSystem;
   procedure AddOAFile(HelpFile: string);
   begin
     {$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile+' ('+SmartPath(HelpFile)+')');{$ENDIF}
-    HelpFacility^.AddOAHelpFile(HelpFile);
+    if HelpFacility^.AddOAHelpFile(HelpFile)=false then
+      ErrorBox(FormatStrStr(msg_failedtoloadhelpfile,HelpFile),nil);
     {$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile);{$ENDIF}
   end;
 
   procedure AddHTMLFile(TOCEntry,HelpFile: string);
   begin
     {$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile+' ('+SmartPath(HelpFile)+')');{$ENDIF}
-    HelpFacility^.AddHTMLHelpFile(HelpFile, TOCEntry);
+    if HelpFacility^.AddHTMLHelpFile(HelpFile, TOCEntry)=false then
+      ErrorBox(FormatStrStr(msg_failedtoloadhelpfile,HelpFile),nil);
     {$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile);{$ENDIF}
   end;
 
   procedure AddHTMLIndexFile(HelpFile: string);
   begin
     {$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile+' ('+SmartPath(HelpFile)+')');{$ENDIF}
-    HelpFacility^.AddHTMLIndexHelpFile(HelpFile);
+    if HelpFacility^.AddHTMLIndexHelpFile(HelpFile)=false then
+      ErrorBox(FormatStrStr(msg_failedtoloadhelpfile,HelpFile),nil);
     {$IFDEF DEBUG}SetStatus(msg_LoadingHelpFile);{$ENDIF}
   end;
 
@@ -298,7 +301,7 @@ begin
       if P>0 then
         begin TopicTitle:=copy(S,P+1,255); S:=copy(S,1,P-1); end;
       if TopicTitle='' then TopicTitle:=S;
-      if copy(UpcaseStr(ExtOf(S)),1,length(HTMLExt))=HTMLExt then { this recognizes both .htm and .html }
+      if copy(UpcaseStr(ExtOf(S)),1,length(HTMLExt))=UpcaseStr(HTMLExt) then { this recognizes both .htm and .html }
           AddHTMLFile(TopicTitle,S) else
       if UpcaseStr(ExtOf(S))=UpcaseStr(HTMLIndexExt) then
           AddHTMLIndexFile(S) else
@@ -456,7 +459,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.30  2000-05-02 08:42:27  pierre
+  Revision 1.31  2000-05-29 10:44:56  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.30  2000/05/02 08:42:27  pierre
    * new set of Gabor changes: see fixes.txt
 
   Revision 1.29  2000/04/25 08:42:33  pierre

+ 12 - 5
ide/text/fpintf.pas

@@ -23,7 +23,7 @@ function  GetRunParameters: string;
 procedure SetRunParameters(const Params: string);
 
 { Compile }
-procedure Compile(const FileName: string);
+procedure Compile(const FileName, ConfigFile: string);
 procedure SetPrimaryFile(const fn:string);
 
 
@@ -63,7 +63,7 @@ end;
                                    Compile
 ****************************************************************************}
 
-procedure Compile(const FileName: string);
+procedure Compile(const FileName, ConfigFile: string);
 var
   cmd : string;
 {$ifdef USE_EXTERNAL_COMPILER}
@@ -76,9 +76,13 @@ var
 {$endif USE_EXTERNAL_COMPILER}
 begin
 {$ifndef USE_EXTERNAL_COMPILER}
-  cmd:='[fp.cfg] -d'+SwitchesModeStr[SwitchesMode];
+  cmd:='-d'+SwitchesModeStr[SwitchesMode];
+  if ConfigFile<>'' then
+    cmd:='['+ConfigFile+'] '+cmd;
 {$else USE_EXTERNAL_COMPILER}
-  cmd:='-n @fp.cfg -d'+SwitchesModeStr[SwitchesMode];
+  cmd:='-n -d'+SwitchesModeStr[SwitchesMode];
+  if ConfigFile<>'' then
+    cmd:='@'+ConfigFile+' '+cmd;
   if not UseExternalCompiler then
 {$endif USE_EXTERNAL_COMPILER}
     if LinkAfter then
@@ -208,7 +212,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.10  2000-05-02 08:42:27  pierre
+  Revision 1.11  2000-05-29 10:44:56  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.10  2000/05/02 08:42:27  pierre
    * new set of Gabor changes: see fixes.txt
 
   Revision 1.9  2000/03/01 22:37:25  pierre

+ 5 - 2
ide/text/fpmhelp.inc

@@ -186,7 +186,7 @@ begin
                               LS^.StoreDocuments(BS^);
                               if BS^.Status<>stOK then
                                 begin
-                                  ErrorBox(msg_errorstoringindexdata,nil);
+                                  ErrorBox(FormatStrInt(msg_errorstoringindexdata,BS^.Status),nil);
                                   Re:=cmCancel;
                                 end;
                               Dispose(BS, Done);
@@ -252,7 +252,10 @@ end;
 
 {
   $Log$
-  Revision 1.10  2000-05-02 08:42:28  pierre
+  Revision 1.11  2000-05-29 10:44:57  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.10  2000/05/02 08:42:28  pierre
    * new set of Gabor changes: see fixes.txt
 
   Revision 1.9  2000/04/25 08:42:33  pierre

+ 6 - 2
ide/text/fpstre.inc

@@ -490,7 +490,7 @@ const
       msg_filedoesnotcontainanylinks = '%s doesn''t contain any links, thus it isn''t suitable for indexing.';
       msg_filealreadyexistsoverwrite = 'File %s already exists. Overwrite?';
       msg_storinghtmlindexinfile = 'Storing HTML index in %s';
-      msg_errorstoringindexdata = 'Error storing index data';
+      msg_errorstoringindexdata = 'Error storing index data (%d)';
 
       dialog_switchesmode = 'SwitchesMode';
       static_switchesmode_switchesmode = 'Switches Mode';
@@ -647,6 +647,7 @@ const
       msg_loadinghelpfile = 'Loading help file...';
       msg_buildinghelpindex = 'Building Help Index...';
       msg_locatingtopic = 'Locating topic...';
+      msg_failedtoloadhelpfile = 'Failed to load help file %s';
 
       { Browser messages }
       msg_symbolnotfound = #3'Symbol %s not found';
@@ -943,7 +944,10 @@ const
 
 {
   $Log$
-  Revision 1.1  2000-05-02 08:42:28  pierre
+  Revision 1.2  2000-05-29 10:44:57  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.1  2000/05/02 08:42:28  pierre
    * new set of Gabor changes: see fixes.txt
 
 

+ 6 - 2
ide/text/fpstrh.inc

@@ -490,7 +490,7 @@ const
       msg_filedoesnotcontainanylinks = 'a %s nem tartalmaz kapcsokat, ¡gy nem alkalmas indexel‚sre.';
       msg_filealreadyexistsoverwrite = 'A %s f jl m r l‚tezik. Fel�l¡rja?';
       msg_storinghtmlindexinfile = 'HTML index t rol sa a %s f jlban';
-      msg_errorstoringindexdata = 'Hiba az index adatok t rol sa k”zben';
+      msg_errorstoringindexdata = 'Hiba az index adatok t rol sa k”zben (%d)';
 
       dialog_switchesmode = 'SwitchesMode';
       static_switchesmode_switchesmode = 'Switches Mode';
@@ -647,6 +647,7 @@ const
       msg_loadinghelpfile = 'S£g¢ f jl bet”lt‚se...';
       msg_buildinghelpindex = 'S£g¢index k‚sz¡t‚se...';
       msg_locatingtopic = 'T‚ma bet”lt‚se...';
+      msg_failedtoloadhelpfile = 'Nem siker�lt bet”lteni a %s s£g¢-f jlt';
 
       { Browser messages }
       msg_symbolnotfound = #3'Nem tal lom a %s szimb¢lumot';
@@ -943,7 +944,10 @@ const
 
 {
   $Log$
-  Revision 1.1  2000-05-02 08:42:28  pierre
+  Revision 1.2  2000-05-29 10:44:57  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.1  2000/05/02 08:42:28  pierre
    * new set of Gabor changes: see fixes.txt
 
 

+ 8 - 2
ide/text/fpsymbol.pas

@@ -741,9 +741,12 @@ begin
 end;
 
 procedure TSymbolScopeView.Draw;
+var DeltaX: sw_integer;
 begin
   inherited Draw;
-  SetCursor(2+SymbolTypLen+length(LookUpStr),Focused-TopItem);
+  if Assigned(HScrollBar)=false then DeltaX:=0 else
+    DeltaX:=HScrollBar^.Value-HScrollBar^.Min;
+  SetCursor(2+SymbolTypLen+length(LookUpStr)-DeltaX,Focused-TopItem);
 end;
 
 procedure TSymbolScopeView.LookUp(S: string);
@@ -1555,7 +1558,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.26  2000-05-02 08:42:28  pierre
+  Revision 1.27  2000-05-29 10:44:57  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.26  2000/05/02 08:42:28  pierre
    * new set of Gabor changes: see fixes.txt
 
   Revision 1.25  2000/04/18 11:42:37  pierre

+ 11 - 1
ide/text/fpviews.pas

@@ -781,6 +781,13 @@ begin
   { But why do we need to check all ??
     Probably because of the ones which were not inserted into
     Desktop as the Messages view
+
+    Exactly. Some windows are inserted directly in the Application and not
+    in the Desktop. btw. Does TStatusLine.HelpCtx really change? Why?
+    Only GetHelpCtx should return different values depending on the
+    focused view (and it's helpctx), but TStatusLine's HelpCtx field
+    shouldn't change...  Gabor
+
   if Assigned(W)=false then W:=Desktop^.FirstThat(@Match);}
   SearchWindow:=PWindow(W);
 end;
@@ -3402,7 +3409,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.70  2000-05-16 21:50:53  pierre
+  Revision 1.71  2000-05-29 10:44:57  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.70  2000/05/16 21:50:53  pierre
    * avoid to typecast the status line to a TWindow
 
   Revision 1.69  2000/05/02 08:42:29  pierre

+ 1 - 1
ide/text/globdir.inc

@@ -106,7 +106,7 @@
   {$define DEBUG}
   {$undef EXEDEBUG}
   {$undef USERESSTRINGS}
-  {$define LANG_HUN}
+  {.$define LANG_HUN}
 {$endif}
 
 {$ifdef NOWINCLIP}

+ 10 - 9
ide/text/gplprog.pt

@@ -1,9 +1,9 @@
 {
-    $Id$DATE $TIME peter Exp $
-    This file is part of $PROMPT('This file is part of')
-    Copyright (c) $DATE('yyyy') by $PROMPT('Your name')
+    $Id$
+    <partof>
+    Copyright (c) 1998 by <yourname>
 
-    $PROMPT('Description of file')
+    <infoline>
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,18 +13,19 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-program $PROMPT('program');
+program ;
 
-uses $PROMPT('uses');
+uses ;
 
 BEGIN
 END.
 {
   $Log$
-  Revision 1.2  2000-05-02 08:42:29  pierre
-   * new set of Gabor changes: see fixes.txt
+  Revision 1.3  2000-05-29 10:44:58  pierre
+   + New bunch of Gabor's changes: see fixes.txt
 
   Revision 1.1  1999/02/19 15:37:26  peter
     + init
 
-}
+}
+

+ 8 - 8
ide/text/gplunit.pt

@@ -1,9 +1,9 @@
 {
-    $Id$DATE $TIME peter Exp $
-    This file is part of $PROMPT('This file is part of')
-    Copyright (c) $DATE('yyyy') by $PROMPT('Your name')
+    $Id$
+    <partof>
+    Copyright (c) 1998 by <yourname>
 
-    $PROMPT('Description of file')
+    <infoline>
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,11 +13,11 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-unit $PROMPT('unit');
+unit ;
 
 interface
 
-uses $PROMPT('uses');
+uses ;
 
 const
 
@@ -30,8 +30,8 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2000-05-02 08:42:29  pierre
-   * new set of Gabor changes: see fixes.txt
+  Revision 1.3  2000-05-29 10:44:58  pierre
+   + New bunch of Gabor's changes: see fixes.txt
 
   Revision 1.1  1999/02/19 15:37:26  peter
     + init

+ 2 - 2
ide/text/program.pt

@@ -1,6 +1,6 @@
-program $PROMPT('program');
+program ;
 
-uses $PROMPT('uses');
+uses ;
 
 BEGIN
 END.

+ 2 - 15
ide/text/readme.txt

@@ -4,21 +4,8 @@ This file is just a log of important changes
 starting 1999/10/29
 
 
-2000/01/28:
-   + Partial Syntax released:
-     this allows to open highlighted files faster.
-     The highlighting is only computed up to the current editor position
-     and is continued in the Idle loop as a background process
-     (it not a real separate process).
-
-2000/01/10:
-   + working register window
-
-1999/11/10:
-   + Grouped action started for Undo.
-     Undo of Copy/Cut/Paste or Clear should work.
-
-1999/10/29:
+1999/10/29 :
   Undo/Redo stuff added to normal compilation
   this is still buggy !!!
   Any use of Copy/Cut/Paste or Clear will generate wrong Undo
+  We will t

+ 2 - 1
ide/text/test.pas

@@ -151,7 +151,8 @@ BEGIN
   writeln(IsOdd(3));
   writeln(Func1(5,5,Bool,T));
   new(X);
-  X^.next:=X;
+  new(X^.next);
+  X^.next^.next:=X;
   dispose(X);
  { for i:=1 to 99 do
     Writeln('Line ',i); }

+ 2 - 2
ide/text/unit.pt

@@ -1,8 +1,8 @@
-unit $PROMPT('unit');
+unit ;
 
 interface
 
-uses $PROMPT('uses');
+uses ;
 
 const
 

+ 6 - 2
ide/text/weditor.pas

@@ -660,7 +660,7 @@ procedure RegisterWEditor;
 implementation
 
 uses
-  MsgBox,Dialogs,App,StdDlg,HistList,Validate,
+  MsgBox,Dialogs,App,StdDlg,Validate,
 {$ifdef WinClipSupported}
   Strings,WinClip,
 {$endif WinClipSupported}
@@ -3044,6 +3044,7 @@ begin
 {$ifdef TEST_PARTIAL_SYNTAX}
     evIdle :
       begin
+        CCAction:=ccDontCare;
         { Complete syntax by 20 lines increment }
         { could already be quite lengthy on slow systems }
         if not GetSyntaxCompleted then
@@ -5841,7 +5842,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.90  2000-05-17 11:58:26  pierre
+  Revision 1.91  2000-05-29 10:44:58  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.90  2000/05/17 11:58:26  pierre
    * remove openbrace because of multiple comment level problem
 
   Revision 1.89  2000/05/17 09:44:46  pierre

+ 164 - 22
ide/text/whelp.pas

@@ -18,10 +18,14 @@ unit WHelp;
 
 interface
 
-uses Objects;
+uses Objects,
+     WUtils;
 
 const
-      MinFormatVersion  = $34;
+      MinFormatVersion  = $04; { was $34 }
+
+      TP55FormatVersion = $04;
+      TP70FormatVersion = $34;
 
       Signature      = '$*$* &&&&$*$'#0;
       ncRawChar      = $F;
@@ -44,6 +48,7 @@ const
       hscCode        = #5;
       hscCenter      = #10;
       hscRight       = #11;
+      hscNamedMark   = #12;
 
 type
       FileStamp      = array [0..32] of char; {+ null terminator + $1A }
@@ -107,6 +112,21 @@ type
         Keywords      : array[0..0] of THLPKeywordDescriptor;
       end;
 
+      THLPKeywordDescriptor55 = packed record
+        PosY          : byte;
+        StartX        : byte;
+        EndX          : byte;
+        Dunno         : array[0..1] of word;
+        KwContext     : word;
+      end;
+
+      THLPKeyWordRecord55 = packed record
+        UpContext     : word;
+        DownContext   : word;
+        KeyWordCount  : byte;
+        Keywords      : array[0..0] of THLPKeywordDescriptor55;
+      end;
+
       TRecord = packed record
         SClass   : byte;
         Size     : word;
@@ -140,7 +160,10 @@ type
         LastAccess    : longint;
         FileID        : word;
         Param         : PString;
+        StartNamedMark: integer;
+        NamedMarks    : PUnsortedStringCollection;
         function LinkSize: sw_word;
+        function GetNamedMarkIndex(const MarkName: string): sw_integer;
       end;
 
       PTopicCollection = ^TTopicCollection;
@@ -243,7 +266,7 @@ uses
 {$ifdef Win32}
   windows,
 {$endif Win32}
-  WUtils,WViews,WHTMLHlp;
+  WViews,WHTMLHlp;
 
 
 Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
@@ -285,6 +308,7 @@ begin
   New(P); FillChar(P^,SizeOf(P^), 0);
   P^.HelpCtx:=HelpCtx; P^.FileOfs:=Pos; P^.FileID:=FileID;
   P^.Param:=NewStr(Param);
+  New(P^.NamedMarks, Init(100,100));
   NewTopic:=P;
 end;
 
@@ -299,12 +323,17 @@ begin
        FreeMem(P^.Links,P^.LinkSize);
     P^.Links:=nil;
     if P^.Param<>nil then DisposeStr(P^.Param); P^.Param:=nil;
+    if Assigned(P^.NamedMarks) then Dispose(P^.NamedMarks, Done); P^.NamedMarks:=nil;
     Dispose(P);
   end;
 end;
 
 function CloneTopic(T: PTopic): PTopic;
 var NT: PTopic;
+procedure CloneMark(P: PString); {$ifndef FPC}far;{$endif}
+begin
+  NT^.NamedMarks^.InsertStr(GetStr(P));
+end;
 begin
   New(NT); Move(T^,NT^,SizeOf(NT^));
   if NT^.Text<>nil then
@@ -313,6 +342,11 @@ begin
      begin GetMem(NT^.Links,NT^.LinkSize); Move(T^.Links^,NT^.Links^,NT^.LinkSize); end;
   if NT^.Param<>nil then
      NT^.Param:=NewStr(T^.Param^);
+  if Assigned(T^.NamedMarks) then
+  begin
+    New(NT^.NamedMarks, Init(T^.NamedMarks^.Count,10));
+    T^.NamedMarks^.ForEach(@CloneMark);
+  end;
   CloneTopic:=NT;
 end;
 
@@ -338,6 +372,20 @@ begin
   LinkSize:=LinkCount*SizeOf(Links^[0]);
 end;
 
+function TTopic.GetNamedMarkIndex(const MarkName: string): sw_integer;
+var I,Index: sw_integer;
+begin
+  Index:=-1;
+  if Assigned(NamedMarks) then
+  for I:=0 to NamedMarks^.Count-1 do
+    if CompareText(GetStr(NamedMarks^.At(I)),MarkName)=0 then
+     begin
+       Index:=I;
+       Break;
+     end;
+  GetNamedMarkIndex:=Index;
+end;
+
 function TTopicCollection.At(Index: sw_Integer): PTopic;
 begin
   At:=inherited At(Index);
@@ -531,10 +579,13 @@ begin
     F^.Seek(P+length(Signature)-1);
     F^.Read(Version,SizeOf(Version));
     OK:=(F^.Status=stOK) and (Version.FormatVersion>=MinFormatVersion);
-    if OK then OK:=ReadRecord(R,true);
-    OK:=OK and (R.SClass=rtFileHeader) and (R.Size=SizeOf(Header));
-    if OK then Move(R.Data^,Header,SizeOf(Header));
-    DisposeRecord(R);
+    if OK then
+    begin
+      OK:=ReadRecord(R,true);
+      OK:=OK and (R.SClass=rtFileHeader) and (R.Size=SizeOf(Header));
+      if OK then Move(R.Data^,Header,SizeOf(Header));
+      DisposeRecord(R);
+    end;
   end;
   ReadHeader:=OK;
 end;
@@ -644,6 +695,36 @@ end;
 function TOAHelpFile.ReadTopic(T: PTopic): boolean;
 var SrcPtr,DestPtr,TopicSize: sw_word;
     NewR: TRecord;
+    LinkPosCount: integer;
+    LinkPos: array[1..50] of TRect;
+function IsLinkPosStart(X,Y: integer): boolean;
+var OK: boolean;
+    I: integer;
+begin
+  OK:=false;
+  for I:=1 to LinkPosCount do
+    with LinkPos[I] do
+      if (A.X=X) and (A.Y=Y) then
+        begin
+          OK:=true;
+          Break;
+        end;
+  IsLinkPosStart:=OK;
+end;
+function IsLinkPosEnd(X,Y: integer): boolean;
+var OK: boolean;
+    I: integer;
+begin
+  OK:=false;
+  for I:=1 to LinkPosCount do
+    with LinkPos[I] do
+      if (B.X=X) and (B.Y=Y) then
+        begin
+          OK:=true;
+          Break;
+        end;
+  IsLinkPosEnd:=OK;
+end;
 function ExtractTextRec(var R: TRecord): boolean;
 function GetNextNibble: byte;
 var B,N: byte;
@@ -653,12 +734,41 @@ begin
   Inc(SrcPtr);
   GetNextNibble:=N;
 end;
-procedure AddChar(C: char);
+procedure RealAddChar(C: char);
 begin
   if Assigned(NewR.Data) then
     PByteArray(NewR.Data)^[DestPtr]:=ord(C);
   Inc(DestPtr);
 end;
+var CurX,CurY: integer;
+    InLink: boolean;
+procedure AddChar(C: char);
+begin
+  if IsLinkPosStart(CurX+2,CurY) then
+    begin
+      RealAddChar(hscLink);
+      InLink:=true;
+    end
+  else
+    if (C=hscLineBreak) and (InLink) then
+      begin
+        RealAddChar(hscLink);
+        InLink:=false;
+      end;
+  RealAddChar(C);
+  if IsLinkPosEnd(CurX+2,CurY) then
+    begin
+      RealAddChar(hscLink);
+      InLink:=false;
+    end;
+  if C<>hscLineBreak then
+    Inc(CurX)
+  else
+    begin
+      CurX:=0;
+      Inc(CurY);
+    end;
+end;
 var OK: boolean;
     C: char;
     P: pointer;
@@ -689,6 +799,7 @@ begin
        ctNone   : ;
        ctNibble :
          begin
+           CurX:=0; CurY:=0; InLink:=false;
            NewR.SClass:=0;
            NewR.Size:=0;
            NewR.Data:=nil;
@@ -698,8 +809,10 @@ begin
              C:=GetNextChar;
              AddChar(C);
            end;
+           if InLink then AddChar(hscLineBreak);
            TopicSize:=DestPtr;
 
+           CurX:=0; CurY:=0; InLink:=false;
            NewR.SClass:=R.SClass;
            NewR.Size:=Min(MaxHelpTopicSize,TopicSize);
            GetMem(NewR.Data, NewR.Size);
@@ -709,6 +822,7 @@ begin
              C:=GetNextChar;
              AddChar(C);
            end;
+           if InLink then AddChar(hscLineBreak);
            DisposeRecord(R); R:=NewR;
            if (R.Size>DestPtr) then
            begin
@@ -727,6 +841,7 @@ begin
   OK:=T<>nil;
   if OK and (T^.Text=nil) then
   begin
+    LinkPosCount:=0; FillChar(LinkPos,Sizeof(LinkPos),0);
     FillChar(TextR,SizeOf(TextR),0); FillChar(KeyWR,SizeOf(KeyWR),0);
     F^.Seek(T^.FileOfs); OK:=F^.Status=stOK;
     if OK then OK:=ReadRecord(TextR,true);
@@ -734,26 +849,50 @@ begin
     if OK then OK:=ReadRecord(KeyWR,true);
     OK:=OK and (KeyWR.SClass=rtKeyword);
 
-    if OK then OK:=ExtractTextRec(TextR);
     if OK then
     begin
+      case Version.FormatVersion of
+        TP55FormatVersion :
+           with THLPKeywordRecord55(KeyWR.Data^) do
+           begin
+             T^.LinkCount:=KeywordCount;
+             GetMem(T^.Links,T^.LinkSize);
+             if T^.LinkCount>0 then
+             for I:=0 to T^.LinkCount-1 do
+             with Keywords[I] do
+             begin
+               T^.Links^[I].Context:=KwContext;
+               T^.Links^[I].FileID:=ID;
+               Inc(LinkPosCount);
+               with LinkPos[LinkPosCount] do
+               begin
+                 A.Y:=PosY-1; B.Y:=PosY-1;
+                 A.X:=StartX-1; B.X:=EndX-1;
+               end;
+             end;
+           end;
+      else
+           with THLPKeywordRecord(KeyWR.Data^) do
+           begin
+             T^.LinkCount:=KeywordCount;
+             GetMem(T^.Links,T^.LinkSize);
+             if KeywordCount>0 then
+             for I:=0 to KeywordCount-1 do
+             begin
+               T^.Links^[I].Context:=Keywords[I].KwContext;
+               T^.Links^[I].FileID:=ID;
+             end;
+           end;
+      end;
+    end;
+
+    if OK then OK:=ExtractTextRec(TextR);
+    if OK then
       if TextR.Size>0 then
       begin
         T^.Text:=TextR.Data; T^.TextSize:=TextR.Size;
         TextR.Data:=nil; TextR.Size:=0;
       end;
-      with THLPKeywordRecord(KeyWR.Data^) do
-      begin
-        T^.LinkCount:=KeywordCount;
-        GetMem(T^.Links,T^.LinkSize);
-        if KeywordCount>0 then
-        for I:=0 to KeywordCount-1 do
-        begin
-          T^.Links^[I].Context:=Keywords[I].KwContext;
-          T^.Links^[I].FileID:=ID;
-        end;
-      end;
-    end;
 
     DisposeRecord(TextR); DisposeRecord(KeyWR);
   end;
@@ -985,7 +1124,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.19  2000-04-25 08:42:35  pierre
+  Revision 1.20  2000-05-29 10:44:59  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.19  2000/04/25 08:42:35  pierre
    * New Gabor changes : see fixes.txt
 
   Revision 1.18  2000/04/18 11:42:38  pierre

+ 109 - 3
ide/text/whlpview.pas

@@ -84,11 +84,31 @@ type
         function SearchItem(Key: pointer; Rel: TSearchRelation; var Index: integer): boolean; virtual;
       end;}
 
+      PNamedMark = ^TNamedMark;
+      TNamedMark = object(TObject)
+        constructor Init(const AName: string; AX, AY: integer);
+        function    GetName: string;
+        destructor  Done; virtual;
+      private
+        Name: PString;
+        Pos: TPoint;
+      end;
+
+      PNamedMarkCollection = ^TNamedMarkCollection;
+      TNamedMarkCollection = object(TSortedCollection)
+        function At(Index: sw_Integer): PNamedMark;
+        function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
+        function SearchMark(const Name: string): PNamedMark;
+        function GetMarkPos(const Name: string; var P: TPoint): boolean;
+        procedure Add(const Name: string; P: TPoint);
+      end;
+
       PHelpTopic = ^THelpTopic;
       THelpTopic = object(TObject)
         Topic: PTopic;
         Lines: PUnsortedStringCollection;
         Links: PLinkCollection;
+        NamedMarks: PNamedMarkCollection;
         ColorAreas: PColorAreaCollection;
       public
         constructor Init(ATopic: PTopic);
@@ -307,11 +327,73 @@ begin
   Search:=Index<>-1;
 end;}
 
+constructor TNamedMark.Init(const AName: string; AX, AY: integer);
+begin
+  inherited Init;
+  Name:=NewStr(AName);
+  Pos.X:=AX; Pos.Y:=AY;
+end;
+
+function TNamedMark.GetName: string;
+begin
+  GetName:=GetStr(Name);
+end;
+
+destructor TNamedMark.Done;
+begin
+  if Assigned(Name) then DisposeStr(Name); Name:=nil;
+  inherited Done;
+end;
+
+function TNamedMarkCollection.At(Index: sw_Integer): PNamedMark;
+begin
+  At:=inherited At(Index);
+end;
+
+function TNamedMarkCollection.Compare(Key1, Key2: Pointer): sw_Integer;
+var K1: PNamedMark absolute Key1;
+    K2: PNamedMark absolute Key2;
+    R: integer;
+    N1,N2: string;
+begin
+  N1:=UpcaseStr(K1^.GetName); N2:=UpcaseStr(K2^.GetName);
+  if N1<N2 then R:=-1 else
+  if N1>N2 then R:= 1 else
+  R:=0;
+  Compare:=R;
+end;
+
+function TNamedMarkCollection.SearchMark(const Name: string): PNamedMark;
+var M,P: PNamedMark;
+    I: sw_integer;
+begin
+  New(M, Init(Name,0,0));
+  if Search(M,I)=false then P:=nil else
+    P:=At(I);
+  Dispose(M, Done);
+  SearchMark:=P;
+end;
+
+function TNamedMarkCollection.GetMarkPos(const Name: string; var P: TPoint): boolean;
+var M: PNamedMark;
+begin
+  M:=SearchMark(Name);
+  if Assigned(M) then
+    P:=M^.Pos;
+  GetMarkPos:=Assigned(M);
+end;
+
+procedure TNamedMarkCollection.Add(const Name: string; P: TPoint);
+begin
+  Insert(New(PNamedMark, Init(Name, P.X, P.Y)));
+end;
+
 constructor THelpTopic.Init(ATopic: PTopic);
 begin
   inherited Init;
   Topic:=ATopic;
   New(Lines, Init(100,100)); New(Links, Init(50,50)); New(ColorAreas, Init(50,50));
+  New(NamedMarks, Init(10,10));
 end;
 
 procedure THelpTopic.SetParams(AMargin, AWidth: sw_integer);
@@ -324,7 +406,7 @@ begin
 end;
 
 procedure THelpTopic.ReBuild;
-var TextPos,LinkNo: sw_word;
+var TextPos,LinkNo,NamedMarkNo: sw_word;
     Line,CurWord: string;
     C: char;
     InLink,InColorArea: boolean;
@@ -404,12 +486,13 @@ begin
      end;
 end;
 begin
-  Lines^.FreeAll; Links^.FreeAll;
+  Lines^.FreeAll; Links^.FreeAll; NamedMarks^.FreeAll;
   if Topic=nil then Lines^.Insert(NewStr('No help available for this topic.')) else
   begin
     LineStart:=0; NextLineStart:=0;
     TextPos:=0; ClearLine; CurWord:=''; Line:='';
     CurPos.X:=Margin+LineStart; CurPos.Y:=0; LinkNo:=0;
+    NamedMarkNo:=0;
     InLink:=false; InColorArea:=false; ZeroLevel:=0;
     LineAlign:=laLeft;
     FirstLink:=0; LastLink:=0;
@@ -467,6 +550,12 @@ begin
              LineAlign:=laCenter;
         hscRight  :
              LineAlign:=laCenter;
+        hscNamedMark :
+             begin
+               if NamedMarkNo<Topic^.NamedMarks^.Count then
+                 NamedMarks^.Add(GetStr(Topic^.NamedMarks^.At(NamedMarkNo)),CurPos);
+               Inc(NamedMarkNo);
+             end;
         #32: if InLink then CurWord:=CurWord+C else
                 begin CheckZeroLevel; AddWord(CurWord+C); CurWord:=''; end;
       else begin CheckZeroLevel; CurWord:=CurWord+C; end;
@@ -539,6 +628,7 @@ destructor THelpTopic.Done;
 begin
   inherited Done;
   Dispose(Lines, Done); Dispose(Links, Done); Dispose(ColorAreas, Done);
+  Dispose(NamedMarks, Done);
   if (Topic<>nil) then DisposeTopic(Topic);
 end;
 
@@ -778,6 +868,8 @@ begin
 end;
 
 procedure THelpViewer.SetTopic(Topic: PTopic);
+var Bookmark: string;
+    P: TPoint;
 begin
   CurLink:=-1;
   if (HelpTopic=nil) or (Topic<>HelpTopic^.Topic) then
@@ -799,6 +891,17 @@ begin
   RenderTopic;
   BuildTopicWordList;
   Lookup('');
+  if Assigned(Topic) then
+  if Topic^.StartNamedMark>0 then
+   if Topic^.NamedMarks^.Count>=Topic^.StartNamedMark then
+    begin
+      Bookmark:=GetStr(Topic^.NamedMarks^.At(Topic^.StartNamedMark-1));
+      if HelpTopic^.NamedMarks^.GetMarkPos(Bookmark,P) then
+      begin
+        SetCurPtr(P.X,P.Y);
+        ScrollTo(0,Max(0,P.Y-1));
+      end;
+    end;
   SetSelection(CurPos,CurPos);
   DrawView;
   if Owner<>nil then Owner^.UnLock;
@@ -1154,7 +1257,10 @@ end;
 END.
 {
   $Log$
-  Revision 1.14  2000-04-25 08:42:35  pierre
+  Revision 1.15  2000-05-29 10:45:00  pierre
+   + New bunch of Gabor's changes: see fixes.txt
+
+  Revision 1.14  2000/04/25 08:42:35  pierre
    * New Gabor changes : see fixes.txt
 
   Revision 1.13  2000/04/18 11:42:39  pierre