MG: bugfixes + starting programs

git-svn-id: trunk@276 -

ide/codetools.pp

@@ -926,19 +926,16 @@ var Find,Atom:string;
   FindPosition,FindAtomStart,SemicolonPos:integer;
 begin
   Result:=false;
-  if AddCode='' then begin
+  if AddCode='' then exit;
-    Result:=true;
-    exit;
-  end;
   if Source='' then exit;
-  // search "LazarusResources.Add('<ResourceName>',"
+  // search the "LazarusResources.Add('<ResourceName>'," in AddCode
   FindPosition:=1;
   repeat
-    Atom:=ReadNextPascalAtom(Source,FindPosition,FindAtomStart);
+    Atom:=ReadNextPascalAtom(AddCode,FindPosition,FindAtomStart);
   until (Atom='') or (Atom=',');
   if Atom='' then exit;
   // search the resource start in code
-  Find:=copy(AddCode,1,FindPosition);
+  Find:=copy(AddCode,1,FindPosition-1);
   Position:=SearchCodeInSource(Source,Find,1,EndPosition,false);
   if Position<1 then exit;
   // search resource end in code

ide/compiler.pp

@@ -32,7 +32,7 @@ uses
   Classes, SysUtils, Forms, Controls, CompilerOptions, Project, Process;
 
 type
-  TOnOutputString = procedure (Value: String) of Object;
+  TOnOutputString = procedure (const Value: String) of Object;
   TErrorType = (etNone, etHint, etWarning, etError, etFatal);
   TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean)
       of object;
@@ -46,7 +46,7 @@ type
     constructor Create;
     destructor Destroy; override;
     function Compile(AProject: TProject): TModalResult;
-    function GetSourcePosition(Line: string; var Filename:string;
+    function GetSourcePosition(const Line: string; var Filename:string;
        var CaretXY: TPoint; var MsgType: TErrorType): boolean;
     property OnOutputString : TOnOutputString
        read FOnOutputString write FOnOutputString;
@@ -63,7 +63,7 @@ const
 var
   Compiler1 : TCompiler;
 
-function ErrorTypeNameToType(Name:string): TErrorType;
+function ErrorTypeNameToType(const Name:string): TErrorType;
 
 
 implementation
@@ -74,11 +74,12 @@ uses linux;
 {$ENDIF linux}
 
 
-function ErrorTypeNameToType(Name:string): TErrorType;
+function ErrorTypeNameToType(const Name:string): TErrorType;
+var LowName: string;
 begin
-  Name:=lowercase(Name);
+  LowName:=lowercase(Name);
   for Result:=Low(TErrorType) to High(TErrorType) do
-    if lowercase(ErrorTypeNames[Result])=Name then exit;
+    if lowercase(ErrorTypeNames[Result])=LowName then exit;
   Result:=etNone;
 end;
 
@@ -166,7 +167,7 @@ begin
       end;
     end;
     // TProcess does not report, if a program can not be executed
-    // to get good error messages consider the os
+    // to get good error messages consider the OS
     {$IFDEF linux}
     if not Linux.Access(CmdLine,Linux.X_OK) then begin
       case LinuxError of
@@ -220,7 +221,8 @@ begin
             if Buf[i] in [#10,#13] then begin
               OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
               ProcessOutputLine;
-              if (i<Count) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1]) then
+              if (i<Count) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
+              then
                 inc(i);
               LineStart:=i+1;
             end;
@@ -250,14 +252,11 @@ end;
 {--------------------------------------------------------------------------
             TCompiler GetSourcePosition
 ---------------------------------------------------------------------------}
