Changeset 126 for branches/generator
- Timestamp:
- Nov 30, 2017, 12:02:32 AM (7 years ago)
- Location:
- branches/generator
- Files:
-
- 14 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/generator/Forms/UFormGrammer.pas
r124 r126 62 62 procedure TFormGrammer.SaveData(Grammer: TGrammer); 63 63 begin 64 Grammer.Modified := True; 64 65 if ComboBoxStartRule.ItemIndex <> -1 then 65 66 Grammer.TopRule := TRule(ComboBoxStartRule.Items.Objects[ComboBoxStartRule.ItemIndex]) -
branches/generator/Forms/UFormMain.lfm
r124 r126 5 5 Width = 1050 6 6 Caption = 'Language generator' 7 ClientHeight = 6 537 ClientHeight = 644 8 8 ClientWidth = 1050 9 9 Menu = MainMenu1 10 10 OnClose = FormClose 11 OnCloseQuery = FormCloseQuery 11 12 OnShow = FormShow 12 LCLVersion = '1. 6.4.0'13 LCLVersion = '1.8.0.4' 13 14 object MemoBNF: TMemo 14 15 Left = 0 15 Height = 6 1816 Height = 609 16 17 Top = 35 17 18 Width = 1050 18 19 Align = alClient 20 ReadOnly = True 19 21 ScrollBars = ssAutoBoth 20 22 TabOrder = 0 … … 69 71 Caption = 'File' 70 72 object MenuItem11: TMenuItem 71 Action = A New73 Action = AProjectNew 72 74 end 73 75 object MenuItem4: TMenuItem 74 Action = A Open76 Action = AProjectOpen 75 77 end 76 78 object MenuItem10: TMenuItem 77 Action = A Save79 Action = AProjectSave 78 80 end 79 81 object MenuItem5: TMenuItem 80 Action = ASaveAs 82 Action = AProjectSaveAs 83 end 84 object MenuItem13: TMenuItem 85 Action = AProjectClose 81 86 end 82 87 object MenuItem12: TMenuItem … … 119 124 OnExecute = AExitExecute 120 125 end 121 object A Open: TAction126 object AProjectOpen: TAction 122 127 Caption = 'Open...' 123 128 Hint = 'Open...' 124 129 ImageIndex = 4 125 OnExecute = A OpenExecute130 OnExecute = AProjectOpenExecute 126 131 end 127 object A SaveAs: TAction132 object AProjectSaveAs: TAction 128 133 Caption = 'Save as...' 129 134 Hint = 'Save as...' 130 135 ImageIndex = 5 131 OnExecute = A SaveAsExecute136 OnExecute = AProjectSaveAsExecute 132 137 end 133 138 object ABuildCompiler: TAction … … 136 141 OnExecute = ABuildCompilerExecute 137 142 end 138 object A Save: TAction143 object AProjectSave: TAction 139 144 Caption = 'Save' 140 145 ImageIndex = 5 141 OnExecute = A SaveExecute146 OnExecute = AProjectSaveExecute 142 147 end 143 object A New: TAction148 object AProjectNew: TAction 144 149 Caption = 'New' 145 150 ImageIndex = 10 146 OnExecute = A NewExecute151 OnExecute = AProjectNewExecute 147 152 end 148 153 object AGrammerSettings: TAction 149 154 Caption = 'Settings' 150 155 OnExecute = AGrammerSettingsExecute 156 end 157 object AProjectClose: TAction 158 Caption = 'Close' 159 OnExecute = AProjectCloseExecute 151 160 end 152 161 end -
branches/generator/Forms/UFormMain.pas
r124 r126 15 15 TFormMain = class(TForm) 16 16 ABuildCompiler: TAction; 17 AProjectClose: TAction; 17 18 AGrammerSettings: TAction; 18 A New: TAction;19 A Save: TAction;19 AProjectNew: TAction; 20 AProjectSave: TAction; 20 21 AExit: TAction; 21 A Open: TAction;22 A SaveAs: TAction;22 AProjectOpen: TAction; 23 AProjectSaveAs: TAction; 23 24 ARules: TAction; 24 25 ActionList1: TActionList; … … 30 31 MenuItem11: TMenuItem; 31 32 MenuItem12: TMenuItem; 33 MenuItem13: TMenuItem; 32 34 MenuItem2: TMenuItem; 33 35 MenuItem3: TMenuItem; … … 46 48 procedure AExitExecute(Sender: TObject); 47 49 procedure AGrammerSettingsExecute(Sender: TObject); 48 procedure ANewExecute(Sender: TObject);49 procedure AOpenExecute(Sender: TObject);50 50 procedure ARulesExecute(Sender: TObject); 51 procedure ASaveAsExecute(Sender: TObject); 52 procedure ASaveExecute(Sender: TObject); 51 procedure AProjectNewExecute(Sender: TObject); 52 procedure AProjectOpenExecute(Sender: TObject); 53 procedure AProjectCloseExecute(Sender: TObject); 54 procedure AProjectSaveAsExecute(Sender: TObject); 55 procedure AProjectSaveExecute(Sender: TObject); 53 56 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); 57 procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); 54 58 procedure FormShow(Sender: TObject); 55 59 private … … 71 75 UFormRules, UCore, UFormGrammer; 72 76 73 { TFormMain } 77 resourcestring 78 SUnsavedChanges = 'Unsaved changes'; 79 SDoYouWantToSaveProject = 'There are unsaved changes in project. Do you want to save them?'; 80 SNewGrammer = 'New grammer.xtg'; 81 82 { TFormMain } 74 83 75 84 procedure TFormMain.ARulesExecute(Sender: TObject); … … 81 90 FormRules.ShowModal; 82 91 ReloadMemo; 92 UpdateInterface; 83 93 FreeAndNil(FormRules); 84 94 end; 85 95 86 procedure TFormMain.A SaveAsExecute(Sender: TObject);96 procedure TFormMain.AProjectSaveAsExecute(Sender: TObject); 87 97 begin 88 98 SaveDialog1.FileName := Core.Grammer.FileName; 89 99 if SaveDialog1.Execute then begin 100 Core.LastOpenedFile := SaveDialog1.FileName; 90 101 Core.Grammer.SaveToXmlFile(SaveDialog1.FileName); 91 102 UpdateInterface; … … 93 104 end; 94 105 95 procedure TFormMain.A SaveExecute(Sender: TObject);106 procedure TFormMain.AProjectSaveExecute(Sender: TObject); 96 107 begin 97 108 Core.Grammer.SaveToXmlFile(Core.Grammer.FileName); … … 104 115 end; 105 116 117 procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: boolean); 118 begin 119 AProjectClose.Execute; 120 if Assigned(Core.Grammer) then CanClose := False; 121 end; 122 106 123 procedure TFormMain.FormShow(Sender: TObject); 107 124 begin 108 125 Core.PersistentForm1.Load(Self, True); 126 Core.Initialize; 109 127 ReloadMemo; 110 128 UpdateInterface; … … 113 131 procedure TFormMain.ReloadMemo; 114 132 begin 115 MemoBNF.Lines.Text := Core.Grammer.GetString; 133 if Assigned(Core.Grammer) then 134 MemoBNF.Lines.Text := Core.Grammer.GetString 135 else MemoBNF.Lines.Clear; 116 136 end; 117 137 118 138 procedure TFormMain.UpdateInterface; 119 begin 120 Caption := Core.Grammer.FileName + ' - ' + Application.Title; 139 var 140 NewTitle: string; 141 begin 142 NewTitle := Application.Title; 143 if Assigned(Core.Grammer) then begin 144 NewTitle := ExtractFileNameWithoutExt(ExtractFileName(Core.Grammer.FileName)) + ' - ' + NewTitle; 145 if Core.Grammer.Modified then NewTitle := NewTitle + '*'; 146 end; 147 Caption := NewTitle; 148 AProjectClose.Enabled := Assigned(Core.Grammer); 149 AProjectSave.Enabled := Assigned(Core.Grammer) and Core.Grammer.Modified; 150 AProjectSaveAs.Enabled := Assigned(Core.Grammer); 151 AGrammerSettings.Enabled := Assigned(Core.Grammer); 152 ABuildCompiler.Enabled := Assigned(Core.Grammer); 153 ARules.Enabled := Assigned(Core.Grammer); 121 154 end; 122 155 … … 134 167 if FormGrammer.ShowModal = mrOk then begin 135 168 FormGrammer.SaveData(Core.Grammer); 169 UpdateInterface; 136 170 end; 137 171 FreeAndNil(FormGrammer); 138 172 end; 139 173 140 procedure TFormMain.ANewExecute(Sender: TObject); 141 begin 142 Core.Grammer.Rules.Clear; 143 ReloadMemo; 144 UpdateInterface; 174 procedure TFormMain.AProjectNewExecute(Sender: TObject); 175 begin 176 AProjectClose.Execute; 177 if not Assigned(Core.Grammer) then begin 178 Core.Grammer := TGrammer.Create; 179 Core.Grammer.FileName := SNewGrammer; 180 ReloadMemo; 181 UpdateInterface; 182 end; 145 183 end; 146 184 … … 150 188 end; 151 189 152 procedure TFormMain.AOpenExecute(Sender: TObject); 153 begin 154 OpenDialog1.FileName := Core.Grammer.FileName; 155 if OpenDialog1.Execute then begin 156 Core.Grammer.LoadFromXmlFile(OpenDialog1.FileName); 190 procedure TFormMain.AProjectOpenExecute(Sender: TObject); 191 begin 192 AProjectClose.Execute; 193 if not Assigned(Core.Grammer) then begin 194 OpenDialog1.FileName := Core.LastOpenedFile; 195 if OpenDialog1.Execute then begin 196 Core.LastOpenedFile := OpenDialog1.FileName; 197 Core.Grammer := TGrammer.Create; 198 Core.Grammer.LoadFromXmlFile(OpenDialog1.FileName); 199 ReloadMemo; 200 UpdateInterface; 201 end; 202 end; 203 end; 204 205 procedure TFormMain.AProjectCloseExecute(Sender: TObject); 206 var 207 DialogResult: TModalResult; 208 begin 209 if not Assigned(Core.Grammer) then Exit; 210 211 DialogResult := mrNo; 212 if Core.Grammer.Modified then begin 213 DialogResult := MessageDlg(SUnsavedChanges, SDoYouWantToSaveProject, mtConfirmation, [mbYes, mbNo, mbCancel], 0); 214 if DialogResult = mrYes then begin 215 AProjectSave.Execute; 216 end; 217 end; 218 if (DialogResult = mrNo) or (DialogResult = mrYes) then begin 219 FreeAndNil(Core.Grammer); 157 220 ReloadMemo; 158 221 UpdateInterface; -
branches/generator/Forms/UFormRule.pas
r123 r126 96 96 procedure TFormRule.SaveData(Rule: TRule); 97 97 begin 98 Rule.Grammer.Modified := True; 98 99 Rule.Name := EditName.Text; 99 100 Rule.CreateSourceNode := CheckBoxCreateNode.Checked; -
branches/generator/Forms/UFormRuleItem.pas
r124 r126 143 143 procedure TFormRuleItem.SaveData(RuleItem: TRuleItem); 144 144 begin 145 RuleItem.Grammer.Modified := True; 145 146 TFormRuleItems(FormRuleItems).SaveData(RuleItem.SubItems); 146 147 RuleItem.RuleItemType := TRuleItemType(ComboBoxType.ItemIndex); -
branches/generator/Forms/UFormRuleItems.pas
r122 r126 130 130 mtConfirmation, mbYesNo, 0) = mrYes then 131 131 for I := ListView1.Items.Count - 1 downto 0 do 132 if ListView1.Items[I].Selected then 132 if ListView1.Items[I].Selected then begin 133 133 RuleItems.ParentRule.Items.Remove(TRuleItem(ListView1.Items[I].Data)); 134 RuleItems.Grammer.Modified := True; 135 end; 134 136 ReloadList; 135 137 end; -
branches/generator/Forms/UFormRules.pas
r122 r126 121 121 mtConfirmation, mbYesNo, 0) = mrYes then 122 122 for I := ListView1.Items.Count - 1 downto 0 do 123 if ListView1.Items[I].Selected then 123 if ListView1.Items[I].Selected then begin 124 Rules.Grammer.Modified := True; 124 125 Rules.Remove(TRule(ListView1.Items[I].Data)); 126 end; 125 127 ReloadList; 126 128 end; -
branches/generator/Packages/Common/Languages/UJobProgressView.cs.po
r114 r126 39 39 msgid "Total estimated time: %s" 40 40 msgstr "CelkovÃœ odhadovanÃœ Äas: %s" 41 -
branches/generator/UCore.lfm
r119 r126 372 372 top = 123 373 373 end 374 object XMLConfig1: TXMLConfig 375 StartEmpty = False 376 RootName = 'CONFIG' 377 ReadOnly = False 378 left = 201 379 top = 262 380 end 374 381 end -
branches/generator/UCore.pas
r118 r126 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, Controls, ActnList, URules, UPersistentForm; 8 Classes, SysUtils, XMLConf, FileUtil, Controls, ActnList, URules, DOM, 9 UPersistentForm; 9 10 10 11 type … … 15 16 ImageList1: TImageList; 16 17 PersistentForm1: TPersistentForm; 18 XMLConfig1: TXMLConfig; 17 19 procedure DataModuleCreate(Sender: TObject); 18 20 procedure DataModuleDestroy(Sender: TObject); … … 20 22 { private declarations } 21 23 public 24 LastOpenedFile: string; 25 ReopenLastFile: Boolean; 22 26 Grammer: TGrammer; 27 procedure LoadConfig; 28 procedure SaveConfig; 29 procedure Initialize; 23 30 end; 24 31 … … 30 37 {$R *.lfm} 31 38 39 uses 40 UFormMain; 41 32 42 { TCore } 33 43 34 44 procedure TCore.DataModuleCreate(Sender: TObject); 35 45 begin 36 Grammer := TGrammer.Create; 37 Grammer.LoadFromXmlFile('pascal.grm'); 46 ForceDirectories(GetAppConfigDir(False)); 47 XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml'; 48 LoadConfig; 38 49 end; 39 50 40 51 procedure TCore.DataModuleDestroy(Sender: TObject); 41 52 begin 42 Grammer.SaveToXmlFile('pascal.grm'); 43 FreeAndNil(Grammer); 53 SaveConfig; 54 end; 55 56 procedure TCore.LoadConfig; 57 begin 58 with XMLConfig1 do begin 59 LastOpenedFile := string(GetValue('LastOpenedFile', 'pascal.grm')); 60 ReopenLastFile := GetValue('ReopenLastFile', True); 61 end; 62 end; 63 64 procedure TCore.SaveConfig; 65 begin 66 with XMLConfig1 do begin 67 SetValue('LastOpenedFile', DOMString(LastOpenedFile)); 68 SetValue('ReopenLastFile', ReopenLastFile); 69 Flush; 70 end; 71 end; 72 73 procedure TCore.Initialize; 74 begin 75 FormMain.AProjectNew.Execute; 76 if ReopenLastFile and FileExists(LastOpenedFile) then 77 Grammer.LoadFromXmlFile(LastOpenedFile) 44 78 end; 45 79 -
branches/generator/URules.pas
r125 r126 120 120 procedure LoadFromXmlFile(FileName: string); 121 121 procedure SaveToXmlFile(FileName: string); 122 procedure Clear; 122 123 constructor Create; 123 124 destructor Destroy; override; … … 148 149 ParserFile := TStringList.Create; 149 150 with ParserFile do begin 150 Add('unit Parse ;');151 Add('unit Parser;'); 151 152 Add(''); 152 153 Add('{$MODE Delphi}'); … … 158 159 Add(' Content: string;'); 159 160 Add(' Position: Integer;'); 161 Add(' procedure Error(Text: string);'); 160 162 Add(' function Expect(Text: string; Required: Boolean = False): Boolean;'); 161 163 Add(' function ExpectRange(CharFrom, CharTo: Char; Required: Boolean = False): Boolean;'); 162 164 for Rule in Rules do 163 165 Add(' function Parse' + Rule.Name + ': Boolean;'); 166 Add(' constructor Create;'); 164 167 Add(' end;'); 165 168 Add(''); 166 169 Add('implementation'); 170 Add(''); 171 Add('constructor TParser.Create;'); 172 Add('begin'); 173 Add(' Position := 1;'); 174 Add('end;'); 175 Add(''); 176 Add('procedure TParser.Error(Text: string);'); 177 Add('begin'); 178 Add(' WriteLn(''Error: '' + Text);'); 179 Add('end;'); 167 180 Add(''); 168 181 Add('function TParser.Expect(Text: string; Required: Boolean = False): Boolean;'); … … 172 185 Add(' ReadText := Copy(Content, Position, Length(Text));'); 173 186 Add(' Inc(Position, Length(Text));'); 174 Add(' Result := Text = ReadText ');187 Add(' Result := Text = ReadText;'); 175 188 Add(' if not Result and Required then Error(''Expected '' + Text + '' but found '' + ReadText + ''.'');'); 176 189 Add('end;'); … … 242 255 Add('procedure Compile(FileName: string);'); 243 256 Add('var'); 244 Add(' SourceFile: Text;'); 257 Add(' SourceFile: file of Char;'); 258 Add(' Parser: TParser;'); 259 Add(' I: Integer;'); 245 260 Add('begin'); 246 261 Add(' AssignFile(SourceFile, FileName);'); 247 262 Add(' Reset(SourceFile);'); 248 Add(' SetLength(Content, FileSize(SourceFile));');249 263 Add(' Parser := TParser.Create;'); 250 Add(' Read(SourceFile, Parser.Content);'); 264 Add(' SetLength(Parser.Content, FileSize(SourceFile));'); 265 Add(' I := 1;'); 266 Add(' while not Eof(SourceFile) do begin'); 267 Add(' Read(SourceFile, Parser.Content[I]);'); 268 Add(' Inc(I);'); 269 Add(' end;'); 251 270 Add(' CloseFile(SourceFile);'); 252 271 if Assigned(TopRule) then … … 256 275 Add(''); 257 276 Add('begin'); 258 Add(' if ParamCount > 1 then'); 259 Add(' Compile(ParamStr(1));'); 277 Add(' if ParamCount > 0 then'); 278 Add(' Compile(ParamStr(1))'); 279 Add(' else WriteLn(''File name not specified as parameter.'');'); 260 280 Add('end.'); 261 281 SaveToFile(FileName); … … 269 289 Item: TRuleItem; 270 290 SourceFile: TStringList; 291 TypeSectionStarted: Boolean; 271 292 begin 272 293 SourceFile := TStringList.Create; … … 281 302 Add(' fgl;'); 282 303 Add(''); 283 Add('type');304 TypeSectionStarted := False; 284 305 for Rule in Rules do 285 306 if Rule.CreateSourceNode then begin 307 if not TypeSectionStarted then begin 308 Add('type'); 309 TypeSectionStarted := True; 310 end; 286 311 Add(' T' + Rule.Name + ' = class;'); 287 312 end; … … 365 390 end; 366 391 392 procedure TGrammer.Clear; 393 begin 394 TopRule := nil; 395 Rules.Clear; 396 end; 397 367 398 constructor TGrammer.Create; 368 399 begin -
branches/generator/generator.lpi
r124 r126 14 14 <EnableI18N LFM="False"/> 15 15 </i18n> 16 <VersionInfo>17 <StringTable ProductVersion=""/>18 </VersionInfo>19 16 <BuildModes Count="2"> 20 17 <Item1 Name="Debug" Default="True"/> … … 71 68 </local> 72 69 </RunParams> 73 <RequiredPackages Count=" 3">70 <RequiredPackages Count="4"> 74 71 <Item1> 72 <PackageName Value="FCL"/> 73 </Item1> 74 <Item2> 75 75 <PackageName Value="TemplateGenerics"/> 76 76 <DefaultFilename Value="Packages/TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/> 77 </Item 1>78 <Item 2>77 </Item2> 78 <Item3> 79 79 <PackageName Value="Common"/> 80 80 <DefaultFilename Value="Packages/Common/Common.lpk" Prefer="True"/> 81 </Item 2>82 <Item 3>81 </Item3> 82 <Item4> 83 83 <PackageName Value="LCL"/> 84 </Item 3>84 </Item4> 85 85 </RequiredPackages> 86 86 <Units Count="9"> -
branches/generator/generator.lpr
r124 r126 8 8 {$ENDIF}{$ENDIF} 9 9 Interfaces, // this includes the LCL widgetset 10 Forms, UCore, URules, Common, TemplateGenerics, UFormRule, UFormMain, 11 UFormRules, UFormRuleItem, UFormRuleItems, SysUtils, UFormGrammer 10 Forms, UCore, Common, TemplateGenerics, UFormMain, SysUtils 12 11 { you can add units after this }; 13 12
Note:
See TracChangeset
for help on using the changeset viewer.