Changeset 120

Timestamp:

Nov 29, 2017, 1:21:22 PM (7 years ago)

Author:

chronos

Message:

• Added: Show "Used by" rules in rule edit window.

Location:

branches/generator

Files:

• Forms/UFormRule.lfm (modified) (2 diffs)
• Forms/UFormRule.pas (modified) (5 diffs)
• URules.pas (modified) (6 diffs)
• generator.lpr (modified) (1 diff)

branches/generator/Forms/UFormRule.lfm

@@ -45 +45 @@
     Top = 80
     Width = 640
-    ActivePage = TabSheet1
+    ActivePage = TabSheetUsedBy
     Anchors = [akTop, akLeft, akRight, akBottom]
-    TabIndex = 0
+    TabIndex = 2
     TabOrder = 2
     object TabSheet1: TTabSheet
@@ -54 +54 @@
     object TabSheet2: TTabSheet
       Caption = 'Links'
+    end
+    object TabSheetUsedBy: TTabSheet
+      Caption = 'Used by'
+      ClientHeight = 359
+      ClientWidth = 632
+      object ListView1: TListView
+        Left = 0
+        Height = 359
+        Top = 0
+        Width = 632
+        Align = alClient
+        Columns = <        
+          item
+            Caption = 'Name'
+            Width = 200
+          end>
+        OwnerData = True
+        ReadOnly = True
+        RowSelect = True
+        TabOrder = 0
+        ViewStyle = vsReport
+        OnData = ListView1Data
+      end
     end
   end

branches/generator/Forms/UFormRule.pas

@@ -19 +19 @@
     EditName: TEdit;
     Label1: TLabel;
+    ListView1: TListView;
     PageControl1: TPageControl;
     TabSheet1: TTabSheet;
     TabSheet2: TTabSheet;
+    TabSheetUsedBy: TTabSheet;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure FormShow(Sender: TObject);
+    procedure ListView1Data(Sender: TObject; Item: TListItem);
   private
     FormRuleItems: TFormRuleItems;
+    UsedByRules: TStringList;
+    procedure ReloadUsedByRules;
   public
     Rule: TRule;
@@ -39 +44 @@
 implementation
 
+uses
+  UCore;
+
 {$R *.lfm}
 
@@ -46 +54 @@
 begin
   EditName.SetFocus;
+  PageControl1.TabIndex := 0;  // Select first tab by default
+end;
+
+procedure TFormRule.ListView1Data(Sender: TObject; Item: TListItem);
+begin
+  if Item.Index < UsedByRules.Count then
+  begin
+    Item.Caption := UsedByRules[Item.Index];
+    Item.Data := UsedByRules.Objects[Item.Index];
+  end;
+end;
+
+procedure TFormRule.ReloadUsedByRules;
+begin
+  ListView1.Items.Count := UsedByRules.Count;
+  ListView1.Refresh;
 end;
 
@@ -54 +78 @@
   FormRuleItems.Align := alClient;
   FormRuleItems.Show;
+  UsedByRules := TStringList.Create;
 end;
 
 procedure TFormRule.FormDestroy(Sender: TObject);
 begin
+  FreeAndNil(UsedByRules);
   FreeAndNil(FormRuleItems);
 end;
@@ -64 +90 @@
 begin
   Self.Rule := Rule;
+  Rule.Grammer.GetUsedByRule(Rule, UsedByRules);
+  ReloadUsedByRules;
   EditName.Text := Rule.Name;
   CheckBoxCreateNode.Checked := Rule.CreateSourceNode;

branches/generator/URules.pas

@@ -76 +76 @@
   TRule = class
   private
-    function GetGrammer: TGrammer;
+    FGrammer: TGrammer;
     procedure SetGrammer(AValue: TGrammer);
   public
@@ -83 +83 @@
     Items: TRuleItems;
     Links: TRuleLinks;
-    property Grammer: TGrammer read GetGrammer write SetGrammer;
     constructor Create;
     destructor Destroy; override;
+    procedure GetUsedByRule(RefRule: TRule; UsedByRules: TStrings);
     procedure LoadFromXmlNode(Node: TDOMNode);
     procedure SaveToXmlNode(Node: TDOMNode);
     function GetString: string;
+    property Grammer: TGrammer read FGrammer write SetGrammer;
   end;
 
@@ -117 +118 @@
     destructor Destroy; override;
     procedure BuildCompiler;
+    procedure GetUsedByRule(RefRule: TRule; UsedByRules: TStrings);
     function GetString: string;
     property Modified: Boolean read FModified write SetModified;
@@ -308 +310 @@
 end;
 
+procedure TGrammer.GetUsedByRule(RefRule: TRule; UsedByRules: TStrings);
+var
+  Rule: TRule;
+begin
+  UsedByRules.Clear;
+  for Rule in Rules do
+    Rule.GetUsedByRule(RefRule, UsedByRules);
+end;
+
 function TGrammer.GetString: string;
 begin
@@ -498 +509 @@
 end;
 
-function TRule.GetGrammer: TGrammer;
-begin
-  Result := Items.Grammer;
-end;
-
 procedure TRule.SetGrammer(AValue: TGrammer);
 begin
+  if FGrammer = AValue then Exit;
+  FGrammer := AValue;
   Items.Grammer := AValue;
 end;
@@ -520 +528 @@
   FreeAndNil(Items);
   inherited Destroy;
+end;
+
+procedure TRule.GetUsedByRule(RefRule: TRule; UsedByRules: TStrings);
+var
+  Item: TRuleItem;
+begin
+  for Item in Items do
+    if (Item.RuleItemType = ritNonTerminal) and
+      (Item.NonTerminal = RefRule) and
+      (UsedByRules.IndexOf(Item.ParentRule.Name) = -1) then
+      UsedByRules.AddObject(Item.ParentRule.Name, Item.ParentRule);
 end;
 

branches/generator/generator.lpr

@@ -26 +26 @@
   {$ENDIF}
 
-  Application.Title:='Language generator';
+  Application.Title := 'Language generator';
   RequireDerivedFormResource := True;
   Application.Initialize;