+ object support for browser

  * html help fixes
  * more desktop saving things
  * NODEBUG directive to exclude debugger

ide/fake/compiler/browcol.pas

@@ -11,6 +11,12 @@ uses
 
 const
     SymbolTypLen : integer=6;
+type
+    { possible types for symtable entries }
+    tsymtyp = (abstractsym,varsym,typesym,procsym,unitsym,programsym,
+               constsym,enumsym,typedconstsym,errorsym,syssym,
+               labelsym,absolutesym,propertysym,funcretsym,
+               macrosym);
 
 type
     TStoreCollection = object(TStringCollection)
@@ -25,26 +31,43 @@ type
     TTypeNameCollection = object(TStoreCollection)
     end;
 
-    PSymbol = ^TSymbol;
+    PSymbolCollection       = ^TSymbolCollection;
+    PSortedSymbolCollection = ^TSortedSymbolCollection;
+    PReferenceCollection    = ^TReferenceCollection;
 
     PReference = ^TReference;
     TReference = object(TObject)
       FileName  : PString;
       Position  : TPoint;
+      constructor Init(AFileName: PString; ALine, AColumn: Sw_integer);
       function    GetFileName: string;
+      destructor  Done; virtual;
     end;
 
-    PSymbolCollection = ^TSymbolCollection;
-    PSortedSymbolCollection = ^TSortedSymbolCollection;
-    PReferenceCollection = ^TReferenceCollection;
+    PSymbolMemInfo = ^TSymbolMemInfo;
+    TSymbolMemInfo = record
+      Addr      : longint;
+      LocalAddr : longint;
+      Size      : longint;
+      PushSize  : longint;
+    end;
 
+    PSymbol = ^TSymbol;
     TSymbol = object(TObject)
       Name       : PString;
-      ParamCount : Sw_integer;
-      Params     : PPointerArray;
+      Typ        : tsymtyp;
+      Params     : PString;
       References : PReferenceCollection;
       Items      : PSymbolCollection;
-      procedure   SetParams(AParamCount: Sw_integer; AParams: PPointerArray);
+      DType      : PString;
+      VType      : PString;
+      ObjectID   : longint;
+      AncestorID : longint;
+      Ancestor   : PSymbol;
+      Flags      : longint;
+      MemInfo    : PSymbolMemInfo;
+      constructor Init(const AName: string; ATyp: tsymtyp; AParams: string; AMemInfo: PSymbolMemInfo);
+      procedure   SetMemInfo(const AMemInfo: TSymbolMemInfo);
       function    GetReferenceCount: Sw_integer;
       function    GetReference(Index: Sw_integer): PReference;
       function    GetItemCount: Sw_integer;
@@ -52,6 +75,26 @@ type
       function    GetName: string;
       function    GetText: string;
       function    GetTypeName: string;
+      destructor  Done; virtual;
+    end;
+
+    PObjectSymbolCollection = ^TObjectSymbolCollection;
+
+    PObjectSymbol = ^TObjectSymbol;
+    TObjectSymbol = object(TObject)
+      Parent     : PObjectSymbol;
+      Symbol     : PSymbol;
+      Expanded   : boolean;
+      constructor Init(AParent: PObjectSymbol; ASymbol: PSymbol);
+      constructor InitName(const AName: string);
+      function    GetName: string;
+      function    GetDescendantCount: sw_integer;
+      function    GetDescendant(Index: sw_integer): PObjectSymbol;
+      procedure   AddDescendant(P: PObjectSymbol);
+      destructor  Done; virtual;
+    private
+      Name: PString;
+      Descendants: PObjectSymbolCollection;
     end;
 
     TSymbolCollection = object(TSortedCollection)
@@ -66,6 +109,19 @@ type
       function  LookUp(const S: string; var Idx: sw_integer): string; virtual;
     end;
 
+    PIDSortedSymbolCollection = ^TIDSortedSymbolCollection;
+    TIDSortedSymbolCollection = object(TSymbolCollection)
+      function  Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
+      procedure Insert(Item: Pointer); virtual;
+      function  SearchSymbolByID(AID: longint): PSymbol;
+    end;
+
+    TObjectSymbolCollection = object(TSortedCollection)
+      function  Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
+      function  LookUp(const S: string; var Idx: sw_integer): string; virtual;
+       function At(Index: Sw_Integer): PObjectSymbol;
+    end;
+
     TReferenceCollection = object(TCollection)
        function At(Index: Sw_Integer): PReference;
     end;
@@ -74,6 +130,9 @@ const
   Modules     : PSymbolCollection = nil;
   ModuleNames : PModuleNameCollection = nil;
   TypeNames   : PTypeNameCollection = nil;
+  ObjectTree  : PObjectSymbol = nil;
+
+function SearchObjectForSymbol(O: PSymbol): PObjectSymbol;
 
 procedure InitBrowserCol;
 procedure DoneBrowserCol;
@@ -141,21 +200,71 @@ begin
 end;
 
 
+{****************************************************************************
+                           TIDSortedSymbolCollection
+****************************************************************************}
+
+function TIDSortedSymbolCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+begin
+  Compare:=0;
+end;
+
+procedure TIDSortedSymbolCollection.Insert(Item: Pointer);
+begin
+end;
+
+function TIDSortedSymbolCollection.SearchSymbolByID(AID: longint): PSymbol;
+begin
+  SearchSymbolByID:=nil;
+end;
+
+
+{****************************************************************************
+                           TObjectSymbolCollection
+****************************************************************************}
+
+function TObjectSymbolCollection.At(Index: Sw_Integer): PObjectSymbol;
+begin
+end;
+
+function TObjectSymbolCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
+begin
+  Compare:=0;
+end;
+
+function TObjectSymbolCollection.LookUp(const S: string; var Idx: sw_integer): string;
+begin
+  LookUp:='';
+end;
+
+
 {****************************************************************************
                                 TReference
 ****************************************************************************}
 
+constructor TReference.Init(AFileName: PString; ALine, AColumn: Sw_integer);
+begin
+end;
+
 function TReference.GetFileName: string;
 begin
   GetFileName:='';
 end;
 
+destructor TReference.Done;
+begin
+end;
+
 
 {****************************************************************************
                                    TSymbol
 ****************************************************************************}
 
-procedure TSymbol.SetParams(AParamCount: Sw_integer; AParams: PPointerArray);
+constructor TSymbol.Init(const AName: string; ATyp: tsymtyp; AParams: string; AMemInfo: PSymbolMemInfo);
+begin
+end;
+
+procedure TSymbol.SetMemInfo(const AMemInfo: TSymbolMemInfo);
 begin
 end;
 
@@ -194,11 +303,62 @@ begin
   GetTypeName:='';
 end;
 
+destructor TSymbol.Done;
+begin
+end;
+
+
+{*****************************************************************************
+                                 TObjectSymbol
+*****************************************************************************}
+
+constructor TObjectSymbol.Init(AParent: PObjectSymbol; ASymbol: PSymbol);
+begin
+end;
+
+constructor TObjectSymbol.InitName(const AName: string);
+begin
+end;
+
+function TObjectSymbol.GetName: string;
+begin
+end;
+
+function TObjectSymbol.GetDescendantCount: sw_integer;
+begin
+  GetDescendantCount:=0;
+end;
+
+function TObjectSymbol.GetDescendant(Index: sw_integer): PObjectSymbol;
+begin
+  GetDescendant:=nil;
+end;
+
+procedure TObjectSymbol.AddDescendant(P: PObjectSymbol);
+begin
+end;
+
+destructor TObjectSymbol.Done;
+begin
+end;
+
+
+{*****************************************************************************
+                              Main Routines
+*****************************************************************************}
+
 procedure CreateBrowserCols;
 begin
 end;
 
 
+function SearchObjectForSymbol(O: PSymbol): PObjectSymbol;
+begin
+  SearchObjectForSymbol:=nil;
+end;
+
+
+
 {*****************************************************************************
                                  Initialize
 *****************************************************************************}
@@ -247,7 +407,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  1999-01-28 19:56:12  peter
+  Revision 1.2  1999-04-07 21:55:39  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.1  1999/01/28 19:56:12  peter
     * moved to include compiler/gdb independent of each other
 
   Revision 1.3  1999/01/22 10:24:16  peter

ide/text/fp.pas

@@ -15,11 +15,7 @@
  **********************************************************************}
 program FP;
 
-{$ifndef LINUX}
-  {$ifndef FV20}
-    {$define VESA}
-  {$endif}
-{$endif}
+{$I globdir.inc}
 
 uses
 {$ifdef IDEHeapTrc}
@@ -27,10 +23,13 @@ uses
 {$endif IDEHeapTrc}
   Dos,Objects,
   BrowCol,
+  Views,App,Dialogs,ColorSel,Menus,StdDlg,Validate,
+  {$ifdef EDITORS}Editors{$else}WEditor{$endif},
+  ASCIITab,Calc,
   WViews,
-  FPIDE,
+  FPIDE,FPCalc,FPCompile,
   FPIni,FPViews,FPConst,FPVars,FPUtils,FPHelp,FPSwitch,FPUsrScr,
-  FPTools,FPDebug,FPTemplt,FPCatch,FPRedir,FPDesk
+  FPTools,{$ifndef NODEBUG}FPDebug,{$endif}FPTemplt,FPCatch,FPRedir,FPDesk
 {$ifdef TEMPHEAP}
   ,dpmiexcp
 {$endif TEMPHEAP}
@@ -76,6 +75,44 @@ begin
   end;
 end;
 
