Changeset 49


Ignore:
Timestamp:
Mar 4, 2012, 5:26:20 PM (12 years ago)
Author:
chronos
Message:
  • Added: Compiled target code now can be browsed using Target project navigation.
Location:
trunk
Files:
3 added
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/Compiler/UCompiler.pas

    r47 r49  
    2121  private
    2222    FAnalyzer: TAnalyzer;
     23    FTarget: TTarget;
    2324    FOnErrorMessage: TErrorMessageEvent;
    2425    function GetSource(Name: string; var SourceCode: string): Boolean;
     26    function WriteTarget(Name: string; TargetCode: string): Boolean;
    2527    procedure ErrorMessage(Text: string; Position: TPoint; FileName: string);
    2628    procedure SetAnalyzer(const AValue: TAnalyzer);
    2729    procedure AnalyzeAll;
    2830    procedure ProduceAll;
     31    procedure SetTarget(AValue: TTarget);
    2932  public
    3033    AbstractCode: TProgram;
    3134    ErrorMessages: TListObject;
    3235    CompiledFolder: string;
    33     Target: TTarget;
     36
    3437    TargetFolder: string;
    3538    Targets: TListTarget;
    … …  
    4346      write FOnErrorMessage;
    4447    property Analyzer: TAnalyzer read FAnalyzer write SetAnalyzer;
     48    property Target: TTarget read FTarget write SetTarget;
    4549  end;
    4650
    … …  
    5357resourcestring
    5458  SNothingToAnalyze = 'Nothing to analyze';
     59  SRewritingExistedTarget = 'Reqriting existing target file %s';
    5560
    5661{ TCompiler }
    … …  
    113118end;
    114119
     120function TCompiler.WriteTarget(Name: string; TargetCode: string): Boolean;
     121var
     122  I: Integer;
     123  F: TFileStream;
     124begin
     125  I := 0;
     126  while (I < TargetFiles.Count) and (ExtractFileNameOnly(TargetFiles[I]) <> Name) do Inc(I);
     127  if I >= TargetFiles.Count then begin
     128    try
     129      ForceDirectoriesUTF8(ExtractFileDir(Name));
     130      if FileExistsUTF8(Name) then
     131        F := TFileStream.Create(UTF8Decode(Name), fmOpenWrite)
     132        else F := TFileStream.Create(UTF8Decode(Name), fmCreate);
     133      F.Size := 0;
     134      if Length(TargetCode) > 0 then
     135        F.Write(TargetCode[1], Length(TargetCode));
     136      Result := True;
     137      TargetFiles.Add(Name);
     138    finally
     139      F.Free;
     140    end;
     141  end else begin
     142    Result := False;
     143    ErrorMessage(Format(SRewritingExistedTarget, [Name]), Point(0, 0), '');
     144  end;
     145end;
     146
    115147procedure TCompiler.ErrorMessage(Text: string; Position: TPoint; FileName: string);
    116148var
    … …  
    160192      Target.Producer.Produce(TModule(Modules[I]));
    161193      Target.Producer.AssignToStringList(ProducedCode);
    162       TargetFileName := TargetFolder + DirectorySeparator +
    163         CompiledFolder + DirectorySeparator + Target.Name +
    164         DirectorySeparator + TModule(Modules[I]).TargetFile;
    165       ForceDirectoriesUTF8(ExtractFileDir(TargetFileName));
    166       ProducedCode.SaveToFile(TargetFileName);
     194      TargetFileName := TargetFolder + DirectorySeparator + TModule(Modules[I]).TargetFile;
     195      if Assigned(Target.Producer.OnWriteTarget) then
     196        Target.Producer.OnWriteTarget(TargetFileName, ProducedCode.Text);
    167197    end;
    168198  finally
    … …  
    171201end;
    172202
     203procedure TCompiler.SetTarget(AValue: TTarget);
     204begin
     205  if FTarget = AValue then Exit;
     206  FTarget := AValue;
     207  FTarget.Producer.OnWriteTarget := WriteTarget;
     208end;
     209
    173210end.

  • trunk/Compiler/UProducer.pas

    r44 r49  
    1010type
    1111
     12  TWriteTargetEvent = function (Name: string; Code: string): Boolean of object;
     13
    1214  { TProducer }
    1315
    1416  TProducer = class
     17  private
     18    FOnWriteTarget: TWriteTargetEvent;
     19  public
    1520    TextSource: TStringList;
    1621    IndentationLength: Integer;
    … …  
    2328    constructor Create;
    2429    destructor Destroy; override;
     30    property OnWriteTarget: TWriteTargetEvent read FOnWriteTarget write FOnWriteTarget;
    2531  end;
    2632

  • trunk/IDE/Forms/UFormMain.lfm

    r48 r49  
    9999    Top = 26
    100100    Width = 200
    101     ActivePage = TabSheetCompiledProject
     101    ActivePage = TabSheetTargetProject
    102102    Align = alRight
    103103    TabIndex = 2
    … …  
    110110      Caption = 'Code Tree'
    111111    end
    112     object TabSheetCompiledProject: TTabSheet
     112    object TabSheetTargetProject: TTabSheet
    113113      Caption = 'Target project'
    114114    end
    … …  
    579579    object MenuItem9: TMenuItem
    580580      Caption = 'Help'
     581      object MenuItem33: TMenuItem
     582        Action = AHelp
     583      end
    581584      object MenuItem10: TMenuItem
    582585        Action = AHomepage
    … …  
    584587      object MenuItem11: TMenuItem
    585588        Action = AAbout
    586         Bitmap.Data = {
    587           36040000424D3604000000000000360000002800000010000000100000000100
    588           2000000000000004000064000000640000000000000000000000000000000000
    589           0000000000000000000000000000000000000000000000000000000000000000
    590           0000000000000000000000000000000000000000000000000000000000000000
    591           00000000000000000000916429FF855A24FF885015FF824A1DFF7E4719FF7944
    592           17FF583C0EFF49340DFF00000000000000000000000000000000000000000000
    593           000000000000A1692CFFC08858FFE0C9B4FFF7F1ECFFFEFDFCFFFEFDFCFFF5F0
    594           ECFFDCC9B8FF9E7857FF473108FF000000000000000000000000000000000000
    595           0000B2702BFFDBAB80FFF8EFE7FFE2BBA6FFCC7E56FFC15823FFC05722FFC97F
    596           56FFDEBAA7FFF2EBE7FFB39376FF483108FF000000000000000000000000B677
    597           34FFD6996BFFF9F0E7FFDDA488FFC75013FFC04E11FFDCA688FFFFFEFEFFB549
    598           11FFB64A10FFD59E82FFF3ECE7FF9A7352FF49340DFF0000000000000000B479
    599           3AFFEFD6C1FFEDC5B2FFDD5A1AFFD55617FFD25313FFD87D4DFFE3A686FFBB4C
    600           11FFB34A12FFB64A10FFDEB9A6FFDCC9B8FF563C0DFF0000000000000000CD7F
    601           45FFFCF4EDFFEC9772FFE86021FFE05A1DFFDB5819FFEDAA89FFFFFEFEFFC84E
    602           12FFB94C11FFB34C13FFC77B53FFF6F0ECFF7A4319FF0000000000000000CD81
    603           47FFFFFEFEFFF87A46FFF96829FFF66525FFF16020FFF18653FFFFFEFEFFF0BF
    604           A8FFC55A24FFB64C15FFB75724FFFEFEFDFF7F481AFF0000000000000000CD84
    605           4EFFFFFEFEFFFC814CFFFF7031FFFF6B2CFFFD6928FFF86523FFF49265FFFDF5
    606           F1FFF4D4C5FFC65018FFBA5927FFFEFEFDFF834A1CFF0000000000000000D183
    607           4CFFFCF7F1FFFAA582FFFF733AFFFF844EFFFFAE8AFFFE6C2DFFF76727FFF192
    608           68FFFFFEFEFFE98354FFD78560FFF8F1ECFF81551FFF0000000000000000C483
    609           41FFF0DAC3FFFAD1C0FFFF7940FFFF986EFFFFFEFEFFFFC9B2FFFD9164FFFAC6
    610           AFFFFEF5F1FFF5773DFFEDC5B2FFE4CBB3FF905D21FF0000000000000000C484
    611           45FFDCA277FFFCF4EDFFFABFA6FFFF7A43FFFFBB9EFFFFF6F3FFFFFEFEFFFEED
    612           E5FFFA9970FFF3B69CFFF8F0E6FFBB8B56FF986426FF00000000000000000000
    613           0000C48443FFE5B999FFFCF4EDFFFBD2C1FFFAA887FFFD8757FFFD8454FFF8A5
    614           82FFF7CEBDFFFAF1E7FFD2A77AFFA36A2AFF0000000000000000000000000000
    615           000000000000C58442FFDCA277FFF3DAC7FFFCF7F1FFFFFEFEFFFFFEFEFFFCF4
    616           EDFFF1D6C0FFC7935DFFA66F33FF000000000000000000000000000000000000
    617           00000000000000000000C58444FFC28342FFD89C6DFFD69668FFD49463FFD696
    618           68FFB2793CFFB1783BFF00000000000000000000000000000000000000000000
    619           0000000000000000000000000000000000000000000000000000000000000000
    620           0000000000000000000000000000000000000000000000000000
    621         }
    622589      end
    623590    end
    … …  
    633600      ImageIndex = 10
    634601      OnExecute = AProjectNewExecute
     602      ShortCut = 16462
    635603    end
    636604    object AProjectOpen: TAction
    … …  
    640608      ImageIndex = 7
    641609      OnExecute = AProjectOpenExecute
     610      ShortCut = 16463
    642611    end
    643612    object AProjectSave: TAction
    … …  
    673642      ImageIndex = 4
    674643      OnExecute = AExitExecute
     644      ShortCut = 16499
    675645    end
    676646    object ARun: TAction
    … …  
    682652    object AAbout: TAction
    683653      Caption = 'About...'
    684       ImageIndex = 5
    685654      OnExecute = AAboutExecute
    686655    end
    … …  
    697666      Category = 'View'
    698667      Caption = 'Object inspector'
     668      ShortCut = 122
    699669    end
    700670    object AViewSourceEditor: TAction
    … …  
    732702      Category = 'Run'
    733703      Caption = 'Stop'
     704      ImageIndex = 0
    734705      ShortCut = 16497
    735706    end
    … …  
    737708      Category = 'Run'
    738709      Caption = 'Pause'
     710      ImageIndex = 8
    739711    end
    740712    object AReset: TAction
    … …  
    761733      Caption = 'Run to cursor'
    762734      ShortCut = 115
     735    end
     736    object AHelp: TAction
     737      Caption = 'Help'
     738      ImageIndex = 5
     739      ShortCut = 112
    763740    end
    764741  end

  • trunk/IDE/Forms/UFormMain.lrt

    r48 r49  
    22TFORMMAIN.TABSHEETPROJECT.CAPTION=Project
    33TFORMMAIN.TABSHEETCODETREE.CAPTION=Code Tree
    4 TFORMMAIN.TABSHEETCOMPILEDPROJECT.CAPTION=Target project
     4TFORMMAIN.TABSHEETTARGETPROJECT.CAPTION=Target project
    55TFORMMAIN.TABSHEETMESSAGES.CAPTION=Messages
    66TFORMMAIN.TABSHEETBREAKPOINTS.CAPTION=Breakpoints
    … …  
    4545TFORMMAIN.ASTEPOUT.CAPTION=Step out
    4646TFORMMAIN.ARUNTOCURSOR.CAPTION=Run to cursor
     47TFORMMAIN.AHELP.CAPTION=Help

  • trunk/IDE/Forms/UFormMain.pas

    r48 r49  
    2828  TFormMain = class(TForm)
    2929    ABuild: TAction;
     30    AHelp: TAction;
    3031    ARunToCursor: TAction;
    3132    AStepOut: TAction;
    … …  
    8283    MenuItem31: TMenuItem;
    8384    MenuItem32: TMenuItem;
     85    MenuItem33: TMenuItem;
    8486    MenuItemProducer: TMenuItem;
    8587    MenuItem3: TMenuItem;
    … …  
    103105    TabSheetMessages: TTabSheet;
    104106    TabSheetBreakpoints: TTabSheet;
    105     TabSheetCompiledProject: TTabSheet;
     107    TabSheetTargetProject: TTabSheet;
    106108    TabSheetSource: TTabSheet;
    107109    TabSheetTarget: TTabSheet;
    … …  
    150152    procedure ProjectOpen(FileName: string);
    151153    procedure UpdateMenu;
     154    procedure UpdateToolbar;
    152155  public
    153156    ReopenLastOpenedFile: Boolean;
    … …  
    172175  UFormMessages, UFormSourceCode, UFormProject, UCommon, UFormAbout, UFormOptions,
    173176  UFormTargets, UTarget, UAnalyzer, UProducer, UExecutor, UFormProjectNew,
    174   UProjectTemplates;
     177  UProjectTemplates, UFormTargetProject;
    175178
    176179resourcestring
    … …  
    239242      Compiler.SourceFiles.Clear;
    240243      Project.Files.DumpFileList(Compiler.SourceFiles);
    241       Compiler.TargetFolder := ExtractFileDir(Project.FileName);
     244      TargetProject.FileName := ExtractFileDir(Project.FileName) + DirectorySeparator +
     245        Compiler.CompiledFolder + DirectorySeparator + Compiler.Target.Name +
     246        DirectorySeparator + 'Target.tppr';
     247      Compiler.TargetFolder := ExtractFileDir(TargetProject.FileName);
    242248      Compiler.Compile;
     249      TargetProject.Files.LoadFromList(Compiler.TargetFiles);
     250      FormTargetProject.UpdateInterface;
    243251    end;
    244252    FormProject.TreeViewProjectChange(Self, FormProject.TreeViewProject.Selected);
    … …  
    332340
    333341  UpdateMenu;
     342  UpdateToolbar;
    334343  FormSourceCode.UpdateInterface;
     344  FormTargetCode.UpdateInterface;
    335345  FormProject.UpdateInterface;
    336346end;
    … …  
    350360  FormProject.Align := alClient;
    351361  FormProject.Show;
     362  FormTargetProject.ManualDock(TabSheetTargetProject, nil, alClient);
     363  FormTargetProject.Align := alClient;
     364  FormTargetProject.Show;
    352365  FormCodeTree.ManualDock(TabSheetCodeTree, nil, alClient);
    353366  FormCodeTree.Align := alClient;
    … …  
    473486end;
    474487
     488procedure TFormMain.UpdateToolbar;
     489var
     490  I: Integer;
     491begin
     492  for I := 0 to ToolBar1.ButtonCount - 1 do
     493    TToolButton(ToolBar1.Buttons[I]).Hint := TToolButton(ToolBar1.Buttons[I]).Caption;
     494end;
     495
    475496procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
    476497begin

  • trunk/IDE/Forms/UFormTargetCode.pas

    r46 r49  
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, SynEdit,
    99  SynHighlighterMulti, SynHighlighterVB, SynHighlighterPas, SynHighlighterCpp,
    10   SynHighlighterXML;
     10  SynHighlighterXML, UProject;
    1111
    1212type
    … …  
    2020    SynXMLSyn1: TSynXMLSyn;
    2121  private
    22     { private declarations }
     22    FProjectFile: TProjectFile;
     23    procedure SetProjectFile(AValue: TProjectFile);
    2324  public
    24     { public declarations }
    25   end;
     25    procedure UpdateInterface;
     26    property ProjectFile: TProjectFile read FProjectFile write SetProjectFile;
     27  end;
    2628
    2729var
    … …  
    3234{$R *.lfm}
    3335
     36uses
     37  UFormMain;
     38
     39procedure TFormTargetCode.SetProjectFile(AValue: TProjectFile);
     40begin
     41  if FProjectFile = AValue then Exit;
     42  FProjectFile := AValue;
     43  if Assigned(AValue) then
     44    SynEdit1.Lines.Assign(FProjectFile.Source)
     45    else SynEdit1.ClearAll;
     46end;
     47
     48procedure TFormTargetCode.UpdateInterface;
     49begin
     50  SynEdit1.Enabled := FormMain.Project.Active;
     51  if not FormMain.Project.Active then SynEdit1.ClearAll;
     52end;
     53
     54
    3455end.
    3556

  • trunk/IDE/Languages/Transpascal.cs.po

    r48 r49  
    123123msgstr "Ukončit"
    124124
     125#: tformmain.ahelp.caption
     126msgctxt "tformmain.ahelp.caption"
     127msgid "Help"
     128msgstr "Nápověda"
     129
    125130#: tformmain.ahomepage.caption
    126131msgctxt "tformmain.ahomepage.caption"
    … …  
    314319msgstr "Strom kódu"
    315320
    316 #: tformmain.tabsheetcompiledproject.caption
    317 msgctxt "tformmain.tabsheetcompiledproject.caption"
    318 msgid "Target project"
    319 msgstr "Cílový projekt"
    320 
    321321#: tformmain.tabsheetmessages.caption
    322322msgctxt "tformmain.tabsheetmessages.caption"
    … …  
    339339msgstr "Cílový kód"
    340340
     341#: tformmain.tabsheettargetproject.caption
     342msgctxt "tformmain.tabsheettargetproject.caption"
     343msgid "Target project"
     344msgstr "Cílový projekt"
     345
    341346#: tformmessages.caption
    342347msgctxt "tformmessages.caption"
    … …  
    425430msgid "Target code"
    426431msgstr "Cílový kód"
     432
     433#: tformtargetproject.caption
     434msgid "FormTargetProject"
     435msgstr ""
    427436
    428437#: tformtargets.caption

  • trunk/IDE/Languages/Transpascal.po

    r48 r49  
    115115msgstr ""
    116116
     117#: tformmain.ahelp.caption
     118msgctxt "TFORMMAIN.AHELP.CAPTION"
     119msgid "Help"
     120msgstr ""
     121
    117122#: tformmain.ahomepage.caption
    118123msgctxt "TFORMMAIN.AHOMEPAGE.CAPTION"
    … …  
    305310msgstr ""
    306311
    307 #: tformmain.tabsheetcompiledproject.caption
    308 msgctxt "TFORMMAIN.TABSHEETCOMPILEDPROJECT.CAPTION"
    309 msgid "Target project"
    310 msgstr ""
    311 
    312312#: tformmain.tabsheetmessages.caption
    313313msgctxt "TFORMMAIN.TABSHEETMESSAGES.CAPTION"
    … …  
    330330msgstr ""
    331331
     332#: tformmain.tabsheettargetproject.caption
     333msgctxt "TFORMMAIN.TABSHEETTARGETPROJECT.CAPTION"
     334msgid "Target project"
     335msgstr ""
     336
    332337#: tformmessages.caption
    333338msgctxt "TFORMMESSAGES.CAPTION"
    … …  
    417422msgstr ""
    418423
     424#: tformtargetproject.caption
     425msgid "FormTargetProject"
     426msgstr ""
     427
    419428#: tformtargets.caption
    420429msgctxt "tformtargets.caption"

  • trunk/IDE/Transpascal.lpi

    r48 r49  
    106106      </Item7>
    107107    </RequiredPackages>
    108     <Units Count="16">
     108    <Units Count="17">
    109109      <Unit0>
    110110        <Filename Value="Transpascal.lpr"/>
    … …  
    213213        <UnitName Value="UProjectTemplates"/>
    214214      </Unit15>
     215      <Unit16>
     216        <Filename Value="Forms\UFormTargetProject.pas"/>
     217        <IsPartOfProject Value="True"/>
     218        <ComponentName Value="FormTargetProject"/>
     219        <ResourceBaseClass Value="Form"/>
     220        <UnitName Value="UFormTargetProject"/>
     221      </Unit16>
    215222    </Units>
    216223  </ProjectOptions>

  • trunk/IDE/Transpascal.lpr

    r48 r49  
    1313  UFormTargetCode, UFormCodeTree, TemplateGenerics, CoolTranslator, Common,
    1414  UFormAbout, UFormOptions, UFormTargets, UFormCompilerSettings,
    15 UFormProjectNew, UProjectTemplates;
     15UFormProjectNew, UProjectTemplates, UFormTargetProject;
    1616
    1717{$R *.res}
    … …  
    4242  Application.CreateForm(TFormTargets, FormTargets);
    4343  Application.CreateForm(TFormProjectNew, FormProjectNew);
     44  Application.CreateForm(TFormTargetProject, FormTargetProject);
    4445  Application.Run;
    4546end.

  • trunk/IDE/UProject.pas

    r48 r49  
    4141  private
    4242    FModified: Boolean;
     43    function GetAbsoluteFileName: string;
    4344    procedure SetModified(const AValue: Boolean);
    4445  public
    … …  
    5354    procedure Save;
    5455    property Modified: Boolean read FModified write SetModified;
     56    property AbsoluteFileName: string read GetAbsoluteFileName;
    5557  end;
    5658
    … …  
    6062    Parent: TProject;
    6163    procedure DumpFileList(Files: TListString);
     64    procedure LoadFromList(Files: TListString);
    6265    procedure Load;
    6366    procedure Save;
    … …  
    170173  Files.Clear;
    171174  for I := 0 to Count - 1 do
    172     Files.Add(TProjectFile(Items[I]).FileName);
     175    Files.Add(TProjectFile(Items[I]).AbsoluteFileName);
     176end;
     177
     178procedure TProjectFileList.LoadFromList(Files: TListString);
     179var
     180  I: Integer;
     181  NewFile: TProjectFile;
     182  FileName: string;
     183begin
     184  Clear;
     185  for I := 0 to Files.Count - 1 do begin
     186    FileName := Files[I];
     187    if Copy(FileName, 1, Length(ExtractFileDir(Parent.FileName))) =
     188      ExtractFileDir(Parent.FileName) then
     189        System.Delete(FileName, 1, Length(ExtractFileDir(Parent.FileName)) + 1);
     190    NewFile := AddFile(FileName);
     191    NewFile.Load;
     192  end;
    173193end;
    174194
    … …  
    245265end;
    246266
     267function TProjectFile.GetAbsoluteFileName: string;
     268begin
     269  Result := ExtractFileDir(Parent.FileName) + DirectorySeparator + FileName;
     270end;
     271
    247272constructor TProjectFile.Create;
    248273begin
    … …  
    277302      FileName := UTF8Encode(NewNode.TextContent);
    278303  end;
    279   if FileExistsUTF8(ExtractFileDir(Parent.FileName) + DirectorySeparator + FileName) then Load;
     304  if FileExistsUTF8(AbsoluteFileName) then Load;
    280305end;
    281306
    282307procedure TProjectFile.Load;
    283308begin
    284   Source.LoadFromFile(ExtractFileDir(Parent.FileName) + DirectorySeparator + FileName);
     309  Source.LoadFromFile(AbsoluteFileName);
    285310end;
    286311
Note: See TracChangeset for help on using the changeset viewer.