source: trunk/Units/UProject.pas

Last change on this file was 19, checked in by chronos, 7 years ago
  • Fixed: Build under Lazarus 1.8.0.
  • Modified: Updated Common package.
File size: 4.5 KB
Line 
1unit UProject;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils, UVCS, UBackend, Contnrs, DOM, XMLRead, XMLWrite, UXMLUtils,
9 LazFileUtils;
10
11type
12
13{ TProject }
14
15 TProject = class
16 private
17 FBackend: TBackend;
18 function GetDirectory: string;
19 function GetRepositoryURL: string;
20 procedure SetDirectory(AValue: string);
21 procedure SetRepositoryURL(AValue: string);
22 procedure SetBackend(AValue: TBackend);
23 public
24 WorkingCopy: TWorkingCopy;
25 Repository: TRepository;
26 procedure Open(Directory: string);
27 constructor Create;
28 destructor Destroy; override;
29 procedure LoadXMLNOde(Node: TDOMNode);
30 procedure SaveXMLNOde(Node: TDOMNode);
31 property Backend: TBackend read FBackend write SetBackend;
32 property Directory: string read GetDirectory write SetDirectory;
33 property RepositoryURL: string read GetRepositoryURL write SetRepositoryURL;
34 end;
35
36 { TProjects }
37
38 TProjects = class(TObjectList)
39 procedure LoadXMLNode(Node: TDOMNode);
40 procedure SaveXMLNode(Node: TDOMNode);
41 end;
42
43 { TProjectGroup }
44
45 TProjectGroup = class
46 FileName: string;
47 Projects: TProjects;
48 constructor Create;
49 destructor Destroy; override;
50 procedure LoadFromFile(FileName: string);
51 procedure SaveToFile(FileName: string);
52 end;
53
54
55implementation
56
57resourcestring
58 SWrongFileFormat = 'Wrong file format';
59
60{ TProjects }
61
62procedure TProjects.LoadXMLNode(Node: TDOMNode);
63var
64 NewProject: TProject;
65 Node2: TDOMNode;
66begin
67 Node2 := Node.FirstChild;
68 while Assigned(Node2) and (Node2.NodeName = 'Project') do begin
69 NewProject := TProject.Create;
70 NewProject.LoadXMLNode(Node2);
71 Add(NewProject);
72 Node2 := Node2.NextSibling;
73 end;
74end;
75
76procedure TProjects.SaveXMLNode(Node: TDOMNode);
77var
78 I: Integer;
79 NewNode: TDOMNode;
80begin
81 for I := 0 to Count - 1 do begin;
82 NewNode := Node.OwnerDocument.CreateElement('Project');
83 Node.AppendChild(NewNode);
84 TProject(Items[I]).SaveXMLNode(NewNode);
85 end;
86end;
87
88
89{ TProjectGroup }
90
91constructor TProjectGroup.Create;
92begin
93 Projects := TProjects.Create;
94end;
95
96destructor TProjectGroup.Destroy;
97begin
98 Projects.Free;
99 inherited Destroy;
100end;
101
102procedure TProjectGroup.LoadFromFile(FileName: string);
103var
104 Doc: TXMLDocument;
105 RootNode: TDOMNode;
106 Node: TDOMNode;
107 Node2: TDOMNode;
108begin
109 Self.FileName := FileName;
110 ReadXMLFile(Doc, UTF8Decode(FileName));
111 with Doc do try
112 if Doc.DocumentElement.NodeName <> 'ProjectGroup' then
113 raise Exception.Create(SWrongFileFormat);
114 RootNode := Doc.DocumentElement;
115 with RootNode do begin
116 Node := FindNode('Projects');
117 if Assigned(Node) then Projects.LoadXMLNode(Node);
118 end;
119 finally
120 Doc.Free;
121 end;
122end;
123
124procedure TProjectGroup.SaveToFile(FileName: string);
125var
126 NewNode: TDOMNode;
127 Doc: TXMLDocument;
128 RootNode: TDOMNode;
129begin
130 if FileName = '' then Exit;
131 Self.FileName := FileName;
132 Doc := TXMLDocument.Create;
133 with Doc do try
134 RootNode := CreateElement('ProjectGroup');
135 AppendChild(RootNode);
136 with RootNode do begin
137 NewNode := OwnerDocument.CreateElement('Projects');
138 AppendChild(NewNode);
139 Projects.SaveXMLNode(NewNode);
140 end;
141 ForceDirectoriesUTF8(ExtractFileDir(FileName));
142 WriteXMLFile(Doc, UTF8Decode(FileName));
143 finally
144 Doc.Free;
145 end;
146end;
147
148{ TProject }
149
150procedure TProject.SetBackend(AValue: TBackend);
151begin
152 if FBackend = AValue then Exit;
153 FBackend := AValue;
154 FreeAndNil(WorkingCopy);
155 WorkingCopy := AValue.WorkingCopyClass.Create;
156 FreeAndNil(Repository);
157 Repository := AValue.RepositoryClass.Create;
158end;
159
160function TProject.GetDirectory: string;
161begin
162 Result := WorkingCopy.Path;
163end;
164
165function TProject.GetRepositoryURL: string;
166begin
167 Result := WorkingCopy.RepositoryURL;
168end;
169
170procedure TProject.SetDirectory(AValue: string);
171begin
172 WorkingCopy.Path := AValue;
173end;
174
175procedure TProject.SetRepositoryURL(AValue: string);
176begin
177 WorkingCopy.RepositoryURL := AValue;
178 Repository.Path := AValue;
179end;
180
181procedure TProject.Open(Directory: string);
182begin
183 WorkingCopy.Path := Directory;
184end;
185
186constructor TProject.Create;
187begin
188 WorkingCopy := TWorkingCopy.Create;
189 Repository := TRepository.Create;
190end;
191
192destructor TProject.Destroy;
193begin
194 WorkingCopy.Free;
195 Repository.Free;
196 inherited Destroy;
197end;
198
199procedure TProject.LoadXMLNOde(Node: TDOMNode);
200begin
201 RepositoryURL := ReadString(Node, 'RepositoryURL', '');
202 Directory := ReadString(Node, 'Directory', '');
203end;
204
205procedure TProject.SaveXMLNOde(Node: TDOMNode);
206begin
207 WriteString(Node, 'RepositoryURL', RepositoryURL);
208 WriteString(Node, 'Directory', Directory);
209end;
210
211end.
212
Note: See TracBrowser for help on using the repository browser.