1unit mgrfpdocproj;
2
3{$mode objfpc}{$H+}
4
5interface
6
7uses
8  Classes, SysUtils, fpdocproj, fpdocxmlopts;
9
10Type
11  { TFPDocProjectManager }
12
13  TFPDocProjectManager = Class(TComponent)
14  Private
15    FProject : TFPDocProject;
16    FPackage : TFPDocPackage;
17    FExpandMacros: Boolean;
18    FMacros: TStrings;
19    procedure SetMacros(AValue: TStrings);
20  protected
21    Procedure CheckPackage;
22    procedure GetItemsFromDirectory(AList: TStrings; ADirectory, AMask: String; ARecurse: Boolean);
23    procedure DoMacro(Sender: TObject; const TagString: String; TagParams: TStringList; out ReplaceText: String); virtual;
24    function ExpandMacrosInFile(AFileName: String): TStream; virtual;
25  Public
26    Constructor Create(AOwner : TComponent); override;
27    Destructor Destroy; override;
28    procedure AddDescrFilesFromDirectory(Const ADirectory, AMask : String; ARecurse: Boolean);
29    procedure AddInputFilesFromDirectory(Const ADirectory, AMask, AOptions: String; ARecurse: Boolean);
30    procedure AddInputFile(Const AFile : String; AOptions : String = '');
31    procedure AddImportFile(Const AFile,APrefix : String);
32    procedure AddDescrFile(Const AFile : String);
33    procedure RemoveInputFile(Const AFile : String);
34    procedure RemoveDescrFile(Const AFile : String);
35    procedure WriteOptionFile(const AFileName: String);
36    procedure ReadOptionFile(const AFileName: String);
37    Procedure Selectpackage(Const APackageName : String);
38    Procedure AddPackage (Const APackageName : String);
39    procedure SetOption(Const AOption : String; Enable : Boolean = True);
40    Property Project : TFPDocProject Read FProject;
41    Property SelectedPackage : TFPDocPackage Read FPackage;
42    Property Macros : TStrings Read FMacros Write SetMacros;
43    Property ExpandMacros : Boolean Read FExpandMacros Write FExpandMacros;
44  end;
45  EMgrFPDoc = Class(Exception);
46
47implementation
48
49uses dom,xmlread,fptemplate;
50
51procedure TFPDocProjectManager.SetMacros(AValue: TStrings);
52begin
53  if FMacros=AValue then Exit;
54  FMacros.Assign(AValue);
55end;
56
57procedure TFPDocProjectManager.DoMacro(Sender: TObject; const TagString: String;
58  TagParams: TStringList; out ReplaceText: String);
59begin
60  ReplaceText:=FMacros.Values[TagString];
61end;
62
63
64Procedure TFPDocProjectManager.GetItemsFromDirectory(AList : TStrings; ADirectory,AMask : String; ARecurse : Boolean);
65
66Var
67  D : String;
68  Info : TSearchRec;
69
70begin
71  D:=ADirectory;
72  if (D='.') then
73    D:='';
74  if (D<>'') then
75    D:=includeTrailingPathDelimiter(D);
76  If FindFirst(D+AMask,0,info)=0 then
77    try
78      Repeat
79      if ((Info.Attr and faDirectory)=0) then
80        AList.add(D+Info.Name);
81      Until (FindNext(Info)<>0);
82    finally
83      FindClose(Info);
84    end;
85  If ARecurse and (FindFirst(ADirectory+AMask,0,info)=0) then
86    try
87      Repeat
88      if ((Info.Attr and faDirectory)<>0) then
89        GetItemsFromDirectory(Alist,IncludeTrailingPathDelimiter(D+Info.Name),AMask,ARecurse);
90      Until (FindNext(Info)<>0);
91    finally
92      FindClose(Info);
93    end;
94end;
95
96constructor TFPDocProjectManager.Create(AOwner: TComponent);
97begin
98  inherited Create(AOwner);
99  FProject:=TFPDocProject.Create(Self);
100  FMacros:=TStringList.Create;
101end;
102
103destructor TFPDocProjectManager.Destroy;
104begin
105  FreeAndNil(FMacros);
106  FreeAndNil(FProject);
107  inherited Destroy;
108end;
109
110Function TFPDocProjectManager.ExpandMacrosInFile(AFileName : String) : TStream;
111
112Var
113  F : TFileStream;
114  T : TTemplateParser;
115
116begin
117  F:=TFileStream.Create(AFileName,fmOpenRead or fmShareDenyWrite);
118  try
119    Result:=TMemoryStream.Create;
120    try
121      T:=TTemplateParser.Create;
122      try
123        T.StartDelimiter:='$(';
124        T.EndDelimiter:=')';
125        T.AllowTagParams:=true;
126        T.OnReplaceTag:=@DoMacro;
127        T.ParseStream(F,Result);
128      finally
129        T.Free;
130      end;
131      Result.Position:=0;
132    except
133      FreeAndNil(Result);
134      Raise;
135    end;
136  finally
137    F.Free;
138  end;
139end;
140
141Procedure TFPDocProjectManager.AddDescrFilesFromDirectory(const ADirectory,AMask : String; ARecurse : Boolean);
142
143Var
144  L : TStringList;
145  M : String;
146
147begin
148  CheckPackage;
149  M:=AMask;
150  if (M='') then
151    M:='*.xml';
152  L:=TStringList.Create;
153  try
154    GetItemsFromDirectory(L,ADirectory,M,ARecurse);
155    FPackage.Descriptions.AddStrings(L);
156  finally
157    L.Free;
158  end;
159end;
160
161Procedure TFPDocProjectManager.AddInputFilesFromDirectory(Const ADirectory,AMask,AOptions : String; ARecurse : Boolean);
162
163Var
164  L : TStringList;
165  I : integer;
166  M : String;
167
168begin
169  CheckPackage;
170  M:=AMask;
171  if (M='') then
172    M:='*.pp';
173  L:=TStringList.Create;
174  try
175    GetItemsFromDirectory(L,ADirectory,M,ARecurse);
176    For I:=0 to L.Count-1 do
177      AddInputFile(L[i],AOPtions);
178  finally
179    L.Free;
180  end;
181end;
182
183procedure TFPDocProjectManager.AddInputFile(const AFile: String; AOptions : String = '');
184
185Var
186  S : String;
187
188begin
189  CheckPackage;
190  S:=AFile;
191  If (AOptions<>'') then
192    S:=AOptions+' '+S;
193  FPackage.Inputs.Add(S);
194end;
195
196procedure TFPDocProjectManager.AddImportFile(const AFile, APrefix: String);
197
198begin
199  CheckPackage;
200  FPackage.Imports.Add(AFile+','+APrefix);
201end;
202
203procedure TFPDocProjectManager.AddDescrFile(const AFile: String);
204
205begin
206  CheckPackage;
207  if FPackage.Descriptions.IndexOf(AFile)<>-1 then
208    Raise EMgrFPDoc.Createfmt('Duplicate description file : "%s"',[AFile]);
209  FPackage.Descriptions.Add(AFile);
210end;
211
212procedure TFPDocProjectManager.RemoveInputFile(const AFile: String);
213
214Var
215  I : Integer;
216
217begin
218  I:=FPackage.Inputs.IndexOf(AFile);
219  If (I<>-1) then
220    FPackage.Inputs.Delete(I);
221end;
222
223procedure TFPDocProjectManager.RemoveDescrFile(const AFile: String);
224
225Var
226  I : Integer;
227
228begin
229  I:=FPackage.Descriptions.IndexOf(AFile);
230  If (I<>-1) then
231    FPackage.Descriptions.Delete(I);
232end;
233
234procedure TFPDocProjectManager.ReadOptionFile(Const AFileName : String);
235
236Var
237  XML : TXMLDocument;
238  S : TStream;
239
240begin
241  With TXMLFPDocOptions.Create(Self) do
242    try
243      if not (ExpandMacros) then
244        LoadOptionsFromFile(FProject,AFileName)
245      else
246        begin
247        S:=ExpandMacrosInFile(AFileName);
248        try
249          ReadXMLFile(XML,S,AFileName);
250          try
251            LoadFromXml(FProject,XML)
252          finally
253            XML.Free;
254          end;
255        finally
256          S.Free;
257        end;
258        end;
259    finally
260      Free;
261    end;
262end;
263
264procedure TFPDocProjectManager.Selectpackage(const APackageName: String);
265begin
266  FPackage:=FProject.Packages.FindPackage(APackageName);
267  If (FPackage=Nil) then
268    Raise EMgrFPDoc.CreateFmt('Unknown package : "%s"',[APackageName]);
269end;
270
271procedure TFPDocProjectManager.AddPackage(const APackageName: String);
272begin
273  if FProject.Packages.FindPackage(APackageName)<>Nil then
274    Raise EMgrFPDoc.CreateFmt('Duplicate package : "%s"',[APackageName]);
275  FPackage:=FProject.Packages.Add as TFPDocPackage;
276  FPackage.Name:=APackageName;
277end;
278
279procedure TFPDocProjectManager.SetOption(const AOption: String;
280  Enable: Boolean = true);
281
282Var
283  O,V : String;
284  P : Integer;
285  EO : TEngineOptions;
286
287begin
288  V:=LowerCase(AOption);
289  P:=Pos('=',V);
290  If (P=0) then
291    P:=Length(V)+1;
292  O:=Copy(V,1,P-1);
293  Delete(V,1,P);
294  EO:=FProject.Options;
295  Case IndexOfString(o,OptionNames) of
296    0 : EO.HideProtected:=Enable;
297    1 : EO.WarnNoNode:=Enable;
298    2 : EO.ShowPrivate:=Enable;
299    3 : EO.StopOnParseError:=Enable;
300    4 : EO.ostarget:=v;
301    5 : EO.cputarget:=v;
302    6 : EO.MoDir:=V;
303    7 : EO.InterfaceOnly:=Not Enable;
304    8 : EO.Backend:=V;
305    9 : EO.Language:=v;
306    10 : EO.DefaultPackageName:=V;
307    11 : EO.DontTrim:=Enable;
308  else
309    EO.BackendOptions.add('--'+O);
310    EO.BackendOptions.add(v);
311  end;
312end;
313
314procedure TFPDocProjectManager.WriteOptionFile(Const AFileName : String);
315
316begin
317  With TXMLFPDocOptions.Create(Self) do
318    try
319      SaveOptionsToFile(FProject,AFileName);
320    finally
321      Free;
322    end;
323end;
324
325procedure TFPDocProjectManager.CheckPackage;
326
327begin
328  if (FPackage=Nil) then
329    Raise EMgrFPDoc.Create('Error: No package selected');
330end;
331
332
333
334end.
335
336