paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-28 19:02:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: added add to/remove from project, small bugfixes

Browse Source 
git-svn-id: trunk@254 -
This commit is contained in:
lazarus 2001-04-04 12:20:35 +00:00
parent 8524e2e580
commit ff15c0780a
8 changed files with 228 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -28,7 +28,6 @@ designer/bookmark.lrs svneol=native#text/pascal
designer/controlselection.pp svneol=native#text/pascal
designer/customeditor.pp svneol=native#text/pascal
designer/designer.pp svneol=native#text/pascal
designer/designerwidget.pp svneol=native#text/pascal
designer/filesystem.pp svneol=native#text/pascal
designer/jitforms.pp svneol=native#text/pascal
designer/lazarus_control_images.lrs svneol=native#text/pascal
@ -36,7 +35,6 @@ designer/objectinspector.pp svneol=native#text/pascal
designer/propedits.pp svneol=native#text/pascal
designer/scalecompsdlg.pp svneol=native#text/pascal
designer/sizecompsdlg.pp svneol=native#text/pascal
designer/widgetstack.pp svneol=native#text/pascal
examples/bitbtnform.pp svneol=native#text/pascal
examples/bitbutton.pp svneol=native#text/pascal
examples/checkbox.pp svneol=native#text/pascal

47
designer/designerwidget.pp
View File

@ -1,47 +0,0 @@
{ /***************************************************************************
designerwidget.pp - Designer Widget Stack
-------------------
Implements a widget list created by TDesigner.
Initial Revision : Sat May 10 23:15:32 CST 1999
***************************************************************************/
/***************************************************************************
* *
* 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. *
* *
***************************************************************************/
}
unit designerwidget;
{$mode objfpc}
interface
uses
classes, controls;
type
TDesignerWidget = class(TObject)
private
FWidget: TControl;
public
procedure AddWidget(wcontrol: TControl);
end;
implementation
procedure AddWidget(wcontrol: TControl);
begin
end;
end.

60
designer/widgetstack.pp
View File

@ -1,60 +0,0 @@
{ /***************************************************************************
widgetstack.pp - Designer Widget Stack
-------------------
Implements a widget list created by TDesigner.
Initial Revision : Sat May 10 23:15:32 CST 1999
***************************************************************************/
/***************************************************************************
* *
* 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. *
* *
***************************************************************************/
}
unit widgetstack;
{$mode objfpc}
interface
uses
classes, designerwidget;
type
TWidgetStack = class(TObject)
public
procedure AddControl(widget:TDesignerWidget);
function GetControlByName(const wname: string):TDesignerWidget;
function GetControlByIndex(const windex: integer):TDesignerWidget;
function GetControlCount:integer;
end;
implementation
procedure AddControl(widget:TDesignerWidget);
begin
end;
function GetControlByName(const wname: string):TDesignerWidget;
begin
end;
function GetControlByIndex(const windex: integer):TDesignerWidget;
begin
end;
function GetControlCount:integer;
begin
end;
end.

50
ide/compiler.pp
View File

