Michael Van Canneyt schrieb:
You remember my -n and -v options?
Absolutely, and I'll gladly accept patches implementing those 2 things
in fpdoc.
If you could separate those out from your other work, that would be much
appreciated. If not, send whatever you have, and I'll try to extract it
myself.
I'll attach an patch with my remaining changes, fpdoc-nv.patch. Here's a
roadmap for you:
I've enclosed most still different parts of the code with conditional
DoDi. This should allow (me) to run both versions from the same source,
and helps in searching for differences.
pparser.pp is extended with a -v option, passed as commandline argument.
It writes out the currently processed unit. Not perfect, of course, it
would be more useful when the current unit were shown with every error
message, by default.
pscanner.pp is even more nasty, I could not find an easy way to
implement a -v (or -vt) option. That's why I added a conditional
"Verbose", that turns on the trace of tried include directories. Perhaps
you find an better way, using the settings of pparser.
IMO this option is essential for the fpdoc compiler (--input) options
setup in every project. I'd be happy if you can provide common package
options, like
<package name="bla" options="-Fi common to all units"/>
which is automatically appended to all unit options.
dGlobals.pp contains the Verbose flag, for use in fpdoc. And the help
messages, of course.
AddDocFile gets an additional package name, that allows to exclude
unrelated docs, and also does wildcard substitution.
dw_html.pp traces the created HTML files. Like with pparser, the element
name (html file) should be shown with *every* error message instead.
fpdoc.pp obviously accepts the added commandline options. It also
creates a default project whenever invoked without a project.
fpdocproj.pas Options.DryRun should be obvious.
Improved --imports handling, so that the prefix is no more required (can
be synthesized). This part can be ommitted.
Moved CreateDocumentation here, to make it independent from commandline
handling.
fpdocxmlopts.pas can be almost ignored, it retains my old save/load code
(see DoDiSave), until I'm sure that I added all required modifications
to your code. Thanks for extracting the file names from the options :-)
Have fun :-)
DoDi
Index: packages/fcl-passrc/src/pparser.pp
===================================================================
--- packages/fcl-passrc/src/pparser.pp (revision 19730)
+++ packages/fcl-passrc/src/pparser.pp (working copy)
@@ -304,6 +304,7 @@
Start, CurPos: PChar;
Filename: String;
Scanner: TPascalScanner;
+ Verbose: boolean; //should become a global option!?
procedure ProcessCmdLinePart;
var
@@ -332,6 +333,7 @@
include(Scanner.Options,po_delphi);
Parser.Options:=Parser.Options+[po_delphi];
end;
+ 'v': Verbose := True;
end;
end else
if Filename <> '' then
@@ -347,6 +349,7 @@
FileResolver := nil;
Scanner := nil;
Parser := nil;
+ Verbose := False;
try
FileResolver := TFileResolver.Create;
Scanner := TPascalScanner.Create(FileResolver);
@@ -407,6 +410,9 @@
if Filename = '' then
raise Exception.Create(SErrNoSourceGiven);
+ if Verbose then
+ WriteLn('Now parsing ', Filename);
+
Scanner.OpenFile(Filename);
Parser.ParseMain(Result);
finally
Index: packages/fcl-passrc/src/pscanner.pp
===================================================================
--- packages/fcl-passrc/src/pscanner.pp (revision 19730)
+++ packages/fcl-passrc/src/pscanner.pp (working copy)
@@ -17,6 +17,8 @@
{$mode objfpc}
{$h+}
+{.$DEFINE Verbose} //should become a property
+
unit PScanner;
interface
@@ -466,6 +468,10 @@
If FileExists(Result) then exit;
Result:=Dir+uppercase(Fn);
If FileExists(Result) then exit;
+{$IFDEF Verbose}
+ //if Verbose then
+ WriteLn('Tried: ', Result);
+{$ENDIF}
Result:='';
end;
end;
@@ -494,13 +500,22 @@
begin
Try
FN:=SearchLowUpCase(FIncludePaths[i]+AName);
- If (FN<>'') then
+ If (FN<>'') then begin
+{$IFDEF Verbose}
+ //if Verbose then
+ WriteLn('Found: ', FN);
+{$ENDIF}
Result := TFileLineReader.Create(FN);
+ end;
except
Result:=Nil;
end;
Inc(I);
end;
+
+ if Result <> nil then
+ exit; //succ!
+
// search in BaseDirectory
if BaseDirectory<>'' then
begin
Index: utils/fpdoc/dglobals.pp
===================================================================
--- utils/fpdoc/dglobals.pp (revision 19730)
+++ utils/fpdoc/dglobals.pp (working copy)
@@ -28,6 +28,7 @@
Var
LEOL : Integer;
modir : string;
+ Verbose: boolean = False; //debug option
resourcestring
// Output strings
@@ -149,7 +150,9 @@
SUsageOption170 = '--warn-no-node Warn if no documentation node was
found.';
SUsageOption180 = '--mo-dir=dir Set directory where language files
reside to dir';
SUsageOption190 = '--parse-impl (Experimental) try to parse
implementation too';
- SUsageOption200 = '--dont-trim Don''t trim XML contents';
+ SUsageOption200 = '--dont-trim Don''t trim XML contents';
+ SUsageOption201 = '-n Don''t create documents';
+ SUsageOption202 = '-v Verbose, you better redirect
output into an logfile';
SUsageOption210 = '--write-project=file Do not write documentation, create
project file instead';
SUsageFormats = 'The following output formats are supported by this
fpdoc:';
@@ -303,7 +306,11 @@
function FindLinkedNode(ANode: TDocNode): TDocNode;
// Documentation file support
- procedure AddDocFile(const AFilename: String;DontTrim:boolean=false);
+{$IFDEF DoDi}
+ function AddDocFile(const AFilename, APackageName:
String;DontTrim:boolean=false): boolean;
+{$ELSE}
+ function AddDocFile(const AFilename: String;DontTrim:boolean=false):
boolean;
+{$ENDIF}
// Documentation retrieval
function FindDocNode(AElement: TPasElement): TDocNode;
@@ -1285,7 +1292,11 @@
end;
end;
-procedure TFPDocEngine.AddDocFile(const AFilename:
String;DontTrim:boolean=false);
+{$IFDEF DoDi}
+function TFPDocEngine.AddDocFile(const AFilename, APackageName:
String;DontTrim:boolean=false): boolean;
+{$ELSE}
+function TFPDocEngine.AddDocFile(const AFilename:
String;DontTrim:boolean=false): boolean;
+{$ENDIF}
function ReadNode(OwnerDocNode: TDocNode; Element: TDOMElement): TDocNode;
var
@@ -1346,20 +1357,52 @@
Element: TDOMElement;
Doc: TXMLDocument;
PackageDocNode, TopicNode,ModuleDocNode: TDocNode;
+ UseDoc: boolean;
+//wildcard substitution
+ Info : TSearchRec;
+ pattern, prefix: string;
+begin
+{$IFDEF DoDi}
+(* The document is retained only when it contains the current package.
+ Assume that the names match in case?
-begin
+ Try: resolve wildcards in filename.
+ ToDo: strip duplicate file references, when wildcards and explicit
references are mixed.
+*)
+ i := Pos('*', AFilename);
+ if i > 0 then begin
+ //add all files matching pattern
+ prefix := Copy(AFileName, 1, i-1);
+ pattern := ChangeFileExt(AFilename, '.xml'); //in case no extension is
given
+ if FindFirst(pattern, faAnyFile, Info) = 0 then begin
+ repeat
+ UseDoc := AddDocFile(prefix + Info.Name, APackageName, DontTrim);
+ if Verbose and UseDoc then
+ WriteLn('Using ', Info.Name);
+ until FindNext(info)<>0;
+ FindClose(Info);
+ end;
+ exit(true); //all done, no document loaded here
+ end;
+{$ELSE}
+{$ENDIF}
+
+ UseDoc := False; //becomes true when really required
if DontTrim then
ReadXMLFileALT(Doc, AFilename)
else
ReadXMLFile(Doc, AFilename);
- DescrDocs.Add(Doc);
- DescrDocNames.Add(AFilename);
Node := Doc.DocumentElement.FirstChild;
while Assigned(Node) do
begin
- if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'package') then
+ if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'package')
+ {$IFDEF DoDi}
+ and ((Node as TDOMElement)['name']= APackageName)
+ {$ENDIF}
+ then //only for current package
begin
+ UseDoc:=True; //this document is really used
PackageDocNode := ReadNode(RootDocNode, TDOMElement(Node));
PackageDocNode.IncRefCount;
// Scan all 'module' elements within this package element
@@ -1401,6 +1444,15 @@
end;
Node := Node.NextSibling;
end;
+ Result := UseDoc;
+ if UseDoc then begin
+ DescrDocs.Add(Doc);
+ DescrDocNames.Add(AFilename);
+ end else begin
+ if Verbose then
+ WriteLn('Skip ', AFilename);
+ Doc.Free; //more to release?
+ end;
end;
function TFPDocEngine.FindDocNode(AElement: TPasElement): TDocNode;
Index: utils/fpdoc/dw_html.pp
===================================================================
--- utils/fpdoc/dw_html.pp (revision 19730)
+++ utils/fpdoc/dw_html.pp (working copy)
@@ -735,6 +735,8 @@
try
Filename := Engine.Output + Allocator.GetFilename(Element,
SubpageIndex);
try
+ if dGlobals.Verbose then
+ WriteLn('Create ', Filename);
CreatePath(Filename);
WriteHTMLFile(PageDoc, Filename);
except
Index: utils/fpdoc/fpdoc.pp
===================================================================
--- utils/fpdoc/fpdoc.pp (revision 19730)
+++ utils/fpdoc/fpdoc.pp (working copy)
@@ -12,6 +12,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
+{$DEFINE CreateProject} //always create an project file?
program FPDoc;
@@ -42,15 +43,23 @@
TFPDocAplication = Class(TCustomApplication)
private
FProject : TFPDocProject;
- FProjectFile : Boolean;
+ {$IFDEF DoDi}
+ FXMLProject: TXMLFPDocOptions;
+ {$ELSE}
+ FProjectFile: boolean;
+ {$ENDIF}
FPackage : TFPDocPackage;
FWriteProjectFile : String;
Protected
procedure ParseCommandLine;
procedure Parseoption(const S: String);
Procedure Usage(AnExitCode : Byte);
+ {$IFDEF DoDi}
+ //enable new CreateProjectFile
+ {$ELSE}
Procedure CreateProjectFile(Const AFileName : String);
procedure CreateDocumentation(APackage : TFPDocPackage; Options :
TEngineOptions);
+ {$ENDIF}
Procedure DoRun; override;
Public
Constructor Create(AOwner : TComponent); override;
@@ -90,6 +99,11 @@
Writeln(SUsageOption180);
Writeln(SUsageOption190);
Writeln(SUsageOption200);
+{$IFDEF DoDi}
+ Writeln(SUsageOption201);
+ Writeln(SUsageOption202);
+{$ELSE}
+{$ENDIF}
Writeln(SUsageOption210);
L:=TStringList.Create;
Try
@@ -126,6 +140,8 @@
Halt(AnExitCode);
end;
+{$IFDEF DoDi}
+{$ELSE}
procedure TFPDocAplication.CreateProjectFile(const AFileName: String);
begin
With TXMLFPDocOptions.Create(Self) do
@@ -135,11 +151,15 @@
Free;
end;
end;
+{$ENDIF}
destructor TFPDocAplication.Destroy;
begin
FreeAndNil(FProject);
+{$IFDEF DoDi}
+ FreeAndNil(FXMLProject);
+{$ENDIF}
Inherited;
end;
@@ -178,16 +198,17 @@
begin
s:=ParamStr(I);
If ProjectOpt(S) then
+ begin
ParseOption(s);
- If (FProject.Packages.Count=1) then
- FPackage:=FProject.Packages[0]
- else if (FProject.Options.DefaultPackageName<>'') then
-
Fpackage:=FProject.Packages.FindPackage(FProject.Options.DefaultPackageName);
+ If FProject.Packages.Count>0 then
+ begin
+
Fpackage:=FProject.Packages.FindPackage(FProject.Options.DefaultPackageName);
+ if FPackage = nil then
+ FPackage:=FProject.Packages[0];
+ break; //ignore further projects? (else handle first instance when
another project was given)
+ end;
+ end;
end;
- If FProject.Packages.Count=0 then
- begin
- FPackage:=FProject.Packages.Add as TFPDocPackage;
- end;
// Check package
for i := 1 to ParamCount do
begin
@@ -195,13 +216,30 @@
If PackageOpt(S) then
ParseOption(s);
end;
+
+ if (FPackage=Nil) or (FPackage.Name='') then
+ begin
+ Writeln(SNeedPackageName);
+ Usage(1); //also show help, not only error
+ end;
+
for i := 1 to ParamCount do
begin
s:=ParamStr(I);
If Not (ProjectOpt(s) or PackageOpt(S)) then
ParseOption(s);
end;
+{$IFDEF DoDi}
+//always create project, when none was given (allow for use in scripts!)
+ if not assigned(FXMLProject) and assigned(SelectedPackage) then begin
+ FXMLProject := TXMLFPDocOptions.Create(self, SelectedPackage.Name +
'_auto.xml');
+ FXMLProject.Modified := True; //force save
+ end;
+ if assigned(FXMLProject) then
+ FXMLProject.SaveProject(FProject);
+{$ELSE}
SelectedPackage; // Will print error if none available.
+{$ENDIF}
end;
procedure TFPDocAplication.Parseoption(Const S : String);
@@ -228,7 +266,6 @@
var
i: Integer;
Cmd, Arg: String;
-
begin
if (s = '-h') or (s = '--help') then
Usage(0)
@@ -242,6 +279,11 @@
FProject.Options.StopOnParseError := True
else if s = '--dont-trim' then
FProject.Options.donttrim := True
+ else if s = '-v' then
+ //FProject.Options.Verbose := True
+ dGlobals.Verbose:=True
+ else if s = '-n' then
+ FProject.Options.DryRun := True
else
begin
i := Pos('=', s);
@@ -257,6 +299,15 @@
end;
if (Cmd = '--project') or (Cmd='-p') then
begin
+ {$IFDEF DoDi}//todo: fix!
+ if FXMLProject <> nil then
+ begin
+ //error: only 1 project
+ exit;
+ end;
+ FXMLProject := TXMLFPDocOptions.Create(self, Arg);
+ FXMLProject.LoadProject(FProject);
+ {$ELSE}
FProjectFile:=True;
With TXMLFPDocOptions.Create(self) do
try
@@ -264,6 +315,7 @@
finally
Free;
end;
+ {$ENDIF}
end
else if (Cmd = '--descr') then
AddToFileList(SelectedPackage.Descriptions, Arg)
@@ -286,10 +338,12 @@
else if Cmd = '--import' then
SelectedPackage.Imports.Add(Arg)
else if Cmd = '--package' then
- begin
- If FProjectFile then
- FPackage:=FProject.Packages.FindPackage(Arg)
- else
+ begin //scanned after project, selects a package
+ FPackage:=FProject.Packages.FindPackage(Arg);
+ if assigned(FPackage) then
+ exit; //all done
+ //create new package
+ FPackage:=FProject.Packages.Add as TFPDocPackage;
FPackage.Name:=Arg;
end
else if Cmd = '--ostarget' then
@@ -310,7 +364,8 @@
end;
end;
-
+{$IFDEF DoDi}
+{$ELSE}
procedure TFPDocAplication.CreateDocumentation(APackage : TFPDocPackage;
Options : TEngineOptions);
var
@@ -348,6 +403,8 @@
WriteLn(StdErr, Format('%s(%d,%d): %s',
[e.Filename, e.Row, e.Column, e.Message]));
end;
+ if Options.DryRun then
+ exit; //don't produce output
WriterClass:=GetWriterClass(Options.Backend);
Writer:=WriterClass.Create(Engine.Package,Engine);
Writeln('Writing doc');
@@ -371,6 +428,7 @@
FreeAndNil(Engine);
end;
end;
+{$ENDIF}
Procedure TFPDocAplication.DoRun;
@@ -386,10 +444,14 @@
WriteLn(SCopyright);
WriteLn;
ParseCommandLine;
+{$IFDEF DoDi}
+ FProject.CreateDocumentation(FPackage);
+{$ELSE}
if (FWriteProjectFile<>'') then
CreateProjectFile(FWriteProjectFile)
else
CreateDocumentation(FPackage,FProject.Options);
+{$ENDIF}
WriteLn(SDone);
Terminate;
end;
@@ -404,6 +466,8 @@
FProject.Options.OSTarget:=DefOSTarget;
end;
+{$R *.res}
+
begin
With TFPDocAplication.Create(Nil) do
try
Index: utils/fpdoc/fpdocproj.pas
===================================================================
--- utils/fpdoc/fpdocproj.pas (revision 19730)
+++ utils/fpdoc/fpdocproj.pas (working copy)
@@ -9,13 +9,26 @@
Type
+ { TFPDocImports }
+
+ TFPDocImports = class(TStringList)
+ protected
+ //function Get(index: integer): string; override;
+ function Add(const S: string): Integer; override;
+ //procedure Put(index: integer; const s: string); override;
+ public
+ function ImportName(const s: string): string;
+ property Strings[index: integer]: string read GetValueFromIndex write Put;
+ end;
+
{ TFPDocPackage }
TFPDocPackage = Class(TCollectionItem)
private
FContent: String;
+ FDescDir: string;
FDescriptions: TStrings;
- FIMports: TStrings;
+ FIMports: TFPDocImports;
FinPuts: TStrings;
FName: String;
FOutput: String;
@@ -24,9 +37,10 @@
destructor destroy; override;
procedure Assign(Source : TPersistent); override;
Property Name : String Read FName Write FName;
+ Property Imports : TFPDocImports read FIMports;
Property Inputs : TStrings Read FinPuts;
Property Descriptions : TStrings Read FDescriptions;
- Property Imports : TStrings read FIMports;
+ property DescDir: string read FDescDir write FDescDir;
Property ContentFile : String Read FContent Write FContent;
Property Output : String Read FOutput Write FOutput;
end;
@@ -65,6 +79,8 @@
Constructor Create;
Destructor Destroy; override;
procedure Assign(Source : TPersistent); override;
+ public //debug options
+ DryRun: boolean;
Published
Property OSTarget : String Read FOSTarget Write FOStarget;
Property CPUTarget : String Read FCPUTarget Write FCPUTarget;
@@ -91,6 +107,10 @@
Public
Constructor Create(AOwner : TComponent); override;
Destructor Destroy; override;
+ {$IFDEF DoDi}
+ procedure CreateDocumentation(APackage : TFPDocPackage);
+ {$ELSE}
+ {$ENDIF}
Published
Property Packages : TFPDocPackages Read FPackages Write FPackages;
Property Options : TEngineOptions Read FOptions Write setOptions;
@@ -98,6 +118,38 @@
implementation
+uses
+ dWriter, dGlobals, PParser;
+
+{ TFPDocImports }
+
+function TFPDocImports.Add(const s: string): integer;
+var
+ pkg: string;
+begin
+//Add either a package name (only), or pkg=s
+ pkg := ImportName(s);
+ Result := IndexOfName(pkg);
+ if Result < 0 then
+ Result := inherited Add(pkg);
+ if s <> pkg then
+ Strings[Result] := pkg + '=' + s;
+end;
+
+function TFPDocImports.ImportName(const s: string): string;
+//function TFPDocPackage.ImportName(const s: string): string;
+var
+ p: integer;
+ s2: string;
+begin
+//extract the package name from an --imports option
+ s2 := s;
+ p := pos(',', s2);
+ if p > 0 then
+ SetLength(s2, p-1);
+ Result := ChangeFileExt(ExtractFileName(s2), '');
+end;
+
{ TEngineOptions }
procedure TEngineOptions.SetBackendOptions(const AValue: TStrings);
@@ -164,6 +216,79 @@
inherited Destroy;
end;
+{$IFDEF DoDi}
+//beware: sync with TFPDocAplication.CreateDocumentation
+procedure TFPDocProject.CreateDocumentation(APackage: TFPDocPackage);
+var
+ i,j: Integer;
+ WriterClass : TFPDocWriterClass;
+ Writer : TFPDocWriter;
+ Engine : TFPDocEngine;
+ Cmd,Arg : String;
+begin
+ Engine:=TFPDocEngine.Create;
+ try
+ For J:=0 to Apackage.Imports.Count-1 do
+ begin
+ Arg:=Apackage.Imports[j];
+ i := Pos(',', Arg);
+ if i <= 0 then
+ raise EInOutError('Missing context file for ' +
APackage.Imports.Names[j])
+ else
+ Engine.ReadContentFile(Copy(Arg,1,i-1),Copy(Arg,i+1,Length(Arg)));
+ end;
+ for i := 0 to APackage.Descriptions.Count - 1 do
+ Engine.AddDocFile(APackage.Descriptions[i],
APackage.Name,Options.donttrim);
+ Engine.SetPackageName(APackage.Name);
+ Engine.Output:=APackage.Output;
+ Engine.HideProtected:=Options.HideProtected;
+ Engine.HidePrivate:=Not Options.ShowPrivate;
+ if Length(Options.Language) > 0 then
+ TranslateDocStrings(Options.Language);
+ for i := 0 to APackage.Inputs.Count - 1 do
+ try
+ Arg := APackage.Inputs[i];
+ if dGlobals.Verbose then
+ begin
+ Arg := Arg+' -v'; //force verbose parser
+ end;
+ ParseSource(Engine, Arg, Options.OSTarget, Options.CPUTarget);
+ except
+ on e: EParserError do
+ If Options.StopOnParseError then
+ Raise
+ else
+ WriteLn(StdErr, Format('%s(%d,%d): %s',
+ [e.Filename, e.Row, e.Column, e.Message]));
+ end;
+ WriterClass:=GetWriterClass(Options.Backend);
+ Writer:=WriterClass.Create(Engine.Package,Engine);
+ if not Options.DryRun then
+ Writeln('Writing doc');
+ With Writer do
+ Try
+ If Options.BackendOptions.Count>0 then
+ for I:=0 to ((Options.BackendOptions.Count-1) div 2) do
+ begin
+ Cmd:=Options.BackendOptions[I*2];
+ Arg:=Options.BackendOptions[I*2+1];
+ If not InterPretOption(Cmd,Arg) then
+ WriteLn(StdErr, Format(SCmdLineInvalidOption,[Cmd+'='+Arg]));
+ end;
+ if not Options.DryRun then
+ WriteDoc;
+ Finally
+ Free;
+ end;
+ if not Options.DryRun and (Length(APackage.ContentFile) > 0) then
+ Engine.WriteContentFile(APackage.ContentFile);
+ finally
+ FreeAndNil(Engine);
+ end;
+end;
+{$ELSE}
+{$ENDIF}
+
{ TFPDocPackages }
function TFPDocPackages.GetP(AIndex : Integer): TFPDocPackage;
@@ -202,7 +327,7 @@
constructor TFPDocPackage.Create(ACollection: TCollection);
begin
inherited Create(ACollection);
- FImports:=TStringList.Create;
+ FImports:=TFPDocImports.Create;
FDescriptions:=TStringList.Create;
FInputs:=TStringList.Create;
end;
Index: utils/fpdoc/fpdocxmlopts.pas
===================================================================
--- utils/fpdoc/fpdocxmlopts.pas (revision 19730)
+++ utils/fpdoc/fpdocxmlopts.pas (working copy)
@@ -16,22 +16,44 @@
FMacros: TStrings;
procedure SetMacros(AValue: TStrings);
Protected
+ Doc: TXMLDocument;
+ FileName: string;
Procedure Error(Const Msg : String);
Procedure Error(Const Fmt : String; Args : Array of Const);
Procedure LoadPackage(APackage : TFPDocPackage; E : TDOMElement); virtual;
Procedure LoadPackages(Packages : TFPDocPackages; E : TDOMElement);
Procedure LoadEngineOptions(Options : TEngineOptions; E : TDOMElement);
virtual;
+{$IFDEF DoDiSave}
+ function OldSaveToXML(AProject : TFPDocProject; ADoc: TXMLDocument):
boolean;
+ function SaveOptions(AProject : TFPDocProject): boolean;
+ function SavePackage(APackage : TFPDocPackage; Pkgs: TDOMElement): boolean;
+ procedure SaveImports(APackage : TFPDocPackage; Pkg: TDOMElement);
+ function NeedNode(P: TDomNode; const ATag: string): TDOMElement;
+ function FindChild(N: TDOMNode; const ATag, AVal: string): TDOMNode;
+{$ELSE}
Procedure SaveEngineOptions(Options : TEngineOptions; XML : TXMLDocument;
AParent : TDOMElement); virtual;
procedure SaveDescription(const ADescription: String; XML: TXMLDocument;
AParent: TDOMElement); virtual;
procedure SaveInputFile(const AInputFile: String; XML: TXMLDocument;
AParent: TDOMElement);virtual;
Procedure SavePackage(APackage : TFPDocPackage; XML : TXMLDocument;
AParent : TDOMElement); virtual;
procedure DoMacro(Sender: TObject; const TagString: String; TagParams:
TStringList; out ReplaceText: String); virtual;
function ExpandMacrosInFile(AFileName: String): TStream; virtual;
+{$ENDIF}
Public
+ Modified: boolean;
+{$IFDEF DoDi}
+ constructor Create(AOwner: TComponent; const AFile: string);
+ //symmetric load/save
+ function LoadProject(AProject : TFPDocProject): boolean;
+ function SaveProject(AProject : TFPDocProject): boolean;
+{$ELSE}
+{$ENDIF}
Constructor Create (AOwner : TComponent); override;
Destructor Destroy; override;
Procedure LoadOptionsFromFile(AProject : TFPDocProject; Const AFileName :
String);
Procedure LoadFromXML(AProject : TFPDocProject; XML : TXMLDocument);
virtual;
+{$IFDEF DoDi}
+{$ELSE}
+{$ENDIF}
Procedure SaveOptionsToFile(AProject : TFPDocProject; Const AFileName :
String);
procedure SaveToXML(AProject : TFPDocProject; ADoc: TXMLDocument); virtual;
Property Macros : TStrings Read FMacros Write SetMacros;
@@ -51,7 +73,7 @@
implementation
-Uses XMLRead, XMLWrite;
+Uses XMLRead, XMLWrite, dGlobals;
Resourcestring
SErrInvalidRootNode = 'Invalid options root node: Got "%s", expected
"docproject"';
@@ -146,6 +168,9 @@
S:=S.NextSibling;
end;
end
+ end else if O.NodeName = 'import' then begin
+ //handle after --import in commandline options
+ APackage.Imports.Add(O['package']);
end;
N:=N.NextSibling;
end;
@@ -455,6 +480,15 @@
XML : TXMLDocument;
begin
+ if not Modified then
+ exit; //don't save unmodified project
+ if AFileName = '' then
+ exit; //no filename?
+ if AFileName = FileName then
+ exit; //don't overwrite
+ if dGlobals.Verbose then
+ WriteLn('Creating FPDoc project ', GetCurrentDir, DirectorySeparator,
AFileName);
+
XML:=TXMLDocument.Create;
try
SaveToXML(AProject,XML);
@@ -464,5 +498,263 @@
end;
end;
+{$IFDEF DoDi}
+
+constructor TXMLFPDocOptions.Create(AOwner: TComponent; const AFile: string);
+begin
+ inherited Create(AOwner);
+ FileName := AFile;
+end;
+
+function TXMLFPDocOptions.LoadProject(AProject: TFPDocProject): boolean;
+begin
+ Result := False;
+ if FileName = '' then
+ exit; //message?
+ Modified := not FileExists(FileName);
+ if Modified then begin
+ WriteLn('Not found: ', GetCurrentDir, DirectorySeparator, FileName);
+ exit; //save later
+ end;
+ try
+ LoadOptionsFromFile(AProject, FileName);
+ Result := True;
+ except
+ //message?
+ end;
+end;
+
+{$IFDEF DoDiSave}
+
+function TXMLFPDocOptions.OldSaveToXML(AProject: TFPDocProject; ADoc:
TXMLDocument): boolean;
+var
+ i: integer;
+ E: TDOMElement;
+begin
+ doc := ADoc;
+ E := NeedNode(doc.FirstChild, 'packages');
+ for i := 0 to AProject.Packages.Count - 1 do
+ SavePackage(AProject.Packages[i], E);
+ SaveOptions(AProject);
+ Result := True;
+end;
+
+function TXMLFPDocOptions.SaveOptions(AProject: TFPDocProject): boolean;
+var
+ i: integer;
+ Opts: TDOMElement;
+ O: TEngineOptions;
+ n: string;
+
+ procedure AddBool(const n: string; v: Boolean; reverse: boolean=False);
+ var
+ Nn: TDOMNode;
+ Opt: TDOMElement;
+ begin
+ if reverse = v then
+ exit; //only store True options
+ Nn := FindChild(Opts, 'name', n);
+ if Nn <> nil then
+ exit; //already stored
+ Opt := doc.CreateElement('option');
+ Opts.AppendChild(Opt);
+ Opt['name'] := n;
+ Opt['value'] := 'true';
+ end;
+
+ procedure AddStr(const n, v: string);
+ var
+ Nn: TDOMNode;
+ Opt: TDOMElement;
+ begin
+ if v = '' then
+ exit; //nostore empty options
+ Nn := FindChild(Opts, 'name', n);
+ if Nn <> nil then
+ exit; //already stored
+ Opt := doc.CreateElement('option');
+ Opts.AppendChild(Opt);
+ Opt['name'] := n;
+ Opt['value'] := v;
+ end;
+
+begin
+ Opts := doc.FirstChild.FindNode('options') as TDOMElement;
+ O := AProject.Options;
+ AddBool('hide-protected', O.HideProtected); //todo: use option name constants
+ AddBool('warn-no-node', O.WarnNoNode);
+ AddBool('show-private', O.ShowPrivate);
+ AddBool('stop-on-parser-error', O.StopOnParseError);
+ AddStr('ostarget', O.OSTarget);
+ AddStr('cputarget', O.CPUTarget);
+ AddStr('mo-dir', O.MoDir);
+ AddBool('parse-impl', O.InterfaceOnly, True);
+ AddStr('format', O.Backend);
+ AddStr('language', O.Language);
+ AddStr('package', O.DefaultPackageName);
+ AddBool('dont-trim', O.DontTrim);
+ Result := True;
+end;
+
+function TXMLFPDocOptions.SavePackage(APackage: TFPDocPackage; Pkgs:
TDOMElement
+ ): boolean;
+var
+ i: integer;
+ pkg, U, M, D: TDOMElement;
+ Mn: TDOMNode;
+ fo, f, o: string; //split filename+options
+
+ procedure SplitUnit(s: string);
+ var
+ i: integer;
+ begin
+ //problem separating options from unit :-(
+ f := s;
+ o := '';
+ end;
+
+begin
+//create package element
+ pkg := doc.CreateElement('package');
+ Pkgs.AppendChild(pkg);
+//add attribs - if not empty
+ pkg['name'] := APackage.Name;
+ pkg['output']:=APackage.Output;
+ pkg['content']:=APackage.ContentFile;
+ SaveImports(APackage, pkg);
+//add units
+ U := NeedNode(pkg, 'units');
+ for i := 0 to APackage.Inputs.Count - 1 do begin
+ fo := APackage.Inputs[i];
+ SplitUnit(fo);
+ Mn := FindChild(U, 'file', f);
+ if Mn=nil then begin
+ M := doc.CreateElement('unit');
+ U.AppendChild(M);
+ M['file'] := f;
+ if o<>'' then
+ M['options'] := o;
+ end; //else update?
+ end;
+//add descriptions
+ D := NeedNode(pkg, 'descriptions');
+ for i := 0 to APackage.Descriptions.Count - 1 do begin
+ f := APackage.Descriptions[i];
+ Mn :=FindChild(D, 'file', f);
+ if Mn=nil then begin
+ U := doc.CreateElement('description');
+ D.AppendChild(U);
+ U['file'] := f;
+ end;
+ end;
+ Result := True;
+end;
+
+procedure TXMLFPDocOptions.SaveImports(APackage: TFPDocPackage; Pkg:
TDOMElement
+ );
+var
+ i, n: integer;
+ s: string;
+ U: TDOMElement;
+begin
+//save all package options (currently: imports only)
+ n := APackage.Imports.Count;
+//add imports
+ for i := 0 to n-1 do begin
+ U := NeedNode(pkg, 'import');
+ s := APackage.Imports.Names[i];
+ U['package'] := s;
+ end;
+//more options?
+end;
+
+function TXMLFPDocOptions.NeedNode(P: TDomNode; const ATag: string
+ ): TDOMElement;
+var
+ n: TDOMNode absolute result;
+begin
+ n := p.FindNode(ATag);
+ if assigned(n) then
+ exit;
+//create new child
+ Result := doc.CreateElement(ATag);
+ p.AppendChild(Result);
+end;
+
+function TXMLFPDocOptions.FindChild(N: TDOMNode; const ATag, AVal: string
+ ): TDOMNode;
+begin
+ Result := N.FirstChild;
+ while assigned(Result) do begin
+ if (Result is TDOMElement)
+ and (CompareText(TDOMElement(Result).AttribStrings[ATag], AVal)=0) then
+ exit;
+ Result := Result.NextSibling;
+ end;
+end;
+
+procedure TXMLFPDocOptions.LoadOptionsFromFile(AProject: TFPDocProject;
+ const AFileName: String);
+
+Var
+ XML : TXMLDocument;
+
+begin
+ XMLRead.ReadXMLFile(XML,AFileName);
+ try
+ LoadFromXML(AProject,XML);
+ finally
+ FreeAndNil(XML);
+ end;
+end;
+
+function TXMLFPDocOptions.SaveProject(AProject: TFPDocProject): boolean;
+Var
+ ss: TStringStream;
+ XML : TXMLDocument;
+const
+ template = '<docproject>'+LineEnding+
+ ' <packages>'+LineEnding+
+ ' </packages>'+LineEnding+
+ ' <options>'+LineEnding+
+ ' </options>'+LineEnding+
+ '</docproject>'+LineEnding;
+begin
+ Result := False; //in case of exceptions
+ if not Modified then
+ exit; //don't save unmodified project
+ if FileName = '' then
+ exit; //no filename?
+//debug
+ if dGlobals.Verbose then
+ WriteLn('Creating FPDoc project ', GetCurrentDir, DirectorySeparator,
FileName);
+ try
+ ss := TStringStream.Create(template);
+ XMLRead.ReadXMLFile(XML, ss);
+ try
+ Result := OldSaveToXML(AProject,XML);
+ if Result then begin
+ XMLWrite.WriteXMLFile(XML, FileName);
+ Modified := False;
+ end;
+ finally
+ XML.Free;
+ ss.Free;
+ end;
+ except
+ //message?
+ end;
+end;
+
+{$ELSE}
+function TXMLFPDocOptions.SaveProject(AProject: TFPDocProject): boolean;
+begin
+ Result := False;
+ SaveOptionsToFile(AProject, FileName);
+ Result := True;
+end;
+
+{$ENDIF DoDiSave}
+{$ENDIF DoDi}
end.
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel
