source: trunk/IDE/Core.pas

unit Core;

interface

uses
  Classes, SysUtils, FileUtil, LastOpenedList, Project, ApplicationInfo,
  Compiler, Registry, RegistryEx, DebugLog, Translator, Target,
  SourceCodePascal, ModularSystem;

type
  { TCustomCompiler }

  TCustomCompiler = class(TCompiler)
  private
    procedure InitSystemModule;
  public
    StartTime: TDateTime;
    SourceFiles: TSourceFileManager;
    TargetFiles: TSourceFileManager;
    procedure Init; override;
    function ElapsedTime: TDateTime;
    procedure LoadFromRegistry(Root: HKEY; const Key: string);
    procedure SaveToRegistry(Root: HKEY; const Key: string);
    constructor Create; override;
    destructor Destroy; override;
  end;

  { TCore }

  TCore = class(TDataModule)
    ApplicationInfo: TApplicationInfo;
    Translator1: TTranslator;
    DebugLog1: TDebugLog;
    LastOpenedFiles: TLastOpenedList;
    ModuleManager1: TModuleManager;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure LastOpenedFilesChange(Sender: TObject);
  private
    procedure ProjectChange(Sender: TObject);
    function LoadSourceFile(FileName: string; var Content: string): Boolean;
    function SaveSourceFile(FileName: string; const Content: string): Boolean;
  public
    ReopenLastOpenedFile: Boolean;
    LogParsing: Boolean;
    Project: TProject;
    ProjectTemplates: TProjectTemplates;
    TargetProject: TProject;
    Compiler: TCustomCompiler;
    ModuleManager: TModuleManager;
    procedure ProjectTemplatesInit;
    procedure ProjectOpen(FileName: string);
    procedure ProjectNew;
    procedure CompilerDebugLog(Text: string);
    procedure LoadFromRegistry(Root: HKEY; const Key: string);
    procedure SaveToRegistry(Root: HKEY; const Key: string);
    procedure RegisterIDEModules;
    procedure RegisterCompilerModules;
  end;

var
  Core: TCore;


implementation

{$R *.lfm}

uses
  FormMain, ProjectTemplates, IDEModulePascal, ModulePascal, ModuleGCC,
  ModuleInterpretter, ModuleDelphi, ModulePHP, ModuleJava, ModuleASM8051,
  ModuleXML, ModuleNASM;

{ TCore }

procedure TCore.ProjectOpen(FileName: string);
begin
  ProjectNew;
  Project.LoadFromFile(FileName);
  LastOpenedFiles.AddItem(FileName);
  FormMain.FormMain.UpdateInterface;
end;

procedure TCore.ProjectNew;
begin
  if Assigned(Project) then FreeAndNil(Project);
  Project := TProject.Create;
  Project.FileName := SNewProject;
  Project.OnChange := ProjectChange;
end;

procedure TCore.CompilerDebugLog(Text: string);
begin
  DebugLog1.Add('', Text);
end;

procedure TCore.DataModuleCreate(Sender: TObject);
begin
  DeleteFile(DebugLog1.FileName);
  Compiler := TCustomCompiler.Create;
  //Compiler.OnLoadSource := LoadSourceFile;
  //Compiler.OnSaveTarget := SaveSourceFile;
  Project := TProject.Create;
  ProjectTemplates := TProjectTemplates.Create;
  TargetProject := TProject.Create;
  LastOpenedFiles := TLastOpenedList.Create(nil);
  LastOpenedFiles.OnChange := LastOpenedFilesChange;

  ReopenLastOpenedFile := True;
  LogParsing := False;

  ModuleManager := TModuleManager.Create(nil);
  RegisterIDEModules;

  RegisterCompilerModules;
end;

procedure TCore.DataModuleDestroy(Sender: TObject);
begin
  FreeAndNil(ModuleManager);
  FreeAndNil(ProjectTemplates);
  FreeAndNil(LastOpenedFiles);
  FreeAndNil(TargetProject);
  FreeAndNil(Project);
  FreeAndNil(Compiler);
end;

procedure TCore.ProjectTemplatesInit;
begin
  ProjectTemplates.AddTemplate(TProjectTemplateConsoleApp.Create);
  ProjectTemplates.AddTemplate(TProjectTemplateGUIApp.Create);
  ProjectTemplates.AddTemplate(TProjectTemplatePackage.Create);
  ProjectTemplates.AddTemplate(TProjectTemplateUnit.Create);
end;

procedure TCore.LastOpenedFilesChange(Sender: TObject);
begin
  LastOpenedFiles.LoadToMenuItem(FormMain.FormMain.MenuItemOpenRecent,
    FormMain.FormMain.OpenRecentClick);
  LastOpenedFiles.LoadToMenuItem(FormMain.FormMain.PopupMenu1.Items,
    FormMain.FormMain.OpenRecentClick);
end;

procedure TCore.ProjectChange(Sender: TObject);
begin
  FormMain.FormMain.UpdateInterface;
end;

function TCore.LoadSourceFile(FileName: string; var Content: string): Boolean;
begin
end;

function TCore.SaveSourceFile(FileName: string; const Content: string): Boolean;
begin
end;

procedure TCore.LoadFromRegistry(Root: HKEY; const Key: string);
begin
  with TRegistryEx.Create do
    try
      RootKey := Root;
      OpenKey(Key, True);
      if ValueExists('ReopenLastOpenedFile') then
        ReopenLastOpenedFile := ReadBool('ReopenLastOpenedFile')
        else ReopenLastOpenedFile := True;
      if ValueExists('TargetName') then
        Compiler.Target := Compiler.Targets.SearchBySysName(ReadString('TargetName'))
        else Compiler.Target := nil;
      if ValueExists('LogParsing') then
        LogParsing := ReadBool('LogParsing')
        else LogParsing := False;
      if ValueExists('LanguageCode') then
        Translator1.Language := Translator1.Languages.SearchByCode(ReadString('LanguageCode'))
        else Translator1.Language := Translator1.Languages.SearchByCode('');
    finally
      Free;
    end;
  LastOpenedFiles.LoadFromRegistry(TRegistryContext.Create(Root, Key + '\LastOpenedFiles')); //Root, Key + '\LastOpenedFiles');
  Compiler.LoadFromRegistry(Root, Key + '\Compiler');
  FormMain.FormMain.LoadFromRegistry(Root, Key);
end;

procedure TCore.SaveToRegistry(Root: HKEY; const Key: string);
begin
  with TRegistryEx.Create do
    try
      RootKey := Root;
      OpenKey(Key, True);
      WriteBool('ReopenLastOpenedFile', ReopenLastOpenedFile);
      if Assigned(Compiler.Target) then
        WriteString('TargetName', Compiler.Target.SysName)
        else WriteString('TargetName', '');
      WriteBool('LogParsing', LogParsing);
      if Assigned(Translator1.Language) and (Translator1.Language.Code <> '') then
        WriteString('LanguageCode', Translator1.Language.Code)
        else WriteString('LanguageCode', '');
    finally
      Free;
    end;
  LastOpenedFiles.SaveToRegistry(TRegistryContext.Create(Root, Key + '\LastOpenedFiles'));
  Compiler.SaveToRegistry(Root, Key + '\Compiler');
  FormMain.FormMain.SaveToRegistry(Root, Key);
end;

procedure TCore.RegisterIDEModules;
begin
  ModuleManager.RegisterModule(TIDEModulePascal.Create(nil));
end;

