paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 05:09:49 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ object support for browser

Browse Source 
* html help fixes
  * more desktop saving things
  * NODEBUG directive to exclude debugger
This commit is contained in:
peter 1999-04-07 21:55:39 +00:00
parent 1bbbb8e6ca
commit 3dafa09576
28 changed files with 1600 additions and 292 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

184
ide/fake/compiler/browcol.pas
View File

@ -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

68
ide/text/fp.pas
View File

@ -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

26
ide/text/fpcalc.pas
View File

@ -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

21
ide/text/fpcatch.pas
View File

@ -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

70
ide/text/fpcompil.pas
View File

@ -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

10
ide/text/fpconst.pas
View File

@ -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

30
ide/text/fpdesk.pas
View File

@ -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

10
ide/text/fphelp.pas
View File

@ -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

18
ide/text/fpide.pas
View File

@ -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

16
ide/text/fpini.pas
View File

@ -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

13
ide/text/fpmcomp.inc
View File

@ -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

42
ide/text/fpmrun.inc
View File

@ -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

20
ide/text/fpmsrch.inc
View File

@ -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

59
ide/text/fpredir.pas
View File

@ -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

203
ide/text/fpsymbol.pas
View File

@ -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

78
ide/text/fptools.pas
View File

@ -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

18
ide/text/fputils.pas
View File

@ -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

134
ide/text/fpviews.pas
View File

@ -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

228
ide/text/utils/tphc.pas
View File

@ -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.

19
ide/text/vesa.pas
View File

@ -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

140
ide/text/weditor.pas
View File

@ -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

32
ide/text/whelp.pas
View File

@ -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

27
ide/text/whlpview.pas
View File

@ -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

138
ide/text/whtml.pas
View File

@ -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,44 +103,7 @@ 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;
function LowcaseStr(S: string): string;
var I: Longint;
begin
for I:=1 to length(S) do
S[I]:=Lowcase(S[I]);
LowcaseStr:=S;
end;
function LTrim(S: string): string;
begin
while copy(S,1,1)=' ' do Delete(S,1,1);
LTrim:=S;
end;
function RTrim(S: string): string;
begin
while copy(S,length(S),1)=' ' do Delete(S,length(S),1);
RTrim:=S;
end;
function Trim(S: string): string;
begin
Trim:=RTrim(LTrim(S));
end;
uses WUtils;
function TTextFile.GetLine(Idx: sw_integer; var S: string): boolean;
begin
@ -144,6 +111,36 @@ begin
GetLine:=false;
end;
constructor TMemoryTextFile.Init;
begin
inherited Init;
New(Lines, Init(500,500));
end;
procedure TMemoryTextFile.AddLine(const S: string);
begin
Lines^.Insert(NewStr(S));
end;
function TMemoryTextFile.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 TMemoryTextFile.Done;
begin
inherited Done;
if Lines<>nil then Dispose(Lines, Done); Lines:=nil;
end;
constructor TDOSTextFile.Init(AFileName: string);
{$ifdef TPUNIXLF}
procedure readln(var t:text;var s: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
}

83
ide/text/whtmlhlp.pas
View File

@ -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);

30
ide/text/wresourc.pas
View File

@ -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

82
ide/text/wutils.pas
View File

@ -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

93
ide/text/wviews.pas
View File

@ -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