+Procedure MyStreamError(Var S: TStream); {$ifndef FPC}far;{$endif}
+var ErrS: string;
+begin
+  {$ifdef GABOR}{$ifdef TP}asm int 3;end;{$endif}{$endif}
+  case S.Status of
+    stGetError : ErrS:='Get of unregistered object type';
+    stPutError : ErrS:='Put of unregistered object type';
+  else ErrS:='';
+  end;
+  if Assigned(Application) then
+    ErrorBox('Stream error: '+#13+ErrS,nil)
+  else
+    writeln('Error: ',ErrS);
+end;
+
+procedure RegisterIDEObjects;
+begin
+  RegisterApp;
+  RegisterAsciiTab;
+  RegisterCalc;
+  RegisterColorSel;
+  RegisterDialogs;
+{$ifdef EDITORS}
+  RegisterEditors;
+{$else}
+  RegisterCodeEditors;
+{$endif}
+  RegisterFPCalc;
+  RegisterFPCompile;
+  RegisterFPTools;
+  RegisterFPViews;
+  RegisterMenus;
+  RegisterStdDlg;
+  RegisterObjects;
+  RegisterValidate;
+  RegisterViews;
+end;
+
 var CanExit : boolean;
 
 BEGIN
@@ -84,13 +121,18 @@ BEGIN
   StartupDir:=CompleteDir(FExpand('.'));
   IDEDir:=CompleteDir(DirOf(Paramstr(0)));
 
+  RegisterIDEObjects;
+  StreamError:=@MyStreamError;
+
   ProcessParams(true);
 
 {$ifdef VESA}
   InitVESAScreenModes;
 {$endif}
   InitRedir;
+{$ifndef NODEBUG}
   InitBreakpoints;
+{$endif}
   InitReservedWords;
   InitHelpFiles;
   InitSwitches;
@@ -140,12 +182,22 @@ BEGIN
   DoneHelpFiles;
   DoneReservedWords;
   DoneBrowserCol;
+{$ifndef NODEBUG}
   DoneDebugger;
   DoneBreakpoints;
+{$endif}
+
+  StreamError:=nil;
 END.
 {
   $Log$
-  Revision 1.20  1999-03-23 16:16:36  peter
+  Revision 1.21  1999-04-07 21:55:40  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.20  1999/03/23 16:16:36  peter
     * linux fixes
 
   Revision 1.19  1999/03/23 15:11:26  peter

ide/text/fpcalc.pas

@@ -68,20 +68,26 @@ type
   end;
 
 const
+  RCalcButton: TStreamRec = (
+     ObjType: 10139;
+     VmtLink: Ofs(TypeOf(TCalcButton)^);
+     Load:    @TCalcButton.Load;
+     Store:   @TCalcButton.Store
+  );
   RCalcDisplay: TStreamRec = (
-     ObjType: 10040;
+     ObjType: 10140;
      VmtLink: Ofs(TypeOf(TCalcDisplay)^);
      Load:    @TCalcDisplay.Load;
      Store:   @TCalcDisplay.Store
   );
   RCalculator: TStreamRec = (
-     ObjType: 10041;
+     ObjType: 10141;
      VmtLink: Ofs(TypeOf(TCalculator)^);
      Load:    @TCalculator.Load;
      Store:   @TCalculator.Store
   );
 
-procedure RegisterCalc;
+procedure RegisterFPCalc;
 
 implementation
 
@@ -415,8 +421,9 @@ begin
   Hide;
 end;
 
-procedure RegisterCalc;
+procedure RegisterFPCalc;
 begin
+  RegisterType(RCalcButton);
   RegisterType(RCalcDisplay);
   RegisterType(RCalculator);
 end;
@@ -424,11 +431,18 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  1999-03-01 15:41:49  peter
+  Revision 1.4  1999-04-07 21:55:41  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.3  1999/03/01 15:41:49  peter
     + Added dummy entries for functions not yet implemented
     * MenuBar didn't update itself automatically on command-set changes
     * Fixed Debugging/Profiling options dialog
-    * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
 set
+    * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
+ set
     * efBackSpaceUnindents works correctly
     + 'Messages' window implemented
     + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros

ide/text/fpcatch.pas

@@ -36,7 +36,7 @@ Var
 Implementation
 
 uses
-  commands,msgbox,
+  app,commands,msgbox,
   fpide,fpviews;
 
 
@@ -46,17 +46,22 @@ Procedure CatchSignal(Sig : Integer);cdecl;
 {$else}
 Function CatchSignal(Sig : longint):longint;
 {$endif}
+var CanQuit: boolean;
 begin
   case Sig of
    SIGSEGV : begin
-               MyApp.Done;
+               if Assigned(Application) then MyApp.Done;
                Writeln('Internal Error caught');
                Halt;
              end;
     SIGINT : begin
-               if MessageBox(#3'Do You really want to quit?',nil,mferror+mfyesbutton+mfnobutton)=cmYes then
+               if Assigned(Application) then
+                 CanQuit:=MessageBox(#3'Do You really want to quit?',nil,mferror+mfyesbutton+mfnobutton)=cmYes
+               else
+                 CanQuit:=true;
+               if CanQuit then
                 begin
-                  MyApp.Done;
+                  if Assigned(Application) then MyApp.Done;
                   Halt;
                 end;
              end;
@@ -82,7 +87,13 @@ end.
 
 {
   $Log$
-  Revision 1.1  1999-02-20 15:18:28  peter
+  Revision 1.2  1999-04-07 21:55:42  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.1  1999/02/20 15:18:28  peter
     + ctrl-c capture with confirm dialog
     + ascii table in the tools menu
     + heapviewer

ide/text/fpcompil.pas

@@ -63,6 +63,8 @@ type
       procedure   SetCompileShow(b:boolean);
       procedure   StartCompilation;
       function    EndCompilation:boolean;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
     private
       CompileShowed : boolean;
       Mode   : TCompileMode;
@@ -94,6 +96,7 @@ const
 
 procedure DoCompile(Mode: TCompileMode);
 
+procedure RegisterFPCompile;
 
 implementation
 
@@ -101,12 +104,29 @@ uses
   Dos,Video,
   App,Commands,
   CompHook,
-  WEditor,
+  WUtils,WEditor,
 {$ifdef redircompiler}
   FPRedir,
 {$endif}
   FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
 
+{$ifndef OLDCOMP}
+const
+  RCompilerMessageListBox: TStreamRec = (
+     ObjType: 1211;
+     VmtLink: Ofs(TypeOf(TCompilerMessageListBox)^);
+     Load:    @TCompilerMessageListBox.Load;
+     Store:   @TCompilerMessageListBox.Store
+  );
+  RCompilerMessageWindow: TStreamRec = (
+     ObjType: 1212;
+     VmtLink: Ofs(TypeOf(TCompilerMessageWindow)^);
+     Load:    @TCompilerMessageWindow.Load;
+     Store:   @TCompilerMessageWindow.Store
+  );
+{$else}
+{$endif}
+
 const
     LastStatusUpdate : longint = 0;
 
@@ -422,6 +442,34 @@ begin
   GetPalette:=@S;
 end;
 
+constructor TCompilerMessageWindow.Load(var S: TStream);
+begin
+  inherited Load(S);
+
+  S.Read(CompileShowed,SizeOf(CompileShowed));
+  S.Read(Mode,SizeOf(Mode));
+  GetSubViewPtr(S,MsgLB);
+  GetSubViewPtr(S,CurrST);
+  GetSubViewPtr(S,InfoST);
+  GetSubViewPtr(S,LineST);
+
+  UpdateInfo;
+end;
+
+procedure TCompilerMessageWindow.Store(var S: TStream);
+begin
+  if MsgLB^.List=nil then
+    MsgLB^.NewList(New(PCollection, Init(100,100)));
+  inherited Store(S);
+
+  S.Write(CompileShowed,SizeOf(CompileShowed));
+  S.Write(Mode,SizeOf(Mode));
+  PutSubViewPtr(S,MsgLB);
+  PutSubViewPtr(S,CurrST);
+  PutSubViewPtr(S,InfoST);
+  PutSubViewPtr(S,LineST);
+end;
+
 destructor TCompilerMessageWindow.Done;
 begin
   SetCompileShow(false);
@@ -438,6 +486,9 @@ function CompilerStatus: boolean; {$ifndef FPC}far;{$endif}
 begin
 { only display every 50 lines }
   if (status.currentline mod 50=0) then
+  { ^^^ I don't think this is a good idea, since it could eventually
+    come that we don't have a line number for seconds which is a multiple
+    of 50... What was the problem with the GetDosTicks() solution?  - BG }
    begin
      { update info messages }
      if assigned(CompilerMessageWindow) then
@@ -805,10 +856,25 @@ end;
 
 {$endif}
 
+procedure RegisterFPCompile;
+begin
+{$ifndef OLDCOMP}
+  RegisterType(RCompilerMessageListBox);
+  RegisterType(RCompilerMessageWindow);
+{$else}
+{$endif}
+end;
+
 end.
 {
   $Log$
-  Revision 1.22  1999-04-01 10:27:07  pierre
+  Revision 1.23  1999-04-07 21:55:43  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.22  1999/04/01 10:27:07  pierre
    + file(line) in start of message added
 
   Revision 1.21  1999/04/01 10:15:17  pierre

ide/text/fpconst.pas

@@ -303,6 +303,8 @@ const
      CBrowserTab =
         #6#12;
 
+     CBrowserOutline = #9#10#10#11;
+
      CGDBInputLine     = #9#9#10#11#12;
 
      CIDEAppColor = CAppColor +
@@ -323,7 +325,13 @@ implementation
 END.
 {
   $Log$
-  Revision 1.16  1999-03-23 15:11:27  peter
+  Revision 1.17  1999-04-07 21:55:44  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.16  1999/03/23 15:11:27  peter
     * desktop saving things
     * vesa mode
     * preferences dialog

ide/text/fpdesk.pas

@@ -17,6 +17,14 @@ unit FPDesk;
 
 interface
 
+const
+     ResHistory         = 'HISTORY';
+     ResClipboard       = 'CLIPBOARD';
+     ResWatches         = 'WATCHES';
+     ResBreakpoints     = 'BREAKPOINTS';
+     ResDesktop         = 'DESKTOP';
+     ResSymbols         = 'SYMBOLS';
+
 procedure InitDesktopFile;
 function  LoadDesktop: boolean;
 function  SaveDesktop: boolean;
@@ -25,6 +33,7 @@ procedure DoneDesktopFile;
 implementation
 
 uses Dos,
+     Objects,App,
      WResource,
      FPConst,FPVars,FPUtils;
 
@@ -61,7 +70,16 @@ begin
 end;
 
 function WriteOpenWindows(F: PResourceFile): boolean;
+var S: PMemoryStream;
 begin
+  {$ifndef DEV}Exit;{$endif}
+
+  New(S, Init(1024*1024,4096));
+  Desktop^.Store(S^);
+  S^.Seek(0);
+  F^.CreateResource(resDesktop,rcBinary,0);
+  F^.AddResourceEntryFromStream(resDesktop,langDefault,0,S^,S^.GetSize);
+  Dispose(S, Done);
   WriteOpenWindows:=true;
 end;
 
@@ -77,9 +95,9 @@ end;
 
 function SaveDesktop: boolean;
 var OK: boolean;
-    F: PSimpleResourceFile;
+    F: PResourceFile;
 begin
-  New(F, Create(DesktopPath));
+  New(F, CreateFile(DesktopPath));
   OK:=true;
   if OK and ((DesktopFileFlags and dfHistoryLists)<>0) then
     OK:=WriteHistory(F);
@@ -100,7 +118,13 @@ end;
 END.
 {
   $Log$
-  Revision 1.2  1999-03-23 16:16:39  peter
+  Revision 1.3  1999-04-07 21:55:45  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.2  1999/03/23 16:16:39  peter
     * linux fixes
 
   Revision 1.1  1999/03/23 15:11:28  peter

ide/text/fphelp.pas

@@ -61,7 +61,7 @@ uses Objects,Views,App,MsgBox,
      FPConst,FPVars,FPUtils;
 
 const
-    MaxStatusLevel = {$ifdef FPC}10{$else}2{$endif};
+    MaxStatusLevel = {$ifdef FPC}10{$else}1{$endif};
 
 var StatusStack : array[0..MaxStatusLevel] of string[MaxViewWidth];
 
@@ -379,7 +379,13 @@ end;
 END.
 {
   $Log$
-  Revision 1.13  1999-03-23 15:11:28  peter
+  Revision 1.14  1999-04-07 21:55:46  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.13  1999/03/23 15:11:28  peter
     * desktop saving things
     * vesa mode
     * preferences dialog

ide/text/fpide.pas

@@ -19,7 +19,7 @@ interface
 uses
   Objects,Drivers,Views,App,Gadgets,MsgBox,
   {$ifdef EDITORS}Editors,{$else}WEditor,{$endif}
-  Comphook,
+  Comphook,Browcol,
   FPViews,FPSymbol;
 
 type
@@ -126,10 +126,10 @@ uses
   Video,Mouse,Keyboard,
   Dos,Memory,Menus,Dialogs,StdDlg,ColorSel,Commands,HelpCtx,
   AsciiTab,
-  Systems,BrowCol,
+  Systems,
   WUtils,WHelp,WHlpView,WINI,WViews,
   FPConst,FPVars,FPUtils,FPSwitch,FPIni,FPIntf,FPCompile,FPHelp,
-  FPTemplt,FPCalc,FPUsrScr,FPTools,FPDebug,FPRedir;
+  FPTemplt,FPCalc,FPUsrScr,FPTools,{$ifndef NODEBUG}FPDebug,{$endif}FPRedir;
 
 
 function IDEUseSyntaxHighlight(Editor: PFileEditor): boolean; {$ifndef FPC}far;{$endif}
@@ -463,8 +463,10 @@ begin
                with PSourceWindow(Event.InfoPtr)^ do
                  if Editor^.FileName<>'' then
                    AddRecentFile(Editor^.FileName,Editor^.CurPos.X,Editor^.CurPos.Y);
+               {$ifndef NODEBUG}
                if assigned(Debugger) and (PView(Event.InfoPtr)=Debugger^.LastSource) then
                  Debugger^.LastSource:=nil;
+               {$endif}
              end;
 
          end;
@@ -552,7 +554,9 @@ begin
   SetCmdState([cmSaveAll],IsThereAnyEditor);
   SetCmdState([cmCloseAll,cmTile,cmCascade,cmWindowList],IsThereAnyWindow);
   SetCmdState([cmFindProcedure,cmObjects,cmModules,cmGlobals{,cmInformation}],IsSymbolInfoAvailable);
+{$ifndef NODEBUG}
   SetCmdState([cmResetDebugger],assigned(debugger) and debugger^.debugger_started);
+{$endif}
   SetCmdState([cmToolsMsgNext,cmToolsMsgPrev],MessagesWindow<>nil);
   UpdateTools;
   UpdateRecentFileList;
@@ -734,7 +738,13 @@ end;
 END.
 {
   $Log$
-  Revision 1.25  1999-03-23 15:11:29  peter
+  Revision 1.26  1999-04-07 21:55:47  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.25  1999/03/23 15:11:29  peter
     * desktop saving things
     * vesa mode
     * preferences dialog

ide/text/fpini.pas

@@ -36,7 +36,7 @@ implementation
 uses
   Dos,Objects,Drivers,App,
   WINI,{$ifndef EDITORS}WEditor{$else}Editors{$endif},
-  FPDebug,FPConst,FPVars,FPViews,
+  {$ifndef NODEBUG}FPDebug,{$endif}FPConst,FPVars,FPViews,
   FPIntf,FPTools,FPSwitch;
 
 const
@@ -143,6 +143,7 @@ begin
   StrToPalette:=C;
 end;
 
+{$ifndef NODEBUG}
 procedure WriteOneBreakPointEntry(I : longint;INIFile : PINIFile);
 var PB : PBreakpoint;
     S : String;
@@ -210,6 +211,7 @@ begin
        BreakpointCollection^.Insert(PB);
      end;
 end;
+{$endif NODEBUG}
 
 function ReadINIFile: boolean;
 var INIFile: PINIFile;
@@ -282,9 +284,11 @@ begin
   { Search }
   FindFlags:=INIFile^.GetIntEntry(secSearch,ieFindFlags,FindFlags);
   { Breakpoints }
+{$ifndef NODEBUG}
   BreakpointCount:=INIFile^.GetIntEntry(secBreakpoint,ieBreakpointCount,0);
   for i:=1 to BreakpointCount do
     ReadOneBreakPointEntry(i-1,INIFile);
+{$endif}
   { Tools }
   for I:=1 to MaxToolCount do
     begin
@@ -436,10 +440,12 @@ begin
   { Search }
   INIFile^.SetIntEntry(secSearch,ieFindFlags,FindFlags);
   { Breakpoints }
+{$ifndef NODEBUG}
   BreakPointCount:=BreakpointCollection^.Count;
   INIFile^.SetIntEntry(secBreakpoint,ieBreakpointCount,BreakpointCount);
   for i:=1 to BreakpointCount do
     WriteOneBreakPointEntry(I-1,INIFile);
+{$endif}
   { Tools }
   INIFile^.DeleteSection(secTools);
   for I:=1 to GetToolCount do
@@ -482,7 +488,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.18  1999-03-23 15:11:31  peter
+  Revision 1.19  1999-04-07 21:55:48  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.18  1999/03/23 15:11:31  peter
     * desktop saving things
     * vesa mode
     * preferences dialog

ide/text/fpmcomp.inc

@@ -74,6 +74,11 @@ end;
 
 procedure TIDEApp.DoInformation;
 begin
+  if ProgramInfoWindow=nil then
+    begin
+      New(ProgramInfoWindow, Init);
+      Desktop^.Insert(ProgramInfoWindow);
+    end;
   with ProgramInfoWindow^ do
    begin
      if not GetState(sfVisible) then
@@ -92,7 +97,13 @@ end;
 
 {
   $Log$
-  Revision 1.4  1999-03-19 16:04:30  peter
+  Revision 1.5  1999-04-07 21:55:49  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.4  1999/03/19 16:04:30  peter
     * new compiler dialog
 
   Revision 1.3  1999/03/12 01:13:59  peter

ide/text/fpmrun.inc

@@ -17,6 +17,7 @@
 
 procedure TIDEApp.DoStepOver;
 begin
+{$ifndef NODEBUG}
   if not assigned(Debugger) then
    begin
      InitDebugger;
@@ -35,11 +36,15 @@ begin
       Debugger^.TraceNext;
     end;
   Debugger^.AnnotateError;
+{$else NODEBUG}
+  NoDebugger;
+{$endif NODEBUG}
 end;
 
 
 procedure TIDEApp.DoTraceInto;
 begin
+{$ifndef NODEBUG}
   if not assigned(Debugger) then
    begin
      InitDebugger;
@@ -60,6 +65,9 @@ begin
       Debugger^.TraceNext;
     end;
   Debugger^.AnnotateError;
+{$else NODEBUG}
+  NoDebugger;
+{$endif NODEBUG}
 end;
 
 
@@ -81,13 +89,18 @@ begin
       Exit;
     end;
 
+{$ifndef NODEBUG}
   if not assigned(Debugger) then
+{$endif}
     begin
       DoExecute(ExeFile,GetRunParameters,'','',exNormal);
       LastExitCode:=DosExitCode;
     end
+{$ifndef NODEBUG}
   else
-    Debugger^.Continue;
+    Debugger^.Continue
+{$endif}
+  ;
 end;
 
 
@@ -119,9 +132,13 @@ end;
 
 procedure TIDEApp.DoResetDebugger;
 begin
+{$ifndef NODEBUG}
   if assigned(Debugger) then
      DoneDebugger;
   UpdateScreen(true);
+{$else NODEBUG}
+  NoDebugger;
+{$endif NODEBUG}
 end;
 
 procedure TIDEApp.DoContToCursor;
@@ -130,6 +147,7 @@ var
   FileName : string;
   LineNr : longint;
 begin
+{$ifndef NODEBUG}
   if (DeskTop^.First=nil) or
      (TypeOf(DeskTop^.First^)<>TypeOf(TSourceWindow)) then
     Begin
@@ -147,13 +165,20 @@ begin
       Debugger^.Command('tbreak '+NameAndExtOf(FileName)+':'+IntToStr(LineNr));
       Debugger^.Continue;
     end;
+{$else NODEBUG}
+  NoDebugger;
+{$endif NODEBUG}
 end;
 
 procedure TIDEApp.DoOpenGDBWindow;
 begin
+{$ifndef NODEBUG}
   InitGDBWindow;
   If assigned(GDBWindow) then
     GDBWindow^.MakeFirst;
+{$else NODEBUG}
+  NoDebugger;
+{$endif NODEBUG}
 end;
 
 procedure TIDEApp.DoToggleBreak;
@@ -163,6 +188,7 @@ var
   b : boolean;
   LineNr : longint;
 begin
+{$ifndef NODEBUG}
   if (DeskTop^.First=nil) or
      (TypeOf(DeskTop^.First^)<>TypeOf(TSourceWindow)) then
     Begin
@@ -178,15 +204,25 @@ begin
       b:=BreakpointCollection^.ToggleFileLine(FileName,LineNr);
       W^.Editor^.SetLineBreakState(LineNr,b);
     end;
+{$else NODEBUG}
+  NoDebugger;
+{$endif NODEBUG}
 end;
 
 {
   $Log$
-  Revision 1.14  1999-03-01 15:41:58  peter
+  Revision 1.15  1999-04-07 21:55:50  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.14  1999/03/01 15:41:58  peter
     + Added dummy entries for functions not yet implemented
     * MenuBar didn't update itself automatically on command-set changes
     * Fixed Debugging/Profiling options dialog
-    * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
 set
+    * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
+ set
     * efBackSpaceUnindents works correctly
     + 'Messages' window implemented
     + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros

ide/text/fpmsrch.inc

@@ -21,7 +21,10 @@ end;
 
 procedure TIDEApp.Objects;
 begin
-  NotImplemented;
+  if ObjectTree=nil then
+     begin ErrorBox('No debug info available.',nil); Exit; end;
+
+  OpenSymbolBrowser(0,0,'Objects','Global scope',nil,nil,nil,ObjectTree,nil);
 end;
 
 procedure TIDEApp.Globals;
@@ -62,7 +65,7 @@ begin
     WarningBox('Too many symbols. Can''t display all of them.',nil);
   Desktop^.GetExtent(R); R.A.X:=R.B.X-35;
   Desktop^.Insert(New(PBrowserWindow, Init(R,
-    'Browse: Globals',SearchFreeWindowNo,nil,'Global scope',S,nil)));
+    'Browse: Globals',SearchFreeWindowNo,nil,'Global scope',S,nil,nil,nil)));
 end;
 
 procedure TIDEApp.Modules;
@@ -77,16 +80,23 @@ begin
      begin ErrorBox('No debug info available.',nil); Exit; end;
   New(S, Init(500,500));
   BrowCol.Modules^.ForEach(@InsertInS);
-  OpenSymbolBrowser(0,0,'Units','Global scope',nil,S,nil);
+  OpenSymbolBrowser(0,0,'Units','Global scope',nil,S,nil,nil,nil);
 end;
 
 {
   $Log$
-  Revision 1.5  1999-03-01 15:41:59  peter
+  Revision 1.6  1999-04-07 21:55:51  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.5  1999/03/01 15:41:59  peter
     + Added dummy entries for functions not yet implemented
     * MenuBar didn't update itself automatically on command-set changes
     * Fixed Debugging/Profiling options dialog
-    * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
 set
+    * TCodeEditor converts spaces to tabs at save only if efUseTabChars is
+ set
     * efBackSpaceUnindents works correctly
     + 'Messages' window implemented
     + Added '$CAP MSG()' and '$CAP EDIT' to available tool-macros

ide/text/fpredir.pas

@@ -101,7 +101,7 @@ Var
 {$endif TP}
 
 var
-  FIN,FOUT,FERR     : File;
+  FIN,FOUT,FERR     : ^File;
   RedirChangedOut,
   RedirChangedIn    : Boolean;
   RedirChangedError : Boolean;
@@ -156,6 +156,15 @@ end;
 
 {$endif def go32v2}
 
+{$ifdef TP}
+Function FdClose (Handle : Longint) : boolean;
+begin
+  { if executed as under GO32 this hangs the DOS-prompt }
+  FdClose:=true;
+end;
+
+{$endif}
+
 {$I-}
 function FileExist(const FileName : PathStr) : Boolean;
 var
@@ -174,12 +183,12 @@ function ChangeRedirOut(Const Redir : String; AppendToFile : Boolean) : Boolean;
   begin
     ChangeRedirOut:=False;
     If Redir = '' then Exit;
-    Assign (FOUT, Redir);
+    Assign (FOUT^, Redir);
     If AppendToFile and FileExist(Redir) then
       Begin
-      Reset(FOUT,1);
-      Seek(FOUT,FileSize(FOUT));
-      End else Rewrite (FOUT);
+      Reset(FOUT^,1);
+      Seek(FOUT^,FileSize(FOUT^));
+      End else Rewrite (FOUT^);
 
     RedirErrorOut:=IOResult;
     IOStatus:=RedirErrorOut;
@@ -187,11 +196,11 @@ function ChangeRedirOut(Const Redir : String; AppendToFile : Boolean) : Boolean;
 {$ifndef FPC}
     Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
     OldHandleOut:=Handles^[StdOutputHandle];
-    Handles^[StdOutputHandle]:=Handles^[FileRec (FOUT).Handle];
+    Handles^[StdOutputHandle]:=Handles^[FileRec (FOUT^).Handle];
     ChangeRedirOut:=True;
 {$else}
     if dup(StdOutputHandle,TempHOut) and
-       dup2(FileRec(FOUT).Handle,StdOutputHandle) then
+       dup2(FileRec(FOUT^).Handle,StdOutputHandle) then
       ChangeRedirOut:=True;
 {$endif def FPC}
      RedirChangedOut:=True;
@@ -201,8 +210,8 @@ function ChangeRedirIn(Const Redir : String) : Boolean;
   begin
     ChangeRedirIn:=False;
     If Redir = '' then Exit;
-    Assign (FIN, Redir);
-    Reset(FIN,1);
+    Assign (FIN^, Redir);
+    Reset(FIN^,1);
 
     RedirErrorIn:=IOResult;
     IOStatus:=RedirErrorIn;
@@ -210,11 +219,11 @@ function ChangeRedirIn(Const Redir : String) : Boolean;
 {$ifndef FPC}
     Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
     OldHandleIn:=Handles^[StdInputHandle];
-    Handles^[StdInputHandle]:=Handles^[FileRec (FIN).Handle];
+    Handles^[StdInputHandle]:=Handles^[FileRec (FIN^).Handle];
     ChangeRedirIn:=True;
 {$else}
     if dup(StdInputHandle,TempHIn) and
-       dup2(FileRec(FIN).Handle,StdInputHandle) then
+       dup2(FileRec(FIN^).Handle,StdInputHandle) then
       ChangeRedirIn:=True;
 {$endif def FPC}
      RedirChangedIn:=True;
@@ -224,12 +233,12 @@ function ChangeRedirError(Const Redir : String; AppendToFile : Boolean) : Boolea
   begin
     ChangeRedirError:=False;
     If Redir = '' then Exit;
-    Assign (FERR, Redir);
+    Assign (FERR^, Redir);
     If AppendToFile and FileExist(Redir) then
       Begin
-      Reset(FERR,1);
-      Seek(FERR,FileSize(FERR));
-      End else Rewrite (FERR);
+      Reset(FERR^,1);
+      Seek(FERR^,FileSize(FERR^));
+      End else Rewrite (FERR^);
 
     RedirErrorError:=IOResult;
     IOStatus:=RedirErrorError;
@@ -237,11 +246,11 @@ function ChangeRedirError(Const Redir : String; AppendToFile : Boolean) : Boolea
 {$ifndef FPC}
     Handles:=Ptr (prefseg, PWord (Ptr (prefseg, $34))^);
     OldHandleError:=Handles^[StdErrorHandle];
-    Handles^[StdErrorHandle]:=Handles^[FileRec (FERR).Handle];
+    Handles^[StdErrorHandle]:=Handles^[FileRec (FERR^).Handle];
     ChangeRedirError:=True;
 {$else}
     if dup(StdErrorHandle,TempHError) and
-       dup2(FileRec(FERR).Handle,StdErrorHandle) then
+       dup2(FileRec(FERR^).Handle,StdErrorHandle) then
       ChangeRedirError:=True;
 {$endif}
      RedirChangedError:=True;
@@ -292,7 +301,7 @@ end;
 {$else}
     dup2(TempHOut,StdOutputHandle);
 {$endif}
-    Close (FOUT);
+    Close (FOUT^);
     fdClose(TempHOut);
     RedirChangedOut:=false;
   end;
@@ -309,7 +318,7 @@ end;
 {$else}
     dup2(TempHIn,StdInputHandle);
 {$endif}
-    Close (FIn);
+    Close (FIn^);
     fdClose(TempHIn);
     RedirChangedIn:=false;
   end;
@@ -326,7 +335,7 @@ end;
 {$else}
     dup2(TempHError,StdErrorHandle);
 {$endif}
-    Close (FERR);
+    Close (FERR^);
     fdClose(TempHError);
     RedirChangedError:=false;
   end;
@@ -424,10 +433,18 @@ end;
                                   Initialize
 *****************************************************************************}
 
+Begin
+  New(FIn); New(FOut); New(FErr);
 End.
 {
   $Log$
-  Revision 1.14  1999-03-20 00:04:49  pierre
+  Revision 1.15  1999-04-07 21:55:52  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.14  1999/03/20 00:04:49  pierre
    * handle loss fixed
 
   Revision 1.13  1999/03/09 01:34:35  peter

ide/text/fpsymbol.pas

@@ -17,7 +17,7 @@ unit FPSymbol;
 
 interface
 
-uses Objects,Drivers,Views,Dialogs,
+uses Objects,Drivers,Views,Dialogs,Outline,
      BrowCol,
      FPViews;
 
@@ -26,7 +26,8 @@ const
       btScope       = 0;
       btReferences  = 1;
       btInheritance = 2;
-      btBreakWatch  = 3;
+      btMemInfo     = 3;
+      btBreakWatch  = 4;
 
 type
     PSymbolView = ^TSymbolView;
@@ -67,6 +68,31 @@ type
       References: PReferenceCollection;
     end;
 
+    PSymbolMemInfoView = ^TSymbolMemInfoView;
+    TSymbolMemInfoView = object(TStaticText)
+      constructor  Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
+      procedure    GetText(var S: String); virtual;
+      function     GetPalette: PPalette; virtual;
+    private
+      MemInfo: PSymbolMemInfo;
+    end;
+
+    PSymbolInheritanceView = ^TSymbolInheritanceView;
+    TSymbolInheritanceView = object(TOutlineViewer)
+      constructor  Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
+      function     GetRoot: Pointer; virtual;
+      function     HasChildren(Node: Pointer): Boolean; virtual;
+      function     GetChild(Node: Pointer; I: Integer): Pointer; virtual;
+      function     GetNumChildren(Node: Pointer): Integer; virtual;
+      function     GetText(Node: Pointer): String; virtual;
+      procedure    Adjust(Node: Pointer; Expand: Boolean); virtual;
+      function     IsExpanded(Node: Pointer): Boolean; virtual;
+      procedure    Selected(I: Integer); virtual;
+      function     GetPalette: PPalette; virtual;
+    private
+      Root: PObjectSymbol;
+    end;
+
     PBrowserTabItem = ^TBrowserTabItem;
     TBrowserTabItem = record
       Sign  : char;
@@ -94,7 +120,8 @@ type
     PBrowserWindow = ^TBrowserWindow;
     TBrowserWindow = object(TFPWindow)
       constructor Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
-                    const AName: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection);
+                    const AName: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
+                    AInheritance: PObjectSymbol; AMemInfo: PSymbolMemInfo);
       procedure   HandleEvent(var Event: TEvent); virtual;
       procedure   SetState(AState: Word; Enable: Boolean); virtual;
       procedure   Close; virtual;
@@ -105,10 +132,13 @@ type
       Sym           : PSymbol;
       ScopeView     : PSymbolScopeView;
       ReferenceView : PSymbolReferenceView;
+      InheritanceView: PSymbolInheritanceView;
+      MemInfoView   : PSymbolMemInfoView;
     end;
 
 procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
-            Symbols: PSymbolCollection; References: PReferenceCollection);
+            Symbols: PSymbolCollection; References: PReferenceCollection;
+            Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
 
 function IsSymbolInfoAvailable: boolean;
 
@@ -118,7 +148,7 @@ implementation
 
 uses Commands,App,
      WEditor,WViews,
-     FPConst,FPUtils,FPVars,FPDebug;
+     FPConst,FPUtils,FPVars,{$ifndef FPDEBUG}FPDebug{$endif};
 
 function NewBrowserTabItem(ASign: char; ALink: PView; ANext: PBrowserTabItem): PBrowserTabItem;
 var P: PBrowserTabItem;
@@ -166,7 +196,7 @@ begin
        If assigned(PS) then
          OpenSymbolBrowser(0,20,
                 PS^.Items^.At(Index)^.GetName,'',PS^.Items^.At(Index),
-                PS^.Items^.At(Index)^.Items,PS^.Items^.At(Index)^.References)
+                PS^.Items^.At(Index)^.Items,PS^.Items^.At(Index)^.References,nil,PS^.MemInfo)
        else
          begin
            P:=@Name;
@@ -526,6 +556,118 @@ begin
 end;
 
 
+constructor TSymbolMemInfoView.Init(var Bounds: TRect; AMemInfo: PSymbolMemInfo);
+begin
+  inherited Init(Bounds,'');
+  Options:=Options or (ofSelectable+ofTopSelect);
+  MemInfo:=AMemInfo;
+end;
+
+procedure TSymbolMemInfoView.GetText(var S: String);
+function SizeStr(Size: longint): string;
+var S: string[40];
+begin
+  S:=IntToStrL(Size,7);
+  S:=S+' byte';
+  if Size>0 then S:=S+'s';
+  SizeStr:=S;
+end;
+function AddrStr(Addr: longint): string;
+type TLongint = record LoW,HiW: word; end;
+begin
+  with TLongint(Addr) do
+  AddrStr:='$'+IntToHexL(HiW,4)+IntToHexL(HiW,4);
+end;
+begin
+  S:=
+   #13+
+{  ' Memory location: '+AddrStr(MemInfo^.Addr)+#13+
+  '   Local address: '+AddrStr(MemInfo^.LocalAddr)+#13+}
+
+  { ??? internal linker ??? }
+
+  '  Size in memory: '+SizeStr(MemInfo^.Size)+#13+
+  '   Size on stack: '+SizeStr(MemInfo^.PushSize)+#13+
+  ''
+  ;
+end;
+
+function TSymbolMemInfoView.GetPalette: PPalette;
+begin
+  GetPalette:=inherited GetPalette;
+end;
+
+{****************************************************************************
+                          TSymbolInheritanceView
+****************************************************************************}
+
+constructor TSymbolInheritanceView.Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar; ARoot: PObjectSymbol);
+begin
+  inherited Init(Bounds,AHScrollBar,AVScrollBar);
+  Options:=Options or (ofSelectable+ofTopSelect);
+  Root:=ARoot;
+  ExpandAll(GetRoot); Update;
+end;
+
+function TSymbolInheritanceView.GetRoot: Pointer;
+begin
+  GetRoot:=Root;
+end;
+
+function TSymbolInheritanceView.HasChildren(Node: Pointer): Boolean;
+begin
+  HasChildren:=GetNumChildren(Node)>0;
+end;
+
+function TSymbolInheritanceView.GetChild(Node: Pointer; I: Integer): Pointer;
+begin
+  GetChild:=PObjectSymbol(Node)^.GetDescendant(I);
+end;
+
+function TSymbolInheritanceView.GetNumChildren(Node: Pointer): Integer;
+begin
+  GetNumChildren:=PObjectSymbol(Node)^.GetDescendantCount;
+end;
+
+function TSymbolInheritanceView.GetText(Node: Pointer): String;
+begin
+  GetText:=PObjectSymbol(Node)^.GetName;
+end;
+
+procedure TSymbolInheritanceView.Adjust(Node: Pointer; Expand: Boolean);
+begin
+  PObjectSymbol(Node)^.Expanded:=Expand;
+end;
+
+function TSymbolInheritanceView.IsExpanded(Node: Pointer): Boolean;
+begin
+  IsExpanded:=PObjectSymbol(Node)^.Expanded;
+end;
+
+function TSymbolInheritanceView.GetPalette: PPalette;
+const P: string[length(CBrowserOutline)] = CBrowserOutline;
+begin
+  GetPalette:=@P;
+end;
+
+procedure TSymbolInheritanceView.Selected(I: Integer);
+var P: pointer;
+    S: PSymbol;
+    Anc: PObjectSymbol;
+begin
+  P:=GetNode(I);
+  if P=nil then Exit;
+
+  S:=PObjectSymbol(P)^.Symbol;
+  if S^.Ancestor=nil then Anc:=nil else
+    Anc:=SearchObjectForSymbol(S^.Ancestor);
+  OpenSymbolBrowser(Origin.X-1,FOC-Delta.Y+1,
+    S^.GetName,
+    S^.GetText,S,
+    S^.Items,S^.References,Anc,S^.MemInfo);
+end;
+
+
 {****************************************************************************
                                TBrowserTab
 ****************************************************************************}
@@ -642,7 +784,7 @@ begin
       begin
         DontClear:=false; Idx:=-1;
         for I:=0 to GetItemCount-1 do
-          if Upcase(GetCtrlChar(Event.KeyCode))=Upcase(GetItem(I)^.Sign) then
+          if GetCtrlCode(GetItem(I)^.Sign)=Event.KeyCode then
             begin
               Idx:=I;
               Break;
@@ -670,7 +812,8 @@ begin
 end;
 
 constructor TBrowserWindow.Init(var Bounds: TRect; ATitle: TTitleStr; ANumber: Sw_Integer;ASym : PSymbol;
-             const AName: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection);
+             const AName: string; ASymbols: PSymbolCollection; AReferences: PReferenceCollection;
+             AInheritance: PObjectSymbol; AMemInfo: PSymbolMemINfo);
 var R: TRect;
     ST: PStaticText;
     HSB,VSB: PScrollBar;
@@ -716,13 +859,27 @@ begin
       ReferenceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
       Insert(ReferenceView);
     end;
+  if assigned(AInheritance) then
+    begin
+      New(InheritanceView, Init(R, nil,nil, AInheritance));
+      InheritanceView^.GrowMode:=gfGrowHiX+gfGrowHiY;
+      Insert(InheritanceView);
+    end;
+  if assigned(AMemInfo) then
+    begin
+      New(MemInfoView, Init(R, AMemInfo));
+      MemInfoView^.GrowMode:=gfGrowHiX+gfGrowHiY;
+      Insert(MemInfoView);
+    end;
 
   GetExtent(R); R.Grow(-1,-1); R.Move(0,1); R.B.Y:=R.A.Y+1;
   New(PageTab, Init(R,
     NewBrowserTabItem('S',ScopeView,
     NewBrowserTabItem('R',ReferenceView,
+    NewBrowserTabItem('I',InheritanceView,
+    NewBrowserTabItem('M',MemInfoView,
     nil))
-    ));
+    ))));
   PageTab^.GrowMode:=gfGrowHiX;
   Insert(PageTab);
 
@@ -730,12 +887,16 @@ begin
    SelectTab(btScope)
   else
    if assigned(ReferenceView) then
-    SelectTab(btReferences);
+    SelectTab(btReferences)
+  else
+   if assigned(InheritanceView) then
+    SelectTab(btInheritance);
 end;
 
 procedure TBrowserWindow.HandleEvent(var Event: TEvent);
 var DontClear: boolean;
     S: PSymbol;
+    Anc: PObjectSymbol;
     P: TPoint;
 begin
   case Event.What of
@@ -751,10 +912,12 @@ begin
               Desktop^.MakeLocal(P,P); Inc(P.Y,ScopeView^.Focused-ScopeView^.TopItem);
               Inc(P.Y);
               if (S^.GetReferenceCount>0) or (S^.GetItemCount>0) then
+              if S^.Ancestor=nil then Anc:=nil else
+                Anc:=SearchObjectForSymbol(S^.Ancestor);
               OpenSymbolBrowser(Origin.X-1,P.Y,
                 S^.GetName,
                 ScopeView^.GetText(ScopeView^.Focused,255),S,
-                S^.Items,S^.References);
+                S^.Items,S^.References,Anc,S^.MemInfo);
             end;
       end;
 {    evCommand :
@@ -883,6 +1046,10 @@ begin
     Tabs:=Tabs or (1 shl btScope);
   if assigned(ReferenceView) then
     Tabs:=Tabs or (1 shl btReferences);
+  if assigned(InheritanceView) then
+    Tabs:=Tabs or (1 shl btInheritance);
+  if assigned(MemInfoView) then
+    Tabs:=Tabs or (1 shl btMemInfo);
   if Assigned(Sym) then
     if (Pos('proc',Sym^.GetText)>0) or (Pos('var',Sym^.GetText)>0) then
       Tabs:=Tabs or (1 shl btBreakWatch);
@@ -896,7 +1063,8 @@ begin
 end;
 
 procedure OpenSymbolBrowser(X,Y: Sw_integer;const Name,Line: string;S : PSymbol;
-            Symbols: PSymbolCollection; References: PReferenceCollection);
+            Symbols: PSymbolCollection; References: PReferenceCollection;
+            Inheritance: PObjectSymbol; MemInfo: PSymbolMemInfo);
 var R: TRect;
 begin
   if X=0 then X:=Desktop^.Size.X-35;
@@ -904,14 +1072,19 @@ begin
   R.B.X:=R.A.X+35; R.B.Y:=R.A.Y+15;
   while (R.B.Y>Desktop^.Size.Y) do R.Move(0,-1);
   Desktop^.Insert(New(PBrowserWindow, Init(R,
-    'Browse: '+Name,SearchFreeWindowNo,S,Line,Symbols,References)));
+    'Browse: '+Name,SearchFreeWindowNo,S,Line,Symbols,References,Inheritance,MemInfo)));
 end;
 
