paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-14 14:59:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: added build lazarus feature and config dialog

Browse Source 
git-svn-id: trunk@620 -
This commit is contained in:
lazarus 2002-01-24 14:12:54 +00:00
parent 2e747471d8
commit 9c03030dd4
7 changed files with 650 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -104,6 +104,7 @@ examples/testtools.inc svneol=native#text/pascal
examples/toolbar.pp svneol=native#text/pascal
examples/trackbar.pp svneol=native#text/pascal
ide/breakpointsdlg.pp svneol=native#text/pascal
ide/buildlazdialog.pas svneol=native#text/pascal
ide/codetemplatedialog.pp svneol=native#text/pascal
ide/compiler.pp svneol=native#text/pascal
ide/compileroptions.pp svneol=native#text/pascal
@ -133,6 +134,7 @@ ide/lazarus_dci.lrs svneol=native#text/pascal
ide/lazconf.pp svneol=native#text/pascal
ide/macropromptdlg.pas svneol=native#text/pascal
ide/main.pp svneol=native#text/pascal
ide/miscoptions.pas svneol=native#text/pascal
ide/msgview.pp svneol=native#text/pascal
ide/newprojectdlg.pp svneol=native#text/pascal
ide/outputfilter.pas svneol=native#text/pascal

388
ide/buildlazdialog.pas Normal file
View File

@ -0,0 +1,388 @@
{
/***************************************************************************
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************/
Author: Mattias Gaertner
Abstract:
Defines the TBuildLazarusOptions which stores the settings for the
"Build Lazarus" function of the IDE.
TConfigureBuildLazarusDlg is used to edit TBuildLazarusOptions.
The BuildLazarus function will build the lazarus parts.
}
unit BuildLazDialog;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls, Buttons, LResources,
XMLCfg, ExtToolDialog, ExtToolEditDlg, TransferMacros;
type
TMakeMode = (mmNone, mmBuild, mmCleanBuild);
TBuildLazarusOptions = class
private
fBuildLCL: TMakeMode;
fBuildSynEdit: TMakeMode;
fBuildCodeTools: TMakeMode;
fBuildIDE: TMakeMode;
fBuildExamples: TMakeMode;
fCleanAll: boolean;
fMakeFilename: string;
public
constructor Create;
procedure Load(XMLConfig: TXMLConfig; const Path: string);
procedure Save(XMLConfig: TXMLConfig; const Path: string);
property BuildLCL: TMakeMode read fBuildLCL write fBuildLCL;
property BuildSynEdit: TMakeMode read fBuildSynEdit write fBuildSynEdit;
property BuildCodeTools: TMakeMode read fBuildCodeTools write fBuildCodeTools;
property BuildIDE: TMakeMode read fBuildIDE write fBuildIDE;
property BuildExamples: TMakeMode read fBuildExamples write fBuildExamples;
property CleanAll: boolean read fCleanAll write fCleanAll;
property MakeFilename: string read fMakeFilename write fMakeFilename;
end;
TConfigureBuildLazarusDlg = class(TForm)
CleanAllCheckBox: TCheckBox;
BuildLCLRadioGroup: TRadioGroup;
BuildSynEditRadioGroup: TRadioGroup;
BuildCodeToolsRadioGroup: TRadioGroup;
BuildIDERadioGroup: TRadioGroup;
BuildExamplesRadioGroup: TRadioGroup;
OkButton: TButton;
CancelButton: TButton;
procedure OkButtonClick(Sender: TObject);
procedure CancelButtonClick(Sender: TObject);
private
function MakeModeToInt(MakeMode: TMakeMode): integer;
function IntToMakeMode(i: integer): TMakeMode;
public
procedure Load(Options: TBuildLazarusOptions);
procedure Save(Options: TBuildLazarusOptions);
constructor Create(AnOwner: TComponent); override;
end;
function ShowConfigureBuildLazarusDlg(
Options: TBuildLazarusOptions): TModalResult;
function BuildLazarus(Options: TBuildLazarusOptions;
ExternalTools: TExternalToolList; Macros: TTransferMacroList): TModalResult;
implementation
const
MakeModeNames: array[TMakeMode] of string = (
'None', 'Build', 'Clean & Build'
);
function StrToMakeMode(const s: string): TMakeMode;
begin
for Result:=Succ(mmNone) to High(TMakeMode) do
if AnsiCompareText(s,MakeModeNames[Result])=0 then exit;
Result:=mmNone;
end;
function ShowConfigureBuildLazarusDlg(
Options: TBuildLazarusOptions): TModalResult;
var ConfigBuildLazDlg: TConfigureBuildLazarusDlg;
begin
Result:=mrCancel;
ConfigBuildLazDlg:=TConfigureBuildLazarusDlg.Create(Application);
try
ConfigBuildLazDlg.Load(Options);
Result:=ConfigBuildLazDlg.ShowModal;
if Result=mrOk then
ConfigBuildLazDlg.Save(Options);
finally
ConfigBuildLazDlg.Free;
end;
Result:=mrOk;
end;
function BuildLazarus(Options: TBuildLazarusOptions;
ExternalTools: TExternalToolList; Macros: TTransferMacroList): TModalResult;
var
Tool: TExternalToolOptions;
begin
Result:=mrCancel;
Tool:=TExternalToolOptions.Create;
try
Tool.Filename:=Options.MakeFilename;
Tool.ScanOutputForFPCMessages:=true;
Tool.ScanOutputForMakeMessages:=true;
if Options.CleanAll then begin
// clean lazarus source directories
Tool.Title:='Clean Lazarus Source';
Tool.WorkingDirectory:='$(LazarusDir)';
Tool.CmdLineParams:='cleanall';
Result:=ExternalTools.Run(Tool,Macros);
if Result<>mrOk then exit;
end;
if Options.BuildLCL<>mmNone then begin
// build lcl
Tool.Title:='Build LCL';
Tool.WorkingDirectory:='$(LazarusDir)/lcl';
if Options.BuildLCL=mmBuild then
Tool.CmdLineParams:=''
else
Tool.CmdLineParams:='clean all';
Result:=ExternalTools.Run(Tool,Macros);
if Result<>mrOk then exit;
end;
if Options.BuildSynEdit<>mmNone then begin
// build SynEdit
Tool.Title:='Build SynEdit';
Tool.WorkingDirectory:='$(LazarusDir)/components/synedit';
if Options.BuildSynEdit=mmBuild then
Tool.CmdLineParams:=''
else
Tool.CmdLineParams:='clean all';
Result:=ExternalTools.Run(Tool,Macros);
if Result<>mrOk then exit;
end;
if Options.BuildCodeTools<>mmNone then begin
// build CodeTools
Tool.Title:='Build CodeTools';
Tool.WorkingDirectory:='$(LazarusDir)/components/codetools';
if Options.BuildCodeTools=mmBuild then
Tool.CmdLineParams:=''
else
Tool.CmdLineParams:='clean all';
Result:=ExternalTools.Run(Tool,Macros);
if Result<>mrOk then exit;
end;
if Options.BuildIDE<>mmNone then begin
// build IDE
Tool.Title:='Build IDE';
Tool.WorkingDirectory:='$(LazarusDir)';
if Options.BuildIDE=mmBuild then
Tool.CmdLineParams:='ide'
else
// ToDo: the Makefile needs a 'cleanide'
Tool.CmdLineParams:='clean all';
Result:=ExternalTools.Run(Tool,Macros);
if Result<>mrOk then exit;
end;
if Options.BuildExamples<>mmNone then begin
// build Examples
Tool.Title:='Build Examples';
Tool.WorkingDirectory:='$(LazarusDir)/examples';
if Options.BuildExamples=mmBuild then
Tool.CmdLineParams:=''
else
Tool.CmdLineParams:='clean all';
Result:=ExternalTools.Run(Tool,Macros);
if Result<>mrOk then exit;
end;
Result:=mrOk;
finally
Tool.Free;
end;
end;
{ TConfigureBuildLazarusDlg }
constructor TConfigureBuildLazarusDlg.Create(AnOwner: TComponent);
var MakeMode: TMakeMode;
begin
inherited Create(AnOwner);
if LazarusResources.Find(Classname)=nil then begin
SetBounds((Screen.Width-350) div 2,(Screen.Height-320) div 2,350,320);
Caption:='Configure "Build Lazarus"';
CleanAllCheckBox:=TCheckBox.Create(Self);
with CleanAllCheckBox do begin
Parent:=Self;
Name:='CleanAllCheckBox';
SetBounds(10,10,Self.ClientWidth-24,20);
Caption:='Clean all';
Visible:=true;
end;
BuildLCLRadioGroup:=TRadioGroup.Create(Self);
with BuildLCLRadioGroup do begin
Parent:=Self;
Name:='BuildLCLRadioGroup';
SetBounds(10,CleanAllCheckBox.Top+CleanAllCheckBox.Height+5,
CleanAllCheckBox.Width,40);
Caption:='Build LCL';
for MakeMode:=Low(TMakeMode) to High(TMakeMode) do
Items.Add(MakeModeNames[MakeMode]);
Columns:=3;
Visible:=true;
end;
BuildSynEditRadioGroup:=TRadioGroup.Create(Self);
with BuildSynEditRadioGroup do begin
Parent:=Self;
Name:='BuildSynEditRadioGroup';
SetBounds(10,BuildLCLRadioGroup.Top+BuildLCLRadioGroup.Height+5,
BuildLCLRadioGroup.Width,BuildLCLRadioGroup.Height);
Caption:='Build SynEdit';
for MakeMode:=Low(TMakeMode) to High(TMakeMode) do
Items.Add(MakeModeNames[MakeMode]);
Columns:=3;
Visible:=true;
end;
BuildCodeToolsRadioGroup:=TRadioGroup.Create(Self);
with BuildCodeToolsRadioGroup do begin
Parent:=Self;
Name:='BuildCodeToolsRadioGroup';
SetBounds(10,BuildSynEditRadioGroup.Top+BuildSynEditRadioGroup.Height+5,
BuildLCLRadioGroup.Width,BuildLCLRadioGroup.Height);
Caption:='Build CodeTools';
for MakeMode:=Low(TMakeMode) to High(TMakeMode) do
Items.Add(MakeModeNames[MakeMode]);
Columns:=3;
Visible:=true;
end;
BuildIDERadioGroup:=TRadioGroup.Create(Self);
with BuildIDERadioGroup do begin
Parent:=Self;
Name:='BuildIDERadioGroup';
SetBounds(10,BuildCodeToolsRadioGroup.Top+BuildCodeToolsRadioGroup.Height+5,
BuildLCLRadioGroup.Width,BuildLCLRadioGroup.Height);
Caption:='Build IDE';
for MakeMode:=Low(TMakeMode) to High(TMakeMode) do
Items.Add(MakeModeNames[MakeMode]);
Columns:=3;
Visible:=true;
end;
BuildExamplesRadioGroup:=TRadioGroup.Create(Self);
with BuildExamplesRadioGroup do begin
Parent:=Self;
Name:='BuildExamplesRadioGroup';
SetBounds(10,BuildIDERadioGroup.Top+BuildIDERadioGroup.Height+5,
BuildLCLRadioGroup.Width,BuildLCLRadioGroup.Height);
Caption:='Build Examples';
for MakeMode:=Low(TMakeMode) to High(TMakeMode) do
Items.Add(MakeModeNames[MakeMode]);
Columns:=3;
Visible:=true;
end;
OkButton:=TButton.Create(Self);
with OkButton do begin
Parent:=Self;
Name:='OkButton';
SetBounds(Self.ClientWidth-180,Self.ClientHeight-38,80,25);
Caption:='Ok';
OnClick:=@OkButtonClick;
Visible:=true;
end;
CancelButton:=TButton.Create(Self);
with CancelButton do begin
Parent:=Self;
Name:='CancelButton';
SetBounds(Self.ClientWidth-90,OkButton.Top,OkButton.Width,OkButton.Height);
Caption:='Cancel';
OnClick:=@CancelButtonClick;
Visible:=true;
end;
end;
end;
procedure TConfigureBuildLazarusDlg.OkButtonClick(Sender: TObject);
begin
ModalResult:=mrOk;
end;
procedure TConfigureBuildLazarusDlg.CancelButtonClick(Sender: TObject);
begin
ModalResult:=mrCancel;
end;
procedure TConfigureBuildLazarusDlg.Load(Options: TBuildLazarusOptions);
begin
CleanAllCheckBox.Checked:=Options.CleanAll;
BuildLCLRadioGroup.ItemIndex:=MakeModeToInt(Options.BuildLCL);
BuildSynEditRadioGroup.ItemIndex:=MakeModeToInt(Options.BuildSynEdit);
BuildCodeToolsRadioGroup.ItemIndex:=MakeModeToInt(Options.BuildCodeTools);
BuildIDERadioGroup.ItemIndex:=MakeModeToInt(Options.BuildIDE);
BuildExamplesRadioGroup.ItemIndex:=MakeModeToInt(Options.BuildExamples);
end;
procedure TConfigureBuildLazarusDlg.Save(Options: TBuildLazarusOptions);
begin
Options.CleanAll:=CleanAllCheckBox.Checked;
Options.BuildLCL:=IntToMakeMode(BuildLCLRadioGroup.ItemIndex);
Options.BuildSynEdit:=IntToMakeMode(BuildSynEditRadioGroup.ItemIndex);
Options.BuildCodeTools:=IntToMakeMode(BuildCodeToolsRadioGroup.ItemIndex);
Options.BuildIDE:=IntToMakeMode(BuildIDERadioGroup.ItemIndex);
Options.BuildExamples:=IntToMakeMode(BuildExamplesRadioGroup.ItemIndex);
end;
function TConfigureBuildLazarusDlg.MakeModeToInt(MakeMode: TMakeMode): integer;
begin
case MakeMode of
mmBuild: Result:=1;
mmCleanBuild: Result:=2;
else Result:=0;
end;
end;
function TConfigureBuildLazarusDlg.IntToMakeMode(i: integer): TMakeMode;
begin
case i of
1: Result:=mmBuild;
2: Result:=mmCleanBuild;
else Result:=mmNone;
end;
end;
{ TBuildLazarusOptions }
procedure TBuildLazarusOptions.Save(XMLConfig: TXMLConfig; const Path: string);
begin
XMLConfig.SetValue(Path+'BuildLCL/Value',MakeModeNames[fBuildLCL]);
XMLConfig.SetValue(Path+'BuildSynEdit/Value',MakeModeNames[fBuildSynEdit]);
XMLConfig.SetValue(Path+'BuildCodeTools/Value',MakeModeNames[fBuildCodeTools]);
XMLConfig.SetValue(Path+'BuildIDE/Value',MakeModeNames[fBuildIDE]);
XMLConfig.SetValue(Path+'BuildExamples/Value',MakeModeNames[fBuildExamples]);
XMLConfig.SetValue(Path+'CleanAll/Value',fCleanAll);
XMLConfig.SetValue(Path+'MakeFilename/Value',fMakeFilename);
end;
procedure TBuildLazarusOptions.Load(XMLConfig: TXMLConfig; const Path: string);
begin
fBuildLCL:=StrToMakeMode(XMLConfig.GetValue(Path+'BuildLCL/Value',
MakeModeNames[fBuildLCL]));
fBuildSynEdit:=StrToMakeMode(XMLConfig.GetValue(Path+'BuildSynEdit/Value',
MakeModeNames[fBuildSynEdit]));
fBuildCodeTools:=StrToMakeMode(XMLConfig.GetValue(Path+'BuildCodeTools/Value',
MakeModeNames[fBuildCodeTools]));
fBuildIDE:=StrToMakeMode(XMLConfig.GetValue(Path+'BuildIDE/Value',
MakeModeNames[fBuildIDE]));
fBuildExamples:=StrToMakeMode(XMLConfig.GetValue(Path+'BuildExamples/Value',
MakeModeNames[fBuildExamples]));
fCleanAll:=XMLConfig.GetValue(Path+'CleanAll/Value',fCleanAll);
fMakeFilename:=XMLConfig.GetValue(Path+'MakeFilename/Value',fMakeFilename);
end;
constructor TBuildLazarusOptions.Create;
begin
inherited Create;
fMakeFilename:='/usr/bin/make';
end;
end.

2
ide/environmentopts.pp
View File

@ -483,7 +483,7 @@ begin
ConfFileName:=SetDirSeparators(GetPrimaryConfigPath+'/'+EnvOptsConfFileName);
CopySecondaryConfigFile(EnvOptsConfFileName);
if (not FileExists(ConfFileName)) then begin
writeln('environment config file not found');
writeln('Note: environment config file not found - using defaults');
end;
FFilename:=ConfFilename;
end;

54
ide/exttooldialog.pas
View File

@ -39,12 +39,15 @@ const
type
TOnNeedsOutputFilter = procedure(var OutputFilter: TOutputFilter;
var Abort: boolean) of object;
TOnFreeOutputFilter = procedure(OutputFilter: TOutputFilter;
ErrorOccurred: boolean) of object;
{
the storage object for all external tools
}
TExternalToolList = class(TList)
private
fOnFreeOutputFilter: TOnFreeOutputFilter;
fOnNeedsOutputFilter: TOnNeedsOutputFilter;
fRunningTools: TList; // list of TProcess
function GetToolOpts(Index: integer): TExternalToolOptions;
@ -69,6 +72,8 @@ type
property Items[Index: integer]: TExternalToolOptions
read GetToolOpts write SetToolOpts; default;
property OnFreeOutputFilter: TOnFreeOutputFilter
read fOnFreeOutputFilter write fOnFreeOutputFilter;
property OnNeedsOutputFilter: TOnNeedsOutputFilter
read fOnNeedsOutputFilter write fOnNeedsOutputFilter;
end;
@ -245,7 +250,7 @@ function TExternalToolList.Run(ExtTool: TExternalToolOptions;
var WorkingDir, Filename, Params, CmdLine, Title: string;
TheProcess: TProcess;
TheOutputFilter: TOutputFilter;
Abort: boolean;
Abort, ErrorOccurred: boolean;
begin
Result:=mrCancel;
if ExtTool=nil then exit;
@ -276,34 +281,39 @@ writeln('[TExternalToolList.Run] ',CmdLine);
Result:=mrAbort;
exit;
end;
end else
TheOutputFilter:=nil;
if (TheOutputFilter<>nil) then begin
TheOutputFilter.PrgSourceFilename:='';
TheOutputFilter.Options:=[ofoExceptionOnError,ofoMakeFilenamesAbsolute];
if ExtTool.ScanOutputForFPCMessages then
TheOutputFilter.Options:=TheOutputFilter.Options
+[ofoSearchForFPCMessages];
if ExtTool.ScanOutputForMakeMessages then
TheOutputFilter.Options:=TheOutputFilter.Options
+[ofoSearchForMakeMessages];
ErrorOccurred:=false;
try
if TheOutputFilter.IsParsing then begin
TheOutputFilter.Execute(TheProcess);
TheOutputFilter.ReadLine('"'+Title+'" successfully runned :)',true);
end else
TheProcess.Execute;
TheOutputFilter.PrgSourceFilename:='';
TheOutputFilter.Options:=[ofoExceptionOnError,
ofoMakeFilenamesAbsolute];
if ExtTool.ScanOutputForFPCMessages then
TheOutputFilter.Options:=TheOutputFilter.Options
+[ofoSearchForFPCMessages];
if ExtTool.ScanOutputForMakeMessages then
TheOutputFilter.Options:=TheOutputFilter.Options
+[ofoSearchForMakeMessages];
try
try
TheOutputFilter.Execute(TheProcess);
TheOutputFilter.ReadLine('"'+Title+'" successfully runned :)',
true);
finally
TheProcess.WaitOnExit;
TheProcess.Free;
end;
except
on e: EOutputFilterError do begin
ErrorOccurred:=true;
end;
end;
finally
TheProcess.WaitOnExit;
TheProcess.Free;
if Assigned(OnFreeOutputFilter) then
OnFreeOutputFilter(TheOutputFilter,ErrorOccurred);
end;
end else begin
AddRunningTool(TheProcess,true);
end;
except
on e: EOutputFilterError do begin
raise;
end;
on e: Exception do
MessageDlg('Failed to run tool',
'Unable to run the tool "'+Title+'":'#13+e.Message,mtError,[mbOk],0);

51
ide/keymapping.pp
View File

@ -30,29 +30,29 @@ uses
const
// editor commands constants. see syneditkeycmds.pp for more
ecFind = ecUserFirst + 1;
ecFindAgain = ecUserFirst + 2;
ecFindNext = ecFindAgain;
ecReplace = ecUserFirst + 3;
ecFind = ecUserFirst + 1;
ecFindAgain = ecUserFirst + 2;
ecFindNext = ecFindAgain;
ecReplace = ecUserFirst + 3;
ecFindProcedureDefinition = ecUserFirst + 4;
ecFindProcedureMethod = ecUserFirst + 5;
ecGotoLineNumber = ecUserFirst + 6;
ecGotoLineNumber = ecUserFirst + 6;
ecNextEditor = ecUserFirst + 7;
ecPrevEditor = ecUserFirst + 8;
ecNextEditor = ecUserFirst + 7;
ecPrevEditor = ecUserFirst + 8;
ecPeriod = ecUserFirst + 9;
ecPeriod = ecUserFirst + 9;
ecFindPrevious = ecUserFirst + 10;
ecFindInFiles = ecUserFirst + 11;
ecJumpBack = ecUserFirst + 12;
ecJumpForward = ecUserFirst + 13;
ecAddJumpPoint = ecUserFirst + 14;
ecViewJumpHistory = ecUserFirst + 15;
ecFindPrevious = ecUserFirst + 10;
ecFindInFiles = ecUserFirst + 11;
ecJumpBack = ecUserFirst + 12;
ecJumpForward = ecUserFirst + 13;
ecAddJumpPoint = ecUserFirst + 14;
ecViewJumpHistory = ecUserFirst + 15;
ecFindDeclaration = ecUserFirst + 20;
ecFindBlockOtherEnd = ecUserFirst + 21;
ecFindBlockStart = ecUserFirst + 22;
ecFindDeclaration = ecUserFirst + 20;
ecFindBlockOtherEnd = ecUserFirst + 21;
ecFindBlockStart = ecUserFirst + 22;
ecWordCompletion = ecUserFirst + 100;
ecCompleteCode = ecUserFirst + 101;
@ -66,17 +66,18 @@ const
ecBuild = ecClose + 1;
ecRun = ecBuild + 1;
ecPause = ecRun + 1;
ecStepInto = ecPause + 1;
ecStepOver = ecStepInto + 1;
ecRunToCursor = ecStepOver + 1;
ecStopProgram = ecRunToCursor + 1;
ecBuildAll = ecStopProgram + 1;
ecStepInto = ecPause + 1;
ecStepOver = ecStepInto + 1;
ecRunToCursor = ecStepOver + 1;
ecStopProgram = ecRunToCursor + 1;
ecBuildAll = ecStopProgram + 1;
ecBuildLazarus = ecBuildAll + 1;
ecJumpToEditor = ecUserFirst + 300;
ecToggleFormUnit = ecUserFirst + 301;
ecExtToolFirst = ecUserFirst + 400;
ecExtToolLast = ecUserFirst + 499;
ecExtToolFirst = ecUserFirst + 400;
ecExtToolLast = ecUserFirst + 499;
ecGotoEditor1 = ecUserFirst + 2000;
ecGotoEditor2 = ecGotoEditor1 + 1;
@ -362,6 +363,7 @@ begin
ecClose: Result:= 'close';
ecBuild: Result:= 'build program/project';
ecBuildAll: Result:= 'build all files of program/project';
ecBuildLazarus: Result:= 'build lazarus';
ecRun: Result:= 'run program';
ecPause: Result:= 'pause program';
ecStepInto: Result:= 'step into';
@ -955,6 +957,7 @@ begin
Add('Close',ecClose,VK_F4,[ssCtrl],VK_UNKNOWN,[]);
Add('Build project/program',ecBuild,VK_F9,[ssCtrl],VK_UNKNOWN,[]);
Add('Build all files of project/program',ecBuildAll,VK_UNKNOWN,[],VK_UNKNOWN,[]);
Add('Build Lazarus',ecBuildLazarus,VK_UNKNOWN,[],VK_UNKNOWN,[]);
Add('Run program',ecRun,VK_F9,[],VK_UNKNOWN,[]);
Add('Pause program',ecPause,VK_UNKNOWN,[],VK_UNKNOWN,[]);
Add('Step into',ecStepInto,VK_F7,[],VK_UNKNOWN,[]);

85
ide/main.pp
View File

@ -39,7 +39,8 @@ uses
PropEdits, ControlSelection, UnitEditor, CompilerOptions, EditorOptions,
EnvironmentOpts, TransferMacros, KeyMapping, ProjectOpts, IDEProcs, Process,
UnitInfoDlg, Debugger, DBGWatch, RunParamsOpts, ExtToolDialog, MacroPromptDlg,
LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg, ColumnDlg, OutputFilter;
LMessages, ProjectDefs, Watchesdlg, BreakPointsdlg, ColumnDlg, OutputFilter,
BuildLazDialog, MiscOptions;
const
Version_String = '0.8.2 alpha';
@ -147,6 +148,8 @@ type
itmToolConfigure: TMenuItem;
itmToolSyntaxCheck: TMenuItem;
itmToolGuessUnclosedBlockCheck: TMenuItem;
itmToolBuildLazarus: TMenuItem;
itmToolConfigureBuildLazarus: TMenuItem;
itmEnvGeneralOptions: TMenuItem;
itmEnvEditorOptions: TMenuItem;
@ -217,6 +220,8 @@ type
procedure mnuToolConfigureClicked(Sender : TObject);
procedure mnuToolSyntaxCheckClicked(Sender : TObject);
procedure mnuToolGuessUnclosedBlockClicked(Sender : TObject);
procedure mnuToolBuildLazarusClicked(Sender : TObject);
procedure mnuToolConfigBuildLazClicked(Sender : TObject);
// enironment menu
procedure mnuEnvGeneralOptionsClicked(Sender : TObject);
@ -292,8 +297,10 @@ type
// External Tools events
procedure OnExtToolNeedsOutputFilter(var OutputFilter: TOutputFilter;
var Abort: boolean);
var Abort: boolean);
procedure OnExtToolFreeOutputFilter(OutputFilter: TOutputFilter;
ErrorOccurred: boolean);
private
FHintSender : TObject;
FCodeLastActivated : Boolean; //used for toggling between code and forms
@ -357,6 +364,7 @@ type
// external tools
function DoRunExternalTool(Index: integer): TModalResult;
function DoBuildLazarus: TModalResult;
// useful methods
procedure GetCurrentUnit(var ActiveSourceEditor:TSourceEditor;
@ -518,7 +526,7 @@ begin
end;
end;
// load environment and editor options
// load environment, miscellaneous and editor options
CreatePrimaryConfigPath;
EnvironmentOptions:=TEnvironmentOptions.Create;
@ -527,6 +535,8 @@ begin
Load(false);
if EnvironmentOptions.CompilerFilename='' then
EnvironmentOptions.CompilerFilename:=FindDefaultCompilerPath;
ExternalTools.OnNeedsOutputFilter:=@OnExtToolNeedsOutputFilter;
ExternalTools.OnFreeOutputFilter:=@OnExtToolFreeOutputFilter;
end;
UpdateDefaultPascalFileExtensions;
@ -534,6 +544,9 @@ begin
EditorOpts.Load;
EnvironmentOptions.ExternalTools.LoadShortCuts(EditorOpts.KeyMap);
MiscellaneousOptions:=TMiscellaneousOptions.Create;
MiscellaneousOptions.Load;
// set the IDE mode to none (= editing mode)
ToolStatus:=itNone;
@ -810,6 +823,8 @@ CheckHeap(IntToStr(GetMem_Cnt));
TheCompiler.Free;
TheOutputFilter.Free;
MacroList.Free;
MiscellaneousOptions.Free;
MiscellaneousOptions:=nil;
EditorOpts.Free;
EditorOpts:=nil;
EnvironmentOptions.Free;
@ -1424,6 +1439,17 @@ begin
itmToolGuessUnclosedBlockCheck.OnClick := @mnuToolGuessUnclosedBlockClicked;
mnuTools.Add(itmToolGuessUnclosedBlockCheck);
itmToolBuildLazarus := TMenuItem.Create(Self);
itmToolBuildLazarus.Name:='itmToolBuildLazarus';
itmToolBuildLazarus.Caption := 'Build Lazarus';
itmToolBuildLazarus.OnClick := @mnuToolBuildLazarusClicked;
mnuTools.Add(itmToolBuildLazarus);
itmToolConfigureBuildLazarus := TMenuItem.Create(Self);
itmToolConfigureBuildLazarus.Name:='itmToolConfigureBuildLazarus';
itmToolConfigureBuildLazarus.Caption := 'Configure "Build Lazarus"';
itmToolConfigureBuildLazarus.OnClick := @mnuToolConfigBuildLazClicked;
mnuTools.Add(itmToolConfigureBuildLazarus);
//--------------
// Environment
@ -1803,6 +1829,9 @@ begin
ecGuessUnclosedBlock:
DoJumpToGuessedUnclosedBlock(true);
ecBuildLazarus:
DoBuildLazarus;
else
Handled:=false;
end;
@ -2137,6 +2166,17 @@ begin
DoJumpToGuessedUnclosedBlock(true);
end;
procedure TMainIDE.mnuToolBuildLazarusClicked(Sender : TObject);
begin
DoBuildLazarus;
end;
procedure TMainIDE.mnuToolConfigBuildLazClicked(Sender : TObject);
begin
if ShowConfigureBuildLazarusDlg(MiscellaneousOptions.BuildLazOpts)=mrOk then
MiscellaneousOptions.Save;
end;
//------------------------------------------------------------------------------
procedure TMainIDE.SaveDesktopSettings(
@ -4204,21 +4244,14 @@ end;
//-----------------------------------------------------------------------------
function TMainIDE.DoRunExternalTool(Index: integer): TModalResult;
var OldToolStatus: TIDEToolStatus;
begin
OldToolStatus:=ToolStatus;
try
EnvironmentOptions.ExternalTools.OnNeedsOutputFilter:=
@OnExtToolNeedsOutputFilter;
Result:=EnvironmentOptions.ExternalTools.Run(Index,MacroList);
except
on e: EOutputFilterError do begin
DoJumpToCompilerMessage(-1,true);
Result:=mrCancel;
end;
end;
if (OldToolStatus=itNone) and (ToolStatus=itBuilder) then
ToolStatus:=itNone;
Result:=EnvironmentOptions.ExternalTools.Run(Index,MacroList);
end;
function TMainIDE.DoBuildLazarus: TModalResult;
begin
Result:=BuildLazarus(MiscellaneousOptions.BuildLazOpts,
EnvironmentOptions.ExternalTools,MacroList);
end;
function TMainIDE.DoCheckSyntax: TModalResult;
@ -5648,6 +5681,16 @@ begin
TheOutputFilter.OnOutputString:=@MessagesView.Add;
end;
procedure TMainIDE.OnExtToolFreeOutputFilter(OutputFilter: TOutputFilter;
ErrorOccurred: boolean);
begin
if ToolStatus=itBuilder then
ToolStatus:=itNone;
if ErrorOccurred then
DoJumpToCompilerMessage(-1,true);
end;
//-----------------------------------------------------------------------------
initialization
@ -5664,6 +5707,9 @@ end.
=======
$Log$
Revision 1.206 2002/01/24 14:12:52 lazarus
MG: added build lazarus feature and config dialog
Revision 1.205 2002/01/23 22:12:54 lazarus
MG: external tool output parsing for fpc and make messages
@ -5713,6 +5759,9 @@ end.
<<<<<<< main.pp
$Log$
Revision 1.206 2002/01/24 14:12:52 lazarus
MG: added build lazarus feature and config dialog
Revision 1.205 2002/01/23 22:12:54 lazarus
MG: external tool output parsing for fpc and make messages

133
ide/miscoptions.pas Normal file
View File

@ -0,0 +1,133 @@
{
/***************************************************************************
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************/
Author: Mattias Gaertner
Abstract:
Miscellaneous options of the lazarus IDE.
}
unit MiscOptions;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, BuildLazDialog, LazConf, IDEProcs, XMLCfg;
type
TMiscellaneousOptions = class
private
fBuildLazOpts: TBuildLazarusOptions;
fFilename: string;
function GetFilename: string;
public
constructor Create;
destructor Destroy; override;
procedure Load;
procedure Save;
property BuildLazOpts: TBuildLazarusOptions
read fBuildLazOpts write fBuildLazOpts;
property Filename: string read GetFilename;
end;
var MiscellaneousOptions: TMiscellaneousOptions;
implementation
const
MiscOptsFilename = 'miscellaneousoptions.xml';
MiscOptsVersion = 1;
{ TMiscellaneousOptions }
constructor TMiscellaneousOptions.Create;
begin
inherited Create;
BuildLazOpts:=TBuildLazarusOptions.Create;
end;
destructor TMiscellaneousOptions.Destroy;
begin
BuildLazOpts.Free;
inherited Destroy;
end;
function TMiscellaneousOptions.GetFilename: string;
var
ConfFileName: string;
begin
if fFilename='' then begin
ConfFileName:=SetDirSeparators(GetPrimaryConfigPath+'/'+MiscOptsFilename);
CopySecondaryConfigFile(MiscOptsFilename);
if (not FileExists(ConfFileName)) then begin
writeln('Note: miscellaneous options file not found - using defaults');
end;
FFilename:=ConfFilename;
end;
Result:=fFilename;
end;
procedure TMiscellaneousOptions.Load;
var XMLConfig: TXMLConfig;
FileVersion: integer;
begin
try
XMLConfig:=TXMLConfig.Create(GetFilename);
except
writeln('Error: unable to open miscellaneous options "',GetFilename,'"');
exit;
end;
try
try
FileVersion:=XMLConfig.GetValue('MiscellaneousOptions/Version/Value',0);
if FileVersion<MiscOptsVersion then
writeln('Note: converting old miscellaneous options ...');
BuildLazOpts.Load(XMLConfig,'MiscellaneousOptions/BuildLazarusOptions/');
finally
XMLConfig.Free;
end;
except
writeln('Error: unable read miscellaneous options from "',GetFilename,'"');
end;
end;
procedure TMiscellaneousOptions.Save;
var XMLConfig: TXMLConfig;
begin
try
XMLConfig:=TXMLConfig.Create(GetFilename);
except
writeln('Error: unable to open miscellaneous options "',GetFilename,'"');
exit;
end;
try
try
XMLConfig.SetValue('MiscellaneousOptions/Version/Value',MiscOptsVersion);
BuildLazOpts.Save(XMLConfig,'MiscellaneousOptions/BuildLazarusOptions/');
XMLConfig.Flush;
finally
XMLConfig.Free;
end;
except
writeln('Error: unable read miscellaneous options from "',GetFilename,'"');
end;
end;
end.