mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 12:19:26 +02:00
added some project flags to start getting rid of TProjectType
git-svn-id: trunk@5900 -
This commit is contained in:
mattias
parent
ca675e25c7
commit
4ec908a9f7
25
ide/main.pp
25
ide/main.pp
@ -4131,8 +4131,8 @@ begin
|
||||
AText:=Format(lisAFileAlreadyExistsReplaceIt, ['"', NewFilename, '"', #13]);
|
||||
Result:=MessageDlg(ACaption, AText, mtConfirmation, [mbOk, mbCancel], 0);
|
||||
if Result=mrCancel then exit;
|
||||
end else if Project1.ProjectType in [ptProgram,ptApplication]
|
||||
then begin
|
||||
end
|
||||
else begin
|
||||
if FileExists(NewProgramFilename) then begin
|
||||
ACaption:=lisOverwriteFile;
|
||||
AText:=Format(lisAFileAlreadyExistsReplaceIt, ['"', NewProgramFilename,
|
||||
@ -4927,9 +4927,8 @@ Begin
|
||||
Project1.Units[i].UnitName,i,Project1.Units[i]=ActiveUnitInfo));
|
||||
end else if Project1.MainUnitID=i then begin
|
||||
MainUnitInfo:=Project1.MainUnitInfo;
|
||||
if Project1.ProjectType in [ptProgram,ptApplication,ptCustomProgram]
|
||||
then begin
|
||||
MainUnitName:=CreateSrcEditPageName(MainUnitInfo.UnitName,
|
||||
if pfMainUnitIsPascalSource in Project1.Flags then begin
|
||||
MainUnitName:=CreateSrcEditPageName('',
|
||||
MainUnitInfo.Filename,MainUnitInfo.EditorIndex);
|
||||
if MainUnitName<>'' then begin
|
||||
UnitList.Add(TViewUnitsEntry.Create(
|
||||
@ -5768,8 +5767,7 @@ begin
|
||||
s:='"'+ActiveUnitInfo.Filename+'"'
|
||||
else
|
||||
s:='"'+ActiveSourceEditor.PageName+'"';
|
||||
if (Project1.ProjectType in [ptProgram, ptApplication])
|
||||
and (ActiveUnitInfo.UnitName<>'')
|
||||
if (ActiveUnitInfo.UnitName<>'')
|
||||
and (Project1.IndexOfUnitWithName(ActiveUnitInfo.UnitName,
|
||||
true,ActiveUnitInfo)>=0) then
|
||||
begin
|
||||
@ -5786,7 +5784,7 @@ begin
|
||||
if Result<>mrOk then exit;
|
||||
ActiveUnitInfo.IsPartOfProject:=true;
|
||||
if (FilenameIsPascalUnit(ActiveUnitInfo.Filename))
|
||||
and (Project1.ProjectType in [ptProgram,ptApplication])
|
||||
and (pfMainUnitHasUsesSectionForAllUnits in Project1.Flags)
|
||||
then begin
|
||||
ActiveUnitInfo.ReadUnitNameFromSource(false);
|
||||
ShortUnitName:=ActiveUnitInfo.CreateUnitName;
|
||||
@ -5834,7 +5832,7 @@ Begin
|
||||
AnUnitInfo:=Project1.Units[TViewUnitsEntry(UnitList[i]).ID];
|
||||
AnUnitInfo.IsPartOfProject:=false;
|
||||
if (Project1.MainUnitID>=0)
|
||||
and (Project1.ProjectType in [ptProgram,ptApplication])
|
||||
and (pfMainUnitHasUsesSectionForAllUnits in Project1.Flags)
|
||||
then begin
|
||||
if (AnUnitInfo.UnitName<>'') then begin
|
||||
if CodeToolBoss.RemoveUnitFromAllUsesSections(
|
||||
@ -6046,7 +6044,7 @@ begin
|
||||
Result := mrCancel;
|
||||
|
||||
// Check if we can run this project
|
||||
if not (Project1.ProjectType in [ptProgram, ptApplication, ptCustomProgram])
|
||||
if (not (pfRunnable in Project1.Flags))
|
||||
or (Project1.MainUnitID < 0)
|
||||
then Exit;
|
||||
|
||||
@ -9986,7 +9984,7 @@ begin
|
||||
BeginCodeTool(ActiveSourceEditor,ActiveUnitInfo,[]);
|
||||
AnUnitInfo.IsPartOfProject:=true;
|
||||
if FilenameIsPascalUnit(AnUnitInfo.Filename)
|
||||
and (Project1.ProjectType in [ptProgram, ptApplication])
|
||||
and (pfMainUnitHasUsesSectionForAllUnits in Project1.Flags)
|
||||
then begin
|
||||
AnUnitInfo.ReadUnitNameFromSource(false);
|
||||
ShortUnitName:=AnUnitInfo.UnitName;
|
||||
@ -10016,7 +10014,7 @@ begin
|
||||
Result:=mrOk;
|
||||
AnUnitInfo.IsPartOfProject:=false;
|
||||
if (Project1.MainUnitID>=0)
|
||||
and (Project1.ProjectType in [ptProgram, ptApplication])
|
||||
and (pfMainUnitHasUsesSectionForAllUnits in Project1.Flags)
|
||||
then begin
|
||||
BeginCodeTool(ActiveSourceEditor,ActiveUnitInfo,[]);
|
||||
ShortUnitName:=AnUnitInfo.UnitName;
|
||||
@ -10638,6 +10636,9 @@ end.
|
||||
|
||||
{ =============================================================================
|
||||
$Log$
|
||||
Revision 1.765 2004/09/01 10:25:58 mattias
|
||||
added some project flags to start getting rid of TProjectType
|
||||
|
||||
Revision 1.764 2004/09/01 09:43:24 mattias
|
||||
implemented registration of project file types
|
||||
|
||||
|
||||
@ -287,7 +287,10 @@ type
|
||||
|
||||
TProjectFlag = (
|
||||
pfSaveClosedUnits, // save info about closed files (not part of project)
|
||||
pfSaveOnlyProjectUnits // save no info about foreign files
|
||||
pfSaveOnlyProjectUnits, // save no info about foreign files
|
||||
pfMainUnitIsPascalSource,// main unit is pascal, even it does not end in .pas/.pp
|
||||
pfMainUnitHasUsesSectionForAllUnits,// add/remove pascal units to main uses section
|
||||
pfRunnable // project can be run
|
||||
);
|
||||
TProjectFlags = set of TProjectFlag;
|
||||
|
||||
@ -322,7 +325,7 @@ type
|
||||
fJumpHistory: TProjectJumpHistory;
|
||||
fLastReadLPIFileDate: TDateTime;
|
||||
fLastReadLPIFilename: string;
|
||||
fMainUnitID: Integer; // only for ptApplication, ptProgram, ptCGIApplication
|
||||
fMainUnitID: Integer;
|
||||
fModified: boolean;
|
||||
FOnBeginUpdate: TNotifyEvent;
|
||||
FOnEndUpdate: TEndUpdateProjectEvent;
|
||||
@ -546,9 +549,12 @@ const
|
||||
'.lpr','.pas','.pas'
|
||||
);
|
||||
|
||||
DefaultProjectFlags = [pfSaveClosedUnits];
|
||||
DefaultProjectFlags = [pfSaveClosedUnits,pfMainUnitIsPascalSource,
|
||||
pfMainUnitHasUsesSectionForAllUnits,pfRunnable];
|
||||
ProjectFlagNames : array[TProjectFlag] of string = (
|
||||
'SaveClosedFiles', 'SaveOnlyProjectUnits'
|
||||
'SaveClosedFiles', 'SaveOnlyProjectUnits',
|
||||
'MainUnitIsPascalSource', 'MainUnitHasUsesSectionForAllUnits',
|
||||
'Runnable'
|
||||
);
|
||||
|
||||
function ProjectTypeNameToType(const s:string): TProjectType;
|
||||
@ -558,7 +564,7 @@ function ProjectFlagsToStr(Flags: TProjectFlags): string;
|
||||
implementation
|
||||
|
||||
const
|
||||
ProjectInfoFileVersion = 3;
|
||||
ProjectInfoFileVersion = 4;
|
||||
|
||||
function ProjectFlagsToStr(Flags: TProjectFlags): string;
|
||||
var f: TProjectFlag;
|
||||
@ -1191,27 +1197,24 @@ begin
|
||||
|
||||
// create program source
|
||||
NewSource:=TStringList.Create;
|
||||
case fProjectType of
|
||||
case ProjectType of
|
||||
ptProgram, ptApplication, ptCustomProgram:
|
||||
begin
|
||||
NewPrgBuf:=CodeToolBoss.CreateFile(
|
||||
'project1'+ProjectDefaultExt[fProjectType]);
|
||||
'project1'+ProjectDefaultExt[ProjectType]);
|
||||
PrgUnitInfo:=TUnitInfo.Create(NewPrgBuf);
|
||||
PrgUnitInfo.IsPartOfProject:=true;
|
||||
PrgUnitInfo.SyntaxHighlighter:=
|
||||
ExtensionToLazSyntaxHighlighter(ProjectDefaultExt[fProjectType]);
|
||||
ExtensionToLazSyntaxHighlighter(ProjectDefaultExt[ProjectType]);
|
||||
AddUnit(PrgUnitInfo,false);
|
||||
MainUnitID:=0;
|
||||
with NewSource do begin
|
||||
Add('program Project1;');
|
||||
Add('');
|
||||
Add('{$mode objfpc}{$H+}');
|
||||
// This results in crashing programs, when stdout is not open
|
||||
//if fProjectType in [ptApplication] then
|
||||
// Add('{$AppType Gui} // for win32 applications');
|
||||
Add('');
|
||||
Add('uses');
|
||||
case fProjectType of
|
||||
case ProjectType of
|
||||
ptProgram, ptCustomProgram:
|
||||
Add(' Classes;');
|
||||
ptApplication:
|
||||
@ -1224,7 +1227,7 @@ begin
|
||||
end;
|
||||
Add('');
|
||||
Add('begin');
|
||||
case fProjectType of
|
||||
case ProjectType of
|
||||
ptApplication:
|
||||
begin
|
||||
Add(' Application.Initialize;');
|
||||
@ -1455,6 +1458,12 @@ var
|
||||
end;
|
||||
|
||||
procedure LoadFlags;
|
||||
|
||||
procedure SetFlag(f: TProjectFlag; Value: boolean);
|
||||
begin
|
||||
if Value then Include(FFlags,f) else Exclude(FFlags,f);
|
||||
end;
|
||||
|
||||
var f: TProjectFlag;
|
||||
begin
|
||||
FFlags:=[];
|
||||
@ -1466,6 +1475,14 @@ var
|
||||
else
|
||||
Exclude(FFlags,f);
|
||||
end;
|
||||
if FileVersion<=3 then begin
|
||||
// set new flags
|
||||
SetFlag(pfMainUnitIsPascalSource,
|
||||
ProjectType in [ptProgram,ptApplication]);
|
||||
SetFlag(pfMainUnitHasUsesSectionForAllUnits,
|
||||
ProjectType in [ptProgram,ptApplication]);
|
||||
SetFlag(pfRunnable,ProjectType in [ptProgram,ptApplication,ptCustomProgram]);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
@ -2451,8 +2468,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if (OldUnitName<>'')
|
||||
and (ProjectType in [ptProgram, ptApplication]) then
|
||||
if (OldUnitName<>'') and (pfMainUnitHasUsesSectionForAllUnits in Flags) then
|
||||
begin
|
||||
// rename unit in program uses section
|
||||
CodeToolBoss.RenameUsedUnit(MainUnitInfo.Source
|
||||
@ -2802,6 +2818,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.160 2004/09/01 10:25:58 mattias
|
||||
added some project flags to start getting rid of TProjectType
|
||||
|
||||
Revision 1.159 2004/09/01 09:43:24 mattias
|
||||
implemented registration of project file types
|
||||
|
||||
|
||||
@ -243,7 +243,7 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
function TCustomComboBox.GetSelText: string;
|
||||
begin
|
||||
debugln('TCustomComboBox.GetSelText ');
|
||||
//debugln('TCustomComboBox.GetSelText ');
|
||||
if FStyle in [csDropDown, csSimple] then
|
||||
Result:= Copy(Text, SelStart, SelLength)
|
||||
else
|
||||
@ -261,7 +261,7 @@ procedure TCustomComboBox.SetSelText(const Val: string);
|
||||
var
|
||||
OldText, NewText: string;
|
||||
begin
|
||||
debugln('TCustomComboBox.SetSelText ',Val);
|
||||
//debugln('TCustomComboBox.SetSelText ',Val);
|
||||
if FStyle in [csDropDown, csSimple] then begin
|
||||
OldText:=Text;
|
||||
NewText:=LeftStr(OldText,SelStart-1)+Val
|
||||
@ -337,7 +337,7 @@ procedure TCustomComboBox.SelectAll;
|
||||
var
|
||||
CurText: String;
|
||||
begin
|
||||
debugln('TCustomComboBox.SelectAll ');
|
||||
//debugln('TCustomComboBox.SelectAll ');
|
||||
if (FStyle in [csDropDown, csSimple]) then begin
|
||||
CurText:=Text;
|
||||
if (CurText <> '') then begin
|
||||
@ -409,7 +409,7 @@ begin
|
||||
end;
|
||||
|
||||
if Style=csDropDownList then begin
|
||||
debugln('TCustomComboBox.KeyDown ');
|
||||
//debugln('TCustomComboBox.KeyDown ');
|
||||
// DropDownList: allow only navigation keys
|
||||
if not (Key in [VK_UP,VK_DOWN,VK_END,VK_HOME,VK_PRIOR,VK_NEXT,VK_TAB,
|
||||
VK_RETURN])
|
||||
@ -799,6 +799,9 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.44 2004/09/01 10:25:58 mattias
|
||||
added some project flags to start getting rid of TProjectType
|
||||
|
||||
Revision 1.43 2004/08/30 10:49:20 mattias
|
||||
fixed focus catch for combobox csDropDownList
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user