@ -254,6 +254,10 @@ function TCompiler.GetSourcePosition(Line: string; var Filename:string;
var CaretXY: TPoint; var MsgType: TErrorType): boolean;
{This assumes the line will have the format
<filename>(123,45) <ErrorType>: <some text>
ToDo: parse format:
<filename>(456) <ErrorType>: <some text> in line (123)
}
var StartPos, EndPos: integer;
begin
@ -270,18 +274,37 @@ begin
while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
if EndPos>length(Line) then exit;
CaretXY.Y:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
// read column
StartPos:=EndPos+1;
EndPos:=StartPos;
while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
if EndPos>length(Line) then exit;
CaretXY.X:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
// read error type
StartPos:=EndPos+2;
while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos);
if EndPos>length(Line) then exit;
MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos));
Result:=true;
if Line[EndPos]=',' then begin
// format: <filename>(123,45) <ErrorType>: <some text>
// read column
StartPos:=EndPos+1;
EndPos:=StartPos;
while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
if EndPos>length(Line) then exit;
CaretXY.X:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
// read error type
StartPos:=EndPos+2;
while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos);
if EndPos>length(Line) then exit;
MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos));
Result:=true;
end else if Line[EndPos]=')' then begin
// <filename>(456) <ErrorType>: <some text> in line (123)
// read error type
StartPos:=EndPos+2;
while (EndPos<=length(Line)) and (Line[EndPos]<>':') do inc(EndPos);
if EndPos>length(Line) then exit;
MsgType:=ErrorTypeNameToType(copy(Line,StartPos,EndPos-StartPos));
// read second linenumber (more useful)
while (EndPos<=length(Line)) and (Line[EndPos]<>'(') do inc(EndPos);
if EndPos>length(Line) then exit;
StartPos:=EndPos+1;
EndPos:=StartPos;
while (EndPos<=length(Line)) and (Line[EndPos] in ['0'..'9']) do inc(EndPos);
if EndPos>length(Line) then exit;
CaretXY.Y:=StrToIntDef(copy(Line,StartPos,EndPos-StartPos),-1);
Result:=true;
end;
end;
@ -289,6 +312,9 @@ end.
{
$Log$
Revision 1.12 2001/04/04 12:20:34 lazarus
MG: added add to/remove from project, small bugfixes
Revision 1.11 2001/03/31 13:35:22 lazarus
MG: added non-visual-component code to IDE and LCL

44
ide/ideprocs.pp
View File

@ -14,8 +14,50 @@ const
// ToDo: find the constant in the fpc units.
EndOfLine:shortstring={$IFDEF win32}#13+{$ENDIF}#10;
function FilenameIsAbsolute(TheFilename: string):boolean;
function DirectoryExists(DirectoryName: string): boolean;
function ForceDirectory(DirectoryName: string): boolean;
implementation
function FilenameIsAbsolute(TheFilename: string):boolean;
begin
DoDirSeparators(TheFilename);
{$IFDEF win32}
// windows
Result:=(copy(TheFilename,1,2)='\\') or ((length(TheFilename)>3) and
(upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\'));
{$ELSE}
Result:=(TheFilename<>'') and (TheFilename[1]='/');
{$ENDIF}
end;
function DirectoryExists(DirectoryName: string): boolean;
var sr: TSearchRec;
begin
if FindFirst(DirectoryName,faAnyFile,sr)=0 then
Result:=((sr.Attr and faDirectory)>0)
else
Result:=false;
FindClose(sr);
end;
function ForceDirectory(DirectoryName: string): boolean;
var i: integer;
Dir: string;
begin
DoDirSeparators(DirectoryName);
i:=1;
while i<=length(DirectoryName) do begin
if DirectoryName[i]=OSDirSeparator then begin
Dir:=copy(DirectoryName,1,i-1);
if not DirectoryExists(Dir) then begin
Result:=CreateDir(Dir);
if not Result then exit;
end;
end;
end;
Result:=true;
end;
end.

156
ide/main.pp
View File

@ -32,7 +32,7 @@ uses
CodeTools, MsgView, NewProjectDlg, Process, IDEComp, AbstractFormEditor,
FormEditor, CustomFormEditor, ObjectInspector, ControlSelection, PropEdits,
UnitEditor, CompilerOptions, EditorOptions, EnvironmentOpts, TransferMacros,
KeyMapping, ProjectOpts;
KeyMapping, ProjectOpts, IDEProcs;
const
Version_String = '0.7';
@ -86,6 +86,8 @@ type
itmProjectOpen: TMenuItem;
itmProjectSave: TMenuItem;
itmProjectSaveAs: TMenuItem;
itmProjectAddTo: TMenuItem;
itmProjectRemoveFrom: TMenuItem;
itmProjectViewSource: TMenuItem;
itmProjectBuild: TMenuItem;
itmProjectRun: TMenuItem;
@ -146,6 +148,8 @@ type
procedure mnuOpenProjectClicked(Sender : TObject);
procedure mnuSaveProjectClicked(Sender : TObject);
procedure mnuSaveProjectAsClicked(Sender : TObject);
procedure mnuAddToProjectClicked(Sender : TObject);
procedure mnuRemoveFromProjectClicked(Sender : TObject);
procedure mnuViewProjectSourceClicked(Sender : TObject);
procedure mnuBuildProjectClicked(Sender : TObject);
procedure mnuRunProjectClicked(Sender : TObject);
@ -221,6 +225,8 @@ type
function DoSaveProject(SaveAs:boolean):TModalResult;
function DoCloseProject:TModalResult;
function DoOpenProjectFile(AFileName:string):TModalResult;
function DoAddActiveUnitToProject: TModalResult;
function DoRemoveFromProjectDialog: TModalResult;
function DoBuildProject: TModalResult;
function SomethingOfProjectIsModified: boolean;
function DoCreateProjectForProgram(ProgramFilename
@ -290,7 +296,7 @@ var
implementation
uses
ViewUnit_dlg, ViewForm_dlg, Math,LResources, Designer;
ViewUnit_dlg, Math, LResources, Designer;
{ TMainIDE }
@ -961,6 +967,20 @@ begin
mnuProject.Add(CreateSeperator);
itmProjectAddTo := TMenuItem.Create(Self);
itmProjectAddTo.Name:='itmProjectAddTo';
itmProjectAddTo.Caption := 'Add active unit to Project';
itmProjectAddTo.OnClick := @mnuAddToProjectClicked;
mnuProject.Add(itmProjectAddTo);
itmProjectRemoveFrom := TMenuItem.Create(Self);
itmProjectRemoveFrom.Name:='itmProjectRemoveFrom';
itmProjectRemoveFrom.Caption := 'Remove from Project';
itmProjectRemoveFrom.OnClick := @mnuRemoveFromProjectClicked;
mnuProject.Add(itmProjectRemoveFrom);
mnuProject.Add(CreateSeperator);
itmProjectViewSource := TMenuItem.Create(Self);
itmProjectViewSource.Name:='itmProjectViewSource';
itmProjectViewSource.Caption := 'View Source';
@ -1440,6 +1460,16 @@ begin
DoSaveProject(true);
end;
procedure TMainIDE.mnuAddToProjectClicked(Sender : TObject);
begin
DoAddActiveUnitToProject;
end;
procedure TMainIDE.mnuRemoveFromProjectClicked(Sender : TObject);
begin
DoRemoveFromProjectDialog;
end;
procedure TMainIDE.mnuViewProjectSourceClicked(Sender : TObject);
begin
DoOpenMainUnit(false);
@ -2178,7 +2208,7 @@ end;
function TMainIDE.DoViewUnitsAndForms(OnlyForms: boolean): TModalResult;
var UnitList: TList;
i, ProgramNameStart, ProgramNameEnd:integer;
MainUnitName, Ext: string;
MainUnitName, Ext, DlgCaption: string;
MainUnitInfo, AnUnitInfo: TUnitInfo;
MainUnitIndex: integer;
Begin
@ -2223,7 +2253,11 @@ Begin
end;
end;
end;
if ShowViewUnitsDlg(UnitList,true)=mrOk then begin
if OnlyForms then
DlgCaption:='View forms'
else
DlgCaption:='View units';
if ShowViewUnitsDlg(UnitList,true,DlgCaption)=mrOk then begin
for i:=0 to UnitList.Count-1 do begin
if TViewUnitsEntry(UnitList[i]).Selected then begin
AnUnitInfo:=Project.Units[TViewUnitsEntry(UnitList[i]).ID];
@ -2617,6 +2651,102 @@ writeln('[TMainIDE.DoCreateProjectForProgram] END');
Result:=mrOk;
end;
function TMainIDE.DoAddActiveUnitToProject: TModalResult;
var
ActiveSourceEditor:TSourceEditor;
ActiveUnitInfo:TUnitInfo;
s, ShortUnitName: string;
UnitNameStart, UnitNameEnd: integer;
begin
Result:=mrCancel;
GetCurrentUnit(ActiveSourceEditor,ActiveUnitInfo);
if ActiveUnitInfo<>nil then begin
if ActiveUnitInfo.IsPartOfProject=false then begin
if ActiveUnitInfo.Filename<>'' then
s:='"'+ActiveUnitInfo.Filename+'"'
else
s:='"'+SourceNotebook.Notebook.Pages[SourceNotebook.Notebook.PageIndex]
+'"';
if (Project.ProjectType in [ptProgram, ptApplication])
and (ActiveUnitInfo.UnitName<>'')
and (Project.IndexOfUnitWithName(ActiveUnitInfo.UnitName,true)>=0) then begin
MessageDlg('Unable to add '+s+' to project, because there is already a '
+'unit with the same name in the project.',mtInformation,[mbOk],0);
end else begin
if MessageDlg('Add '+s+' to project?',mtConfirmation,[mbOk,mbCancel],0)
=mrOk then
begin
ActiveUnitInfo.IsPartOfProject:=true;
if (ActiveUnitInfo.UnitName<>'')
and (Project.ProjectType in [ptProgram, ptApplication]) then begin
ShortUnitName:=FindUnitNameInSource(ActiveUnitInfo.Source.Source,
UnitNameStart,UnitNameEnd);
if ShortUnitName='' then ShortUnitName:=ActiveUnitInfo.UnitName;
if (ShortUnitName<>'') then
AddToProgramUsesSection(Project.Units[Project.MainUnit].Source
,ShortUnitName,'');
end;
Project.Modified:=true;
end;
end;
end else begin
if ActiveUnitInfo.Filename<>'' then
s:='The file "'+ActiveUnitInfo.Filename+'"'
else
s:='The file "'
+SourceNotebook.Notebook.Pages[SourceNotebook.Notebook.PageIndex]
+'"';
s:=s+' is already part of the project.';
MessageDlg(s,mtInformation,[mbOk],0);
end;
end else begin
Result:=mrOk;
end;
end;
function TMainIDE.DoRemoveFromProjectDialog: TModalResult;
var UnitList: TList;
i:integer;
AName: string;
AnUnitInfo: TUnitInfo;
Begin
UnitList:=TList.Create;
try
for i:=0 to Project.UnitCount-1 do begin
AnUnitInfo:=Project.Units[i];
if (AnUnitInfo.IsPartOfProject) and (i<>Project.MainUnit) then begin
AName:=AnUnitInfo.FileName;
if (AName='') and (AnUnitInfo.Loaded) then begin
AName:=SourceNotebook.NoteBook.Pages[AnUnitInfo.EditorIndex];
end;
if AName<>'' then
UnitList.Add(TViewUnitsEntry.Create(AName,i,false));
end;
end;
if ShowViewUnitsDlg(UnitList,true,'Remove from project')=mrOk then begin
for i:=0 to UnitList.Count-1 do begin
if TViewUnitsEntry(UnitList[i]).Selected then begin
AnUnitInfo:=Project.Units[TViewUnitsEntry(UnitList[i]).ID];
AnUnitInfo.IsPartOfProject:=false;
if (Project.MainUnit>=0)
and (Project.ProjectType in [ptProgram, ptApplication]) then begin
if (AnUnitInfo.UnitName<>'') then
RemoveFromProgramUsesSection(
Project.Units[Project.MainUnit].Source,AnUnitInfo.UnitName);
if (AnUnitInfo.FormName<>'') then
Project.RemoveCreateFormFromProjectFile(
'T'+AnUnitInfo.FormName,AnUnitInfo.FormName);
UpdateMainUnitSrcEdit;
end;
end;
end;
end;
finally
UnitList.Free;
end;
Result:=mrOk;
end;
function TMainIDE.DoBuildProject: TModalResult;
var ActiveSrcEdit: TSourceEditor;
begin
@ -3015,20 +3145,6 @@ end;
function TMainIDE.DoJumpToCompilerMessage(Index:integer;
FocusEditor: boolean): boolean;
function FilenameIsAbsolute(TheFilename: string):boolean;
begin
DoDirSeparators(TheFilename);
{$IFDEF linux}
Result:=(TheFilename<>'') and (TheFilename[1]='/');
{$ELSE}
// windows
Result:=(copy(TheFilename,1,2)='\\') or ((length(TheFilename)>3) and
(upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\'));
{$ENDIF}
end;
// TMainIDE.DoJumpToCompilerMessage
var MaxMessages: integer;
Filename, Ext: string;
CaretXY: TPoint;
@ -3257,8 +3373,8 @@ end.
{ =============================================================================
$Log$
Revision 1.87 2001/04/03 12:14:43 lazarus
MG: added project options
Revision 1.88 2001/04/04 12:20:34 lazarus
MG: added add to/remove from project, small bugfixes
Revision 1.86 2001/03/31 13:35:22 lazarus
MG: added non-visual-component code to IDE and LCL

20
ide/project.pp
View File

@ -20,7 +20,6 @@
***************************************************************************/
}
unit project;
{$mode objfpc}{$H+}
@ -33,7 +32,7 @@ interface
uses
Classes, SysUtils, LCLLinux, XMLCfg, LazConf, CompilerOptions, FileCtrl,
CodeTools, Forms, Controls, EditorOptions, Dialogs;
CodeTools, Forms, Controls, EditorOptions, Dialogs, IDEProcs;
type
//---------------------------------------------------------------------------
@ -1331,20 +1330,6 @@ begin
end;
procedure TProject.OnLoadSaveFilename(var AFilename:string; Load:boolean);
function FilenameIsAbsolute(TheFilename: string):boolean;
begin
DoDirSeparators(TheFilename);
{$IFDEF linux}
Result:=(TheFilename='') or (TheFilename[1]='/');
{$ELSE}
// windows
Result:=(length(TheFilename)<3) or (copy(TheFilename,1,2)='\\')
or ((upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\'));
{$ENDIF}
end;
// OnLoadSaveFilename
var ProjectPath:string;
begin
ProjectPath:=ExtractFilePath(ProjectFile);
@ -1397,6 +1382,9 @@ end.
{
$Log$
Revision 1.19 2001/04/04 12:20:34 lazarus
MG: added add to/remove from project, small bugfixes
Revision 1.18 2001/03/29 12:38:59 lazarus
MG: new environment opts, ptApplication bugfixes

9
ide/viewunit_dlg.pp
View File

@ -49,7 +49,8 @@ type
end;
function ShowViewUnitsDlg(Entries: TList; MultiSelect: boolean): TModalResult;
function ShowViewUnitsDlg(Entries: TList; MultiSelect: boolean;
Caption: string): TModalResult;
// Entries is a list of TViewUnitsEntry(s)
@ -57,12 +58,13 @@ implementation
function ShowViewUnitsDlg(Entries: TList;
MultiSelect: boolean): TModalResult;
MultiSelect: boolean; Caption: string): TModalResult;
var ViewUnits: TViewUnits;
i: integer;
begin
ViewUnits:=TViewUnits.Create(Application);
try
ViewUnits.Caption:=Caption;
ViewUnits.ListBox.Visible:=false;
ViewUnits.ListBox.MultiSelect:=MultiSelect;
with ViewUnits.ListBox.Items do begin
@ -169,6 +171,9 @@ initialization
end.
{
$Log$
Revision 1.8 2001/04/04 12:20:34 lazarus
MG: added add to/remove from project, small bugfixes
Revision 1.7 2001/03/08 15:59:06 lazarus
IDE bugfixes and viewunit/forms functionality