{ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * * * *************************************************************************** Author: Michael Van Canneyt } unit frmBuild; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ComCtrls, EditBtn, ExtCtrls, ActnList, Grids, Process; type { TBuildForm } TGetListEvent = Procedure(List : TStrings) of object; { TBuildForm } TBuildForm = class(TForm) ALoad: TAction; ASave: TAction; ADescrAddAll: TAction; ASourceAdd: TAction; ASourceEdit: TAction; ASourceDelete: TAction; ADescrAdd: TAction; ADescrEdit: TAction; ADescrDelete: TAction; ABuild: TAction; ActionList1: TActionList; BClose: TButton; BBuild: TButton; BLoad: TButton; BSave: TButton; BAddDescription: TButton; BDeleteDescription: TButton; BEditDescription: TButton; BSourceAdd: TButton; BSourceDelete: TButton; BSourceEdit: TButton; BAddAll: TButton; CBHideProtected: TCheckBox; CBPackage: TComboBox; CBFormat: TComboBox; CBContent: TCheckBox; CBShowPrivate: TCheckBox; CBWarnNoNode: TCheckBox; ETargetOS: TEdit; ETargetCPU: TEdit; EOutput: TEditButton; FEImportFIle: TFileNameEdit; Label1: TLabel; Label2: TLabel; Label3: TLabel; LTargetCPU: TLabel; LCBPackage: TLabel; LCBFormat: TLabel; LBDescrFiles: TListBox; ListBox1: TListBox; MLog: TMemo; ODSettings: TOpenDialog; ODDescription: TOpenDialog; PSources: TPanel; PBDescr: TPanel; PCOptions: TPageControl; SDSettings: TSaveDialog; TSBuild: TTabSheet; TSOther: TTabSheet; TSDescription: TTabSheet; TSSources: TTabSheet; TSextra: TTabSheet; SGSources: TStringGrid; procedure ABuildExecute(Sender: TObject); procedure ABuildUpdate(Sender: TObject); procedure ADescrAddAllExecute(Sender: TObject); procedure ADescrAddAllUpdate(Sender: TObject); procedure ADescrAddExecute(Sender: TObject); procedure ADescrDeleteExecute(Sender: TObject); procedure ADescrDeleteUpdate(Sender: TObject); procedure ADescrEditExecute(Sender: TObject); procedure ADescrEditUpdate(Sender: TObject); procedure ALoadExecute(Sender: TObject); procedure ASaveExecute(Sender: TObject); procedure ASourceAddExecute(Sender: TObject); procedure ASourceDeleteExecute(Sender: TObject); procedure ASourceDeleteUpdate(Sender: TObject); procedure ASourceEditExecute(Sender: TObject); procedure ASourceEditUpdate(Sender: TObject); procedure BCloseClick(Sender: TObject); procedure BuildFormCloseQuery(Sender: TObject; var CanClose: boolean); procedure BuildFormCreate(Sender: TObject); procedure BuildFormDestroy(Sender: TObject); procedure EOutputButtonClick(Sender: TObject); private FFileName: String; OldBuf: String; FOnGetList: TGetListEvent; FOptions : TStrings; { private declarations } Procedure SaveOptions(Const AFileName : String); Procedure LoadOptions(Const AFileName : String); procedure SetFileName(const AValue: String); procedure AddToLog(S : String); procedure AppendBufToLog(Buf : PChar; BufSize : Integer); Function BuildCommandLine : String ; procedure BuildDocs; // Description methods Procedure ClearDescr; Function DescrFileCount : Integer; Function DescrFile(Index : Integer) : String; Function CurrentDescrFileIndex : Integer; Function CurrentSourceIndex : Integer; Function AddDescr(Const ASource : String) : Integer; Procedure DeleteDescrFile(Index : Integer); Procedure SetDescrFile(Index : Integer; Const AFileName : String); procedure DoGetAllDescrFiles; // Sources methods Function SourceFileCount : Integer; Function AddSource(Const ASource,AOptions : String) : Integer; Procedure GetSourceOptions(Index : Integer; Out ASource, AOptions: String); Procedure SetSourceOptions(Index : Integer; Const ASource, AOptions: String); Procedure ClearSources; procedure DisplaySources; Procedure DeleteSource(Index : Integer); public { public declarations } Procedure Load; Property FileName : String Read FFileName Write SetFileName; Property OnGetList : TGetListEvent Read FOnGetList Write FOnGetList; end; var BuildForm: TBuildForm; implementation uses Inifiles,frmSource,lazdeopts; Const // Do not localize !! SGlobal = 'Global'; SDescr = 'Descriptions'; SSources = 'Sources'; KeyCount = 'Count'; KeyPackage = 'Package'; KeyFormat = 'Format'; KeyOutput = 'Output'; KeyContent = 'Content'; //KeyLanguage = 'Language'; KeyImport = 'Import'; KeyFile = 'File%d'; KeyOptions = 'Options%d'; KeyTargetOS = 'TargetOS'; KeyTargetCPU = 'TargetCPU'; KeyHideProtected = 'HideProtected'; KeyShowPrivate = 'ShowPrivate'; DefaultFormat = 'html'; DefaultContent = False; DefaultHideProtected = False; DefaultShowPrivate = False; DefaultTargetOS = ''; DefaultTargetCPU = ''; DefaultImport = ''; resourcestring SAddDescriptionFile = 'Select a new description file'; SEditDescriptionFile = 'Change description file'; SSelectOutputFile = 'Select output file name'; SSelectOutputDirectory = 'Select output directory'; SUsingCommand = 'Building docs using command: '; SErrFPDoc = 'Building failed with exit code %d. Please check log.'; SBuildOK = 'Documentation successfully built.'; { TBuildForm } { --------------------------------------------------------------------- Actions of form. ---------------------------------------------------------------------} procedure TBuildForm.ADescrAddExecute(Sender: TObject); begin if Sender=nil then ; With ODDescription do begin Title:=SAddDescriptionFile; If Execute then AddDescr(FileName); end; end; procedure TBuildForm.ABuildExecute(Sender: TObject); begin if Sender=nil then ; BuildDocs; end; procedure TBuildForm.ABuildUpdate(Sender: TObject); begin (Sender as TAction).Enabled:=(CBPackage.Text<>'') and (CBFormat.Text<>'') and (SourceFileCount>0) and (DescrFileCount>0); end; procedure TBuildForm.ADescrAddAllExecute(Sender: TObject); begin if Sender=nil then ; DoGetAllDescrFiles; end; procedure TBuildForm.ADescrAddAllUpdate(Sender: TObject); begin (Sender as Taction).Enabled:=Assigned(FOnGetList); end; procedure TBuildForm.ADescrDeleteExecute(Sender: TObject); begin if Sender=nil then ; DeleteDescrFile(CurrentDescrFileIndex) end; procedure TBuildForm.ADescrDeleteUpdate(Sender: TObject); begin if Sender=nil then ; (Sender as TAction).Enabled:=(CurrentDescrFileIndex>=0); end; procedure TBuildForm.ADescrEditExecute(Sender: TObject); Var Index : Integer; begin if Sender=nil then ; Index:=CurrentDescrFileIndex; With ODDescription do begin FileName:=DescrFile(Index); Title:=SEditDescriptionFile; If Execute then SetDescrFile(Index,FileName); end; end; procedure TBuildForm.ADescrEditUpdate(Sender: TObject); begin (Sender as TAction).Enabled:=(CurrentDescrFileIndex>=0); end; procedure TBuildForm.ALoadExecute(Sender: TObject); begin if Sender=nil then ; With ODSettings do If Execute then begin LoadOptions(FileName); FFileName := FileName; end; end; procedure TBuildForm.ASaveExecute(Sender: TObject); begin if Sender=nil then ; With SDSettings do begin FileName:=Self.FileName; If Execute then begin SaveOptions(FileName); FFileName:=FileName; end; end; end; procedure TBuildForm.ASourceAddExecute(Sender: TObject); begin if Sender=nil then ; With TSourceForm.Create(Self) do Try If ShowModal=mrOK then AddSource(Source,Options) Finally Free; end; end; procedure TBuildForm.ASourceDeleteExecute(Sender: TObject); begin if Sender=nil then ; DeleteSource(CurrentSourceIndex); end; procedure TBuildForm.ASourceDeleteUpdate(Sender: TObject); begin (Sender as TAction).Enabled:=(CurrentSourceIndex>=0); end; procedure TBuildForm.ASourceEditExecute(Sender: TObject); Var Index : Integer; FN,Opt : String; begin if Sender=nil then ; Index:=CurrentSourceIndex; GetSourceOptions(Index,FN,Opt); With TSourceForm.Create(Self) do Try Source:=FN; Options:=Opt; If (ShowModal=mrOk) then SetSourceOptions(Index,Source,Options); Finally Free; end; end; procedure TBuildForm.ASourceEditUpdate(Sender: TObject); begin (Sender as TAction).Enabled:=(CurrentSourceIndex>=0); end; procedure TBuildForm.BCloseClick(Sender: TObject); begin if Sender=nil then ; Close; end; procedure TBuildForm.BuildFormCloseQuery(Sender: TObject; var CanClose: boolean); begin if Sender=nil then ; CanClose:=True; // Check here for modifications. end; procedure TBuildForm.BuildFormCreate(Sender: TObject); begin if Sender=nil then ; FOptions:=TStringList.Create; end; procedure TBuildForm.BuildFormDestroy(Sender: TObject); begin if Sender=nil then ; FOptions.Free; end; procedure TBuildForm.EOutputButtonClick(Sender: TObject); begin if Sender=nil then ; if (lowercase(cbFormat.text)='html') then With TSelectDirectoryDialog.Create(Self) do begin Title:=SSelectOutputDirectory; FileName:=Eoutput.Text; If EXecute then EOutput.Text:=FileName end else With TSaveDialog.Create(Self) do begin Title:=SSelectOutputFile; // Set filter ? FileName:=Eoutput.Text; If Execute then EOutput.Text:=FileName end end; { --------------------------------------------------------------------- general loading and saving of form. ---------------------------------------------------------------------} procedure TBuildForm.SaveOptions(const AFileName: String); Var Ini : TMemInifile; I,ACount : Integer; S,O : String; begin Ini:=TMemIniFile.Create(AFileName); Try With Ini Do begin WriteString(SGLobal,KeyPackage,CBPackage.Text); WriteString(SGlobal,KeyFormat,CBFormat.Text); WriteString(SGlobal,KeyOutput,EOutput.Text); WriteBool (SGlobal,KeyContent,CBContent.Checked); WriteString(SGlobal,KeyTargetOS,ETargetOS.Text); WriteString(SGlobal,KeyTargetCPU,ETargetCPU.Text); WriteBool (SGlobal,KeyHideProtected,CBHideProtected.Checked); WriteBool (SGLobal,KeyShowPrivate,CBShowPrivate.Checked); WriteString(SGlobal,KeyImport,FEImportFIle.Text); ACount:=DescrFileCount; WriteInteger(SDescr,KeyCount,ACount); For I:=1 to ACount do WriteString(SDescr,Format(KeyFile,[i]),DescrFile(I-1)); ACount:=SourceFileCount; WriteInteger(SSources,KeyCount,ACount); For I:=1 to ACount do begin GetSourceOptions(I-1,S,O); WriteString(SSources,Format(KeyFile,[i]),S); WriteString(SSources,Format(KeyOptions,[i]),O); end; end; Finally Ini.Free; end; end; procedure TBuildForm.LoadOptions(const AFileName: String); Var Ini : TMemInifile; I,ACount : Integer; S,O : String; begin Ini:=TMemIniFile.Create(AFileName); Try With Ini Do begin CBPackage.Text:=ReadString(SGLobal,KeyPackage,''); With CBFormat do ItemIndex:=Items.IndexOf(ReadString(SGlobal,KeyFormat,DefaultFormat)); EOutput.Text:=ReadString(SGlobal,KeyOutput,''); CBContent.Checked:=ReadBool(SGlobal,KeyContent,DefaultContent); ETargetOS.Text:=ReadString(SGlobal,KeyTargetOS,DefaultTargetOS); ETargetCPU.Text:=ReadString(SGlobal,KeyTargetCPU,DefaultTargetCPU); CBHideProtected.Checked:=ReadBool(SGlobal,KeyHideProtected,DefaultHideProtected); CBShowPrivate.Checked:=ReadBool(SGLobal,KeyShowPrivate,DefaultShowPrivate); FEImportFIle.Text:=ReadString(SGlobal,KeyImport,DefaultImport); ACount:=ReadInteger(SDescr,KeyCount,0); ClearDescr; For I:=1 to ACount do begin S:=ReadString(SDescr,Format(KeyFile,[i]),''); If (S<>'') then AddDescr(S) end; ACount:=ReadInteger(SSources,KeyCount,0); ClearSources; For I:=1 to ACount do begin S:=ReadString(SSources,Format(KeyFile,[i]),''); If (S<>'') then begin O:=ReadString(SSources,Format(KeyOptions,[i]),''); AddSource(S,O); end; end; end; Finally Ini.Free; end; end; procedure TBuildForm.Load; begin LoadOptions(FileName); end; procedure TBuildForm.SetFileName(const AValue: String); begin if FFileName=AValue then exit; FFileName:=AValue; LoadOptions(AValue); end; { --------------------------------------------------------------------- Description tab methods ---------------------------------------------------------------------} procedure TBuildForm.ClearDescr; begin LBDescrFiles.Items.Clear; end; function TBuildForm.DescrFileCount: Integer; begin Result:=LBDescrFiles.Items.Count; end; function TBuildForm.AddDescr(const ASource: String): Integer; begin Result:=LBDescrFiles.Items.Add(ASource); end; function TBuildForm.DescrFile(Index: Integer): String; begin Result:=LBDescrFiles.Items[Index]; end; function TBuildForm.CurrentDescrFileIndex: Integer; begin Result:=LBDescrFiles.ItemIndex; end; procedure TBuildForm.DeleteDescrFile(Index: Integer); begin LBDescrFiles.Items.Delete(Index); end; Procedure TBuildForm.SetDescrFile(Index: Integer; Const AFileName : String); begin LBDescrFiles.Items[Index]:=AFileName; end; procedure TBuildForm.DoGetAllDescrFiles; Var L : TStringList; I : INteger; S : String; begin L:=TStringList.Create; Try FOnGetList(L); // This is very rudimentary; We should take care of relative paths etc. For I:=0 to L.Count-1 do begin S:=L[i]; If (LBDescrFiles.Items.IndexOf(S)=-1) and (LBDescrFiles.Items.IndexOf(ExpandFileName(S))=-1) then LBDescrFiles.Items.Add(S); end; Finally L.Free; end; end; { --------------------------------------------------------------------- Sources tab methods ---------------------------------------------------------------------} function TBuildForm.AddSource(const ASource, AOptions: String): Integer; begin Result:=FOptions.Add(ASource+'='+AOptions); DisplaySources; end; Procedure TBuildForm.SetSourceOptions(Index : Integer; const ASource, AOptions: String); begin FOptions[Index]:=ASource+'='+AOptions; end; Procedure TBuildForm.GetSourceOptions(Index : Integer; Out ASource, AOptions: String); Var N : Integer; begin AOptions:=FOptions[Index]; N:=Pos('=',AOptions); If N=0 then N:=Length(AOptions)+1; ASource:=Copy(AOptions,1,N-1); System.Delete(AOptions,1,N); end; Procedure TBuildForm.DeleteSource(Index : Integer); begin FOptions.Delete(Index); end; procedure TBuildForm.ClearSources; begin FOptions.Clear; DisplaySources; end; function TBuildForm.SourceFileCount: Integer; begin Result:=FOptions.Count; end; procedure TBuildForm.DisplaySources; Var C,I : Integer; N,O : String; begin C:=FOptions.Count; If (C=0) then SGSources.RowCount:=2 else begin SGSources.RowCount:=C+1; For I:=0 to C-1 do begin GetSourceOptions(I,N,O); SGSources.Cells[0,I+1]:=N; SGSources.Cells[1,I+1]:=O; end; end; end; Function TBuildForm.CurrentSourceIndex : Integer; begin Result:=SGSources.Row-1; end; procedure TBuildForm.AddToLog(S : String); begin MLog.Lines.Add(S); end; procedure TBuildForm.AppendBufToLog(Buf : PChar; BufSize : Integer); Var S,L : String; P : Integer; begin Buf[BufSize]:=#0; S:=OldBuf+StrPas(Buf); P:=Pos(LineEnding,S); While P>0 do begin L:=Copy(S,1,P-1); AddToLog(L); Delete(S,1,P+Length(LineEnding)-1); P:=Pos(LineEnding,S); end; OldBuf:=S; end; Function TBuildForm.BuildCommandLine : String ; Var I : Integer; FN,O : String; begin Result:=cmdFPDoc; Result:=Result+' --package='+CBPackage.Text; Result:=Result+' --output='+Eoutput.Text; Result:=Result+' --format='+CBFormat.Text; If CBShowPrivate.Checked then Result:=Result+' --show-private'; If CBHideProtected.Checked then Result:=Result+' --hide-protected'; if CBContent.Checked then Result:=Result+' --content'; if CBWarnNoNode.Checked then Result:=Result+' --warn-no-node'; if (FEImportFile.FileName<>'') then Result:=Result+' --import='+FEImportFile.FileName; if (ETargetOS.Text<>'') then Result:=Result+' --ostarget='+ETargetOS.Text; if (ETargetCPU.Text<>'') then Result:=Result+' --cputarget='+ETargetCPU.Text; For I:=1 to DescrFileCount do Result:=Result+' --descr='+DescrFile(I-1); For I:=1 to SourceFileCount do begin GetSourceOptions(I-1,FN,O); If (O<>'') then FN:=FN+' '+O; Result:=Result+' --input="'+FN+'"'; end; end; procedure TBuildForm.BuildDocs; Const BufSize = 1024; Var Buf : Array[0..BufSize] of char; Cmd : String; R : Integer; begin PCOptions.ActivePage:=TSBuild; OldBuf:=''; Buf[BufSize]:=#0; With TProcess.Create(Self) do begin Cmd:=BuildCommandLine; CommandLine:=Cmd; AddToLog(SUsingCommand+Cmd); Options:=[poUsePipes,poNoConsole,poStderrToOutPut]; Execute; r:=Output.Read(Buf,BufSize); While (r>0) do begin AppendBufToLog(@Buf,R); r:=Output.Read(Buf,BufSize); end; If (OldBuf<>'') then AddToLog(OldBuf); If ExitCode<>0 then MessageDLG(Format(SErrfpdoc,[ExitCode]),mtError,[mbOK],0) else AddToLog(SBuildOK); end; end; initialization {$I frmbuild.lrs} end.