procedure TCore.RegisterCompilerModules;
begin
  with Compiler.ModuleManager do begin
    RegisterModule(TModulePascal.Create(nil));
    RegisterModule(TModuleGCC.Create(nil));
    RegisterModule(TModuleInterpretter.Create(nil));
    RegisterModule(TModuleDelphi.Create(nil));
    RegisterModule(TModulePHP.Create(nil));
    RegisterModule(TModuleJava.Create(nil));
    RegisterModule(TModuleASM8051.Create(nil));
    RegisterModule(TModuleXML.Create(nil));
    RegisterModule(TModuleNASM.Create(nil));
    Modules.Perform(maEnable);
    Modules.Perform(maStart);
  end;
end;

{ TCustomCompiler }

procedure TCustomCompiler.InitSystemModule;
var
  SystemModule: TSourceModule;
begin
  SystemModule := TSourceModule.Create;
  with SystemModule do begin
    Name := 'System';
    Internal := True;
    with Body.Types.AddNew do begin
      Name := 'Byte';
      Size := 1;
      Internal := True;
    end;
    with Body.Types.AddNew do begin
      Name := 'ShortInt';
      Size := 1;
      Internal := True;
    end;
    with Body.Types.AddNew do begin
      Name := 'Word';
      Size := 2;
      Internal := True;
    end;
    with Body.Types.AddNew do begin
      Name := 'SmallInt';
      Size := 2;
      Internal := True;
    end;
    with Body.Types.AddNew do begin
      Name := 'Cardinal';
      Size := 4;
      Internal := True;
    end;
    with Body.Types.AddNew do begin
      Name := 'Integer';
      Size := 4;
      Internal := True;
    end;
    with Body.Types.AddNew do begin
      Name := 'UInt64';
      Size := 8;
      Internal := True;
    end;
    with Body.Types.AddNew do begin
      Name := 'Int64';
      Size := 8;
      Internal := True;
    end;
    with Body.Functions.AddNew do begin
      Name := 'WriteLn';
      Internal := True;
    end;
    ParentProgram := AbstractCode;
  end;
  AbstractCode.Modules.Add(SystemModule);
end;

procedure TCustomCompiler.Init;
begin
  inherited;
  StartTime := Now;
  InitSystemModule;
end;

function TCustomCompiler.ElapsedTime: TDateTime;
begin
  Result := Now - StartTime;
end;

procedure TCustomCompiler.LoadFromRegistry(Root: HKEY; const Key: string);
var
  I: Integer;
begin
  with TRegistryEx.Create do
    try
      RootKey := Root;
      for I := 0 to Targets.Count - 1 do
      with TTarget(Targets[I]) do begin
        OpenKey(Key + '\Targets\' + Name, True);
        if ValueExists('CompilerPath') then
          Producer.CompilerPath := ReadString('CompilerPath');
      end;
      OpenKey(Key, True);
      if ValueExists('SelectedTarget') then
        Target := Targets.SearchBySysName(ReadString('SelectedTarget'))
        else Target := nil;
    finally
      Free;
    end;
end;

procedure TCustomCompiler.SaveToRegistry(Root: HKEY; const Key: string);
var
  I: Integer;
begin
  with TRegistryEx.Create do
    try
      RootKey := Root;
      for I := 0 to Targets.Count - 1 do
      with TTarget(Targets[I]) do begin
        OpenKey(Key + '\Targets\' + Name, True);
        if Assigned(Producer) then begin
          if Producer.CompilerPath <> '' then WriteString('CompilerPath', Producer.CompilerPath)
            else WriteString('CompilerPath', '');
        end;
      end;
      OpenKey(Key, True);
      if Assigned(Target) then WriteString('SelectedTarget', Target.SysName)
        else WriteString('SelectedTarget', '');
    finally
      Free;
    end;
end;

constructor TCustomCompiler.Create;
begin
  inherited Create;
  SourceFiles := TSourceFileManager.Create;
  TargetFiles := TSourceFileManager.Create;
  OnLoadSource := SourceFiles.GetFileContent;
  OnSaveTarget := TargetFiles.SetFileContent;
end;

destructor TCustomCompiler.Destroy;
begin
  FreeAndNil(TargetFiles);
  FreeAndNil(SourceFiles);
  inherited;
end;

end.