mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-04 19:10:18 +02:00
* new compiler dialog
This commit is contained in:
peter
parent
461a11158e
commit
a299ce06e8
@ -17,12 +17,58 @@ unit FPCompile;
|
||||
|
||||
interface
|
||||
|
||||
uses WViews,
|
||||
FPViews;
|
||||
{ $define VERBOSETXT}
|
||||
|
||||
uses
|
||||
Objects,
|
||||
Drivers,Views,Dialogs,
|
||||
WViews,
|
||||
FPViews;
|
||||
|
||||
type
|
||||
TCompileMode = (cBuild,cMake,cCompile,cRun);
|
||||
TCompileMode = (cBuild,cMake,cCompile,cRun);
|
||||
|
||||
{$ifndef OLDCOMP}
|
||||
type
|
||||
PCompilerMessage = ^TCompilerMessage;
|
||||
TCompilerMessage = object(TMessageItem)
|
||||
function GetText(MaxLen: Sw_Integer): String; virtual;
|
||||
end;
|
||||
|
||||
PCompilerMessageListBox = ^TCompilerMessageListBox;
|
||||
TCompilerMessageListBox = object(TMessageListBox)
|
||||
function GetPalette: PPalette; virtual;
|
||||
end;
|
||||
|
||||
PCompilerMessageWindow = ^TCompilerMessageWindow;
|
||||
TCompilerMessageWindow = object(TFPWindow)
|
||||
constructor Init;
|
||||
procedure Updateinfo;
|
||||
procedure HandleEvent(var Event: TEvent); virtual;
|
||||
function GetPalette: PPalette; virtual;
|
||||
procedure Close;virtual;
|
||||
procedure Zoom;virtual;
|
||||
destructor Done; virtual;
|
||||
procedure AddMessage(AClass: longint;const Msg, Module: string; Line, Column: longint);
|
||||
procedure ClearMessages;
|
||||
procedure SetCompileMode(Amode:TCompileMode);
|
||||
procedure SetCompileShow(b:boolean);
|
||||
procedure StartCompilation;
|
||||
function EndCompilation:boolean;
|
||||
private
|
||||
CompileShowed : boolean;
|
||||
Mode : TCompileMode;
|
||||
MsgLB : PCompilerMessageListBox;
|
||||
CurrST,
|
||||
InfoST : PColorStaticText;
|
||||
LineST : PStaticText;
|
||||
end;
|
||||
|
||||
const
|
||||
CompilerMessageWindow : PCompilerMessageWindow = nil;
|
||||
|
||||
{$else}
|
||||
type
|
||||
PCompileStatusDialog = ^TCompileStatusDialog;
|
||||
TCompileStatusDialog = object(TCenterDialog)
|
||||
ST : PAdvancedStaticText;
|
||||
@ -33,22 +79,486 @@ type
|
||||
MsgLB: PMessageListBox;
|
||||
end;
|
||||
|
||||
const
|
||||
SD: PCompileStatusDialog = nil;
|
||||
|
||||
{$endif}
|
||||
|
||||
procedure DoCompile(Mode: TCompileMode);
|
||||
|
||||
const SD: PCompileStatusDialog = nil;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Dos,Video,
|
||||
Objects,Drivers,Views,App,Commands,
|
||||
App,Commands,
|
||||
CompHook,
|
||||
WEditor,
|
||||
FPRedir,
|
||||
FPConst,FPVars,FPUtils,FPIntf,FPSwitch;
|
||||
|
||||
const
|
||||
LastStatusUpdate : longint = 0;
|
||||
|
||||
{$ifndef OLDCOMP}
|
||||
|
||||
{*****************************************************************************
|
||||
TCompilerMessage
|
||||
*****************************************************************************}
|
||||
|
||||
function TCompilerMessage.GetText(MaxLen: Sw_Integer): String;
|
||||
var
|
||||
ClassS: string[20];
|
||||
S: string;
|
||||
begin
|
||||
if TClass=
|
||||
V_Fatal then ClassS:='Fatal' else if TClass =
|
||||
V_Error then ClassS:='Error' else if TClass =
|
||||
V_Normal then ClassS:='' else if TClass =
|
||||
V_Warning then ClassS:='Warning' else if TClass =
|
||||
V_Note then ClassS:='Note' else if TClass =
|
||||
V_Hint then ClassS:='Hint'
|
||||
{$ifdef VERBOSETXT}
|
||||
else if TClass =
|
||||
V_Macro then ClassS:='Macro' else if TClass =
|
||||
V_Procedure then ClassS:='Procedure' else if TClass =
|
||||
V_Conditional then ClassS:='Conditional' else if TClass =
|
||||
V_Info then ClassS:='Info' else if TClass =
|
||||
V_Status then ClassS:='Status' else if TClass =
|
||||
V_Used then ClassS:='Used' else if TClass =
|
||||
V_Tried then ClassS:='Tried' else if TClass =
|
||||
V_Debug then ClassS:='Debug'
|
||||
else
|
||||
ClassS:='???';
|
||||
{$else}
|
||||
else
|
||||
ClassS:='';
|
||||
{$endif}
|
||||
if ClassS<>'' then
|
||||
ClassS:=RExpand(ClassS,0)+': ';
|
||||
if assigned(Module) and
|
||||
(TClass<=V_ShowFile) and (status.currentsource<>'') and (status.currentline>0) then
|
||||
begin
|
||||
if Row>0 then
|
||||
begin
|
||||
if Col>0 then
|
||||
S:=Module^+'('+IntToStr(Row)+','+IntToStr(Col)+') '+ClassS
|
||||
else
|
||||
S:=Module^+'('+IntToStr(Row)+') '+ClassS;
|
||||
end
|
||||
else
|
||||
S:=Module^+'('+IntToStr(Row)+') '+ClassS
|
||||
end
|
||||
else
|
||||
S:=ClassS;
|
||||
if assigned(Text) then
|
||||
S:=S+Text^;
|
||||
if length(S)>MaxLen then
|
||||
S:=copy(S,1,MaxLen-2)+'..';
|
||||
GetText:=S;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TCompilerMessageListBox
|
||||
*****************************************************************************}
|
||||
|
||||
function TCompilerMessageListBox.GetPalette: PPalette;
|
||||
const
|
||||
P: string[length(CBrowserListBox)] = CBrowserListBox;
|
||||
begin
|
||||
GetPalette:=@P;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TCompilerMessageWindow
|
||||
*****************************************************************************}
|
||||
|
||||
constructor TCompilerMessageWindow.Init;
|
||||
var R: TRect;
|
||||
HSB,VSB: PScrollBar;
|
||||
begin
|
||||
Desktop^.GetExtent(R);
|
||||
R.A.Y:=R.B.Y-7;
|
||||
inherited Init(R,'Compiler Messages',SearchFreeWindowNo);
|
||||
HelpCtx:=hcMessagesWindow;
|
||||
|
||||
HSB:=StandardScrollBar(sbHorizontal+sbHandleKeyboard);
|
||||
Insert(HSB);
|
||||
VSB:=StandardScrollBar(sbVertical+sbHandleKeyboard);
|
||||
Insert(VSB);
|
||||
|
||||
GetExtent(R);
|
||||
R.Grow(-1,-1);
|
||||
New(MsgLB, Init(R, HSB, VSB));
|
||||
Insert(MsgLB);
|
||||
|
||||
Updateinfo;
|
||||
|
||||
CompilerMessageWindow:=@self;
|
||||
end;
|
||||
|
||||
procedure TCompilerMessageWindow.AddMessage(AClass: longint;const Msg, Module: string; Line, Column: longint);
|
||||
begin
|
||||
if AClass>=V_Info then
|
||||
Line:=0;
|
||||
MsgLB^.AddItem(New(PCompilerMessage,Init(AClass, Msg, MsgLB^.AddModuleName(Module), Line, Column)));
|
||||
end;
|
||||
|
||||
procedure TCompilerMessageWindow.ClearMessages;
|
||||
begin
|
||||
MsgLB^.Clear;
|
||||
ReDraw;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCompilerMessageWindow.Updateinfo;
|
||||
begin
|
||||
if CompileShowed then
|
||||
begin
|
||||
InfoST^.SetText(
|
||||
RExpand(' Main file : '#1#$7f+Copy(SmartPath(MainFile),1,39),40)+#2+
|
||||
'Total lines : '#1#$7e+IntToStr(Status.CompiledLines)+#2#13+
|
||||
RExpand(' Target : '#1#$7f+KillTilde(TargetSwitches^.ItemName(TargetSwitches^.GetCurrSel)),40)+#2+
|
||||
'Total errors : '#1#$7e+IntToStr(Status.ErrorCount)
|
||||
);
|
||||
if status.currentline>0 then
|
||||
CurrST^.SetText(' Status: '#1#$7e+status.currentsource+'('+IntToStr(status.currentline)+')'#2)
|
||||
else
|
||||
CurrST^.SetText(' Status: '#1#$7e+status.currentsource+#2);
|
||||
end;
|
||||
ReDraw;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCompilerMessageWindow.SetCompileMode(Amode:TCompileMode);
|
||||
begin
|
||||
mode:=Amode;
|
||||
end;
|
||||
|
||||
procedure TCompilerMessageWindow.SetCompileShow(b:boolean);
|
||||
var
|
||||
r : TRect;
|
||||
c : word;
|
||||
begin
|
||||
r.a:=Origin;
|
||||
r.b:=Size;
|
||||
if b then
|
||||
begin
|
||||
if CompileShowed then
|
||||
exit;
|
||||
dec(r.a.y,4);
|
||||
inc(r.b.x,r.a.x);
|
||||
inc(r.b.y,r.a.y+4);
|
||||
ChangeBounds(r);
|
||||
{ shrink msg listbox }
|
||||
GetExtent(R);
|
||||
R.Grow(-1,-1);
|
||||
dec(R.b.y,5);
|
||||
MsgLB^.ChangeBounds(r);
|
||||
{ insert line and infost }
|
||||
C:=((Desktop^.GetColor(32+6) and $f0) or White)*256+Desktop^.GetColor(32+6);
|
||||
GetExtent(R);
|
||||
R.Grow(-1,-1);
|
||||
inc(R.a.y,5);
|
||||
r.b.y:=r.a.y+1;
|
||||
New(LineST, Init(R, CharStr('Ä', MaxViewWidth)));
|
||||
LineST^.GrowMode:=gfGrowHiX;
|
||||
Insert(LineST);
|
||||
inc(r.a.x);
|
||||
dec(r.b.x);
|
||||
inc(r.a.y);
|
||||
r.b.y:=r.a.y+2;
|
||||
New(InfoST, Init(R,'', C));
|
||||
InfoST^.GrowMode:=gfGrowHiX;
|
||||
InfoST^.DontWrap:=true;
|
||||
Insert(InfoST);
|
||||
inc(r.a.y,2);
|
||||
r.b.y:=r.a.y+1;
|
||||
New(CurrST, Init(R,'', C));
|
||||
CurrST^.GrowMode:=gfGrowHiX;
|
||||
Insert(CurrST);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if not CompileShowed then
|
||||
exit;
|
||||
inc(r.a.y,4);
|
||||
inc(r.b.x,r.a.x);
|
||||
inc(r.b.y,r.a.y-4);
|
||||
ChangeBounds(r);
|
||||
{ remove infost and line }
|
||||
Delete(CurrSt);
|
||||
Delete(InfoSt);
|
||||
Delete(LineSt);
|
||||
end;
|
||||
CompileShowed:=b;
|
||||
{ update all windows }
|
||||
Message(Application,evCommand,cmUpdate,nil);
|
||||
end;
|
||||
|
||||
|
||||
procedure TCompilerMessageWindow.StartCompilation;
|
||||
begin
|
||||
SetCompileShow(true);
|
||||
Updateinfo;
|
||||
end;
|
||||
|
||||
|
||||
function TCompilerMessageWindow.EndCompilation:boolean;
|
||||
var
|
||||
doevent,
|
||||
closewin : boolean;
|
||||
E : TEvent;
|
||||
begin
|
||||
{ be sure that we have the latest info displayed, fake the currentsource
|
||||
and currentline to display the result }
|
||||
status.currentline:=0;
|
||||
if status.errorcount=0 then
|
||||
status.currentsource:='Compilation Succesfull'
|
||||
else
|
||||
status.currentsource:='Compilation Failed';
|
||||
Updateinfo;
|
||||
doevent:=false;
|
||||
closewin:=(status.errorcount=0);
|
||||
if (status.errorcount>0) or (Mode<>cRun) then
|
||||
begin
|
||||
repeat
|
||||
GetEvent(E);
|
||||
case E.what of
|
||||
evKeyDown :
|
||||
begin
|
||||
{ only exit when not navigating trough the errors }
|
||||
case E.Keycode of
|
||||
kbEsc :
|
||||
begin
|
||||
closewin:=true;
|
||||
break;
|
||||
end;
|
||||
kbSpaceBar :
|
||||
begin
|
||||
closewin:=false;
|
||||
doevent:=true;
|
||||
break;
|
||||
end;
|
||||
kbUp,
|
||||
kbDown,
|
||||
kbPgUp,
|
||||
kbPgDn,
|
||||
kbHome,
|
||||
kbEnd : ;
|
||||
else
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
evCommand :
|
||||
begin
|
||||
case E.command of
|
||||
cmQuit,
|
||||
cmClose,
|
||||
cmMsgGotoSource,
|
||||
cmMsgTrackSource :
|
||||
begin
|
||||
closewin:=false;
|
||||
doevent:=true;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
HandleEvent(E);
|
||||
until false;
|
||||
SetCompileShow(false);
|
||||
{ Handle the Source tracking after the window has shrunk }
|
||||
if doevent then
|
||||
HandleEvent(E);
|
||||
end;
|
||||
EndCompilation:=closewin;
|
||||
end;
|
||||
|
||||
|
||||
procedure TCompilerMessageWindow.HandleEvent(var Event: TEvent);
|
||||
begin
|
||||
case Event.What of
|
||||
evBroadcast :
|
||||
case Event.Command of
|
||||
cmListFocusChanged :
|
||||
if Event.InfoPtr=MsgLB then
|
||||
Message(Application,evBroadcast,cmClearLineHighlights,@Self);
|
||||
end;
|
||||
end;
|
||||
inherited HandleEvent(Event);
|
||||
end;
|
||||
|
||||
procedure TCompilerMessageWindow.Close;
|
||||
begin
|
||||
Hide;
|
||||
end;
|
||||
|
||||
procedure TCompilerMessageWindow.Zoom;
|
||||
begin
|
||||
SetCompileShow(false);
|
||||
inherited Zoom;
|
||||
end;
|
||||
|
||||
function TCompilerMessageWindow.GetPalette: PPalette;
|
||||
const
|
||||
S : string[length(CBrowserWindow)] = CBrowserWindow;
|
||||
begin
|
||||
GetPalette:=@S;
|
||||
end;
|
||||
|
||||
destructor TCompilerMessageWindow.Done;
|
||||
begin
|
||||
CompilerMessageWindow:=nil;
|
||||
inherited Done;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Compiler Hooks
|
||||
****************************************************************************}
|
||||
|
||||
function CompilerStatus: boolean; {$ifndef FPC}far;{$endif}
|
||||
begin
|
||||
{ only display every 50 lines }
|
||||
if (status.currentline mod 50=0) then
|
||||
begin
|
||||
{ update info messages }
|
||||
if assigned(CompilerMessageWindow) then
|
||||
CompilerMessageWindow^.updateinfo;
|
||||
{ update memory usage }
|
||||
HeapView^.Update;
|
||||
end;
|
||||
CompilerStatus:=false;
|
||||
end;
|
||||
|
||||
|
||||
procedure CompilerStop; {$ifndef FPC}far;{$endif}
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
function CompilerComment(Level:Longint; const s:string):boolean; {$ifndef FPC}far;{$endif}
|
||||
begin
|
||||
{$ifdef TEMPHEAP}
|
||||
switch_to_base_heap;
|
||||
{$endif TEMPHEAP}
|
||||
CompilerComment:=false;
|
||||
{$ifndef DEV}
|
||||
if (status.verbosity and Level)=Level then
|
||||
{$endif}
|
||||
begin
|
||||
CompilerMessageWindow^.AddMessage(Level,S,status.currentsourcepath+status.currentsource,
|
||||
status.currentline,status.currentcolumn);
|
||||
end;
|
||||
{$ifdef TEMPHEAP}
|
||||
switch_to_temp_heap;
|
||||
{$endif TEMPHEAP}
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
DoCompile
|
||||
****************************************************************************}
|
||||
|
||||
function GetExePath: string;
|
||||
var Path: string;
|
||||
I: Sw_integer;
|
||||
begin
|
||||
Path:='.'+DirSep;
|
||||
if DirectorySwitches<>nil then
|
||||
with DirectorySwitches^ do
|
||||
for I:=0 to ItemCount-1 do
|
||||
begin
|
||||
if Pos('EXE',KillTilde(ItemName(I)))>0 then
|
||||
begin Path:=GetStringItem(I); Break; end;
|
||||
end;
|
||||
GetExePath:=CompleteDir(FExpand(Path));
|
||||
end;
|
||||
|
||||
|
||||
procedure DoCompile(Mode: TCompileMode);
|
||||
var
|
||||
P: PSourceWindow;
|
||||
FileName: string;
|
||||
begin
|
||||
{ Get FileName }
|
||||
P:=Message(Desktop,evBroadcast,cmSearchWindow,nil);
|
||||
if (PrimaryFileMain='') and (P=nil) then
|
||||
begin
|
||||
ErrorBox('Oooops, nothing to compile.',nil);
|
||||
Exit;
|
||||
end;
|
||||
if PrimaryFileMain<>'' then
|
||||
FileName:=PrimaryFileMain
|
||||
else
|
||||
begin
|
||||
if P^.Editor^.Modified and (not P^.Editor^.Save) then
|
||||
begin
|
||||
ErrorBox('Can''t compile unsaved file.',nil);
|
||||
Exit;
|
||||
end;
|
||||
FileName:=P^.Editor^.FileName;
|
||||
end;
|
||||
WriteSwitches(SwitchesPath);
|
||||
MainFile:=FixFileName(FExpand(FileName));
|
||||
If GetEXEPath<>'' then
|
||||
EXEFile:=FixFileName(GetEXEPath+NameOf(MainFile)+ExeExt)
|
||||
else
|
||||
EXEFile:=DirOf(MainFile)+NameOf(MainFile)+ExeExt;
|
||||
{ Reset }
|
||||
CtrlBreakHit:=false;
|
||||
{ Show Compiler Info }
|
||||
if not CompilerMessageWindow^.GetState(sfVisible) then
|
||||
CompilerMessageWindow^.Show;
|
||||
CompilerMessageWindow^.MakeFirst;
|
||||
CompilerMessageWindow^.ClearMessages;
|
||||
|
||||
CompilerMessageWindow^.SetCompileMode(Mode);
|
||||
CompilerMessageWindow^.StartCompilation;
|
||||
|
||||
{ hook compiler output }
|
||||
do_status:=CompilerStatus;
|
||||
do_stop:=CompilerStop;
|
||||
do_comment:=CompilerComment;
|
||||
|
||||
{$ifndef debug}
|
||||
{ this avoids all flickers
|
||||
and allows to get assembler and linker messages
|
||||
but also forbids to use GDB inside !! }
|
||||
ChangeRedirOut('fp$$$.out',false);
|
||||
ChangeRedirError('fp$$$.err',false);
|
||||
{$endif ndef debug}
|
||||
{$ifdef TEMPHEAP}
|
||||
split_heap;
|
||||
switch_to_temp_heap;
|
||||
{$endif TEMPHEAP}
|
||||
Compile(FileName);
|
||||
{$ifdef TEMPHEAP}
|
||||
switch_to_base_heap;
|
||||
{$endif TEMPHEAP}
|
||||
{$ifdef go32v2}
|
||||
RestoreRedirOut;
|
||||
RestoreRedirError;
|
||||
{$endif def go32v2}
|
||||
|
||||
{ endcompilation returns true if the messagewindow should be removed }
|
||||
if CompilerMessageWindow^.EndCompilation then
|
||||
CompilerMessageWindow^.Hide;
|
||||
|
||||
Message(Application,evCommand,cmUpdate,nil);
|
||||
{$ifdef TEMPHEAP}
|
||||
releasetempheap;
|
||||
unsplit_heap;
|
||||
{$endif TEMPHEAP}
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{$else OLDCOMP}
|
||||
|
||||
constructor TCompileStatusDialog.Init;
|
||||
var R: TRect;
|
||||
begin
|
||||
@ -114,7 +624,6 @@ begin
|
||||
{$endif TEMPHEAP}
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Compiler Hooks
|
||||
****************************************************************************}
|
||||
@ -126,7 +635,7 @@ begin
|
||||
if abs(TT-LastStatusUpdate)>=round(CompilerStatusUpdateDelay*18.2) then
|
||||
begin
|
||||
LastStatusUpdate:=TT;
|
||||
if SD<>nil then SD^.Update;
|
||||
if SD<>nil then SD^.Update;
|
||||
end;
|
||||
CompilerStatus:=false;
|
||||
end;
|
||||
@ -159,6 +668,10 @@ begin
|
||||
{$endif TEMPHEAP}
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
DoCompile
|
||||
****************************************************************************}
|
||||
|
||||
function GetExePath: string;
|
||||
var Path: string;
|
||||
I: integer;
|
||||
@ -174,9 +687,6 @@ begin
|
||||
GetExePath:=CompleteDir(FExpand(Path));
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
DoCompile
|
||||
****************************************************************************}
|
||||
|
||||
procedure DoCompile(Mode: TCompileMode);
|
||||
|
||||
@ -285,10 +795,15 @@ begin
|
||||
{$endif TEMPHEAP}
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 1999-03-16 12:38:07 peter
|
||||
Revision 1.19 1999-03-19 16:04:27 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.18 1999/03/16 12:38:07 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
@ -99,6 +99,7 @@ const
|
||||
cmToolsMsgNext = 231;
|
||||
cmToolsMsgPrev = 232;
|
||||
cmGrep = 233;
|
||||
cmCompilerMessages = 234;
|
||||
|
||||
cmNotImplemented = 1000;
|
||||
cmNewFromTemplate = 1001;
|
||||
@ -205,6 +206,7 @@ const
|
||||
hcBrowser = hcShift+cmBrowser;
|
||||
hcDesktopOptions = hcShift+cmDesktopOptions;
|
||||
hcAbout = hcShift+cmAbout;
|
||||
hcCompilerMessages = hcShift+cmCompilerMessages;
|
||||
|
||||
hcSystemMenu = 9000;
|
||||
hcFileMenu = 9001;
|
||||
@ -306,7 +308,10 @@ implementation
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 1999-03-16 12:38:08 peter
|
||||
Revision 1.15 1999-03-19 16:04:28 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.14 1999/03/16 12:38:08 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
@ -42,7 +42,6 @@ type
|
||||
procedure ShowUserScreen;
|
||||
procedure ShowIDEScreen;
|
||||
private
|
||||
Heap: PFPHeapView;
|
||||
procedure NewEditor;
|
||||
procedure NewFromTemplate;
|
||||
procedure OpenRecentFile(RecentIndex: integer);
|
||||
@ -60,6 +59,7 @@ type
|
||||
procedure DoResetDebugger;
|
||||
procedure DoContToCursor;
|
||||
procedure Target;
|
||||
procedure DoCompilerMessages;
|
||||
procedure DoPrimaryFile;
|
||||
procedure DoClearPrimary;
|
||||
procedure DoUserScreenWindow;
|
||||
@ -153,15 +153,21 @@ begin
|
||||
Desktop^.Insert(ClipboardWindow);
|
||||
New(CalcWindow, Init); CalcWindow^.Hide;
|
||||
Desktop^.Insert(CalcWindow);
|
||||
{$ifndef OLDCOMP}
|
||||
New(CompilerMessageWindow, Init);
|
||||
CompilerMessageWindow^.Hide;
|
||||
Desktop^.Insert(CompilerMessageWindow);
|
||||
{$else}
|
||||
New(ProgramInfoWindow, Init);
|
||||
ProgramInfoWindow^.Hide;
|
||||
Desktop^.Insert(ProgramInfoWindow);
|
||||
{$endif}
|
||||
Message(@Self,evBroadcast,cmUpdate,nil);
|
||||
CurDirChanged;
|
||||
{ heap viewer }
|
||||
GetExtent(R); Dec(R.B.X); R.A.X:=R.B.X-9; R.A.Y:=R.B.Y-1;
|
||||
New(Heap, InitKb(R));
|
||||
Insert(Heap);
|
||||
New(HeapView, InitKb(R));
|
||||
Insert(HeapView);
|
||||
end;
|
||||
|
||||
procedure TIDEApp.InitMenuBar;
|
||||
@ -222,7 +228,8 @@ begin
|
||||
NewItem('C~l~ear primary file','', kbNoKey, cmClearPrimary, hcClearPrimary,
|
||||
NewLine(
|
||||
NewItem('~I~nformation...','', kbNoKey, cmInformation, hcInformation,
|
||||
nil)))))))))),
|
||||
NewItem('C~o~mpiler messages','F12', kbF12, cmCompilerMessages, hcCompilerMessages,
|
||||
nil))))))))))),
|
||||
NewSubMenu('~D~ebug', hcDebugMenu, NewMenu(
|
||||
NewItem('~O~utput','', kbNoKey, cmUserScreenWindow, hcUserScreenWindow,
|
||||
NewItem('~U~ser screen','Alt+F5', kbAltF5, cmUserScreen, hcUserScreen,
|
||||
@ -230,7 +237,7 @@ begin
|
||||
NewItem('~G~DB window','', kbNoKey, cmOpenGDBWindow, hcOpenGDBWindow,
|
||||
nil))))),
|
||||
NewSubMenu('~T~ools', hcToolsMenu, NewMenu(
|
||||
NewItem('~M~essages', '', kbNoKey, cmToolsMessages, hcToolsMessages,
|
||||
NewItem('~M~essages', 'F11', kbF11, cmToolsMessages, hcToolsMessages,
|
||||
NewItem('Goto ~n~ext','Alt+F8', kbAltF8, cmToolsMsgNext, hcToolsMsgNext,
|
||||
NewItem('Goto ~p~revious','Alt+F7', kbAltF7, cmToolsMsgPrev, hcToolsMsgPrev,
|
||||
NewLine(
|
||||
@ -393,9 +400,10 @@ begin
|
||||
cmPrimaryFile : DoPrimaryFile;
|
||||
cmClearPrimary : DoClearPrimary;
|
||||
cmInformation : DoInformation;
|
||||
cmCompilerMessages : DoCompilerMessages;
|
||||
{ -- Debug menu -- }
|
||||
cmUserScreen : DoUserScreen;
|
||||
cmToggleBreakpoint : DoToggleBreak;
|
||||
cmToggleBreakpoint : DoToggleBreak;
|
||||
cmOpenGDBWindow : DoOpenGDBWindow;
|
||||
{ -- Options menu -- }
|
||||
cmSwitchesMode : SetSwitchesMode;
|
||||
@ -465,8 +473,11 @@ end;
|
||||
procedure TIDEApp.GetTileRect(var R: TRect);
|
||||
begin
|
||||
Desktop^.GetExtent(R);
|
||||
{ Leave the compiler messages window in the bottom }
|
||||
if assigned(CompilerMessageWindow) then
|
||||
R.B.Y:=CompilerMessageWindow^.Origin.Y;
|
||||
{ Leave the messages window in the bottom }
|
||||
if assigned(MessagesWindow) then
|
||||
if assigned(MessagesWindow) and (MessagesWindow^.Origin.Y<R.B.Y) then
|
||||
R.B.Y:=MessagesWindow^.Origin.Y;
|
||||
end;
|
||||
|
||||
@ -720,7 +731,10 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.23 1999-03-16 12:38:10 peter
|
||||
Revision 1.24 1999-03-19 16:04:29 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.23 1999/03/16 12:38:10 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
@ -82,9 +82,20 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TIDEApp.DoCompilerMessages;
|
||||
begin
|
||||
if not CompilerMessageWindow^.GetState(sfVisible) then
|
||||
CompilerMessageWindow^.Show;
|
||||
CompilerMessageWindow^.MakeFirst;
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1999-03-12 01:13:59 peter
|
||||
Revision 1.4 1999-03-19 16:04:30 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.3 1999/03/12 01:13:59 peter
|
||||
* flag if trytoopen should look for other extensions
|
||||
+ browser tab in the tools-compiler
|
||||
|
||||
|
||||
@ -393,22 +393,71 @@ begin
|
||||
end;
|
||||
|
||||
function MatchesMask(What, Mask: string): boolean;
|
||||
var P: integer;
|
||||
Match: boolean;
|
||||
|
||||
function upper(const s : string) : string;
|
||||
var
|
||||
i : Sw_integer;
|
||||
begin
|
||||
for i:=1 to length(s) do
|
||||
if s[i] in ['a'..'z'] then
|
||||
upper[i]:=char(byte(s[i])-32)
|
||||
else
|
||||
upper[i]:=s[i];
|
||||
upper[0]:=s[0];
|
||||
end;
|
||||
|
||||
Function CmpStr(const hstr1,hstr2:string):boolean;
|
||||
var
|
||||
found : boolean;
|
||||
i1,i2 : Sw_integer;
|
||||
begin
|
||||
i1:=0;
|
||||
i2:=0;
|
||||
found:=true;
|
||||
repeat
|
||||
if found then
|
||||
inc(i2);
|
||||
inc(i1);
|
||||
case hstr1[i1] of
|
||||
'?' :
|
||||
found:=true;
|
||||
'*' :
|
||||
begin
|
||||
found:=true;
|
||||
if (i1=length(hstr1)) then
|
||||
i2:=length(hstr2)
|
||||
else
|
||||
if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
|
||||
begin
|
||||
if i2<length(hstr2) then
|
||||
dec(i1)
|
||||
end
|
||||
else
|
||||
if i2>1 then
|
||||
dec(i2);
|
||||
end;
|
||||
else
|
||||
found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
|
||||
end;
|
||||
until (i1>=length(hstr1)) or (i2>length(hstr2)) or (not found);
|
||||
if found then
|
||||
found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
|
||||
CmpStr:=found;
|
||||
end;
|
||||
|
||||
var
|
||||
D1,D2 : DirStr;
|
||||
N1,N2 : NameStr;
|
||||
E1,E2 : Extstr;
|
||||
begin
|
||||
P:=Pos('*',Mask);
|
||||
if P>0 then
|
||||
begin
|
||||
Mask:=copy(Mask,1,P-1);
|
||||
What:=copy(What,1,P-1);
|
||||
end;
|
||||
Match:=length(Mask)=length(What); P:=1;
|
||||
if Match and (Mask<>'') then
|
||||
repeat
|
||||
Match:=Match and ((Mask[P]='?') or (Upcase(Mask[P])=Upcase(What[P])));
|
||||
Inc(P);
|
||||
until (Match=false) or (P>length(Mask));
|
||||
MatchesMask:=Match;
|
||||
{$ifdef linux}
|
||||
FSplit(What,D1,N1,E1);
|
||||
FSplit(Mask,D2,N2,E2);
|
||||
{$else}
|
||||
FSplit(Upper(What),D1,N1,E1);
|
||||
FSplit(Upper(Mask),D2,N2,E2);
|
||||
{$endif}
|
||||
MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
|
||||
end;
|
||||
|
||||
function MatchesMaskList(What, MaskList: string): boolean;
|
||||
@ -605,7 +654,10 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1999-03-08 14:58:14 peter
|
||||
Revision 1.11 1999-03-19 16:04:31 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.10 1999/03/08 14:58:14 peter
|
||||
+ prompt with dialogs for tools
|
||||
|
||||
Revision 1.9 1999/03/01 15:42:06 peter
|
||||
|
||||
@ -48,6 +48,7 @@ const ClipboardWindow : PClipboardWindow = nil;
|
||||
ProgramInfoWindow: PProgramInfoWindow = nil;
|
||||
GDBWindow : PGDBWindow = nil;
|
||||
UserScreenWindow : PScreenWindow = nil;
|
||||
HeapView : PFPHeapView = nil;
|
||||
HelpFiles : WUtils.PUnsortedStringCollection = nil;
|
||||
ShowStatusOnError: boolean = true;
|
||||
StartupDir : string = '.'+DirSep;
|
||||
@ -74,7 +75,10 @@ implementation
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 1999-03-16 12:38:15 peter
|
||||
Revision 1.14 1999-03-19 16:04:32 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.13 1999/03/16 12:38:15 peter
|
||||
* tools macro fixes
|
||||
+ tph writer
|
||||
+ first things for resource files
|
||||
|
||||
@ -161,8 +161,8 @@ type
|
||||
Text : PString;
|
||||
Module : PString;
|
||||
Row,Col : sw_integer;
|
||||
constructor Init(AClass: longint; AText: string; AModule: PString; ARow, ACol: sw_integer);
|
||||
function GetText(MaxLen: integer): string; virtual;
|
||||
constructor Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
|
||||
function GetText(MaxLen: Sw_integer): string; virtual;
|
||||
procedure Selected; virtual;
|
||||
function GetModuleName: string; virtual;
|
||||
destructor Done; virtual;
|
||||
@ -170,14 +170,14 @@ type
|
||||
|
||||
PMessageListBox = ^TMessageListBox;
|
||||
TMessageListBox = object(THSListBox)
|
||||
Transparent: boolean;
|
||||
NoSelection: boolean;
|
||||
MaxWidth: integer;
|
||||
ModuleNames: PStoreCollection;
|
||||
Transparent : boolean;
|
||||
NoSelection : boolean;
|
||||
MaxWidth : Sw_integer;
|
||||
ModuleNames : PStoreCollection;
|
||||
constructor Init(var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar);
|
||||
procedure AddItem(P: PMessageItem); virtual;
|
||||
function AddModuleName(Name: string): PString; virtual;
|
||||
function GetText(Item: Integer; MaxLen: Integer): String; virtual;
|
||||
function AddModuleName(const Name: string): PString; virtual;
|
||||
function GetText(Item,MaxLen: Sw_Integer): String; virtual;
|
||||
procedure Clear; virtual;
|
||||
procedure TrackSource; virtual;
|
||||
procedure GotoSource; virtual;
|
||||
@ -187,10 +187,12 @@ type
|
||||
destructor Done; virtual;
|
||||
end;
|
||||
|
||||
{$ifdef OLDCOMP}
|
||||
PCompilerMessage = ^TCompilerMessage;
|
||||
TCompilerMessage = object(TMessageItem)
|
||||
function GetText(MaxLen: Integer): String; virtual;
|
||||
function GetText(MaxLen: Sw_Integer): String; virtual;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
PProgramInfoWindow = ^TProgramInfoWindow;
|
||||
TProgramInfoWindow = object(TDlgWindow)
|
||||
@ -1183,11 +1185,12 @@ begin
|
||||
DontClear:=false;
|
||||
case Event.KeyCode of
|
||||
kbEnter :
|
||||
if Owner<>pointer(SD) then
|
||||
Message(@Self,evCommand,cmMsgGotoSource,nil);
|
||||
else DontClear:=true;
|
||||
Message(@Self,evCommand,cmMsgGotoSource,nil);
|
||||
else
|
||||
DontClear:=true;
|
||||
end;
|
||||
if DontClear=false then ClearEvent(Event);
|
||||
if not DontClear then
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
evBroadcast :
|
||||
case Event.Command of
|
||||
@ -1201,15 +1204,17 @@ begin
|
||||
case Event.Command of
|
||||
cmMsgGotoSource :
|
||||
if Range>0 then
|
||||
GotoSource;
|
||||
GotoSource;
|
||||
cmMsgTrackSource :
|
||||
if Range>0 then
|
||||
TrackSource;
|
||||
TrackSource;
|
||||
cmMsgClear :
|
||||
Clear;
|
||||
else DontClear:=true;
|
||||
else
|
||||
DontClear:=true;
|
||||
end;
|
||||
if DontClear=false then ClearEvent(Event);
|
||||
if not DontClear then
|
||||
ClearEvent(Event);
|
||||
end;
|
||||
end;
|
||||
inherited HandleEvent(Event);
|
||||
@ -1233,7 +1238,7 @@ begin
|
||||
DrawView;
|
||||
end;
|
||||
|
||||
function TMessageListBox.AddModuleName(Name: string): PString;
|
||||
function TMessageListBox.AddModuleName(const Name: string): PString;
|
||||
var P: PString;
|
||||
begin
|
||||
if ModuleNames<>nil then
|
||||
@ -1243,7 +1248,7 @@ begin
|
||||
AddModuleName:=P;
|
||||
end;
|
||||
|
||||
function TMessageListBox.GetText(Item: Integer; MaxLen: Integer): String;
|
||||
function TMessageListBox.GetText(Item,MaxLen: Sw_Integer): String;
|
||||
var P: PMessageItem;
|
||||
S: string;
|
||||
begin
|
||||
@ -1254,8 +1259,12 @@ end;
|
||||
|
||||
procedure TMessageListBox.Clear;
|
||||
begin
|
||||
if List<>nil then Dispose(List, Done); List:=nil; MaxWidth:=0;
|
||||
if ModuleNames<>nil then ModuleNames^.FreeAll;
|
||||
if assigned(List) then
|
||||
Dispose(List, Done);
|
||||
List:=nil;
|
||||
MaxWidth:=0;
|
||||
if assigned(ModuleNames) then
|
||||
ModuleNames^.FreeAll;
|
||||
SetRange(0); DrawView;
|
||||
Message(Application,evBroadcast,cmClearLineHighlights,@Self);
|
||||
end;
|
||||
@ -1272,7 +1281,9 @@ begin
|
||||
if P^.Row=0 then Exit;
|
||||
Desktop^.Lock;
|
||||
GetNextEditorBounds(R);
|
||||
{$ifdef OLDCOMP}
|
||||
if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
|
||||
{$endif}
|
||||
R.B.Y:=Owner^.Origin.Y;
|
||||
if P^.Row>0 then Row:=P^.Row-1 else Row:=0;
|
||||
if P^.Col>0 then Col:=P^.Col-1 else Col:=0;
|
||||
@ -1280,7 +1291,9 @@ begin
|
||||
if assigned(W) then
|
||||
begin
|
||||
W^.GetExtent(R);
|
||||
{$ifdef OLDCOMP}
|
||||
if Assigned(Owner) and (Owner=pointer(ProgramInfoWindow)) then
|
||||
{$endif}
|
||||
R.B.Y:=Owner^.Origin.Y;
|
||||
W^.ChangeBounds(R);
|
||||
W^.Editor^.SetCurPtr(Col,Row);
|
||||
@ -1317,7 +1330,7 @@ end;
|
||||
|
||||
procedure TMessageListBox.Draw;
|
||||
var
|
||||
I, J, Item: Integer;
|
||||
I, J, Item: Sw_Integer;
|
||||
NormalColor, SelectedColor, FocusedColor, Color: Word;
|
||||
ColWidth, CurCol, Indent: Integer;
|
||||
B: TDrawBuffer;
|
||||
@ -1392,7 +1405,7 @@ begin
|
||||
if ModuleNames<>nil then Dispose(ModuleNames, Done);
|
||||
end;
|
||||
|
||||
constructor TMessageItem.Init(AClass: longint; AText: string; AModule: PString; ARow, ACol: sw_integer);
|
||||
constructor TMessageItem.Init(AClass: longint; const AText: string; AModule: PString; ARow, ACol: sw_integer);
|
||||
begin
|
||||
inherited Init;
|
||||
TClass:=AClass;
|
||||
@ -1401,7 +1414,7 @@ begin
|
||||
Row:=ARow; Col:=ACol;
|
||||
end;
|
||||
|
||||
function TMessageItem.GetText(MaxLen: integer): string;
|
||||
function TMessageItem.GetText(MaxLen: Sw_integer): string;
|
||||
var S: string;
|
||||
begin
|
||||
if Text=nil then S:='' else S:=Text^;
|
||||
@ -1425,6 +1438,8 @@ begin
|
||||
{ if Module<>nil then DisposeStr(Module);}
|
||||
end;
|
||||
|
||||
{$ifdef OLDCOMP}
|
||||
|
||||
function TCompilerMessage.GetText(MaxLen: Integer): String;
|
||||
var ClassS: string[20];
|
||||
S: string;
|
||||
@ -1456,6 +1471,8 @@ begin
|
||||
GetText:=S;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
constructor TProgramInfoWindow.Init;
|
||||
var R,R2: TRect;
|
||||
HSB,VSB: PScrollBar;
|
||||
@ -2420,7 +2437,10 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.22 1999-03-16 00:44:45 peter
|
||||
Revision 1.23 1999-03-19 16:04:33 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.22 1999/03/16 00:44:45 peter
|
||||
* forgotten in last commit :(
|
||||
|
||||
Revision 1.21 1999/03/08 14:58:16 peter
|
||||
|
||||
@ -960,6 +960,51 @@ begin
|
||||
end;
|
||||
|
||||
procedure TColorStaticText.Draw;
|
||||
|
||||
procedure MoveColorTxt(var b;const curs:string;c:word);
|
||||
var
|
||||
p : ^word;
|
||||
i : sw_integer;
|
||||
col : byte;
|
||||
tilde : boolean;
|
||||
begin
|
||||
tilde:=false;
|
||||
col:=lo(c);
|
||||
p:=@b;
|
||||
i:=0;
|
||||
while (i<length(Curs)) do
|
||||
begin
|
||||
Inc(i);
|
||||
case CurS[i] of
|
||||
#1 :
|
||||
begin
|
||||
Inc(i);
|
||||
Col:=ord(curS[i]);
|
||||
end;
|
||||
#2 :
|
||||
begin
|
||||
if tilde then
|
||||
col:=hi(Color)
|
||||
else
|
||||
col:=lo(Color)
|
||||
end;
|
||||
'~' :
|
||||
begin
|
||||
tilde:=not tilde;
|
||||
if tilde then
|
||||
col:=hi(Color)
|
||||
else
|
||||
col:=lo(Color)
|
||||
end;
|
||||
else
|
||||
begin
|
||||
p^:=(col shl 8) or ord(curs[i]);
|
||||
inc(p);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
C: word;
|
||||
Center: Boolean;
|
||||
@ -1005,7 +1050,7 @@ begin
|
||||
if J > I then P := J else P := I + Size.X;
|
||||
T:=copy(S,I,P-I);
|
||||
if Center then J := (Size.X - {P + I}CStrLen(T)) div 2 else J := 0;
|
||||
MoveCStr(B[J],T,C);
|
||||
MoveColorTxt(B[J],T,C);
|
||||
while (P <= L) and (S[P] = ' ') do Inc(P);
|
||||
if (P <= L) and (S[P] = #13) then
|
||||
begin
|
||||
@ -1035,7 +1080,8 @@ begin
|
||||
CurS:=copy(CurS,1,MaxViewWidth);
|
||||
Delete(S,1,P);
|
||||
end;
|
||||
if CurS<>'' then MoveCStr(B,CurS,C);
|
||||
if CurS<>'' then
|
||||
MoveColorTxt(B,CurS,C);
|
||||
WriteLine(0,Y,Size.X,1,B);
|
||||
end;
|
||||
end;
|
||||
@ -1377,7 +1423,10 @@ end;
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1999-03-08 14:58:23 peter
|
||||
Revision 1.3 1999-03-19 16:04:35 peter
|
||||
* new compiler dialog
|
||||
|
||||
Revision 1.2 1999/03/08 14:58:23 peter
|
||||
+ prompt with dialogs for tools
|
||||
|
||||
Revision 1.1 1999/03/01 15:51:43 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user