docs: initial work to create an application that generates our docs.

This includes builds scripts or executing fpdoc directly.

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.
+