-
 END.
 {
   $Log$
-  Revision 1.13  1999-03-16 00:44:44  peter
+  Revision 1.14  1999-04-07 21:55:53  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.13  1999/03/16 00:44:44  peter
     * forgotten in last commit :(
 
   Revision 1.12  1999/03/01 15:42:02  peter

ide/text/fptools.pas

@@ -92,11 +92,13 @@ type
 
     PToolMessageListBox = ^TToolMessageListBox;
     TToolMessageListBox = object(TMessageListBox)
-      procedure  NewList(AList: PCollection); virtual;
-      procedure  Clear; virtual;
-      procedure  Update; virtual;
-      function   GetPalette: PPalette; virtual;
-      destructor Done; virtual;
+      procedure   NewList(AList: PCollection); virtual;
+      procedure   Clear; virtual;
+      procedure   Update; virtual;
+      function    GetPalette: PPalette; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
+      destructor  Done; virtual;
     end;
 
     PMessagesWindow = ^TMessagesWindow;
@@ -105,6 +107,8 @@ type
       procedure   Update; virtual;
       procedure   HandleEvent(var Event: TEvent); virtual;
       function    GetPalette: PPalette; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
       destructor  Done; virtual;
     private
       MsgLB : PToolMessageListBox;
@@ -136,6 +140,8 @@ const
      MessagesWindow : PMessagesWindow  = nil;
      LastToolMessageFocused : PToolMessage = nil;
 
+procedure RegisterFPTools;
+
 implementation
 
 uses Dos,
@@ -143,6 +149,20 @@ uses Dos,
      WINI,WEditor,
      FPConst,FPVars,FPUtils;
 
+const
+  RToolMessageListBox: TStreamRec = (
+     ObjType: 1600;
+     VmtLink: Ofs(TypeOf(TToolMessageListBox)^);
+     Load:    @TToolMessageListBox.Load;
+     Store:   @TToolMessageListBox.Store
+  );
+  RMessagesWindow: TStreamRec = (
+     ObjType: 1601;
+     VmtLink: Ofs(TypeOf(TMessagesWindow)^);
+     Load:    @TMessagesWindow.Load;
+     Store:   @TMessagesWindow.Store
+  );
+
 type
     THotKeyDef = record
       Name     : string[12];
@@ -1363,6 +1383,23 @@ begin
   GetPalette:=@P;
 end;
 
+constructor TToolMessageListBox.Load(var S: TStream);
+begin
+  inherited Load(S);
+end;
+
+procedure TToolMessageListBox.Store(var S: TStream);
+var OL: PCollection;
+begin
+  OL:=List;
+  New(List, Init(1,1));
+
+  inherited Store(S);
+
+  Dispose(List, Done);
+  List:=OL;
+end;
+
 destructor TToolMessageListBox.Done;
 begin
   HScrollBar:=nil; VScrollBar:=nil;
@@ -1417,16 +1454,45 @@ begin
   GetPalette:=@S;
 end;
 
+constructor TMessagesWindow.Load(var S: TStream);
+begin
+  inherited Load(S);
+
+  GetSubViewPtr(S,MsgLB);
+
+  Update;
+  MessagesWindow:=@Self;
+end;
+
+procedure TMessagesWindow.Store(var S: TStream);
+begin
+  inherited Store(S);
+
+  PutSubViewPtr(S,MsgLB);
+end;
+
 destructor TMessagesWindow.Done;
 begin
   MessagesWindow:=nil;
   inherited Done;
 end;
 
+procedure RegisterFPTools;
+begin
+  RegisterType(RToolMessageListBox);
+  RegisterType(RMessagesWindow);
+end;
+
 END.
 {
   $Log$
-  Revision 1.7  1999-03-23 15:11:35  peter
+  Revision 1.8  1999-04-07 21:55:54  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.7  1999/03/23 15:11:35  peter
     * desktop saving things
     * vesa mode
     * preferences dialog

ide/text/fputils.pas

@@ -41,7 +41,6 @@ function StrToInt(const S: string): longint;
 function IntToHex(L: longint): string;
 function IntToHexL(L: longint; MinLen: byte): string;
 function HexToInt(S: string): longint;
-function CharStr(C: char; Count: byte): string;
 function SmartPath(Path: string): string;
 Function FixPath(s:string;allowdot:boolean):string;
 function FixFileName(const s:string):string;
@@ -85,6 +84,7 @@ const LastStrToIntResult : integer = 0;
 implementation
 
 uses Dos,
+     WUtils,
      FPVars;
 
 function IntToStr(L: longint): string;
@@ -104,14 +104,6 @@ begin
   StrToInt:=L;
 end;
 
-function CharStr(C: char; Count: byte): string;
-var S: string;
-begin
-  S[0]:=chr(Count);
-  FillChar(S[1],Count,C);
-  CharStr:=S;
-end;
-
 function IntToStrZ(L: longint; MinLen: byte): string;
 var S: string;
 begin
@@ -654,7 +646,13 @@ end;
 END.
 {
   $Log$
-  Revision 1.11  1999-03-19 16:04:31  peter
+  Revision 1.12  1999-04-07 21:55:55  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.11  1999/03/19 16:04:31  peter
     * new compiler dialog
 
   Revision 1.10  1999/03/08 14:58:14  peter

ide/text/fpviews.pas

@@ -15,13 +15,9 @@
  **********************************************************************}
 unit FPViews;
 
-interface
+{$i globdir.inc}
 
-{$ifndef LINUX}
-  {$ifndef FV20}
-    {$define VESA}
-  {$endif}
-{$endif}
+interface
 
 uses
   Dos,Objects,Drivers,Commands,HelpCtx,Views,Menus,Dialogs,App,Gadgets,
@@ -63,8 +59,8 @@ type
 
     PFPHelpViewer = ^TFPHelpViewer;
     TFPHelpViewer = object(THelpViewer)
-      function  GetLocalMenu: PMenu; virtual;
-      function  GetCommandTarget: PView; virtual;
+      function    GetLocalMenu: PMenu; virtual;
+      function    GetCommandTarget: PView; virtual;
     end;
 
     PFPHelpWindow = ^TFPHelpWindow;
@@ -122,6 +118,8 @@ type
       procedure   Update; virtual;
       procedure   UpdateCommands; virtual;
       function    GetPalette: PPalette; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
       destructor  Done; virtual;
     end;
 
@@ -158,6 +156,8 @@ type
       procedure   Show; virtual;
       procedure   Hide; virtual;
       procedure   Close; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
       destructor  Done; virtual;
     end;
 
@@ -190,6 +190,8 @@ type
       procedure   Draw; virtual;
       procedure   HandleEvent(var Event: TEvent); virtual;
       function    GetLocalMenu: PMenu; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
       destructor  Done; virtual;
     end;
 
@@ -317,6 +319,8 @@ function StartEditor(Editor: PCodeEditor; FileName: string): boolean;
 procedure InitVESAScreenModes;
 {$endif}
 
+procedure NoDebugger;
+
 const
       SourceCmds  : TCommandSet =
         ([cmSave,cmSaveAs,cmCompile]);
@@ -338,6 +342,8 @@ var  MsgParms : array[1..10] of
              1 : (Long: longint);
          end;
 
+procedure RegisterFPViews;
+
 implementation
 
 uses
@@ -346,6 +352,45 @@ uses
   {$ifdef VESA}Vesa,{$endif}
   FPSwitch,FPSymbol,FPDebug,FPVars,FPUtils,FPCompile,FPHelp;
 
+const
+  RSourceEditor: TStreamRec = (
+     ObjType: 1500;
+     VmtLink: Ofs(TypeOf(TSourceEditor)^);
+     Load:    @TSourceEditor.Load;
+     Store:   @TSourceEditor.Store
+  );
+  RSourceWindow: TStreamRec = (
+     ObjType: 1501;
+     VmtLink: Ofs(TypeOf(TSourceWindow)^);
+     Load:    @TSourceWindow.Load;
+     Store:   @TSourceWindow.Store
+  );
+  RFPHelpViewer: TStreamRec = (
+     ObjType: 1502;
+     VmtLink: Ofs(TypeOf(TFPHelpViewer)^);
+     Load:    @TFPHelpViewer.Load;
+     Store:   @TFPHelpViewer.Store
+  );
+  RFPHelpWindow: TStreamRec = (
+     ObjType: 1503;
+     VmtLink: Ofs(TypeOf(TFPHelpWindow)^);
+     Load:    @TFPHelpWindow.Load;
+     Store:   @TFPHelpWindow.Store
+  );
+  RClipboardWindow: TStreamRec = (
+     ObjType: 1504;
+     VmtLink: Ofs(TypeOf(TClipboardWindow)^);
+     Load:    @TClipboardWindow.Load;
+     Store:   @TClipboardWindow.Store
+  );
+  RMessageListBox: TStreamRec = (
+     ObjType: 1505;
+     VmtLink: Ofs(TypeOf(TMessageListBox)^);
+     Load:    @TMessageListBox.Load;
+     Store:   @TMessageListBox.Store
+  );
+
+
 const
   NoNameCount    : integer = 0;
   ReservedWords  : PUnsortedStringCollection = nil;
@@ -962,6 +1007,22 @@ begin
   GetPalette:=@P;
 end;
 
+constructor TSourceWindow.Load(var S: TStream);
+begin
+  inherited Load(S);
+
+  GetSubViewPtr(S,Indicator);
+  GetSubViewPtr(S,Editor);
+end;
+
+procedure TSourceWindow.Store(var S: TStream);
+begin
+  inherited Store(S);
+
+  PutSubViewPtr(S,Indicator);
+  PutSubViewPtr(S,Editor);
+end;
+
 destructor TSourceWindow.Done;
 begin
   Message(Application,evBroadcast,cmSourceWndClosing,@Self);
@@ -1168,6 +1229,18 @@ begin
   Hide;
 end;
 
+constructor TClipboardWindow.Load(var S: TStream);
+begin
+  inherited Load(S);
+
+  Clipboard:=Editor;
+end;
+
+procedure TClipboardWindow.Store(var S: TStream);
+begin
+  inherited Store(S);
+end;
+
 destructor TClipboardWindow.Done;
 begin
   inherited Done;
@@ -1418,6 +1491,27 @@ begin
   end;
 end;
 
+constructor TMessageListBox.Load(var S: TStream);
+begin
+  inherited Load(S);
+end;
+
+procedure TMessageListBox.Store(var S: TStream);
+var OL: PCollection;
+begin
+  OL:=List;
+  New(List, Init(1,1));
+
+  inherited Store(S);
+
+  Dispose(List, Done);
+  List:=OL;
+  { ^^^ nasty trick - has anyone a better idea how to avoid storing the
+    collection? Pasting here a modified version of TListBox.Store+
+    TAdvancedListBox.Store isn't a better solution, since by eventually
+    changing the obj-hierarchy you'll always have to modify this, too - BG }
+end;
+
 destructor TMessageListBox.Done;
 begin
   inherited Done;
@@ -2493,10 +2587,32 @@ begin
 end;
 {$endif}
 
+procedure NoDebugger;
+begin
+  InformationBox('No debugger support available.',nil);
+end;
+
+procedure RegisterFPViews;
+begin
+  RegisterType(RSourceEditor);
+  RegisterType(RSourceWindow);
+  RegisterType(RFPHelpViewer);
+  RegisterType(RFPHelpWindow);
+  RegisterType(RClipboardWindow);
+  RegisterType(RMessageListBox);
+end;
+
+
 END.
 {
   $Log$
-  Revision 1.27  1999-04-01 10:27:06  pierre
+  Revision 1.28  1999-04-07 21:55:56  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.27  1999/04/01 10:27:06  pierre
    + file(line) in start of message added
 
   Revision 1.26  1999/03/23 16:16:41  peter

ide/text/utils/tphc.pas

@@ -1,28 +1,208 @@
-uses Objects,WHelp,WTPHWriter;
+{
+ !!! Someone please fix DRIVERS.PAS, so it doesn't clears the screen on exit
+     when we didn't use any of it's functions, just had it in 'uses'
 
-var W: THelpFileWriter;
-    HF: TOAHelpFile;
-    P: PTopic;
-const Ctx = 32;
+     Then we can delete GetDosTicks() from WHelp...
+}
+
+uses Objects,WUtils,WHelp,WTPHWriter;
+
+const
+     SrcExt          = '.TXT';
+     HelpExt         = '.FPH';
+     TokenPrefix     = '.';
+     CommentPrefix   = ';';
+     TokenIndex      = 'INDEX';
+     TokenTopic      = 'TOPIC';
+     TokenCode       = 'CODE';
+
+     FirstTempTopic  = 1000000;
+
+     CR              = #$0D;
+     LF              = #$0A;
+
+type
+     THCIndexEntry = record
+       Tag      : PString;
+       TopicName: PString;
+     end;
+
+     THCTopic = record
+       Name     : PString;
+       Topic    : PTopic;
+     end;
+
+     PHCIndexEntryCollection = ^THCIndexEntryCollection;
+     THCIndexEntryCollection = object(T
+
+var SrcName, DestName: string;
+    HelpFile        : THelpFileWriter;
+
+procedure Print(const S: string);
+begin
+  writeln(S);
+end;
+
+procedure Abort; forward;
+
+procedure Help;
+begin
+  Print('Syntax : TPHC <helpsource>[.TXT] <helpfile>[.FPH]');
+  Abort;
+end;
+
+procedure Fatal(const S: string);
+begin
+  Print('Fatal: '+S);
+  Abort;
+end;
+
+procedure Warning(const S: string);
+begin
+  Print('Warning: '+S);
+end;
+
+procedure ProcessParams;
+begin
+  if (ParamCount<1) or (ParamCount>2) then Help;
+  SrcName:=ParamStr(1);
+  if ExtOf(SrcName)='' then SrcName:=SrcName+SrcExt;
+  if ParamCount=1 then
+    DestName:=DirAndNameOf(SrcName)+HelpExt
+  else
+    begin
+      DestName:=ParamStr(2);
+      if ExtOf(DestName)='' then DestName:=DestName+HelpExt;
+    end;
+end;
+
+procedure Compile(SrcS, DestS: PStream);
+var CurLine: string;
+    CurLineNo: longint;
+    CurTopic : PTopic;
+    HelpFile: PHelpFileWriter;
+    InCode: boolean;
+    NextTempTopic: longint;
+procedure AddLine(const S: string);
+begin
+  if CurTopic<>nil then
+    HelpFile^.AddLineToTopic(CurTopic,S);
+end;
+procedure ProcessToken(S: string);
+var P: byte;
+    Token: string;
+    TopicName: string;
+    TopicContext: THelpCtx;
+    Text: string;
+begin
+  S:=Trim(S);
+  P:=Pos(' ',S); if P=0 then P:=length(S)+1;
+  Token:=UpcaseStr(copy(S,1,P-1)); Delete(S,1,P); S:=Trim(S);
+  if Token=TokenIndex then
+    begin
+      if InCode then AddLine(hscCode);
+      if copy(S,1,1)<>'{' then
+        Fatal('"{" expected at line '+IntToStr(CurLineNo));
+      if copy(S,length(S),1)<>'}' then
+        Fatal('"}" expected at line '+IntToStr(CurLineNo));
+      S:=copy(S,2,length(S)-2);
+      P:=Pos(':',S); if P=0 then P:=length(S)+1;
+      Text:=copy(S,1,!!
+    end else
+  if Token=TokenTopic then
+    begin
+      if InCode then AddLine(hscCode);
+      P:=Pos(' ',S); if P=0 then P:=length(S)+1;
+      TopicName:=UpcaseStr(copy(S,1,P-1)); Delete(S,1,P); S:=Trim(S);
+      if TopicName='' then
+        Fatal('Topic name missing at line '+IntToStr(CurLineNo));
+      if S='' then
+        TopicContext:=0
+      else
+        if copy(S,1,1)<>'=' then
+          begin
+            Fatal('"=" expected at line '+IntToStr(CurLineNo));
+            TopicContext:=0;
+          end
+        else
+          begin
+            S:=Trim(copy(S,2,255));
+            TopicContext:=StrToInt(S);
+            if LastStrToIntResult<>0 then
+              Fatal('Error interpreting context number at line '+IntToStr(CurLineNo));
+          end;
+      if TopicContext=0 then
+        begin
+          TopicContext:=NextTempTopic;
+          Inc(NextTempTopic);
+        end;
+      CurTopic:=HelpFile^.CreateTopic(TopicContext);
+    end else
+  if Token=TokenCode then
+    begin
+      AddLine(hscCode);
+      InCode:=not InCode;
+    end else
+  Warning('Uknown token "'+Token+'" encountered at line '+IntToStr(CurLineNo));
+end;
+procedure ProcessLine(const S: string);
+begin
+  AddLine(S);
+end;
+function ReadNextLine: boolean;
+var C: char;
+begin
+  Inc(CurLineNo);
+  CurLine:='';
+  repeat
+    SrcS^.Read(C,1);
+    if (C in[CR,LF])=false then
+      CurLine:=CurLine+C;
+  until (C=LF) or (SrcS^.Status<>stOK);
+  ReadNextLine:=(SrcS^.Status=stOK);
+end;
+var OK: boolean;
+begin
+  New(HelpFile, InitStream(DestS,0));
+  CurTopic:=nil; CurLineNo:=0;
+  NextTempTopic:=FirstTempTopic;
+  InCode:=false;
+  repeat
+    OK:=ReadNextLine;
+    if OK then
+    if copy(CurLine,1,length(CommentPrefix))=CommentPrefix then
+      { comment }
+    else
+    if copy(CurLine,1,length(TokenPrefix))=TokenPrefix then
+      ProcessToken(copy(CurLine,2,255))
+    else
+    { normal help-text }
+    begin
+      ProcessLine(CurLine);
+    end;
+  until OK=false;
+  if HelpFile^.WriteFile=false then
+    Fatal('Error writing help file.');
+  Dispose(HelpFile, Done);
+end;
+
+const SrcS  : PBufStream = nil;
+      DestS : PBufStream = nil;
+
+procedure Abort;
+begin
+  if SrcS<>nil then Dispose(SrcS, Done); SrcS:=nil;
+  if DestS<>nil then Dispose(DestS, Done); DestS:=nil;
+end;
 
 BEGIN
-  W.Init('TEST.TPH',1);
-  P:=W.CreateTopic(Ctx);
-  W.AddTopicToIndex('IndexEntry',P);
-  W.AddLineToTopic(P,'Hello world!');
-  W.AddLineToTopic(P,'This is a '+hscLink+'sample'+hscLink+' help file.');
-  W.AddLineToTopic(P,'And this is it''s 3rd line...');
-  W.AddLinkToTopic(P,Ctx+1);
-  P:=W.CreateTopic(Ctx+1);
-  W.AddTopicToIndex('IndexEntry2',P);
-  W.AddLineToTopic(P,'And this is an other topic!');
-  W.AddLineToTopic(P,'>>>Back to the '+hscLink+'previous topic'+hscLink+'...');
-  W.AddLinkToTopic(P,Ctx);
-  W.WriteFile;
-  W.Done;
-
-  HF.Init('TEST.TPH',1);
-  HF.LoadIndex;
-  P:=HF.LoadTopic(Ctx);
-  HF.Done;
+  Print('þ Help Compiler  Version 0.9  Copyright (c) 1999 by B‚rczi G bor');
+  ProcessParams;
+  New(SrcS, Init(SrcName, stOpenRead, 4096));
+  if (SrcS=nil) or (SrcS^.Status<>stOK) then
+    Fatal('Error opening source file.');
+  New(DestS, Init(DestName, stCreate, 4096));
+  if (DestS=nil) or (DestS^.Status<>stOK) then
+    Fatal('Error creating destination file.');
+  Compile(SrcS,DestS);
 END.

ide/text/vesa.pas

@@ -64,6 +64,7 @@ const
 
 type
      {$ifdef FPC}tregisters=registers;{$endif}
+     {$ifdef TP}tregisters=registers;{$endif}
 
      PtrRec16 = record
        Ofs,Seg: word;
@@ -237,7 +238,7 @@ type
     Regs.CX := 0;
     Regs.ES := Seg(DPMIRegs);
     Regs.DI := Ofs(DPMIRegs);
-    Intr(DPMI_INTR, Regs);
+    Dos.Intr(DPMI_INTR, Regs);
     r.ax := DPMIRegs.EAX;
     r.bx := DPMIRegs.EBX;
     r.cx := DPMIRegs.ECX;
@@ -432,7 +433,7 @@ var r: registers;
     OK: boolean;
 begin
   r.ah:=$4f; r.al:=$02; r.bx:=Mode;
-  intr($10,r);
+  dos.intr($10,r);
   OK:=(r.ax=$004f);
   VESASetMode:=OK;
 end;
@@ -442,7 +443,7 @@ var r : registers;
     OK: boolean;
 begin
   r.ah:=$4f; r.al:=$03;
-  intr($10,r);
+  dos.intr($10,r);
   OK:=(r.ax=$004f);
   if OK then Mode:=r.bx;
   VESAGetMode:=OK;
@@ -453,7 +454,7 @@ var r : registers;
     OK : boolean;
 begin
   r.ah:=$4f; r.al:=$05; r.bh:=0; r.bl:=Window; r.dx:=Position;
-  intr($10,r);
+  dos.intr($10,r);
   OK:=(r.ax=$004f);
   VESASelectMemoryWindow:=OK;
 end;
@@ -463,7 +464,7 @@ var r  : registers;
     OK : boolean;
 begin
   r.ah:=$4f; r.al:=$05; r.bh:=1; r.bl:=Window;
-  intr($10,r);
+  dos.intr($10,r);
   OK:=(r.ax=$004f);
   if OK then Position:=r.dx;
   VESAReturnMemoryWindow:=OK;
@@ -481,7 +482,13 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.3  1999-04-01 10:04:18  pierre
+  Revision 1.4  1999-04-07 21:55:58  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.3  1999/04/01 10:04:18  pierre
    * uses typo errror fixed
 
   Revision 1.2  1999/03/26 19:09:44  peter

ide/text/weditor.pas

@@ -145,10 +145,12 @@ type
       Location: TPoint;
       Modified: Boolean;
       constructor Init(var Bounds: TRect);
-      procedure Draw; virtual;
-      function GetPalette: PPalette; virtual;
-      procedure SetState(AState: Word; Enable: Boolean); virtual;
-      procedure SetValue(ALocation: TPoint; AModified: Boolean);
+      procedure   Draw; virtual;
+      function    GetPalette: PPalette; virtual;
+      procedure   SetState(AState: Word; Enable: Boolean); virtual;
+      procedure   SetValue(ALocation: TPoint; AModified: Boolean);
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
     end;
 
     PEditorAction = ^TEditorAction;
@@ -212,6 +214,8 @@ type
       function    InsertText(const S: string): Boolean; virtual;
       function    GetPalette: PPalette; virtual;
       function    IsClipboard: Boolean;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
       destructor  Done; virtual;
     public
       { Text & info storage abstraction }
@@ -303,6 +307,8 @@ type
       function    Valid(Command: Word): Boolean; virtual;
       procedure   HandleEvent(var Event: TEvent); virtual;
       function    ShouldSave: boolean; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
     end;
 
     TCodeEditorDialog = function(Dialog: Integer; Info: Pointer): Word;
@@ -338,6 +344,8 @@ const
      UseSyntaxHighlight : function(Editor: PFileEditor): boolean = DefUseSyntaxHighlight;
      UseTabsPattern     : function(Editor: PFileEditor): boolean = DefUseTabsPattern;
 
+procedure RegisterCodeEditors;
+
 implementation
 
 uses
@@ -345,6 +353,26 @@ uses
   MsgBox,Dialogs,App,StdDlg,HistList,Validate,
   WUtils,WViews;
 
+const
+  RIndicator: TStreamRec = (
+     ObjType: 1100;
+     VmtLink: Ofs(TypeOf(TIndicator)^);
+     Load:    @TIndicator.Load;
+     Store:   @TIndicator.Store
+  );
+  RCodeEditor: TStreamRec = (
+     ObjType: 1101;
+     VmtLink: Ofs(TypeOf(TCodeEditor)^);
+     Load:    @TCodeEditor.Load;
+     Store:   @TCodeEditor.Store
+  );
+  RFileEditor: TStreamRec = (
+     ObjType: 1102;
+     VmtLink: Ofs(TypeOf(TFileEditor)^);
+     Load:    @TFileEditor.Load;
+     Store:   @TFileEditor.Store
+  );
+
 type
      TFindDialogRec = packed record
        Find     : String[80];
@@ -501,21 +529,6 @@ begin
   StrToInt:=L;
 end;
 
-function CharStr(C: char; Count: byte): string;
-{$ifndef FPC}
-var S: string;
-{$endif}
-begin
-{$ifdef FPC}
-  CharStr[0]:=chr(Count);
-  FillChar(CharStr[1],Count,C);
-{$else}
-  S[0]:=chr(Count);
-  FillChar(S[1],Count,C);
-  CharStr:=S;
-{$endif}
-end;
-
 function RExpand(const S: string; MinLen: byte): string;
 begin
   if length(S)<MinLen then
@@ -935,6 +948,20 @@ begin
   end;
 end;
 
+constructor TIndicator.Load(var S: TStream);
+begin
+  inherited Load(S);
+  S.Read(Location,SizeOf(Location));
+  S.Read(Modified,SizeOf(Modified));
+end;
+
+procedure TIndicator.Store(var S: TStream);
+begin
+  inherited Store(S);
+  S.Write(Location,SizeOf(Location));
+  S.Write(Modified,SizeOf(Modified));
+end;
+
 
 {*****************************************************************************
                 TCodeEditor
@@ -2978,6 +3005,46 @@ begin
   GetPalette:=@P;
 end;
 
+constructor TCodeEditor.Load(var S: TStream);
+begin
+  inherited Load(S);
+
+  New(Actions, Init(500,1000));
+  New(Lines, Init(500,1000));
+  { we have always need at least 1 line }
+  Lines^.Insert(NewLine(''));
+
+  GetPeerViewPtr(S,Indicator);
+  S.Read(SelStart,SizeOf(SelStart));
+  S.Read(SelEnd,SizeOf(SelEnd));
+  S.Read(Highlight,SizeOf(Highlight));
+  S.Read(CurPos,SizeOf(CurPos));
+  S.Read(StoreUndo,SizeOf(StoreUndo));
+  S.Read(IsReadOnly,SizeOf(IsReadOnly));
+  S.Read(NoSelect,SizeOf(NoSelect));
+  S.Read(Flags,SizeOf(Flags));
+  S.Read(TabSize,SizeOf(TabSize));
+  S.Read(HighlightRow,SizeOf(HighlightRow));
+
+  UpdateIndicator; LimitsChanged;
+end;
+
+procedure TCodeEditor.Store(var S: TStream);
+begin
+  inherited Store(S);
+  PutPeerViewPtr(S,Indicator);
+  S.Write(SelStart,SizeOf(SelStart));
+  S.Write(SelEnd,SizeOf(SelEnd));
+  S.Write(Highlight,SizeOf(Highlight));
+  S.Write(CurPos,SizeOf(CurPos));
+  S.Write(StoreUndo,SizeOf(StoreUndo));
+  S.Write(IsReadOnly,SizeOf(IsReadOnly));
+  S.Write(NoSelect,SizeOf(NoSelect));
+  S.Write(Flags,SizeOf(Flags));
+  S.Write(TabSize,SizeOf(TabSize));
+  S.Write(HighlightRow,SizeOf(HighlightRow));
+end;
+
 destructor TCodeEditor.Done;
 begin
   inherited Done;
@@ -3161,6 +3228,25 @@ begin
   Valid:=OK;
 end;
 
+constructor TFileEditor.Load(var S: TStream);
+var P: PString;
+begin
+  inherited Load(S);
+  P:=S.ReadStr;
+  FileName:=GetStr(P);
+  if P<>nil then DisposeStr(P);
+
+  UpdateIndicator;
+  Message(@Self,evBroadcast,cmFileNameChanged,@Self);
+end;
+
+procedure TFileEditor.Store(var S: TStream);
+begin
+  inherited Store(S);
+  S.WriteStr(@FileName);
+end;
+
+
 function CreateFindDialog: PDialog;
 var R,R1,R2: TRect;
     D: PDialog;
@@ -3406,10 +3492,23 @@ begin
   DefUseTabsPattern:=(Editor^.Flags and efUseTabCharacters)<>0;
 end;
 
+procedure RegisterCodeEditors;
+begin
+  RegisterType(RIndicator);
+  RegisterType(RCodeEditor);
+  RegisterType(RFileEditor);
+end;
+
 END.
 {
   $Log$
-  Revision 1.28  1999-03-23 15:11:39  peter
+  Revision 1.29  1999-04-07 21:55:59  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.28  1999/03/23 15:11:39  peter
     * desktop saving things
     * vesa mode
     * preferences dialog
@@ -3544,6 +3643,7 @@ END.
   Revision 1.4  1998/12/27 12:01:23  gabor
     * efXXXX constants revised for BP compatibility
     * fixed column and row highlighting (needs to rewrite default palette in the INI)
+
   Revision 1.3  1998/12/22 10:39:54  peter
     + options are now written/read
     + find and replace routines

ide/text/whelp.pas

@@ -185,7 +185,7 @@ type
         function    LoadIndex: boolean; virtual;
         function    ReadTopic(T: PTopic): boolean; virtual;
       public { protected }
-        F: PBufStream;
+        F: PStream;
         TopicsRead     : boolean;
         IndexTableRead : boolean;
         CompressionRead: boolean;
@@ -224,7 +224,7 @@ type
 const TopicCacheSize    : sw_integer = 10;
       HelpStreamBufSize : sw_integer = 4096;
       HelpFacility      : PHelpFacility = nil;
-      MaxHelpTopicSize  : word = 65520;
+      MaxHelpTopicSize  : sw_word = 65520;
 
 function  NewTopic(FileID: byte; HelpCtx: THelpCtx; Pos: longint; Param: string): PTopic;
 procedure DisposeTopic(P: PTopic);
@@ -236,8 +236,22 @@ implementation
 
 uses
   Dos,
-  WUtils,WHTMLHlp,
-  Drivers;
+  WUtils,WHTMLHlp;
+
+Function GetDosTicks:longint; { returns ticks at 18.2 Hz, just like DOS }
+{$IFDEF OS_LINUX}
+  var
+    tv : TimeVal;
+    tz : TimeZone;
+  begin
+    GetTimeOfDay(tv,tz);
+    GetDosTicks:=((tv.Sec mod 86400) div 60)*1092+((tv.Sec mod 60)*1000000+tv.USec) div 54945;
+  end;
+{$ELSE}
+  begin
+    GetDosTicks:=MemL[$40:$6c];
+  end;
+{$endIF}
 
 procedure DisposeRecord(var R: TRecord);
 begin
@@ -440,7 +454,7 @@ var OK: boolean;
     R: TRecord;
 begin
   inherited Init(AID);
-  New(F, Init(AFileName, stOpenRead, HelpStreamBufSize));
+  F:=New(PBufStream, Init(AFileName, stOpenRead, HelpStreamBufSize));
   OK:=F<>nil;
   if OK then OK:=(F^.Status=stOK);
   if OK then
@@ -922,7 +936,13 @@ end;
 END.
 {
   $Log$
-  Revision 1.11  1999-03-16 12:38:16  peter
+  Revision 1.12  1999-04-07 21:56:00  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.11  1999/03/16 12:38:16  peter
     * tools macro fixes
     + tph writer
     + first things for resource files

ide/text/whlpview.pas

@@ -146,6 +146,8 @@ type
         procedure   RenderTopic; virtual;
         procedure   Lookup(S: string); virtual;
         function    GetPalette: PPalette; virtual;
+        constructor Load(var S: TStream);
+        procedure   Store(var S: TStream);
         destructor  Done; virtual;
       private
         History    : array[0..HistorySize] of THelpHistoryEntry;
@@ -434,6 +436,7 @@ begin
                   if Topic^.Links<>nil then
                     begin
                       Inc(LastLink);
+                      if LinkNo<Topic^.LinkCount then
                       Links^.Insert(NewLink(Topic^.Links^[LinkNo].FileID,
                         Topic^.Links^[LinkNo].Context,LinkStart,LinkEnd));
                       Inc(LinkNo);
@@ -977,7 +980,7 @@ begin
           begin
             X:=DX;
             ScreenX:=X-(Delta.X);
-            if (ScreenX>0) then
+            if (ScreenX>0) and (ScreenX<=High(B)) then
             begin
 {              CurP.X:=X; CurP.Y:=Y;
               if LinkAreaContainsPoint(R,CurP) then}
@@ -999,7 +1002,7 @@ begin
           begin
             X:=DX;
             ScreenX:=X-(Delta.X);
-            if (ScreenX>=0) then
+            if (ScreenX>=0) and (ScreenX<=High(B)) then
             begin
               CurP.X:=X; CurP.Y:=Y;
               if LinkContainsPoint(R,CurP) then
@@ -1018,7 +1021,7 @@ begin
         begin
           X:=DX;
           ScreenX:=X-(Delta.X);
-          if (ScreenX>=0) and (ScreenX<MaxViewWidth) then
+          if (ScreenX>=0) and (ScreenX<High(B)) then
             B[ScreenX]:=(B[ScreenX] and $0fff) or ((SelectionColor and $f0) shl 8);
         end;
       end;
@@ -1036,6 +1039,16 @@ begin
   GetPalette:=@P;
 end;
 
+constructor THelpViewer.Load(var S: TStream);
+begin
+  inherited Load(S);
+end;
+
+procedure THelpViewer.Store(var S: TStream);
+begin
+  inherited Store(S);
+end;
+
 destructor THelpViewer.Done;
 begin
   inherited Done;
@@ -1125,7 +1138,13 @@ end;
 END.
 {
   $Log$
-  Revision 1.7  1999-03-08 14:58:20  peter
+  Revision 1.8  1999-04-07 21:56:02  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.7  1999/03/08 14:58:20  peter
     + prompt with dialogs for tools
 
   Revision 1.6  1999/03/01 15:42:13  peter

ide/text/whtml.pas

@@ -13,11 +13,9 @@
  **********************************************************************}
 unit WHTML;
 
-interface
+{$I globdir.inc}
 
-{$ifndef FPC}
-  {$define TPUNIXLF}
-{$endif}
+interface
 
 uses Objects;
 
@@ -27,15 +25,21 @@ type
       function GetLine(Idx: sw_integer; var S: string): boolean; virtual;
     end;
 
-    PDOSTextFile = ^TDOSTextFile;
-    TDOSTextFile = object(TTextFile)
-      constructor Init(AFileName: string);
+    PMemoryTextFile = ^TMemoryTextFile;
+    TMemoryTextFile = object(TTextFile)
+      constructor Init;
+      procedure   AddLine(const S: string); virtual;
       function    GetLine(Idx: sw_integer; var S: string): boolean; virtual;
       destructor  Done; virtual;
     private
       Lines : PUnsortedStrCollection;
     end;
 
+    PDOSTextFile = ^TDOSTextFile;
+    TDOSTextFile = object(TMemoryTextFile)
+      constructor Init(AFileName: string);
+    end;
+
     PSGMLParser = ^TSGMLParser;
     TSGMLParser = object(TObject)
       constructor Init;
@@ -45,7 +49,7 @@ type
     public
       Line,LinePos: sw_integer;
       procedure   DocSoftBreak; virtual;
-      procedure   DocAddTextChar(C: char); virtual;
+      function    DocAddTextChar(C: char): boolean; virtual;
       procedure   DocAddText(S: string); virtual;
       procedure   DocProcessTag(Tag: string); virtual;
       procedure   DocProcessComment(Comment: string); virtual;
@@ -58,7 +62,7 @@ type
     PHTMLParser = ^THTMLParser;
     THTMLParser = object(TSGMLParser)
       procedure   DocSoftBreak; virtual;
-      procedure   DocAddTextChar(C: char); virtual;
+      function    DocAddTextChar(C: char): boolean; virtual;
       procedure   DocProcessTag(Tag: string); virtual;
       function    DocGetTagParam(Name: string; var Value: string): boolean; virtual;
       procedure   DocProcessComment(Comment: string); virtual;
@@ -99,49 +103,42 @@ type
 
 implementation
 
-function UpcaseStr(S: string): string;
-var I: Longint;
-begin
-  for I:=1 to length(S) do
-      S[I]:=Upcase(S[I]);
-  UpcaseStr:=S;
-end;
-
-function LowCase(C: char): char;
-begin
-  if ('A'<=C) and (C<='Z') then C:=chr(ord(C)+32);
-  LowCase:=C;
-end;
+uses WUtils;
 
-function LowcaseStr(S: string): string;
-var I: Longint;
+function TTextFile.GetLine(Idx: sw_integer; var S: string): boolean;
 begin
-  for I:=1 to length(S) do
-      S[I]:=Lowcase(S[I]);
-  LowcaseStr:=S;
+  Abstract;
+  GetLine:=false;
 end;
 
-function LTrim(S: string): string;
+constructor TMemoryTextFile.Init;
 begin
-  while copy(S,1,1)=' ' do Delete(S,1,1);
-  LTrim:=S;
+  inherited Init;
+  New(Lines, Init(500,500));
 end;
 
-function RTrim(S: string): string;
+procedure TMemoryTextFile.AddLine(const S: string);
 begin
-  while copy(S,length(S),1)=' ' do Delete(S,length(S),1);
-  RTrim:=S;
+  Lines^.Insert(NewStr(S));
 end;
 
-function Trim(S: string): string;
+function TMemoryTextFile.GetLine(Idx: sw_integer; var S: string): boolean;
+var OK: boolean;
+    PS: PString;
 begin
-  Trim:=RTrim(LTrim(S));
+  OK:=(Lines<>nil) and (Idx<Lines^.Count);
+  if OK then
+    begin
+      PS:=Lines^.At(Idx);
+      if PS=nil then S:='' else S:=PS^;
+    end;
+  GetLine:=OK;
 end;
 
-function TTextFile.GetLine(Idx: sw_integer; var S: string): boolean;
+destructor TMemoryTextFile.Done;
 begin
-  Abstract;
-  GetLine:=false;
+  inherited Done;
+  if Lines<>nil then Dispose(Lines, Done); Lines:=nil;
 end;
 
 constructor TDOSTextFile.Init(AFileName: string);
@@ -179,31 +176,12 @@ begin
   while (Eof(f)=false) and (IOResult=0) do
     begin
       readln(f,S);
-      Lines^.Insert(NewStr(S));
+      AddLine(S);
     end;
   Close(f);
 {$I+}
 end;
 
-function TDOSTextFile.GetLine(Idx: sw_integer; var S: string): boolean;
-var OK: boolean;
-    PS: PString;
-begin
-  OK:=(Lines<>nil) and (Idx<Lines^.Count);
-  if OK then
-    begin
-      PS:=Lines^.At(Idx);
-      if PS=nil then S:='' else S:=PS^;
-    end;
-  GetLine:=OK;
-end;
-
-destructor TDOSTextFile.Done;
-begin
-  inherited Done;
-  if Lines<>nil then Dispose(Lines, Done); Lines:=nil;
-end;
-
 constructor TSGMLParser.Init;
 begin
   inherited Init;
@@ -236,11 +214,18 @@ var OK: boolean;
     Pos2: integer;
     Name,Entity: string;
     LiteralCode: boolean;
-    LiteralStart,LiteralEnd: integer;
+    LiteralStart,LiteralEnd,P: integer;
+const TabSize : integer = 8;
+      Tab = #9;
 begin
   WasThereAnyText:=false;
   OK:=true; LinePos:=1;
   LiteralStart:=0; LiteralEnd:=0;
+  repeat
+    P:=Pos(TAB,LineText);
+    if P>0 then
+      LineText:=copy(LineText,1,P-1)+CharStr(' ',TabSize)+copy(LineText,P+1,255);
+  until P=0;
   while (LinePos<=length(LineText)) and OK do
     begin
       LiteralCode:=false;
@@ -275,10 +260,7 @@ begin
         InTag:=true;
 
       if InTag then CurTag:=CurTag+C else
-        begin
-          DocAddTextChar(C);
-          WasThereAnyText:=true;
-        end;
+        WasThereAnyText:=DocAddTextChar(C);
       if (LiteralCode=false) and InTag and (InString=false) and (CurTag='<!--') then
         InComment:=true;
       if (LiteralCode=false) and InTag and InComment and (InString=false) and (length(CurTag)>=3) and
@@ -310,7 +292,7 @@ begin
   Abstract;
 end;
 
-procedure TSGMLParser.DocAddTextChar(C: char);
+function TSGMLParser.DocAddTextChar(C: char): boolean;
 begin
   Abstract;
 end;
@@ -346,7 +328,7 @@ procedure THTMLParser.DocSoftBreak;
 begin
 end;
 
-procedure THTMLParser.DocAddTextChar(C: char);
+function THTMLParser.DocAddTextChar(C: char): boolean;
 begin
 end;
 
@@ -700,7 +682,13 @@ end;
 END.
 {
   $Log$
-  Revision 1.3  1999-03-01 15:51:42  peter
+  Revision 1.4  1999-04-07 21:56:03  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.3  1999/03/01 15:51:42  peter
     + Log
 
 }

ide/text/whtmlhlp.pas

@@ -8,14 +8,14 @@ const
      ListIndent = 2;
      DefIndent  = 4;
 
-     MaxTopicLinks = 100;
+     MaxTopicLinks = 500;
 
 type
     PTopicLinkCollection = ^TTopicLinkCollection;
     TTopicLinkCollection = object(TStringCollection)
-      procedure Insert(Item: Pointer); virtual;
-      function  At(Index: sw_Integer): PString;
-      function  AddItem(Item: string): integer;
+      procedure   Insert(Item: Pointer); virtual;
+      function    At(Index: sw_Integer): PString;
+      function    AddItem(Item: string): integer;
     end;
 
     TParagraphAlign = (paLeft,paCenter,paRight);
@@ -24,7 +24,7 @@ type
     THTMLTopicRenderer = object(THTMLParser)
       function  BuildTopic(P: PTopic; AURL: string; HTMLFile: PTextFile; ATopicLinks: PTopicLinkCollection): boolean;
     public
-      procedure DocAddTextChar(C: char); virtual;
+      function  DocAddTextChar(C: char): boolean; virtual;
       procedure DocSoftBreak; virtual;
       procedure DocTYPE; virtual;
       procedure DocHTML(Entered: boolean); virtual;
@@ -59,7 +59,7 @@ type
       URL: string;
       Topic: PTopic;
       TopicLinks: PTopicLinkCollection;
-      TextPtr: word;
+      TextPtr: sw_word;
       InTitle: boolean;
       InBody: boolean;
       InAnchor: boolean;
@@ -72,6 +72,7 @@ type
       PAlign: TParagraphAlign;
       LinkIndexes: array[0..MaxTopicLinks] of sw_integer;
       LinkPtr: sw_integer;
+      LastTextChar: char;
 {      Anchor: TAnchor;}
       procedure AddText(S: string);
       procedure AddChar(C: char);
@@ -95,7 +96,8 @@ type
 
 implementation
 
-uses Dos;
+uses WUtils,
+     Dos;
 
 const
 {$ifdef LINUX}
@@ -133,12 +135,21 @@ begin
   CompletePath:=Complete;
 end;
 
-function UpcaseStr(S: string): string;
-var I: integer;
+function CompleteURL(const Base, URLRef: string): string;
+var P: integer;
+    Drive: string[20];
+    IsComplete: boolean;
+    S: string;
 begin
-  for I:=1 to length(S) do
-      S[I]:=Upcase(S[I]);
-  UpcaseStr:=S;
+  IsComplete:=false;
+  P:=Pos(':',URLRef);
+  if P=0 then Drive:='' else Drive:=UpcaseStr(copy(URLRef,1,P-1));
+  if Drive<>'' then
+  if (Drive='MAILTO') or (Drive='FTP') or (Drive='HTTP') or (Drive='GOPHER') then
+    IsComplete:=true;
+  if IsComplete then S:=URLRef else
+    S:=CompletePath(Base,URLRef);
+  CompleteURL:=S;
 end;
 
 function EncodeHTMLCtx(FileID: integer; LinkNo: word): longint;
@@ -190,19 +201,37 @@ begin
   AddItem:=Idx;
 end;
 
-procedure THTMLTopicRenderer.DocAddTextChar(C: char);
+function THTMLTopicRenderer.DocAddTextChar(C: char): boolean;
+var Added: boolean;
 begin
-  if InTitle then TopicTitle:=TopicTitle+C else
+  Added:=false;
+  if InTitle then
+    begin
+      TopicTitle:=TopicTitle+C;
+      Added:=true;
+    end
+  else
   if InBody then
     begin
-      if (C<>#32) or (AnyCharsInLine=true) then AddChar(C);
+      if (InPreFormatted) or (C<>#32) or (LastTextChar<>C) then
+      if (C<>#32) or (AnyCharsInLine=true) then
+        begin
+          AddChar(C);
+          LastTextChar:=C;
+          Added:=true;
+        end;
     end;
+  DocAddTextChar:=Added;
 end;
 
 procedure THTMLTopicRenderer.DocSoftBreak;
 begin
   if InPreformatted then DocBreak else
-  if AnyCharsInLine then AddChar(' ');
+  if AnyCharsInLine then
+    begin
+      AddChar(' ');
+      LastTextChar:=' ';
+    end;
 end;
 
 procedure THTMLTopicRenderer.DocTYPE;
@@ -255,7 +284,7 @@ begin
         begin
           InAnchor:=true;
           AddChar(hscLink);
-          HRef:=CompletePath(URL,HRef);
+          HRef:=CompleteURL(URL,HRef);
           LinkIndexes[LinkPtr]:=TopicLinks^.AddItem(HRef);
           Inc(LinkPtr);
         end;
@@ -443,7 +472,7 @@ end;
 
 procedure THTMLTopicRenderer.AddChar(C: char);
 begin
-  if Topic=nil then Exit;
+  if (Topic=nil) or (TextPtr=MaxBytes) then Exit;
   Topic^.Text^[TextPtr]:=ord(C);
   Inc(TextPtr);
   if (C>#15) and (C<>' ') then
@@ -477,12 +506,13 @@ begin
       GetMem(Topic^.Text,Topic^.TextSize);
 
       TopicTitle:='';
-      InTitle:=false; InBody:=false; InAnchor:=false;
+      InTitle:=false; InBody:={false}true; InAnchor:=false;
       InParagraph:=false; InPreformatted:=false;
       Indent:=0; CurHeadLevel:=0;
       PAlign:=paLeft;
       TextPtr:=0; LinkPtr:=0;
       AnyCharsInLine:=false;
+      LastTextChar:=#0;
       OK:=Process(HTMLFile);
 
       if OK then
@@ -493,7 +523,7 @@ begin
               FreeMem(Topic^.Links,Topic^.LinkSize);
               Topic^.Links:=nil; Topic^.LinkCount:=0;
             end;
-          Topic^.LinkCount:=TopicLinks^.Count;
+          Topic^.LinkCount:=LinkPtr{TopicLinks^.Count}; { <- eeeeeek! }
           GetMem(Topic^.Links,Topic^.LinkSize);
           for I:=0 to Topic^.LinkCount-1 do
             begin
@@ -559,7 +589,7 @@ end;
 
 function THTMLHelpFile.ReadTopic(T: PTopic): boolean;
 var OK: boolean;
-    HTMLFile: PDOSTextFile;
+    HTMLFile: PMemoryTextFile;
     Name: string;
     Link: string;
     P: sw_integer;
@@ -576,7 +606,16 @@ begin
           Name:=CompletePath(CurFileName,Link);}
           Name:=Link;
         end;
-      New(HTMLFile, Init(Name));
+      HTMLFile:=New(PDOSTextFile, Init(Name));
+      if HTMLFile=nil then
+        begin
+          New(HTMLFile, Init);
+          HTMLFile^.AddLine('<HEAD><TITLE>Page not available</TITLE></HEAD>');
+          HTMLFile^.AddLine(
+            '<BODY>'+
+            'Sorry, can''t access the URL: '+Name+'... <br><br>'+
+            '</BODY>');
+        end;
       OK:=Renderer^.BuildTopic(T,Name,HTMLFile,TopicLinks);
       if OK then CurFileName:=Name;
       if HTMLFile<>nil then Dispose(HTMLFile, Done);

ide/text/wresourc.pas

@@ -102,6 +102,8 @@ type
        constructor Init(var RS: TStream; ALoad: boolean);
        constructor Create(var RS: TStream);
        constructor Load(var RS: TStream);
+       constructor CreateFile(AFileName: string);
+       constructor LoadFile(AFileName: string);
        function    FirstThatResource(Func: pointer): PResource; virtual;
        procedure   ForEachResource(Func: pointer); virtual;
        procedure   ForEachResourceEntry(Func: pointer); virtual;
@@ -120,6 +122,7 @@ type
        function    FindResourceEntry(const ResName: string; ALangID: longint): PResourceEntry;
      private
        S         : PStream;
+       MyStream  : boolean;
        Resources : PResourceCollection;
        Entries   : PGlobalResourceEntryCollection;
        Header    : TResourceFileHeader;
@@ -137,12 +140,6 @@ type
      end;
      PResourceFile = ^TResourceFile;
 
-     PSimpleResourceFile = ^TSimpleResourceFile;
-     TSimpleResourceFile = object(TResourceFile)
-       constructor Create(AFileName: string);
-       constructor Load(AFileName: string);
-     end;
-
 implementation
 
 uses  CallSpec,
@@ -673,35 +670,44 @@ begin
   if Resources<>nil then Dispose(Resources, Done); Resources:=nil;
   if Entries<>nil then
     begin Entries^.DeleteAll; Dispose(Entries, Done); Entries:=nil; end;
+  if MyStream and Assigned(S) then
+    Dispose(S, Done);
 end;
 
-constructor TSimpleResourceFile.Create(AFileName: string);
+constructor TResourceFile.CreateFile(AFileName: string);
 var B: PBufStream;
 begin
   New(B, Init(AFileName, stCreate, 4096));
   if (B<>nil) and (B^.Status<>stOK) then
     begin Dispose(B, Done); B:=nil; end;
   if B=nil then Fail;
-  if inherited Create(B^)=false then
+  if Create(B^)=false then
     Fail;
+  MyStream:=true;
 end;
 
-constructor TSimpleResourceFile.Load(AFileName: string);
+constructor TResourceFile.LoadFile(AFileName: string);
 var B: PBufStream;
 begin
   New(B, Init(AFileName, stCreate, 4096));
   if (B<>nil) and (B^.Status<>stOK) then
     begin Dispose(B, Done); B:=nil; end;
   if B=nil then Fail;
-  if inherited Load(B^)=false then
+  if Load(B^)=false then
     Fail;
+  MyStream:=true;
 end;
 
-
 END.
 {
   $Log$
-  Revision 1.3  1999-03-23 16:16:43  peter
+  Revision 1.4  1999-04-07 21:56:05  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.3  1999/03/23 16:16:43  peter
     * linux fixes
 
   Revision 1.2  1999/03/23 15:11:40  peter

ide/text/wutils.pas

@@ -62,6 +62,8 @@ function Max(A,B: longint): longint;
 
 function CharStr(C: char; Count: byte): string;
 function UpcaseStr(const S: string): string;
+function LowCase(C: char): char;
+function LowcaseStr(S: string): string;
 function RExpand(const S: string; MinLen: byte): string;
 function LTrim(const S: string): string;
 function RTrim(const S: string): string;
@@ -70,9 +72,16 @@ function IntToStr(L: longint): string;
 function StrToInt(const S: string): longint;
 function GetStr(P: PString): string;
 
+function DirOf(const S: string): string;
+function ExtOf(const S: string): string;
+function NameOf(const S: string): string;
+function NameAndExtOf(const S: string): string;
+function DirAndNameOf(const S: string): string;
+
 function EatIO: integer;
 
 const LastStrToIntResult : integer = 0;
+      DirSep             : char    = {$ifdef Linux}'/'{$else}'\'{$endif};
 
 implementation
 
@@ -122,11 +131,18 @@ begin
 end;
 
 function CharStr(C: char; Count: byte): string;
+{$ifndef FPC}
 var S: string;
+{$endif}
 begin
+{$ifdef FPC}
+  CharStr[0]:=chr(Count);
+  FillChar(CharStr[1],Count,C);
+{$else}
   S[0]:=chr(Count);
   FillChar(S[1],Count,C);
   CharStr:=S;
+{$endif}
 end;
 
 function UpcaseStr(const S: string): string;
@@ -209,12 +225,69 @@ begin
 end;
 
 
+function DirOf(const S: string): string;
+var D: DirStr; E: ExtStr; N: NameStr;
+begin
+  FSplit(S,D,N,E);
+  if (D<>'') and (D[Length(D)]<>DirSep) then
+   DirOf:=D+DirSep
+  else
+   DirOf:=D;
+end;
+
+
+function ExtOf(const S: string): string;
+var D: DirStr; E: ExtStr; N: NameStr;
+begin
+  FSplit(S,D,N,E);
+  ExtOf:=E;
+end;
+
+
+function NameOf(const S: string): string;
+var D: DirStr; E: ExtStr; N: NameStr;
+begin
+  FSplit(S,D,N,E);
+  NameOf:=N;
+end;
+
+function NameAndExtOf(const S: string): string;
+var D: DirStr; E: ExtStr; N: NameStr;
+begin
+  FSplit(S,D,N,E);
+  NameAndExtOf:=N+E;
+end;
+
+function DirAndNameOf(const S: string): string;
+var D: DirStr; E: ExtStr; N: NameStr;
+begin
+  FSplit(S,D,N,E);
+  DirAndNameOf:=D+N;
+end;
+
+
 function EatIO: integer;
 begin
   EatIO:=IOResult;
 end;
 
 
+function LowCase(C: char): char;
+begin
+  if ('A'<=C) and (C<='Z') then C:=chr(ord(C)+32);
+  LowCase:=C;
+end;
+
+
+function LowcaseStr(S: string): string;
+var I: Longint;
+begin
+  for I:=1 to length(S) do
+      S[I]:=Lowcase(S[I]);
+  LowcaseStr:=S;
+end;
+
+
 procedure TNoDisposeCollection.FreeItem(Item: Pointer);
 begin
   { don't do anything here }
@@ -275,10 +348,11 @@ end;
 END.
 {
   $Log$
-  Revision 1.3  1999-03-23 15:11:41  peter
-    * desktop saving things
-    * vesa mode
-    * preferences dialog
+  Revision 1.4  1999-04-07 21:56:06  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
 
   Revision 1.2  1999/03/08 14:58:22  peter
     + prompt with dialogs for tools

ide/text/wviews.pas

@@ -64,8 +64,10 @@ type
     PAdvancedListBox = ^TAdvancedListBox;
     TAdvancedListBox = object(TListBox)
       Default: boolean;
-      procedure FocusItem(Item: sw_integer); virtual;
-      procedure HandleEvent(var Event: TEvent); virtual;
+      procedure   FocusItem(Item: sw_integer); virtual;
+      procedure   HandleEvent(var Event: TEvent); virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
     end;
 
     TLocalMenuListBox = object(TAdvancedListBox)
@@ -84,6 +86,8 @@ type
       Delta: TPoint;
       constructor Init(var Bounds: TRect; AText: String; AColor: word);
       procedure   Draw; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
     end;
 
     PHSListBox = ^THSListBox;
@@ -99,10 +103,10 @@ type
     PAdvancedStatusLine = ^TAdvancedStatusLine;
     TAdvancedStatusLine = object(TStatusLine)
       StatusText: PString;
-      function  GetStatusText: string; virtual;
-      procedure SetStatusText(const S: string); virtual;
-      procedure ClearStatusText; virtual;
-      procedure Draw; virtual;
+      function    GetStatusText: string; virtual;
+      procedure   SetStatusText(const S: string); virtual;
+      procedure   ClearStatusText; virtual;
+      procedure   Draw; virtual;
     end;
 
     PDropDownListBox = ^TDropDownListBox;
@@ -186,12 +190,40 @@ function  GetMenuItemBefore(Menu:PMenu; BeforeOf: PMenuItem): PMenuItem;
 
 procedure NotImplemented;
 
+procedure RegistersWViews;
+
 implementation
 
 uses Mouse,
      Commands,App,MsgBox,
      WUtils;
 
+const
+  RAdvancedListBox: TStreamRec = (
+     ObjType: 1120;
+     VmtLink: Ofs(TypeOf(TAdvancedListBox)^);
+     Load:    @TAdvancedListBox.Load;
+     Store:   @TAdvancedListBox.Store
+  );
+  RColorStaticText: TStreamRec = (
+     ObjType: 1121;
+     VmtLink: Ofs(TypeOf(TColorStaticText)^);
+     Load:    @TColorStaticText.Load;
+     Store:   @TColorStaticText.Store
+  );
+  RHSListBox: TStreamRec = (
+     ObjType: 1122;
+     VmtLink: Ofs(TypeOf(THSListBox)^);
+     Load:    @THSListBox.Load;
+     Store:   @THSListBox.Store
+  );
+  RDlgWindow: TStreamRec = (
+     ObjType: 1123;
+     VmtLink: Ofs(TypeOf(TDlgWindow)^);
+     Load:    @TDlgWindow.Load;
+     Store:   @TDlgWindow.Store
+  );
+
 const
   MessageDialog  : PCenterDialog = nil;
 
@@ -1150,6 +1182,24 @@ begin
  end;
 end;
 
+constructor TColorStaticText.Load(var S: TStream);
+begin
+  inherited Load(S);
+
+  S.Read(Color,SizeOf(Color));
+  S.Read(DontWrap,SizeOf(DontWrap));
+  S.Read(Delta,SizeOf(Delta));
+end;
+
+procedure TColorStaticText.Store(var S: TStream);
+begin
+  inherited Store(S);
+
+  S.Write(Color,SizeOf(Color));
+  S.Write(DontWrap,SizeOf(DontWrap));
+  S.Write(Delta,SizeOf(Delta));
+end;
+
 constructor THSListBox.Init(var Bounds: TRect; ANumCols: Word; AHScrollBar, AVScrollBar: PScrollBar);
 begin
   inherited Init(Bounds,ANumCols,AVScrollBar);
@@ -1932,10 +1982,39 @@ begin
   GetPalette:=@P;
 end;
 
+constructor TAdvancedListBox.Load(var S: TStream);
+begin
+  inherited Load(S);
+
+  S.Read(Default,SizeOf(Default));
+end;
+
+procedure TAdvancedListBox.Store(var S: TStream);
+begin
+  inherited Store(S);
+
+  S.Write(Default,SizeOf(Default));
+end;
+
+procedure RegistersWViews;
+begin
+  RegisterType(RAdvancedListBox);
+  RegisterType(RColorStaticText);
+  RegisterType(RHSListBox);
+  RegisterType(RDlgWindow);
+end;
+
+
 END.
 {
   $Log$
-  Revision 1.5  1999-03-23 16:16:44  peter
+  Revision 1.6  1999-04-07 21:56:07  peter
+    + object support for browser
+    * html help fixes
+    * more desktop saving things
+    * NODEBUG directive to exclude debugger
+
+  Revision 1.5  1999/03/23 16:16:44  peter
     * linux fixes
 
   Revision 1.4  1999/03/23 15:11:42  peter