diff options
-rw-r--r-- | docs/builddocs.pas | 170 |
1 files changed, 170 insertions, 0 deletions
diff --git a/docs/builddocs.pas b/docs/builddocs.pas new file mode 100644 index 00000000..abf1db89 --- /dev/null +++ b/docs/builddocs.pas @@ -0,0 +1,170 @@ +{ + Simple program to buid a documenation script. + It looks for xml description files. Matches those to source files, + and includes those matches in the documentation script. + + TODO: + * Parameter to build script or execute directly fpdoc. + * Make program build Linux shell scripts and Windows Batch scripts. + * Add parameter to include all units, not just those that have documentation + * Order of files are important to fpdoc, so we need some way of indicating the + order in which files must be processed. +} +program builddocs; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, CustApp; + +const + cFPDOC = 'fpdoc'; + cFPDocParameters = ' --package=fpgui --format=ipf --output=fpgui.ipf --content=fpgui.cnt --duplinkeddoc '; + cFilePath = '-Fi../src -Fu../src/corelib/x11/ -Fi../src/corelib/x11/ -Fu../src/gui/ -Fu../src/corelib/ %s'; + cFileLine = ' --input=''%s'' --descr=%s'; + +type + TBuildDocsApp = class(TCustomApplication) + private + FXMLFiles: TStrings; + FPasFiles: TStrings; + FCommand: string; + procedure FileSearch(SearchDir: string; ExtensionMask: string; var FileList: TStrings; Recursive: boolean = True); + function ExtractFileNameOnly(AFilename: string): string; + procedure BuildScript; + protected + procedure DoRun; override; + public + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + procedure WriteHelp; virtual; + end; + +{ TBuildDocsApp } + +procedure TBuildDocsApp.FileSearch(SearchDir: string; ExtensionMask: string; + var FileList: TStrings; Recursive: boolean); +var + Info : TSearchRec; + ExtensionList: TStrings; +begin + SearchDir := IncludeTrailingPathDelimiter(SearchDir); + + ExtensionList := TStringList.Create; + ExtensionList.Delimiter := ';'; + ExtensionList.DelimitedText := ExtensionMask; + + if FindFirst(SearchDir+AllFilesMask, faAnyFile and faDirectory, Info) = 0 then + begin + repeat + if Recursive then + if ((Info.Attr and faDirectory) = faDirectory) and (Info.Name <> '.') and (Info.Name <> '..')then + FileSearch(SearchDir + Info.Name, ExtensionMask, FileList, Recursive); + + if ExtensionList.IndexOf(ExtractFileExt(Info.Name)) <> -1 then + begin + if FileList.IndexOf(SearchDir + Info.Name) = -1 then + FileList.Add(SearchDir + Info.Name); + end; + until FindNext(Info)<>0; + end; + FindClose(Info); + + ExtensionList.Free; +end; + +function TBuildDocsApp.ExtractFileNameOnly(AFilename: string): string; +var + p: integer; +begin + Result := ExtractFileName(AFilename); + p := Length(ExtractFileExt(Result)); + Result := Copy(Result, 1, Length(Result)-p); +end; + +procedure TBuildDocsApp.BuildScript; +var + lPFile, lXFile: string; + i, j: integer; + lFPDoc: string; +begin + lFPDoc := GetEnvironmentVariable('fpdoc'); + if lFPDoc = '' then + lFPDoc := cFPDOC; + FCommand := lFPDoc + cFPDocParameters; + FileSearch('xml/', '.xml', FXMLFiles, True); + FileSearch('../src/', '.pas', FPasFiles, True); + + for i := 0 to FXMLFiles.Count-1 do + begin + lXFile := ExtractFileNameOnly(FXMLFiles[i]); + for j := 0 to FPasFiles.Count-1 do + begin + lPFile := ExtractFileNameOnly(FPasFiles[j]); + if SameText(lXFile, lPFile) then + begin + FCommand := FCommand + ' \' + LineEnding + Format(cFileLine, [Format(cFilePath, [FPasFiles[j]]), FXMLFiles[i]]); + end; + end; + end; + + FXMLFiles.Text := FCommand; + FXMLFiles.SaveToFile('runme2.sh'); +end; + +procedure TBuildDocsApp.DoRun; +var + ErrorMsg: String; +begin + // quick check parameters + ErrorMsg:=CheckOptions('h','help'); + if ErrorMsg<>'' then begin + ShowException(Exception.Create(ErrorMsg)); + Terminate; + Exit; + end; + + // parse parameters + if HasOption('h','help') then begin + WriteHelp; + Terminate; + Exit; + end; + + BuildScript; + + // stop program loop + Terminate; +end; + +constructor TBuildDocsApp.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + StopOnException:=True; + FXMLFiles := TStringList.Create; + FPasFiles := TStringList.Create; +end; + +destructor TBuildDocsApp.Destroy; +begin + FXMLFiles.Free; + FPasFiles.Free; + inherited Destroy; +end; + +procedure TBuildDocsApp.WriteHelp; +begin + { add your help code here } + writeln('Usage: ',ExeName,' -h'); +end; + +var + Application: TBuildDocsApp; + +begin + Application:=TBuildDocsApp.Create(nil); + Application.Title:='Build Docs App'; + Application.Run; + Application.Free; +end. + |