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

implemented registration of project file types

Browse Source 
git-svn-id: trunk@5899 -
This commit is contained in:
mattias 2004-09-01 09:43:24 +00:00
parent 221d6ae2e6
commit ca675e25c7
11 changed files with 599 additions and 425 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
ide/ideprocs.pp
View File

@ -85,7 +85,6 @@ function CompareFilenames(const Filename1, Filename2: string;
function FilenameIsMatching(const Mask, Filename: string;
MatchExactly: boolean): boolean;
function ConvertSpecialFileChars(const Filename: string): string;
function FilenameIsPascalUnit(const Filename: string): boolean;
function FilenameIsPascalSource(const Filename: string): boolean;
function FilenameIsFormText(const Filename: string): boolean;
function CreateRelativePath(const Filename, BaseDirectory: string): string;
@ -305,14 +304,6 @@ begin
until not FileExists(Result);
end;
function FilenameIsPascalUnit(const Filename: string): boolean;
var Ext: string;
begin
Ext:=lowercase(ExtractFileExt(Filename));
Result:=((Ext='.pp') or (Ext='.pas'))
and (ExtractFileNameOnly(Filename)<>'');
end;
function FilenameIsFormText(const Filename: string): boolean;
var Ext: string;
begin

148
ide/main.pp
View File

@ -71,8 +71,8 @@ uses
// compile
Compiler, CompilerOptions, CheckCompilerOpts, ImExportCompilerOpts,
// projects
Project, ProjectDefs, NewProjectDlg, ProjectOpts, PublishProjectDlg,
ProjectInspector,
ProjectIntf, Project, ProjectDefs, NewProjectDlg, ProjectOpts,
PublishProjectDlg, ProjectInspector,
// help manager
HelpManager,
// designer
@ -462,11 +462,11 @@ type
procedure ReOpenIDEWindows;
// methods for 'new unit'
function CreateNewCodeBuffer(NewUnitType:TNewUnitType;
function CreateNewCodeBuffer(Descriptor: TProjectFileDescriptor;
NewFilename: string; var NewCodeBuffer: TCodeBuffer;
var NewUnitName: string): TModalResult;
function CreateNewForm(NewUnitInfo: TUnitInfo; AncestorType: TComponentClass;
ResourceCode: TCodeBuffer): TModalResult;
function CreateNewForm(NewUnitInfo: TUnitInfo;
AncestorType: TPersistentClass; ResourceCode: TCodeBuffer): TModalResult;
// methods for 'save unit'
function DoLoadResourceFile(AnUnitInfo: TUnitInfo;
@ -529,7 +529,7 @@ type
procedure UpdateDefaultPascalFileExtensions;
// files/units
function DoNewEditorFile(NewUnitType: TNewUnitType;
function DoNewEditorFile(NewFileDescriptor: TProjectFileDescriptor;
NewFilename: string; const NewSource: string;
NewFlags: TNewFlags): TModalResult; override;
function DoNewOther: TModalResult;
@ -1525,6 +1525,7 @@ var
FileDescPascalUnitWithForm: TFileDescPascalUnitWithForm;
FileDescPascalUnitWithDataModule: TFileDescPascalUnitWithDataModule;
FileDescText: TFileDescText;
FileDescSimplePascalProgram: TFileDescSimplePascalProgram;
begin
LazProjectFileDescriptors:=TLazProjectFileDescriptors.Create;
// basic pascal unit
@ -1536,6 +1537,9 @@ begin
// pascal unit with datamodule
FileDescPascalUnitWithDataModule:=TFileDescPascalUnitWithDataModule.Create;
LazProjectFileDescriptors.RegisterFileDescriptor(FileDescPascalUnitWithDataModule);
// simple pascal program
FileDescSimplePascalProgram:=TFileDescSimplePascalProgram.Create;
LazProjectFileDescriptors.RegisterFileDescriptor(FileDescSimplePascalProgram);
// empty text file
FileDescText:=TFileDescText.Create;
LazProjectFileDescriptors.RegisterFileDescriptor(FileDescText);
@ -1775,12 +1779,12 @@ end;
procedure TMainIDE.mnuNewUnitClicked(Sender : TObject);
begin
DoNewEditorFile(nuUnit,'','',[nfOpenInEditor,nfCreateDefaultSrc]);
DoNewEditorFile(FileDescriptorUnit,'','',[nfOpenInEditor,nfCreateDefaultSrc]);
end;
procedure TMainIDE.mnuNewFormClicked(Sender : TObject);
begin
DoNewEditorFile(nuForm,'','',[nfOpenInEditor,nfCreateDefaultSrc]);
DoNewEditorFile(FileDescriptorForm,'','',[nfOpenInEditor,nfCreateDefaultSrc]);
end;
procedure TMainIDE.mnuNewOtherClicked(Sender: TObject);
@ -2788,15 +2792,14 @@ begin
end;
procedure TMainIDE.UpdateDefaultPascalFileExtensions;
var nut: TNewUnitType;
var
npt: TProjectType;
DefPasExt: string;
begin
// change default pascal file extensions
DefPasExt:=PascalExtension[EnvironmentOptions.PascalFileExtension];
for nut:=Low(TNewUnitType) to High(TNewUnitType) do
if (UnitTypeDefaultExt[nut]='.pas') or (UnitTypeDefaultExt[nut]='.pp')
then UnitTypeDefaultExt[nut]:=DefPasExt;
if LazProjectFileDescriptors<>nil then
LazProjectFileDescriptors.DefaultPascalFileExt:=DefPasExt;
for npt:=Low(TProjectType) to High(TProjectType) do
if (ProjectDefaultExt[npt]='.pas') or (ProjectDefaultExt[npt]='.pp')
then ProjectDefaultExt[npt]:=DefPasExt;
@ -2956,24 +2959,33 @@ end;
//==============================================================================
function TMainIDE.CreateNewCodeBuffer(NewUnitType:TNewUnitType;
function TMainIDE.CreateNewCodeBuffer(Descriptor: TProjectFileDescriptor;
NewFilename: string;
var NewCodeBuffer: TCodeBuffer; var NewUnitName: string): TModalResult;
begin
//debugln('TMainIDE.CreateNewCodeBuffer START NewFilename=',NewFilename,' ',Descriptor.DefaultFilename,' ',Descriptor.ClassName);
NewUnitName:='';
if NewFilename='' then begin
NewUnitName:=Project1.NewUniqueUnitName(NewUnitType);
NewCodeBuffer:=CodeToolBoss.CreateFile(
NewUnitName+UnitTypeDefaultExt[NewUnitType]);
end else begin
NewUnitName:=ExtractFileNameOnly(NewFilename);
if FilenameIsPascalUnit(NewFilename) then begin
if EnvironmentOptions.PascalFileAutoLowerCase
or EnvironmentOptions.PascalFileAskLowerCase then
NewFilename:=ExtractFilePath(NewFilename)
+lowercase(ExtractFileName(NewFilename));
if Descriptor.IsPascalUnit then begin
NewUnitName:=Project1.NewUniqueUnitName(Descriptor.DefaultSourceName);
NewFilename:=lowercase(NewUnitName)+Descriptor.DefaultFileExt;
end else begin
NewFilename:=Project1.NewUniqueFilename(
ExtractFilename(Descriptor.DefaultFilename));
end;
NewCodeBuffer:=CodeToolBoss.CreateFile(NewFilename);
if NewFilename='' then
RaiseException('');
end;
//debugln('TMainIDE.CreateNewCodeBuffer NewFilename=',NewFilename,' NewUnitName=',NewUnitName);
if FilenameIsPascalUnit(NewFilename) then begin
if NewUnitName='' then
NewUnitName:=ExtractFileNameOnly(NewFilename);
if EnvironmentOptions.PascalFileAutoLowerCase
or EnvironmentOptions.PascalFileAskLowerCase then
NewFilename:=ExtractFilePath(NewFilename)
+lowercase(ExtractFileName(NewFilename));
end;
NewCodeBuffer:=CodeToolBoss.CreateFile(NewFilename);
if NewCodeBuffer<>nil then
Result:=mrOk
else
@ -2981,17 +2993,22 @@ begin
end;
function TMainIDE.CreateNewForm(NewUnitInfo: TUnitInfo;
AncestorType: TComponentClass; ResourceCode: TCodeBuffer): TModalResult;
AncestorType: TPersistentClass; ResourceCode: TCodeBuffer): TModalResult;
var
CInterface : TComponentInterface;
NewComponent: TComponent;
begin
if not AncestorType.InheritsFrom(TComponent) then
RaiseException('TMainIDE.CreateNewForm invalid AncestorType');
//debugln('TMainIDE.CreateNewForm START ',NewUnitInfo.Filename,' ',AncestorType.ClassName,' ',dbgs(ResourceCode<>nil));
// create a buffer for the new resource file and for the LFM file
if ResourceCode=nil then begin
ResourceCode:=
CodeToolBoss.CreateFile(ChangeFileExt(NewUnitInfo.Filename,
ResourceFileExt));
end;
//debugln('TMainIDE.CreateNewForm B ',ResourceCode.Filename);
ResourceCode.Source:='{ '+lisResourceFileComment+' }';
CodeToolBoss.CreateFile(ChangeFileExt(NewUnitInfo.Filename,'.lfm'));
@ -3002,7 +3019,7 @@ begin
// create jit component
CInterface := TComponentInterface(
FormEditor1.CreateComponent(nil,AncestorType,
FormEditor1.CreateComponent(nil,TComponentClass(AncestorType),
ObjectInspector1.Left+ObjectInspector1.Width+60,
MainIDEBar.Top+MainIDEBar.Height+80,
400,300));
@ -3656,10 +3673,10 @@ begin
begin
// create new file
if FilenameIsPascalSource(AFilename) then
Result:=DoNewEditorFile(nuUnit,AFilename,'',
Result:=DoNewEditorFile(FileDescriptorUnit,AFilename,'',
[nfOpenInEditor,nfCreateDefaultSrc])
else
Result:=DoNewEditorFile(nuEmpty,AFilename,'',
Result:=DoNewEditorFile(FileDescriptorText,AFilename,'',
[nfOpenInEditor,nfCreateDefaultSrc]);
end;
end;
@ -4114,7 +4131,7 @@ 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,ptCGIApplication]
end else if Project1.ProjectType in [ptProgram,ptApplication]
then begin
if FileExists(NewProgramFilename) then begin
ACaption:=lisOverwriteFile;
@ -4279,7 +4296,7 @@ begin
Result:=mrOk;
end;
function TMainIDE.DoNewEditorFile(NewUnitType:TNewUnitType;
function TMainIDE.DoNewEditorFile(NewFileDescriptor: TProjectFileDescriptor;
NewFilename: string; const NewSource: string;
NewFlags: TNewFlags): TModalResult;
@ -4294,7 +4311,7 @@ var NewUnitInfo:TUnitInfo;
NewUnitName: string;
NewBuffer: TCodeBuffer;
OldUnitIndex: Integer;
AncestorType: TComponentClass;
AncestorType: TPersistentClass;
NewResBuffer: TCodeBuffer;
begin
debugln('TMainIDE.DoNewEditorFile A NewFilename=',NewFilename);
@ -4309,7 +4326,8 @@ begin
end;
// create new codebuffer and apply naming conventions
Result:=CreateNewCodeBuffer(NewUnitType,NewFilename,NewBuffer,NewUnitName);
Result:=CreateNewCodeBuffer(NewFileDescriptor,NewFilename,NewBuffer,
NewUnitName);
if Result<>mrOk then exit;
NewFilename:=NewBuffer.Filename;
@ -4323,11 +4341,13 @@ begin
NewUnitInfo.Source:=NewBuffer;
end else
NewUnitInfo:=TUnitInfo.Create(NewBuffer);
NewUnitInfo.ImproveUnitNameCache(NewUnitName);
// create source code
if nfCreateDefaultSrc in NewFlags then begin
if NewUnitType in [nuForm,nuDataModule,nuCGIDataModule] then begin
NewUnitInfo.ComponentName:=Project1.NewUniqueComponentName(NewUnitType);
if (NewFileDescriptor.ResourceClass<>nil) then begin
NewUnitInfo.ComponentName:=
Project1.NewUniqueComponentName(NewFileDescriptor.DefaultResourceName);
NewUnitInfo.ComponentResourceName:='';
NewResBuffer:=CodeToolBoss.CreateFile(
ChangeFileExt(NewFilename,ResourceFileExt));
@ -4335,7 +4355,7 @@ begin
RaiseException('TMainIDE.DoNewEditorFile Internal error');
end;
end;
NewUnitInfo.CreateStartCode(NewUnitType,NewUnitName);
NewUnitInfo.CreateStartCode(NewFileDescriptor,NewUnitName);
end else begin
if nfBeautifySrc in NewFlags then
NewBuffer.Source:=BeautifySrc(NewSource)
@ -4353,17 +4373,13 @@ begin
end;
if OldUnitIndex<0 then begin
Project1.AddUnit(NewUnitInfo,
(NewUnitType in [nuForm,nuUnit,nuDataModule,nuCGIDataModule])
NewFileDescriptor.AddToProject
and NewUnitInfo.IsPartOfProject);
end;
// syntax highlighter type
if NewUnitType in [nuForm,nuUnit,nuDataModule,nuCGIDataModule] then begin
NewUnitInfo.SyntaxHighlighter:=lshFreePascal;
end else begin
NewUnitInfo.SyntaxHighlighter:=
ExtensionToLazSyntaxHighlighter(ExtractFileExt(NewFilename))
end;
NewUnitInfo.SyntaxHighlighter:=
ExtensionToLazSyntaxHighlighter(ExtractFileExt(NewFilename));
if nfOpenInEditor in NewFlags then begin
// open a new sourceeditor
@ -4378,14 +4394,7 @@ begin
NewUnitInfo.EditorIndex:=SourceNotebook.NoteBook.PageIndex;
// create component
case NewUnitType of
nuForm: AncestorType:=TForm;
nuDataModule: AncestorType:=TDataModule;
{$IFDEF HasCGIModules}
nuCGIDataModule: AncestorType:=TCGIDataModule;
{$ENDIF}
else AncestorType:=nil;
end;
AncestorType:=NewFileDescriptor.ResourceClass;
if AncestorType<>nil then begin
Result:=CreateNewForm(NewUnitInfo,AncestorType,nil);
if Result<>mrOk then exit;
@ -4426,19 +4435,18 @@ begin
if Result<>mrOk then exit;
case NewIDEItem.TheType of
// files
niiText: Result:=DoNewEditorFile(nuText,'','',
niiText: Result:=DoNewEditorFile(FileDescriptorText,'','',
[nfOpenInEditor,nfCreateDefaultSrc]);
niiUnit: Result:=DoNewEditorFile(nuUnit,'','',
niiUnit: Result:=DoNewEditorFile(FileDescriptorUnit,'','',
[nfOpenInEditor,nfCreateDefaultSrc]);
niiForm: Result:=DoNewEditorFile(nuForm,'','',
niiForm: Result:=DoNewEditorFile(FileDescriptorForm,'','',
[nfOpenInEditor,nfCreateDefaultSrc]);
niiDataModule: Result:=DoNewEditorFile(nuDataModule,'','',
niiDataModule: Result:=DoNewEditorFile(FileDescriptorDatamodule,'','',
[nfOpenInEditor,nfCreateDefaultSrc]);
// projects
niiApplication: DoNewProject(ptApplication);
niiFPCProject: DoNewProject(ptProgram);
niiCustomProject: DoNewProject(ptCustomProgram);
niiCGIApplication: DoNewProject(ptCGIApplication);
// packages
niiPackage: PkgBoss.DoNewPackage;
else
@ -4905,6 +4913,7 @@ Begin
try
for i:=0 to Project1.UnitCount-1 do begin
if not Project1.Units[i].IsPartOfProject then continue;
//debugln('TMainIDE.DoViewUnitsAndForms OnlyForms=',dbgs(OnlyForms),' CompName=',Project1.Units[i].ComponentName,' UnitName=',Project1.Units[i].UnitName);
if OnlyForms then begin
// add all form names of project
if Project1.Units[i].ComponentName<>'' then begin
@ -4918,8 +4927,7 @@ 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,
ptCGIApplication]
if Project1.ProjectType in [ptProgram,ptApplication,ptCustomProgram]
then begin
MainUnitName:=CreateSrcEditPageName(MainUnitInfo.UnitName,
MainUnitInfo.Filename,MainUnitInfo.EditorIndex);
@ -5286,18 +5294,13 @@ Begin
ptApplication:
// create a first form unit
DoNewEditorFile(nuForm,'','',
DoNewEditorFile(FileDescriptorForm,'','',
[nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
ptProgram,ptCustomProgram:
// show program unit
DoOpenMainUnit(false);
ptCGIApplication:
// create a first datamodule
DoNewEditorFile(nuCGIDataModule,'','',
[nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
end;
// rebuild codetools defines
@ -5765,7 +5768,7 @@ begin
s:='"'+ActiveUnitInfo.Filename+'"'
else
s:='"'+ActiveSourceEditor.PageName+'"';
if (Project1.ProjectType in [ptProgram, ptApplication, ptCGIApplication])
if (Project1.ProjectType in [ptProgram, ptApplication])
and (ActiveUnitInfo.UnitName<>'')
and (Project1.IndexOfUnitWithName(ActiveUnitInfo.UnitName,
true,ActiveUnitInfo)>=0) then
@ -5783,7 +5786,7 @@ begin
if Result<>mrOk then exit;
ActiveUnitInfo.IsPartOfProject:=true;
if (FilenameIsPascalUnit(ActiveUnitInfo.Filename))
and (Project1.ProjectType in [ptProgram,ptApplication,ptCGIApplication])
and (Project1.ProjectType in [ptProgram,ptApplication])
then begin
ActiveUnitInfo.ReadUnitNameFromSource(false);
ShortUnitName:=ActiveUnitInfo.CreateUnitName;
@ -5831,7 +5834,7 @@ Begin
AnUnitInfo:=Project1.Units[TViewUnitsEntry(UnitList[i]).ID];
AnUnitInfo.IsPartOfProject:=false;
if (Project1.MainUnitID>=0)
and (Project1.ProjectType in [ptProgram,ptApplication,ptCGIApplication])
and (Project1.ProjectType in [ptProgram,ptApplication])
then begin
if (AnUnitInfo.UnitName<>'') then begin
if CodeToolBoss.RemoveUnitFromAllUsesSections(
@ -6043,8 +6046,7 @@ begin
Result := mrCancel;
// Check if we can run this project
if not (Project1.ProjectType in [ptProgram, ptApplication, ptCustomProgram,
ptCGIApplication])
if not (Project1.ProjectType in [ptProgram, ptApplication, ptCustomProgram])
or (Project1.MainUnitID < 0)
then Exit;
@ -9458,7 +9460,8 @@ begin
Files.Free;
if OpenDiffInEditor then begin
NewDiffFilename:=CreateSrcEditPageName('','diff.txt',-1);
Result:=DoNewEditorFile(nuText,NewDiffFilename,DiffText,[nfOpenInEditor]);
Result:=DoNewEditorFile(FileDescriptorText,NewDiffFilename,DiffText,
[nfOpenInEditor]);
GetCurrentUnit(ActiveSrcEdit,ActiveUnitInfo);
if ActiveSrcEdit=nil then exit;
end;
@ -9983,7 +9986,7 @@ begin
BeginCodeTool(ActiveSourceEditor,ActiveUnitInfo,[]);
AnUnitInfo.IsPartOfProject:=true;
if FilenameIsPascalUnit(AnUnitInfo.Filename)
and (Project1.ProjectType in [ptProgram, ptApplication, ptCGIApplication])
and (Project1.ProjectType in [ptProgram, ptApplication])
then begin
AnUnitInfo.ReadUnitNameFromSource(false);
ShortUnitName:=AnUnitInfo.UnitName;
@ -10013,7 +10016,7 @@ begin
Result:=mrOk;
AnUnitInfo.IsPartOfProject:=false;
if (Project1.MainUnitID>=0)
and (Project1.ProjectType in [ptProgram, ptApplication, ptCGIApplication])
and (Project1.ProjectType in [ptProgram, ptApplication])
then begin
BeginCodeTool(ActiveSourceEditor,ActiveUnitInfo,[]);
ShortUnitName:=AnUnitInfo.UnitName;
@ -10635,6 +10638,9 @@ end.
{ =============================================================================
$Log$
Revision 1.764 2004/09/01 09:43:24 mattias
implemented registration of project file types
Revision 1.763 2004/08/30 16:02:17 mattias
started project interface

160
ide/mainintf.pas
View File

@ -61,14 +61,15 @@ uses
Controls, Graphics, ExtCtrls, Dialogs, FileCtrl, Forms, CodeToolManager,
CodeCache, AVL_Tree, SynEditKeyCmds,
// IDE
ObjectInspector,
LazConf, LazarusIDEStrConsts,
ProjectDefs, Project, PublishModule, BuildLazDialog, Compiler,
ProjectIntf, ProjectDefs, Project, PublishModule, BuildLazDialog, Compiler,
{$IFDEF DisablePkgs}
CompReg, IDEComp,
{$ELSE}
ComponentReg,
{$ENDIF}
TransferMacros, ObjectInspector, PropEdits, OutputFilter, IDEDefs, MsgView,
TransferMacros, PropEdits, OutputFilter, IDEDefs, MsgView,
EnvironmentOpts, EditorOptions, CompilerOptions, KeyMapping, IDEProcs,
Debugger, IDEOptionDefs, CodeToolsDefines, SrcEditorIntf;
@ -199,7 +200,7 @@ type
NeededFlags: TIDEFileStateFlags;
var ResultFlags: TIDEFileStateFlags); virtual; abstract;
function DoNewEditorFile(NewUnitType: TNewUnitType;
function DoNewEditorFile(NewFileDescriptor: TProjectFileDescriptor;
NewFilename: string; const NewSource: string;
NewFlags: TNewFlags): TModalResult; virtual; abstract;
function DoOpenEditorFile(AFileName:string; PageIndex: integer;
@ -291,6 +292,52 @@ const
function OpenFlagsToString(Flags: TOpenFlags): string;
function SaveFlagsToString(Flags: TSaveFlags): string;
//==============================================================================
type
{ TFileDescPascalUnitWithForm }
TFileDescPascalUnitWithForm = class(TFileDescPascalUnitWithResource)
public
constructor Create; override;
function GetInterfaceUsesSection: string; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
end;
{ TFileDescPascalUnitWithDataModule }
TFileDescPascalUnitWithDataModule = class(TFileDescPascalUnitWithResource)
public
constructor Create; override;
function GetInterfaceUsesSection: string; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
end;
{ TFileDescSimplePascalProgram }
TFileDescSimplePascalProgram = class(TFileDescPascalUnit)
public
constructor Create; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
function CreateSource(const Filename, SourceName,
ResourceName: string): string; override;
end;
{ TFileDescText }
TFileDescText = class(TProjectFileDescriptor)
public
constructor Create; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
end;
implementation
@ -338,5 +385,112 @@ begin
MainIDEInterface:=nil;
end;
{ TFileDescPascalUnitWithForm }
constructor TFileDescPascalUnitWithForm.Create;
begin
inherited Create;
Name:=FileDescNameLCLForm;
ResourceClass:=TForm;
UseCreateFormStatements:=true;
end;
function TFileDescPascalUnitWithForm.GetInterfaceUsesSection: string;
begin
Result:='Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs';
end;
function TFileDescPascalUnitWithForm.GetLocalizedName: string;
begin
Result:='Form';
end;
function TFileDescPascalUnitWithForm.GetLocalizedDescription: string;
begin
Result:='Create a new unit with a LCL form.';
end;
{ TFileDescPascalUnitWithDataModule }
constructor TFileDescPascalUnitWithDataModule.Create;
begin
inherited Create;
Name:=FileDescNameDatamodule;
ResourceClass:=TDataModule;
UseCreateFormStatements:=true;
end;
function TFileDescPascalUnitWithDataModule.GetInterfaceUsesSection: string;
begin
Result:='Classes, SysUtils, LResources, Forms, Controls, Dialogs';
end;
function TFileDescPascalUnitWithDataModule.GetLocalizedName: string;
begin
Result:='Data Module';
end;
function TFileDescPascalUnitWithDataModule.GetLocalizedDescription: string;
begin
Result:='Create a new unit with a datamodule.';
end;
{ TFileDescText }
constructor TFileDescText.Create;
begin
inherited Create;
Name:=FileDescNameText;
DefaultFilename:='text.txt';
AddToProject:=false;
end;
function TFileDescText.GetLocalizedName: string;
begin
Result:='Text';
end;
function TFileDescText.GetLocalizedDescription: string;
begin
Result:='Create a new empty text file.';
end;
{ TFileDescSimplePascalProgram }
constructor TFileDescSimplePascalProgram.Create;
begin
inherited Create;
Name:='custom program';
DefaultFilename:='project.pas';
end;
function TFileDescSimplePascalProgram.GetLocalizedName: string;
begin
Result:='Custom Program';
end;
function TFileDescSimplePascalProgram.GetLocalizedDescription: string;
begin
Result:='Custom Program';
end;
function TFileDescSimplePascalProgram.CreateSource(const Filename, SourceName,
ResourceName: string): string;
var
LE: String;
begin
LE:=LineEnding;
Result:='program '+SourceName+';'+LE
+LE
+'{$mode objfpc}{$H+}'+LE
+LE
+'uses'+LE
+' Classes, SysUtils;'+LE
+LE
+'begin'+LE
+'end.'+LE
+LE;
end;
end.

9
ide/newdialog.pas
View File

@ -55,7 +55,6 @@ type
niiApplication,// Project: Application
niiFPCProject, // Project: with hidden main file
niiCustomProject,// Project: pascal program without any specials
niiCGIApplication,// Project: TCGIApplication using package cgilaz
niiPackage // standard package
);
TNewIDEItemTypes = set of TNewIDEItemType;
@ -518,10 +517,6 @@ begin
niiCustomProject:
Result:=lisNewDlgCreateANewCustomProgram;
niiCGIApplication:
Result:=Format(lisNewCreateANewCgiApplicationTheProgramFileIsMaintained, [
#13]);
niiPackage:
Result:=Format(
lisNewDlgCreateANewStandardPackageAPackageIsACollectionOfUn, [#13#13]);
@ -568,10 +563,6 @@ begin
TNewIDEItemTemplate.Create(niiFPCProject,'FPC Project',niifCopy,[]));
NewCategory.Add(
TNewIDEItemTemplate.Create(niiCustomProject,'Custom Project',niifCopy,[]));
{$IFDEF HasCGIModules}
NewCategory.Add(
TNewIDEItemTemplate.Create(niiCGIApplication,'CGI Application',niifCopy,[]));
{$ENDIF}
// category package
NewCategory:=TNewIDEItemCategory.Create('Package');

225
ide/project.pp
View File

@ -93,7 +93,6 @@ type
FComponentLastLRSStreamSize: TStreamSeekType;
fCursorPos: TPoint;
fCustomHighlighter: boolean; // do not change highlighter on file extension change
FDescriptor: TProjectFileDescriptor;
fEditorIndex: integer;
fFileName: string;
fFileReadOnly: Boolean;
@ -130,7 +129,6 @@ type
function GetPrevUnitWithComponent: TUnitInfo;
function GetPrevUnitWithEditorIndex: TUnitInfo;
procedure SetBuildFileIfActive(const AValue: boolean);
procedure SetDescriptor(const AValue: TProjectFileDescriptor);
procedure SetEditorIndex(const AValue: integer);
procedure SetFileReadOnly(const AValue: Boolean);
procedure SetComponent(const AValue: TComponent);
@ -158,7 +156,7 @@ type
function WriteUnitSource: TModalResult;
function WriteUnitSourceToFile(const AFileName: string): TModalResult;
procedure Clear;
procedure CreateStartCode(NewUnitType: TNewUnitType;
procedure CreateStartCode(Descriptor: TProjectFileDescriptor;
const NewUnitName: string);
procedure DecreaseAutoRevertLock;
procedure IgnoreCurrentFileDateOnDisk;
@ -166,6 +164,7 @@ type
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure ReadUnitNameFromSource(TryCache: boolean);
function CreateUnitName: string;
procedure ImproveUnitNameCache(const NewUnitName: string);
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string);
procedure UpdateUsageCount(Min, IfBelowThis, IncIfBelow: extended);
procedure UpdateUsageCount(TheUsage: TUnitUsage; Factor: extended);
@ -200,7 +199,6 @@ type
property CursorPos: TPoint read fCursorPos write fCursorPos;
property CustomHighlighter: boolean
read fCustomHighlighter write fCustomHighlighter;
property Descriptor: TProjectFileDescriptor read FDescriptor write SetDescriptor;
property EditorIndex: integer read fEditorIndex write SetEditorIndex;
property Filename: String read GetFilename;
property FileReadOnly: Boolean read fFileReadOnly write SetFileReadOnly;
@ -285,7 +283,7 @@ type
{ TProject }
TProjectType = // for a description see ProjectTypeDescriptions below
(ptApplication, ptProgram, ptCustomProgram, ptCGIApplication);
(ptApplication, ptProgram, ptCustomProgram);
TProjectFlag = (
pfSaveClosedUnits, // save info about closed files (not part of project)
@ -400,8 +398,9 @@ type
// units
function UnitCount:integer;
function NewUniqueUnitName(NewUnitType:TNewUnitType): string;
function NewUniqueComponentName(NewUnitType:TNewUnitType): string;
function NewUniqueUnitName(const AnUnitName: string): string;
function NewUniqueComponentName(const AComponentPrefix: string): string;
function NewUniqueFilename(const Filename: string): string;
procedure AddUnit(AnUnit: TUnitInfo; AddToProjectFile: boolean);
procedure RemoveUnit(Index: integer);
@ -417,6 +416,7 @@ type
function IndexOfFilename(const AFilename: string;
SearchFlags: TProjectFileSearchFlags): integer;
function ProjectUnitWithFilename(const AFilename: string): TUnitInfo;
function ProjectUnitWithShortFilename(const ShortFilename: string): TUnitInfo;
function ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
function UnitWithEditorIndex(Index:integer): TUnitInfo;
Function UnitWithComponent(AComponent: TComponent): TUnitInfo;
@ -523,7 +523,7 @@ const
ResourceFileExt = '.lrs';
ProjectTypeNames : array[TProjectType] of string = (
'Application', 'Program', 'Custom program', 'CGI Application'
'Application', 'Program', 'Custom program'
);
ProjectTypeDescriptions : array[TProjectType] of string = (
@ -540,21 +540,12 @@ const
// ptCustomProgram
,'Custom program:'#13
+'A freepascal program.'
// ptCGIApplication
,'CGI Application'#13
+'A cgi freepascal program. The program file is '
+'automatically maintained by lazarus.'#13
);
ProjectDefaultExt : array[TProjectType] of string = (
'.lpr','.pas','.pas', 'pas'
'.lpr','.pas','.pas'
);
UnitTypeDefaultExt: array[TNewUnitType] of string = (
'.pas', '.pas', '.pas', '.pas', '.pas', '.txt', '.pas'
);
DefaultProjectFlags = [pfSaveClosedUnits];
ProjectFlagNames : array[TProjectFlag] of string = (
'SaveClosedFiles', 'SaveOnlyProjectUnits'
@ -726,6 +717,12 @@ begin
Result:=ExtractFilenameOnly(Filename);
end;
procedure TUnitInfo.ImproveUnitNameCache(const NewUnitName: string);
begin
if (fUnitName='') or (CompareText(fUnitName,NewUnitName)=0) then
fUnitName:=NewUnitName;
end;
{------------------------------------------------------------------------------
TUnitInfo Clear
------------------------------------------------------------------------------}
@ -994,10 +991,10 @@ begin
fSource.ReadOnly:=ReadOnly;
end;
procedure TUnitInfo.CreateStartCode(NewUnitType: TNewUnitType;
procedure TUnitInfo.CreateStartCode(Descriptor: TProjectFileDescriptor;
const NewUnitName: string);
var AResourceFilename :string;
NewSource, LE: string;
var
NewSource: string;
function Beautified(const s: string): string;
begin
@ -1007,95 +1004,8 @@ var AResourceFilename :string;
begin
if fSource=nil then exit;
NewSource:='';
LE:=LineEnding;
if NewUnitType in [nuForm,nuUnit,nuDataModule,nuCGIDataModule] then begin
fUnitName:=NewUnitName;
AResourceFilename:=fUnitName+ResourceFileExt;
NewSource:=Beautified(
'unit '+fUnitName+';'+LE
+LE
+'{$mode objfpc}{$H+}'+LE
+LE
+'interface'+LE
+LE
+'uses'+LE);
case NewUnitType of
nuUnit:
begin
NewSource:=NewSource+Beautified(
' Classes, SysUtils;'+LE
+LE
+'implementation'+LE);
end;
nuForm, nuDataModule, nuCGIDataModule:
begin
if NewUnitType=nuForm then
NewSource:=NewSource+Beautified(
' Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs;'+LE
+LE
+'type'+LE)
else if NewUnitType=nuDataModule then
NewSource:=NewSource+Beautified(
' Classes, SysUtils, LResources, Forms, Controls, Dialogs;'+LE
+LE
+'type'+LE)
else if NewUnitType=nuCGIDataModule then
NewSource:=NewSource+Beautified(
' Classes, SysUtils, LResources, cgiModules;'+LE
+LE
+'type'+LE);
if NewUnitType=nuForm then
NewSource:=NewSource+Beautified(
+' T'+fComponentName+' = class(TForm)'+LE)
else if NewUnitType=nuDataModule then
NewSource:=NewSource+Beautified(
+' T'+fComponentName+' = class(TDataModule)'+LE)
else if NewUnitType=nuCGIDataModule then
NewSource:=NewSource+Beautified(
+' T'+fComponentName+' = class(TCGIDataModule)'+LE);
NewSource:=NewSource+Beautified(
' private'+LE);
NewSource:=NewSource
+' { private declarations }'+LE;
NewSource:=NewSource+Beautified(
+' public'+LE);
NewSource:=NewSource
+' { public declarations }'+LE;
NewSource:=NewSource+Beautified(
+' end;'+LE
+LE
+'var'+LE
+' '+fComponentName+': T'+fComponentName+';'+LE
+LE
+'implementation'+LE
+LE
+'initialization'+LE);
NewSource:=NewSource
+' {$I '+AResourceFilename+'}'+LE;
end;
end;
NewSource:=NewSource+Beautified(
+LE
+'end.'+LE
+LE);
end else if NewUnitType in [nuCustomProgram] then begin
NewSource:=NewSource+Beautified(
+'program CustomProgram;'+LE
+LE
+'{$mode objfpc}{$H+}'+LE
+LE
+'uses'+LE
+' Classes, SysUtils;'+LE
+LE
+'begin'+LE
+'end.'+LE
+LE);
end;
NewSource:=Beautified(
Descriptor.CreateSource(Filename,NewUnitName,fComponentName));
fSource.Source:=NewSource;
fModified:=true;
end;
@ -1162,12 +1072,6 @@ begin
Modified:=true;
end;
procedure TUnitInfo.SetDescriptor(const AValue: TProjectFileDescriptor);
begin
if FDescriptor=AValue then exit;
FDescriptor:=AValue;
end;
procedure TUnitInfo.SetEditorIndex(const AValue: integer);
begin
if fEditorIndex=AValue then exit;
@ -1288,7 +1192,7 @@ begin
// create program source
NewSource:=TStringList.Create;
case fProjectType of
ptProgram, ptApplication, ptCustomProgram, ptCGIApplication:
ptProgram, ptApplication, ptCustomProgram:
begin
NewPrgBuf:=CodeToolBoss.CreateFile(
'project1'+ProjectDefaultExt[fProjectType]);
@ -1315,8 +1219,6 @@ begin
Add(' Interfaces,');
Add(' Forms;');
end;
ptCGIApplication:
Add(' cgiModules;');
else
Add(' { add your units here };');
end;
@ -1663,6 +1565,7 @@ var
NewIndex: integer;
begin
if (AnUnit = nil) then exit;
//debugln('TProject.AddUnit A ',AnUnit.Filename,' AddToProjectFile=',dbgs(AddToProjectFile));
BeginUpdate(true);
NewIndex:=UnitCount;
fUnitList.Add(AnUnit);
@ -1836,7 +1739,7 @@ begin
Result:=fUnitList.Count;
end;
function TProject.NewUniqueUnitName(NewUnitType:TNewUnitType):string;
function TProject.NewUniqueUnitName(const AnUnitName: string):string;
function ExpandedUnitname(const AnUnitName:string):string;
begin
@ -1857,20 +1760,24 @@ function TProject.NewUniqueUnitName(NewUnitType:TNewUnitType):string;
Result:=false;
end;
// NewUniqueUnitName(NewUnitType:TNewUnitType)
var u:integer;
var
u:integer;
Prefix: string;
begin
u:=1;
case NewUnitType of
nuForm,nuUnit,nuDataModule,nuCGIDataModule: Prefix:='unit';
else Prefix:='text'
end;
while (UnitNameExists(Prefix+IntToStr(u))) do inc(u);
Result:=Prefix+IntToStr(u);
Prefix:=AnUnitName;
while (Prefix<>'') and (Prefix[length(Prefix)] in ['0'..'9']) do
Prefix:=copy(Prefix,1,length(Prefix)-1);
if (Prefix='') or (not IsValidIdent(Prefix)) then
Prefix:='Unit';
u:=0;
repeat
inc(u);
Result:=Prefix+IntToStr(u);
until (not UnitNameExists(Result));
end;
function TProject.NewUniqueComponentName(NewUnitType:TNewUnitType):string;
function TProject.NewUniqueComponentName(const AComponentPrefix: string
): string;
function FormComponentExists(const AComponentName: string): boolean;
var i: integer;
@ -1889,20 +1796,38 @@ function TProject.NewUniqueComponentName(NewUnitType:TNewUnitType):string;
Result:=false;
end;
// NewUniqueComponentName(NewUnitType:TNewUnitType)
var i: integer;
var
u: integer;
Prefix: string;
begin
i:=1;
case NewUnitType of
nuForm, nuUnit: Prefix:='Form';
nuDataModule: Prefix:='DataModule';
nuCGIDataModule: Prefix:='CGIDataModule';
else
Prefix:='form';
end;
while (FormComponentExists(Prefix+IntToStr(i))) do inc(i);
Result:=Prefix+IntToStr(i);
Prefix:=AComponentPrefix;
while (Prefix<>'') and (Prefix[length(Prefix)] in ['0'..'9']) do
Prefix:=copy(Prefix,1,length(Prefix)-1);
if (Prefix='') or (not IsValidIdent(Prefix)) then
Prefix:='Resource';
u:=0;
repeat
inc(u);
Result:=Prefix+IntToStr(u);
until (not FormComponentExists(Result));
end;
function TProject.NewUniqueFilename(const Filename: string): string;
var
FileNameOnly: String;
FileExt: String;
i: Integer;
begin
FileNameOnly:=ExtractFilenameOnly(Filename);
while (FileNameOnly<>'')
and (FileNameOnly[length(FileNameOnly)] in ['0'..'9']) do
FileNameOnly:=copy(FileNameOnly,1,length(FileNameOnly)-1);
FileExt:=ExtractFileExt(Filename);
i:=0;
repeat
inc(i);
Result:=FileNameOnly+IntToStr(i)+FileExt;
until ProjectUnitWithShortFilename(Result)=nil;
end;
function TProject.AddCreateFormToProjectFile(
@ -2527,7 +2452,7 @@ begin
end;
end;
if (OldUnitName<>'')
and (ProjectType in [ptProgram, ptApplication, ptCGIApplication]) then
and (ProjectType in [ptProgram, ptApplication]) then
begin
// rename unit in program uses section
CodeToolBoss.RenameUsedUnit(MainUnitInfo.Source
@ -2656,6 +2581,17 @@ begin
end;
end;
function TProject.ProjectUnitWithShortFilename(const ShortFilename: string
): TUnitInfo;
begin
Result:=fFirst[uilPartOfProject];
while Result<>nil do begin
if CompareFileNames(ShortFilename,ExtractFilename(Result.Filename))=0 then
exit;
Result:=Result.fNext[uilPartOfProject];
end;
end;
function TProject.ProjectUnitWithUnitname(const AnUnitName: string): TUnitInfo;
begin
Result:=fFirst[uilPartOfProject];
@ -2866,6 +2802,9 @@ end.
{
$Log$
Revision 1.159 2004/09/01 09:43:24 mattias
implemented registration of project file types
Revision 1.158 2004/08/30 16:02:17 mattias
started project interface

145
ide/projectdefs.pas
View File

@ -67,8 +67,10 @@ type
TLazProjectFileDescriptors = class(TProjectFileDescriptors)
private
FDefaultPascalFileExt: string;
fDestroying: boolean;
fItems: TList; // list of TProjectFileDescriptor
procedure SetDefaultPascalFileExt(const AValue: string);
protected
function GetItems(Index: integer): TProjectFileDescriptor; override;
public
@ -80,52 +82,14 @@ type
function FindByName(const Name: string): TProjectFileDescriptor; override;
procedure RegisterFileDescriptor(FileDescriptor: TProjectFileDescriptor); override;
procedure UnregisterFileDescriptor(FileDescriptor: TProjectFileDescriptor); override;
procedure UpdateDefaultPascalFileExtensions;
property DefaultPascalFileExt: string read FDefaultPascalFileExt write SetDefaultPascalFileExt;
end;
var
LazProjectFileDescriptors: TLazProjectFileDescriptors;
type
{ TFileDescPascalUnit }
TFileDescPascalUnit = class(TProjectFileDescriptor)
public
constructor Create;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
end;
{ TFileDescPascalUnitWithForm }
TFileDescPascalUnitWithForm = class(TFileDescPascalUnit)
public
constructor Create;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
end;
{ TFileDescPascalUnitWithDataModule }
TFileDescPascalUnitWithDataModule = class(TFileDescPascalUnit)
public
constructor Create;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
end;
{ TFileDescText }
TFileDescText = class(TProjectFileDescriptor)
public
constructor Create;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
end;
//---------------------------------------------------------------------------
// bookmarks of a single file
TFileBookmark = class
@ -958,6 +922,14 @@ end;
{ TLazProjectFileDescriptors }
procedure TLazProjectFileDescriptors.SetDefaultPascalFileExt(
const AValue: string);
begin
if FDefaultPascalFileExt=AValue then exit;
FDefaultPascalFileExt:=AValue;
UpdateDefaultPascalFileExtensions;
end;
function TLazProjectFileDescriptors.GetItems(Index: integer): TProjectFileDescriptor;
begin
Result:=TProjectFileDescriptor(FItems[Index]);
@ -1018,10 +990,19 @@ begin
Result:=nil;
end;
procedure TLazProjectFileDescriptors.RegisterFileDescriptor(FileDescriptor: TProjectFileDescriptor
);
procedure TLazProjectFileDescriptors.RegisterFileDescriptor(
FileDescriptor: TProjectFileDescriptor);
var
DefPasExt: String;
begin
if FileDescriptor.Name='' then
raise Exception.Create('TLazProjectFileDescriptors.RegisterFileDescriptor FileDescriptor.Name empty');
if FileDescriptor.DefaultFilename='' then
raise Exception.Create('TLazProjectFileDescriptors.RegisterFileDescriptor FileDescriptor.DefaultFilename empty');
FileDescriptor.Name:=GetUniqueName(FileDescriptor.Name);
DefPasExt:=DefaultPascalFileExt;
if DefPasExt<>'' then
FileDescriptor.UpdateDefaultPascalFileExtension(DefPasExt);
FItems.Add(FileDescriptor);
end;
@ -1038,80 +1019,14 @@ begin
FileDescriptor.Release;
end;
{ TFileDescPascalUnit }
constructor TFileDescPascalUnit.Create;
procedure TLazProjectFileDescriptors.UpdateDefaultPascalFileExtensions;
var
i: Integer;
DefPasExt: String;
begin
inherited Create;
Name:='unit';
end;
function TFileDescPascalUnit.GetLocalizedName: string;
begin
Result:='Unit';
end;
function TFileDescPascalUnit.GetLocalizedDescription: string;
begin
Result:=lisNewDlgCreateANewPascalUnit;
end;
{ TFileDescPascalUnitWithForm }
constructor TFileDescPascalUnitWithForm.Create;
begin
inherited Create;
Name:='form';
Persistent:=TForm;
UseCreateFormStatements:=true;
end;
function TFileDescPascalUnitWithForm.GetLocalizedName: string;
begin
Result:='Form';
end;
function TFileDescPascalUnitWithForm.GetLocalizedDescription: string;
begin
Result:=lisNewDlgCreateANewUnitWithALCLForm;
end;
{ TFileDescPascalUnitWithDataModule }
constructor TFileDescPascalUnitWithDataModule.Create;
begin
inherited Create;
Name:='datamodule';
Persistent:=TDataModule;
UseCreateFormStatements:=true;
end;
function TFileDescPascalUnitWithDataModule.GetLocalizedName: string;
begin
Result:='Data Module';
end;
function TFileDescPascalUnitWithDataModule.GetLocalizedDescription: string;
begin
Result:=lisNewDlgCreateANewUnitWithADataModule;
end;
{ TFileDescText }
constructor TFileDescText.Create;
begin
inherited Create;
Name:='text';
end;
function TFileDescText.GetLocalizedName: string;
begin
Result:='Text';
end;
function TFileDescText.GetLocalizedDescription: string;
begin
Result:=lisNewDlgCreateANewEmptyTextFile;
DefPasExt:=DefaultPascalFileExt;
if DefPasExt='' then exit;
for i:=0 to Count-1 do Items[i].UpdateDefaultPascalFileExtension(DefPasExt);
end;
initialization

243
ideintf/projectintf.pas
View File

@ -22,45 +22,95 @@ unit ProjectIntf;
interface
uses
Classes, SysUtils, Forms;
Classes, SysUtils, LCLProc, FileCtrl;
const
FileDescNamePascalUnit = 'unit';
FileDescNameLCLForm = 'form';
FileDescNameDatamodule = 'datamodule';
FileDescNameText = 'text';
type
{ TProjectFileDescriptor }
TProjectFileDescriptor = class(TPersistent)
private
FAddToProject: boolean;
FDefaultFileExt: string;
FDefaultFilename: string;
FDefaultResFileExt: string;
FDefaultResourceName: string;
FDefaultSourceName: string;
FIsComponent: boolean;
FIsForm: boolean;
FIsPascalUnit: boolean;
FName: string;
FPersistent: TPersistentClass;
FReferenceCount: integer;
FResourceClass: TPersistentClass;
FRequiredPackages: string;
FUseCreateFormStatements: boolean;
FVisibleInNewDialog: boolean;
protected
procedure SetDefaultFilename(const AValue: string); virtual;
procedure SetDefaultFileExt(const AValue: string); virtual;
procedure SetDefaultSourceName(const AValue: string); virtual;
procedure SetDefaultResFileExt(const AValue: string); virtual;
procedure SetName(const AValue: string); virtual;
procedure SetRequiredPackages(const AValue: string); virtual;
procedure SetPersistent(const AValue: TPersistentClass); virtual;
procedure SetResourceClass(const AValue: TPersistentClass); virtual;
public
constructor Create;
constructor Create; virtual;
function GetLocalizedName: string; virtual;
function GetLocalizedDescription: string; virtual;
procedure Release;
procedure Reference;
function CreateSource(const Filename, SourceName,
ResourceName: string): string; virtual;
procedure UpdateDefaultPascalFileExtension(const DefPasExt: string); virtual;
public
property Name: string read FName write SetName;
property DefaultFilename: string read FDefaultFilename write SetDefaultFilename;
property DefaultFileExt: string read FDefaultFileExt write SetDefaultFileExt;
property DefaultSourceName: string read FDefaultSourceName write SetDefaultSourceName;
property DefaultResFileExt: string read FDefaultResFileExt write SetDefaultResFileExt;
property DefaultResourceName: string read FDefaultResourceName write FDefaultResourceName;
property RequiredPackages: string read FRequiredPackages write SetRequiredPackages; // package names separated by semicolon
property Persistent: TPersistentClass read FPersistent write SetPersistent;
property IsForm: boolean read FIsForm;
property ResourceClass: TPersistentClass read FResourceClass write SetResourceClass;
property IsComponent: boolean read FIsComponent;
property UseCreateFormStatements: boolean read FUseCreateFormStatements write FUseCreateFormStatements;
property VisibleInNewDialog: boolean read FVisibleInNewDialog write FVisibleInNewDialog;
property IsPascalUnit: boolean read FIsPascalUnit write FIsPascalUnit;
property AddToProject: boolean read FAddToProject write FAddToProject;
end;
{ TFileDescPascalUnit }
TFileDescPascalUnit = class(TProjectFileDescriptor)
public
constructor Create; override;
function CreateSource(const Filename, SourceName,
ResourceName: string): string; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
function GetInterfaceUsesSection: string; virtual;
function GetInterfaceSource(const Filename, SourceName,
ResourceName: string): string; virtual;
function GetImplementationSource(const Filename, SourceName,
ResourceName: string): string; virtual;
end;
{ TFileDescPascalUnitWithResource }
TFileDescPascalUnitWithResource = class(TFileDescPascalUnit)
public
function GetInterfaceSource(const Filename, SourceName,
ResourceName: string): string; override;
function GetImplementationSource(const Filename, SourceName,
ResourceName: string): string; override;
end;
{ TProjectFileDescriptors }
TProjectFileDescriptors = class(TPersistent)
@ -74,28 +124,81 @@ type
procedure RegisterFileDescriptor(FileDescriptor: TProjectFileDescriptor); virtual; abstract;
procedure UnregisterFileDescriptor(FileDescriptor: TProjectFileDescriptor); virtual; abstract;
public
property Items[Index: integer]: TProjectFileDescriptor read GetItems;
property Items[Index: integer]: TProjectFileDescriptor read GetItems; default;
end;
var
ProjectFileDescriptors: TProjectFileDescriptors; // will be set by the IDE
function FileDescriptorUnit: TProjectFileDescriptor;
function FileDescriptorForm: TProjectFileDescriptor;
function FileDescriptorDatamodule: TProjectFileDescriptor;
function FileDescriptorText: TProjectFileDescriptor;
implementation
function FileDescriptorUnit: TProjectFileDescriptor;
begin
Result:=ProjectFileDescriptors.FindByName(FileDescNamePascalUnit);
end;
function FileDescriptorForm: TProjectFileDescriptor;
begin
Result:=ProjectFileDescriptors.FindByName(FileDescNameLCLForm);
end;
function FileDescriptorDatamodule: TProjectFileDescriptor;
begin
Result:=ProjectFileDescriptors.FindByName(FileDescNameDatamodule);
end;
function FileDescriptorText: TProjectFileDescriptor;
begin
Result:=ProjectFileDescriptors.FindByName(FileDescNameText);
end;
{ TProjectFileDescriptor }
procedure TProjectFileDescriptor.SetPersistent(const AValue: TPersistentClass);
procedure TProjectFileDescriptor.SetResourceClass(
const AValue: TPersistentClass);
begin
if FPersistent=AValue then exit;
FPersistent:=AValue;
FIsComponent:=(FPersistent<>nil) and (FPersistent.InheritsFrom(TComponent));
FIsForm:=(FPersistent<>nil) and (FPersistent.InheritsFrom(TForm));
if FResourceClass=AValue then exit;
FResourceClass:=AValue;
FIsComponent:=(FResourceClass<>nil)
and (FResourceClass.InheritsFrom(TComponent));
if FResourceClass=nil then
FDefaultResourceName:=''
else begin
FDefaultResourceName:=
copy(FResourceClass.ClassName,2,length(FResourceClass.ClassName)-1);
end;
end;
procedure TProjectFileDescriptor.SetDefaultFileExt(const AValue: string);
begin
if FDefaultFileExt=AValue then exit;
FDefaultFileExt:=AValue;
end;
procedure TProjectFileDescriptor.SetDefaultResFileExt(const AValue: string);
begin
if FDefaultResFileExt=AValue then exit;
FDefaultResFileExt:=AValue;
end;
procedure TProjectFileDescriptor.SetDefaultSourceName(const AValue: string);
begin
if FDefaultSourceName=AValue then exit;
FDefaultSourceName:=AValue;
end;
procedure TProjectFileDescriptor.SetDefaultFilename(const AValue: string);
begin
if FDefaultFilename=AValue then exit;
FDefaultFilename:=AValue;
DefaultFileExt:=ExtractFileExt(FDefaultFilename);
FIsPascalUnit:=(CompareFileExt(DefaultFileExt,'.pp',false)=0)
or (CompareFileExt(DefaultFileExt,'.pas',false)=0);
end;
procedure TProjectFileDescriptor.SetName(const AValue: string);
@ -113,6 +216,8 @@ end;
constructor TProjectFileDescriptor.Create;
begin
FReferenceCount:=1;
DefaultResFileExt:='.lrs';
AddToProject:=true;
end;
function TProjectFileDescriptor.GetLocalizedName: string;
@ -127,6 +232,7 @@ end;
procedure TProjectFileDescriptor.Release;
begin
//debugln('TProjectFileDescriptor.Release A ',Name,' ',dbgs(FReferenceCount));
if FReferenceCount=0 then
raise Exception.Create('');
dec(FReferenceCount);
@ -138,6 +244,117 @@ begin
inc(FReferenceCount);
end;
function TProjectFileDescriptor.CreateSource(const Filename, SourceName,
ResourceName: string): string;
begin
Result:='';
end;
procedure TProjectFileDescriptor.UpdateDefaultPascalFileExtension(
const DefPasExt: string);
begin
if DefPasExt='' then exit;
if FilenameIsPascalUnit(DefaultFileExt) then
DefaultFileExt:=DefPasExt;
if FilenameIsPascalUnit(DefaultFilename) then
DefaultFilename:=ChangeFileExt(DefaultFilename,DefPasExt);
end;
{ TFileDescPascalUnit }
constructor TFileDescPascalUnit.Create;
begin
inherited Create;
Name:=FileDescNamePascalUnit;
DefaultFilename:='unit.pas';
DefaultSourceName:='Unit1';
end;
function TFileDescPascalUnit.CreateSource(const Filename, SourceName,
ResourceName: string): string;
var
LE: string;
begin
LE:=LineEnding;
Result:=
'unit '+SourceName+';'+LE
+LE
+'{$mode objfpc}{$H+}'+LE
+LE
+'interface'+LE
+LE
+'uses'+LE
+' '+GetInterfaceUsesSection+';'+LE
+LE
+GetInterfaceSource(Filename,SourceName,ResourceName)
+'implementation'+LE
+LE
+GetImplementationSource(Filename,SourceName,ResourceName)
+'end.'+LE
+LE;
end;
function TFileDescPascalUnit.GetLocalizedName: string;
begin
Result:='Unit';
end;
function TFileDescPascalUnit.GetLocalizedDescription: string;
begin
Result:='Create a new pascal unit.';
end;
function TFileDescPascalUnit.GetInterfaceUsesSection: string;
begin
Result:='Classes, SysUtils';
end;
function TFileDescPascalUnit.GetInterfaceSource(const Filename, SourceName,
ResourceName: string): string;
begin
Result:='';
end;
function TFileDescPascalUnit.GetImplementationSource(const Filename,
SourceName, ResourceName: string): string;
begin
Result:='';
end;
{ TFileDescPascalUnitWithResource }
function TFileDescPascalUnitWithResource.GetInterfaceSource(const Filename,
SourceName, ResourceName: string): string;
var
LE: string;
begin
LE:=LineEnding;
Result:=
'type'+LE
+' T'+ResourceName+' = class('+ResourceClass.ClassName+')'+LE
+' private'+LE
+' { private declarations }'+LE
+' public'+LE
+' { public declarations }'+LE
+' end;'+LE
+LE
+'var'+LE
+' '+ResourceName+': T'+ResourceName+';'+LE;
end;
function TFileDescPascalUnitWithResource.GetImplementationSource(
const Filename, SourceName, ResourceName: string): string;
var
ResourceFilename: String;
LE: String;
begin
ResourceFilename:=TrimFilename(ExtractFilenameOnly(Filename)+DefaultResFileExt);
LE:=LineEnding;
Result:='initialization'+LE
+' {$I '+ResourceFilename+'}'+LE
+LE
end;
initialization
ProjectFileDescriptors:=nil;

4
lcl/filectrl.pp
View File

@ -162,6 +162,7 @@ function ProgramDirectory: string;
function ExtractFileNameOnly(const AFilename: string): string;
function CompareFileExt(const Filename, Ext: string;
CaseSensitive: boolean): integer;
function FilenameIsPascalUnit(const Filename: string): boolean;
function AppendPathDelim(const Path: string): string;
function ChompPathDelim(const Path: string): string;
function TrimFilename(const AFilename: string): string;
@ -396,6 +397,9 @@ end.
{
$Log$
Revision 1.29 2004/09/01 09:43:24 mattias
implemented registration of project file types
Revision 1.28 2004/08/22 22:47:43 mattias
implemented context help for source editor

12
lcl/include/filectrl.inc
View File

@ -117,6 +117,15 @@ begin
{$ENDIF}
end;
{------------------------------------------------------------------------------
function FilenameIsPascalUnit(const Filename: string): boolean;
------------------------------------------------------------------------------}
function FilenameIsPascalUnit(const Filename: string): boolean;
begin
Result:=(CompareFileExt(Filename,'.pp',false)=0)
or (CompareFileExt(Filename,'.pas',false)=0);
end;
{------------------------------------------------------------------------------
function AppendPathDelim(const Path: string): string;
------------------------------------------------------------------------------}
@ -1047,6 +1056,9 @@ end;
{
$Log$
Revision 1.49 2004/09/01 09:43:24 mattias
implemented registration of project file types
Revision 1.48 2004/08/23 15:05:09 mattias
implemented help jump to FPDoc html unit

59
lcl/lresources.pp
View File

@ -272,11 +272,6 @@ begin
ByteToStrValid:=true;
end;
{function UTF8Decode(const S: UTF8String): WideString;
begin
end;}
procedure BinaryToLazarusResourceCode(BinStream,ResStream:TStream;
const ResourceName, ResourceType: String);
{ example ResStream:
@ -719,8 +714,6 @@ type
dvaNil, dvaCollection, dvaSingle, dvaCurrency, dvaDate, dvaWString,
dvaInt64, dvaUTF8String);
//UTF8String = ansistring;
TDelphiReader = class
private
FStream: TStream;
@ -759,23 +752,6 @@ type
procedure Write(const Buf; Count: Longint);
end;
{function Utf8Decode(const S: UTF8String): WideString;
var
L: Integer;
Temp: WideString;
begin
Result := '';
if S = '' then Exit;
SetLength(Temp, Length(S));
L := Utf8ToUnicode(PWideChar(Temp), Length(Temp)+1, PChar(S), Length(S));
if L > 0 then
SetLength(Temp, L-1)
else
Temp := '';
Result := Temp;
end;}
{ TDelphiReader }
procedure ReadError(Msg: string);
@ -788,11 +764,6 @@ begin
ReadError(rsInvalidPropertyValue);
end;
{procedure PropertyNotFound(const Name: string);
begin
ReadError(Format(rsPropertyDoesNotExist,[Name]));
end;
}
procedure TDelphiReader.SkipBytes(Count: Integer);
begin
FStream.Position:=FStream.Position+Count;
@ -1028,36 +999,6 @@ begin
end;
end;
{function TDelphiReader.ReadWideString: WideString;
var
L: Integer;
Temp: UTF8String;
begin
if NextValue in [dvaString, dvaLString] then
Result := ReadString
else
begin
L := 0;
case ReadValue of
dvaWString:
begin
Read(L, SizeOf(Integer));
SetLength(Result, L);
Read(Pointer(Result)^, L * 2);
end;
dvaUtf8String:
begin
Read(L, SizeOf(Integer));
SetLength(Temp, L);
Read(Pointer(Temp)^, L);
Result := Utf8Decode(Temp);
end;
else
PropValueError;
end;
end;
end;}
function TDelphiReader.ReadInt64: Int64;
begin
if NextValue = dvaInt64 then

10
packager/pkgmanager.pas
View File

@ -44,10 +44,13 @@ uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
// FCL, LCL
Classes, SysUtils, LCLProc, Forms, Controls, FileCtrl, Dialogs, Menus,
// codetools
CodeToolManager, CodeCache, BasicCodeTools, Laz_XMLCfg, AVL_Tree,
// IDE
DialogProcs, LazarusIDEStrConsts, IDEProcs, KeyMapping, ObjectLists,
EnvironmentOpts, MiscOptions, ProjectDefs, InputHistory, Project,
EnvironmentOpts, MiscOptions, ProjectIntf, ProjectDefs, Project, InputHistory,
ComponentReg, UComponentManMain, PackageEditor, AddToPackageDlg, PackageDefs,
PackageLinks, PackageSystem, OpenInstalledPkgDlg, PkgGraphExplorer,
BrokenDependenciesDlg, CompilerOptions, ExtToolEditDlg,
@ -385,8 +388,9 @@ begin
+LE
+'end.'+LE;
Result:=MainIDE.DoNewEditorFile(nuUnit,Params.UnitFilename,NewSource,
[nfOpenInEditor,nfIsNotPartOfProject,nfSave,nfAddToRecent]);
Result:=MainIDE.DoNewEditorFile(FileDescriptorUnit,
Params.UnitFilename,NewSource,
[nfOpenInEditor,nfIsNotPartOfProject,nfSave,nfAddToRecent]);
end;
function TPkgManager.OnPackageEditorDeleteAmbigiousFiles(Sender: TObject;