-function TCompiler.GetSourcePosition(Line: string; var Filename:string;
+function TCompiler.GetSourcePosition(const Line: string; var Filename:string;
   var CaretXY: TPoint; var MsgType: TErrorType): boolean;
-{This assumes the line will have the format
+{ This assumes the line has one of the following formats
 <filename>(123,45) <ErrorType>: <some text>
-
-ToDo: parse format:
 <filename>(456) <ErrorType>: <some text> in line (123)
-
 }
 var StartPos, EndPos: integer;
 begin
@@ -312,6 +311,9 @@ end.
 
 {
   $Log$
+  Revision 1.13  2001/05/29 08:16:26  lazarus
+  MG: bugfixes + starting programs
+
   Revision 1.12  2001/04/04 12:20:34  lazarus
   MG: added  add to/remove from project, small bugfixes
 

ide/lazres.pp

@@ -47,7 +47,7 @@ begin
             BinMemStream.CopyFrom(BinFileStream,BinFileStream.Size);
             BinMemStream.Position:=0;
             BinExt:=uppercase(ExtractFileExt(BinFilename));
-            if BinExt='.LFM' then begin
+            if (BinExt='.LFM') or (BinExt='.DFM') then begin
               ResourceType:='FORMDATA';
               ResourceName:=FindLFMClassName(BinMemStream);
               if ResourceName='' then begin

ide/main.pp

@@ -233,6 +233,7 @@ type
     function DoAddActiveUnitToProject: TModalResult;
     function DoRemoveFromProjectDialog: TModalResult;
     function DoBuildProject: TModalResult;
+    function DoRunProject: TModalResult;
     function SomethingOfProjectIsModified: boolean;
     function DoCreateProjectForProgram(ProgramFilename,
        ProgramSource: string): TModalResult;
@@ -688,8 +689,8 @@ begin
   ViewUnitsSpeedBtn     := CreateButton('ViewUnitsSpeedBtn'    , 'btn_viewunits' , 1, ButtonLeft, ButtonTop, [mfLeft], @mnuViewUnitsClicked);
   ViewFormsSpeedBtn     := CreateButton('ViewFormsSpeedBtn'    , 'btn_viewforms' , 1, ButtonLeft, ButtonTop, [mfLeft], @mnuViewFormsClicked);   
   ToggleFormSpeedBtn    := CreateButton('ToggleFormSpeedBtn'   , 'btn_toggleform', 1, ButtonLeft, ButtonTop, [mfLeft], @mnuToggleFormUnitCLicked);
-  NewFormSpeedBtn       := CreateButton('NewFormSpeedBtn'      , 'btn_newform'   , 1, ButtonLeft, ButtonTop, [mfLeft], @mnuNewFormCLicked);
+  NewFormSpeedBtn       := CreateButton('NewFormSpeedBtn'      , 'btn_newform'   , 1, ButtonLeft, ButtonTop, [mfLeft], @mnuNewFormClicked);
-  RunSpeedButton        := CreateButton('RunSpeedButton'       , 'btn_run'       , 2, ButtonLeft, ButtonTop, [mfLeft, mfTop], nil {@mnuRunClicked});
+  RunSpeedButton        := CreateButton('RunSpeedButton'       , 'btn_run'       , 2, ButtonLeft, ButtonTop, [mfLeft, mfTop], @mnuRunProjectClicked);
   
 //  pnlSpeedButtons.Width := ButtonLeft;
 //  pnlSpeedButtons.Height := ButtonTop;
@@ -846,7 +847,7 @@ begin
 
   itmSearchFind := TMenuItem.Create(nil);
   itmSearchFind.Name:='itmSearchFind';
-  itmSearchFind.caption := 'Find';
+  itmSearchFind.Caption := 'Find';
   mnuSearch.add(itmSearchFind);
 
   itmSearchFindAgain := TMenuItem.Create(nil);
@@ -961,7 +962,6 @@ begin
   itmProjectBuild.Name:='itmProjectBuild';
   itmProjectBuild.Caption := 'Build';
   itmProjectBuild.OnClick := @mnuBuildProjectClicked;
-  itmProjectBuild.Enabled := False;
   mnuProject.Add(itmProjectBuild);
 
   itmProjectRun := TMenuItem.Create(Self);
@@ -1253,6 +1253,12 @@ begin
       Handled:=true;
       DoBuildProject;
     end;
+   ecRun:
+    begin
+      Handled:=true;
+      if DoBuildProject<>mrOk then exit;
+      DoRunProject;
+    end;
   end;
 end;
 
@@ -1450,31 +1456,8 @@ Begin
 end;
 
 Procedure TMainIDE.mnuRunProjectClicked(Sender : TObject);
-var
-  TheProcess : TProcess;
-  TheProgram : String;
 begin
-  Assert(False, 'Trace:Run Project Clicked');
+  DoRunProject;
-  if SourceNotebook.Empty then Begin
-   Application.MessageBox('No units loaded.  Load a program first!','Error',mb_OK);
-   Exit;
-   end;
-
-  TheProgram := ExtractFileName(SourceNotebook.ActiveUnitName);
-  //remove the extension
-  if pos('.',TheProgram) <> 0 then
-     delete(ThePRogram,pos('.',TheProgram),length(TheProgram));
-
-
-  if not FileExists(ExtractFilePath(SOurceNotebook.ActiveUnitName)+TheProgram) then Begin
-     TheProgram := 'No program called "'+TheProgram+'" found!';
-     Application.MessageBox(@TheProgram,'Error',MB_OK);
-     exit;
-     end;
-
-  TheProcess:=TProcess.Create(TheProgram,[poRunSuspended,poUsePipes,poNoConsole]);
-
-  TheProcess.Execute;
 end;
 
 procedure TMainIDE.mnuProjectCompilerSettingsClicked(Sender : TObject);
@@ -2293,7 +2276,10 @@ writeln('TMainIDE.DoNewProject 1');
     begin
       // create a first form unit
       Project.CompilerOptions.OtherUnitFiles:=
-         '$(LazarusDir)'+OSDirSeparator+'lcl'+OSDirSeparator+'units';
+         '$(LazarusDir)'+OSDirSeparator+'lcl'+OSDirSeparator+'units'
+        +';'+
+         '$(LazarusDir)'+OSDirSeparator+'lcl'+OSDirSeparator+'units'
+         +OSDirSeparator+'gtk';
       DoNewEditorUnit(nuForm);
     end;
    ptProgram,ptCustomProgram:
@@ -2760,6 +2746,51 @@ begin
   end;
 end;
 
+function TMainIDE.DoRunProject: TModalResult;
+// quick hack to start programs
+// ToDo:
+//  -switch the IDE mode to running and free the process when program terminates
+//  -implement a better messages form for vast amount of output
+//  -target filename
+//  -command line parameters
+//  -connect program to debugger
+var
+  TheProcess : TProcess;
+  ProgramFilename, Ext, AText : String;
+begin
+  Result:=mrCancel;
+writeln('[TMainIDE.DoRunProject] A');
+  if ToolStatus<>itNone then begin
+    Result:=mrAbort;
+    exit;
+  end;
+  if not (Project.ProjectType in [ptProgram, ptApplication, ptCustomProgram])
+  then exit;
+
+  Ext:=ExtractFileExt(Project.ProjectFile);
+  ProgramFilename := LowerCase(copy(Project.ProjectFile,1,
+                          length(Project.ProjectFile)-length(Ext)));
+
+  if not FileExists(ProgramFilename) then begin
+    AText:='No program file "'+ProgramFilename+'" found!';
+    Application.MessageBox(PChar(AText),'File not found',MB_OK);
+    exit;
+  end;
+
+  try
+    TheProcess:=TProcess.Create(ProgramFilename,
+       [poRunSuspended,poUsePipes,poNoConsole]);
+    TheProcess.Execute;
+  except
+    on e: Exception do begin
+      AText:='Error running program "'+ProgramFilename+'": '+e.Message;
+      Application.MessageBox(PChar(AText),'Error',MB_OK);
+    end;
+  end;
+  Result:=mrOk;
+writeln('[TMainIDE.DoRunProject] END');
+end;
+
 function TMainIDE.SomethingOfProjectIsModified: boolean;
 begin
   Result:=(Project<>nil) 
@@ -3358,6 +3389,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.98  2001/05/29 08:16:26  lazarus
+  MG: bugfixes + starting programs
+
   Revision 1.97  2001/05/28 10:00:54  lazarus
   MG: removed unused code. fixed editor name bug.
 

ide/msgview.pp

@@ -37,7 +37,7 @@ type
     Function GetMessage : String;
   public
     constructor Create(AOwner : TComponent); override;
-    Procedure Add(Texts : String);
+    Procedure Add(const Texts : String);
     Procedure Clear;
     Function GetSelectedLineIndex : Integer;
     property Message : String read GetMessage;
@@ -74,7 +74,7 @@ end;
 {------------------------------------------------------------------------------}
 {  TMessagesView.Add                                                           }
 {------------------------------------------------------------------------------}
-Procedure  TMessagesView.Add(Texts : String);
+Procedure  TMessagesView.Add(const Texts : String);
 Begin
   MessageView.Items.Add(Texts);
 end;

ide/uniteditor.pp

@@ -1369,8 +1369,9 @@ end;
 destructor TSourceNotebook.Destroy;
 var i: integer;
 begin
+writeln('[TSourceNotebook.Destroy]');
   for i:=FSourceEditorList.Count-1 downto 0 do
-    Editors[EditorCount-1].Free;
+    Editors[i].Free;
   if Notebook<>nil then begin
     Notebook.Free;
     NoteBook:=nil;
@@ -1843,10 +1844,11 @@ writeln('TSourceNotebook.NewSe A');
     Notebook.Pages.Insert(PageNum,FindUniquePageName('',-1));
   end;
   Result := TSourceEditor.Create(Self,Notebook.Page[PageNum]);
+writeln('TSourceNotebook.NewSe B');
+  FSourceEditorList.Add(Result);
   Result.FUnitName:=Notebook.Pages[PageNum];
   Result.CodeTemplates:=CodeTemplateModul;
   Notebook.PageIndex := Pagenum;
-  FSourceEditorList.Add(Result);
   Result.EditorComponent.BookMarkOptions.BookmarkImages := MarksImgList;
   Result.PopupMenu:=SrcPopupMenu;
   Result.OnEditorChange := @EditorChanged;
@@ -2170,7 +2172,6 @@ Begin
   Result := GetActiveSE.FileName;
 end;
 
-
 function TSourceNotebook.GetEditors(Index:integer):TSourceEditor;
 begin
   Result:=TSourceEditor(FSourceEditorList[Index]);
@@ -2212,7 +2213,6 @@ begin
       Result:=Filename;
       exit;
     end;
-    FileName:='unit1';
   end;
   ShortName:=ExtractFileName(FileName);
   Ext:=ExtractFileExt(ShortName);