* new compiler dialog

ide/text/fpcompil.pas

@@ -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);
+
+{$ifndef OLDCOMP}
 type
-    TCompileMode = (cBuild,cMake,cCompile,cRun);
+    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

ide/text/fpconst.pas

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

ide/text/fpide.pas

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

ide/text/fpmcomp.inc

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

ide/text/fputils.pas

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

ide/text/fpvars.pas

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

ide/text/fpviews.pas

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

ide/text/wviews.pas

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