Changeset 4 for trunk/UKConfig.pas
- Timestamp:
- May 1, 2014, 7:29:12 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UKConfig.pas
r2 r4 14 14 TLoadTreeOption = (toShowSystem); 15 15 TLoadTreeOptions = set of TLoadTreeOption; 16 TObjectMove = record 17 Source: TObject; 18 NewParent: TObject; 19 end; 20 TObjectMoves = array of TObjectMove; 16 21 17 22 { TMenuNode } … … 33 38 destructor Destroy; override; 34 39 function GetName: string; virtual; 40 function GetabsoluteName: string; virtual; 35 41 procedure LoadTreeNode(Node: TTreeNode; Options: TLoadTreeOptions = []); virtual; 36 end; 42 procedure LoadStats(List: TStrings); virtual; 43 procedure SaveToList(List: TStrings); virtual; 44 procedure PrepareMoveList(var List: TObjectMoves); virtual; 45 function GetTopNode: TMenuNode; virtual; 46 function FindNode(ID: string): TMenuNode; virtual; 47 end; 48 49 TOnLogEvent = procedure (Text: string) of object; 37 50 38 51 { TConfigMenu } … … 42 55 CurrentMenu: TMenuNode; 43 56 Arch: string; 57 FOnLog: TOnLogEvent; 58 procedure Log(Text: string); 44 59 function IsWhiteSpace(Character: Char): Boolean; 45 60 function GetNextToken(var Text: string): string; … … 49 64 BaseDir: string; 50 65 procedure LoadFromDir(Dir: string; Arch: string); 66 property OnLog: TOnLogEvent read FOnLog write FOnLog; 51 67 end; 52 68 … … 81 97 end; 82 98 99 function TMenuNode.GetabsoluteName: string; 100 begin 101 if Assigned(Parent) then Result := Parent.GetabsoluteName + ' - '; 102 Result := Result + GetName; 103 end; 104 83 105 procedure TMenuNode.LoadTreeNode(Node: TTreeNode; Options: TLoadTreeOptions); 84 106 var … … 90 112 if (Name <> '') or ((Name = '') and (toShowSystem in Options)) then begin 91 113 NewNode := Node.TreeNodes.AddChild(Node, GetName); 114 NewNode.Data := TMenuNode(Self.Items[I]); 92 115 LoadTreeNode(NewNode, Options); 93 116 end; … … 95 118 end; 96 119 120 procedure TMenuNode.LoadStats(List: TStrings); 121 begin 122 with List do begin 123 Clear; 124 Add('ID: ' + ID); 125 Add('Name: ' + Name); 126 Add('Depends on: ' + Depends.Text); 127 Add('Selects: ' + Selects.Text); 128 Add('Description: ' + Description.Text); 129 Add('Condition: ' + Condition); 130 Add('Value type: ' + IntToStr(Integer(ValueType))); 131 Add('Default value: ' + DefaultValue); 132 end; 133 end; 134 135 procedure TMenuNode.SaveToList(List: TStrings); 136 var 137 I: Integer; 138 begin 139 if ID <> '' then List.Add(ID); 140 for I := 0 to Items.Count - 1 do 141 with TMenuNode(Items[I]) do begin 142 SaveToList(List); 143 end; 144 end; 145 146 procedure TMenuNode.PrepareMoveList(var List: TObjectMoves); 147 var 148 I: Integer; 149 Node: TMenuNode; 150 NewMove: TObjectMove; 151 begin 152 if Depends.Count > 0 then begin 153 Node := GetTopNode.FindNode(Depends[0]); 154 if Assigned(Node) and (Parent <> Node) then begin 155 NewMove.Source := Self; 156 NewMove.NewParent := Node; 157 SetLength(List, Length(List) + 1); 158 List[Length(List) - 1] := NewMove; 159 end; 160 end else 161 if Condition <> '' then begin 162 Node := GetTopNode.FindNode(Condition); 163 if Assigned(Node) and (Parent <> Node) then begin 164 NewMove.Source := Self; 165 NewMove.NewParent := Node; 166 SetLength(List, Length(List) + 1); 167 List[Length(List) - 1] := NewMove; 168 end; 169 end; 170 I := 0; 171 while I < Items.Count do 172 with TMenuNode(Items[I]) do begin 173 PrepareMoveList(List); 174 Inc(I); 175 end; 176 end; 177 178 function TMenuNode.GetTopNode: TMenuNode; 179 begin 180 if Assigned(Parent) then Result := Parent.GetTopNode 181 else Result := Self; 182 end; 183 184 function TMenuNode.FindNode(ID: string): TMenuNode; 185 var 186 I: Integer; 187 begin 188 Result := nil; 189 if Self.ID = ID then Result := Self 190 else begin 191 I := 0; 192 while (I < Items.Count) do begin 193 Result := TMenuNode(Items[I]).FindNode(ID); 194 if Assigned(Result) then Break; 195 Inc(I); 196 end; 197 end; 198 end; 199 97 200 { TConfigMenu } 201 202 procedure TConfigMenu.Log(Text: string); 203 begin 204 if Assigned(FOnLog) then FOnLog(Text); 205 end; 98 206 99 207 function TConfigMenu.IsWhiteSpace(Character: Char): Boolean; … … 155 263 156 264 begin 265 Log('FILE ' + FileName); 157 266 try 158 267 Content := TStringList.Create; … … 165 274 for I := 0 to Content.Count - 1 do begin 166 275 Line := MergedLines + Content[I]; 276 MergedLines := ''; 167 277 LineIndent := 1; 168 278 while (LineIndent <= Length(Line)) and IsWhiteSpace(Line[LineIndent]) do Inc(LineIndent); … … 317 427 if Command = 'menu' then begin 318 428 Parameter := GetNextToken(Line); 429 Log('MENU ' + Parameter + ' IN ' + CurrentMenu.GetAbsoluteName); 319 430 NewMenu := TMenuNode.Create; 320 431 NewMenu.Name := Parameter; 321 432 NewMenu.Parent := CurrentMenu; 433 NewMenu.Condition := Condition; 434 Condition := ''; 322 435 NewItem := NewMenu; 323 436 CurrentMenu.Items.Add(NewMenu); … … 325 438 end else 326 439 if command = 'endmenu' then begin 327 if Assigned(CurrentMenu.Parent) then 328 CurrentMenu := CurrentMenu.Parent 329 else raise Exception.Create('Can''t change menu level up. ' + GetLog); 440 Log('ENDMENU ' + CurrentMenu.GetAbsoluteName); 441 if Assigned(CurrentMenu.Parent) then begin 442 Condition := CurrentMenu.Condition; 443 CurrentMenu := CurrentMenu.Parent; 444 end else raise Exception.Create('Can''t change menu level up. ' + GetLog); 330 445 end else 331 446 if Command = 'if' then begin … … 346 461 347 462 procedure TConfigMenu.LoadFromDir(Dir: string; Arch: string); 463 var 464 Moves: TObjectMoves; 465 I: Integer; 348 466 begin 349 467 Self.Arch := Arch; … … 354 472 CurrentMenu := TopNode; 355 473 ParseFile(BaseDir + DirectorySeparator + 'Kconfig'); 474 475 TopNode.PrepareMoveList(Moves); 476 for I := 0 to Length(Moves) - 1 do 477 with Moves[I] do begin 478 TMenuNode(Source).Parent.Items.OwnsObjects := False; 479 TMenuNode(Source).Parent.Items.Remove(Source); 480 TMenuNode(Source).Parent.Items.OwnsObjects := True; 481 TMenuNode(Source).Parent := TMenuNode(NewParent); 482 TMenuNode(NewParent).Items.Add(Source); 483 end; 356 484 end; 357 485
Note:
See TracChangeset
for help on using the changeset viewer.