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