paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-04 19:00:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

DocMgr: GUI extended

Browse Source 
git-svn-id: trunk@34739 -
This commit is contained in:
dodi 2012-01-15 09:42:41 +00:00
parent 55b77b7eab
commit 02d648e46f
6 changed files with 835 additions and 176 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
examples/fpdocmanager/docs/umakeskel.xml
View File

@ -107,7 +107,7 @@
</element> </element>
<!-- variable Visibility: public --> <!-- variable Visibility: public -->
<element name="TCmdOptions.WriteDeclaration"> <element name="TCmdOptions.WriteDeclaration">
<short>[?]</short> <short>Emit declaration for elements (--emit-declaration).</short>
<descr/> <descr/>
<seealso/> <seealso/>
</element> </element>
@ -125,7 +125,7 @@
</element> </element>
<!-- variable Visibility: public --> <!-- variable Visibility: public -->
<element name="TCmdOptions.DisableOverride"> <element name="TCmdOptions.DisableOverride">
<short>[?]</short> <short>Do not create nodes for override methods.</short>
<descr/> <descr/>
<seealso/> <seealso/>
</element> </element>

3
examples/fpdocmanager/docs/umanager.xml
View File

@ -1015,6 +1015,9 @@
<descr/> <descr/>
<seealso/> <seealso/>
</element> </element>
<element name="TFPDocManager.OptsFile">
<short>File to use for output options (FPDoc).</short>
</element>
</module> </module>
<!-- uManager --> <!-- uManager -->
</package> </package>

477
examples/fpdocmanager/fmain.lfm
View File

@ -1,20 +1,19 @@
object Main: TMain object Main: TMain
Left = 373 Left = 335
Height = 290 Height = 423
Top = 146 Top = 146
Width = 411 Width = 569
Align = alClient Align = alClient
Caption = 'Main' Caption = 'Main'
ClientHeight = 270 ClientHeight = 403
ClientWidth = 411 ClientWidth = 569
Menu = MainMenu1 Menu = MainMenu1
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate OnCreate = FormCreate
OnResize = FormResize OnResize = FormResize
LCLVersion = '0.9.31' LCLVersion = '0.9.31'
object lbPackages: TComboBox object lbPackages: TComboBox
Left = 0 Left = 0
Height = 270 Height = 403
Top = 0 Top = 0
Width = 94 Width = 94
Align = alLeft Align = alLeft
@ -25,22 +24,348 @@ object Main: TMain
end end
object Units: TPageControl object Units: TPageControl
Left = 94 Left = 94
Height = 270 Height = 403
Top = 0 Top = 0
Width = 317 Width = 475
ActivePage = ViewUnits ActivePage = ViewUnits
Align = alClient Align = alClient
TabIndex = 1 TabIndex = 0
TabOrder = 1 TabOrder = 1
object ViewUnits: TTabSheet
Caption = 'Units'
ClientHeight = 375
ClientWidth = 467
object lbUnits: TListBox
Left = 0
Height = 375
Top = 0
Width = 100
Align = alLeft
ItemHeight = 0
OnClick = lbUnitsClick
TabOrder = 0
end
object GroupBox1: TGroupBox
Left = 100
Height = 375
Top = 0
Width = 367
Align = alClient
Caption = 'Actions'
ClientHeight = 357
ClientWidth = 363
TabOrder = 1
object swAll: TRadioButton
Left = 10
Height = 19
Top = 10
Width = 32
Caption = 'all'
Checked = True
TabOrder = 0
TabStop = True
end
object swSingle: TRadioButton
Left = 48
Height = 19
Top = 10
Width = 43
Caption = 'only'
OnClick = swSingleClick
TabOrder = 1
end
object edUnit: TEdit
Left = 96
Height = 23
Top = 10
Width = 262
Anchors = [akTop, akLeft, akRight]
ReadOnly = True
TabOrder = 2
end
object buRefresh: TButton
Left = 96
Height = 25
Top = 40
Width = 75
Caption = 'Refresh'
OnClick = buRefreshClick
TabOrder = 3
end
object buShowLog: TButton
Left = 10
Height = 25
Top = 208
Width = 68
Caption = 'Show Log'
TabOrder = 4
end
object edLog: TEdit
Left = 88
Height = 23
Top = 208
Width = 269
Anchors = [akTop, akLeft, akRight]
OnChange = edLogChange
TabOrder = 5
end
object buTest: TButton
Left = 9
Height = 25
Top = 40
Width = 75
Caption = 'Test only'
OnClick = buTestClick
TabOrder = 6
end
object swShowUpdate: TCheckBox
Left = 248
Height = 19
Top = 176
Width = 90
Caption = 'Show Update'
OnChange = swShowUpdateChange
TabOrder = 7
end
object optUpd: TCheckGroup
Left = 8
Height = 129
Top = 72
Width = 216
AutoFill = True
Caption = 'Hide...'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2
Columns = 2
Items.Strings = (
'Declaration'
'Overrides'
'Errors'
'SeeAlso'
'Arguments'
'Results'
'Private'
'Protected'
'Class Separators'
)
OnItemClick = optUpdItemClick
TabOrder = 8
Data = {
09000000020202020202030202
}
end
object swSortNodes: TCheckBox
Left = 248
Height = 19
Top = 96
Width = 78
Caption = 'Sort Nodes'
TabOrder = 9
end
end
end
object ViewFinal: TTabSheet
Caption = 'Document'
ClientHeight = 375
ClientWidth = 467
object Label1: TLabel
Left = 10
Height = 16
Top = 74
Width = 39
Caption = 'Format'
ParentColor = False
end
object cbFormat: TComboBox
Left = 70
Height = 23
Top = 72
Width = 375
ItemHeight = 15
OnSelect = cbFormatSelect
ParentColor = True
Style = csDropDownList
TabOrder = 0
end
object swDocOpts: TCheckGroup
Left = 10
Height = 136
Top = 106
Width = 220
AutoFill = True
Caption = 'Options'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
Items.Strings = (
'Stop on parser error'
'Warn on missing description'
'Hide protected'
'Show privates'
'Interface only'
'Don''t trim'
)
OnItemClick = optUpdItemClick
TabOrder = 1
Data = {
06000000020302020302
}
end
object Label2: TLabel
Left = 10
Height = 16
Top = 250
Width = 50
Caption = 'OSTarget'
ParentColor = False
end
object Label3: TLabel
Left = 10
Height = 16
Top = 278
Width = 58
Caption = 'CPUTarget'
ParentColor = False
end
object Label4: TLabel
Left = 10
Height = 16
Top = 307
Width = 53
Caption = 'Language'
ParentColor = False
end
object Label5: TLabel
Left = 10
Height = 16
Top = 346
Width = 34
Caption = 'MoDir'
ParentColor = False
end
object Label6: TLabel
Left = 246
Height = 16
Top = 106
Width = 91
Caption = 'Backend Options'
ParentColor = False
end
object buMakeDoc: TButton
Left = 296
Height = 25
Top = 8
Width = 146
AutoSize = True
Caption = 'Create Documentation'
OnClick = buMakeDocClick
TabOrder = 2
end
object edOS: TEdit
Left = 82
Height = 23
Top = 250
Width = 148
OnExit = edOSExit
TabOrder = 3
end
object edCPU: TEdit
Left = 82
Height = 23
Top = 278
Width = 148
OnExit = edOSExit
TabOrder = 4
end
object edLang: TEdit
Left = 82
Height = 23
Top = 307
Width = 148
OnExit = edOSExit
TabOrder = 5
end
object edMoDir: TEdit
Left = 82
Height = 23
Top = 339
Width = 364
OnExit = edOSExit
TabOrder = 6
end
object Label7: TLabel
Left = 10
Height = 16
Top = 10
Width = 35
Caption = 'Profile'
ParentColor = False
end
object cbProfile: TComboBox
Left = 66
Height = 23
Top = 8
Width = 100
ItemHeight = 15
OnSelect = cbProfileSelect
TabOrder = 7
end
object buNewProfile: TButton
Left = 174
Height = 25
Top = 8
Width = 51
Caption = 'Save'
OnClick = buNewProfileClick
TabOrder = 8
end
object Label8: TLabel
Left = 10
Height = 16
Top = 40
Width = 39
Caption = 'Output'
ParentColor = False
end
object edOutput: TEdit
Left = 66
Height = 23
Top = 40
Width = 376
TabOrder = 9
end
object edBackend: TMemo
Left = 246
Height = 200
Hint = 'Enter command=value pairs'
Top = 128
Width = 200
OnExit = lbBackendExit
ParentShowHint = False
ShowHint = True
TabOrder = 10
end
end
object ViewXML: TTabSheet object ViewXML: TTabSheet
Caption = 'Project' Caption = 'Project'
ClientHeight = 242 ClientHeight = 315
ClientWidth = 309 ClientWidth = 467
inline edXML: TSynEdit inline edXML: TSynEdit
Left = 0 Left = 0
Height = 242 Height = 315
Top = 0 Top = 0
Width = 309 Width = 467
Align = alClient Align = alClient
Font.Height = -13 Font.Height = -13
Font.Name = 'Courier New' Font.Name = 'Courier New'
@ -520,131 +845,15 @@ object Main: TMain
end end
end end
end end
object ViewUnits: TTabSheet
Caption = 'Units'
ClientHeight = 242
ClientWidth = 309
object lbUnits: TListBox
Left = 0
Height = 242
Top = 0
Width = 100
Align = alLeft
ItemHeight = 0
OnClick = lbUnitsClick
TabOrder = 0
end
object GroupBox1: TGroupBox
Left = 100
Height = 242
Top = 0
Width = 209
Align = alClient
Caption = 'Actions'
ClientHeight = 224
ClientWidth = 205
TabOrder = 1
object swAll: TRadioButton
Left = 10
Height = 19
Top = 10
Width = 32
Caption = 'all'
Checked = True
TabOrder = 0
TabStop = True
end
object swSingle: TRadioButton
Left = 48
Height = 19
Top = 10
Width = 43
Caption = 'only'
OnClick = swSingleClick
TabOrder = 1
end
object edUnit: TEdit
Left = 96
Height = 23
Top = 10
Width = 104
Anchors = [akTop, akLeft, akRight]
ReadOnly = True
TabOrder = 2
end
object buRefresh: TButton
Left = 10
Height = 25
Top = 40
Width = 188
Caption = 'Refresh'
OnClick = buRefreshClick
TabOrder = 3
end
object buSkel: TButton
Left = 20
Height = 25
Top = 72
Width = 104
Caption = 'Create Skeleton'
Enabled = False
TabOrder = 4
end
object buUpdate: TButton
Left = 132
Height = 25
Top = 72
Width = 54
Caption = 'Update'
Enabled = False
TabOrder = 5
end
object buShowLog: TButton
Left = 9
Height = 25
Top = 184
Width = 68
Caption = 'Show Log'
TabOrder = 6
end
object edLog: TEdit
Left = 87
Height = 23
Top = 184
Width = 111
Anchors = [akTop, akLeft, akRight]
OnChange = edLogChange
TabOrder = 7
end
object buTest: TButton
Left = 10
Height = 25
Top = 144
Width = 75
Caption = 'Test only'
OnClick = buTestClick
TabOrder = 8
end
object swShowUpdate: TCheckBox
Left = 10
Height = 19
Top = 104
Width = 90
Caption = 'Show Update'
OnChange = swShowUpdateChange
TabOrder = 9
end
end
end
object ViewINI: TTabSheet object ViewINI: TTabSheet
Caption = 'INI' Caption = 'INI'
ClientHeight = 242 ClientHeight = 375
ClientWidth = 309 ClientWidth = 467
object edINI: TMemo object edINI: TMemo
Left = 0 Left = 0
Height = 242 Height = 375
Top = 0 Top = 0
Width = 309 Width = 467
Align = alClient Align = alClient
Lines.Strings = ( Lines.Strings = (
'edINI' 'edINI'

215
examples/fpdocmanager/fmain.pas
View File

@ -11,8 +11,8 @@ unit fMain;
interface interface
uses uses
Classes, SysUtils, FileUtil, SynHighlighterXML, SynEdit, Forms, Classes, SysUtils, FileUtil, SynHighlighterXML, SynEdit, Forms, Controls,
Controls, Graphics, Dialogs, Menus, StdCtrls, ComCtrls, Graphics, Dialogs, Menus, StdCtrls, ComCtrls, ExtCtrls,
uManager; uManager;
type type
@ -20,11 +20,30 @@ type
{ TMain } { TMain }
TMain = class(TForm) TMain = class(TForm)
buSkel: TButton;
buUpdate: TButton;
buRefresh: TButton; buRefresh: TButton;
buShowLog: TButton; buShowLog: TButton;
buTest: TButton; buTest: TButton;
buMakeDoc: TButton;
buNewProfile: TButton;
cbFormat: TComboBox;
cbProfile: TComboBox;
edOutput: TEdit;
edOS: TEdit;
edCPU: TEdit;
edLang: TEdit;
edMoDir: TEdit;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
edBackend: TMemo;
swDocOpts: TCheckGroup;
Label1: TLabel;
swSortNodes: TCheckBox;
optUpd: TCheckGroup;
dlgSelLpk: TOpenDialog; dlgSelLpk: TOpenDialog;
edINI: TMemo; edINI: TMemo;
swShowUpdate: TCheckBox; swShowUpdate: TCheckBox;
@ -41,6 +60,7 @@ type
MenuItem3: TMenuItem; MenuItem3: TMenuItem;
mnExit: TMenuItem; mnExit: TMenuItem;
dlgSelRoot: TSelectDirectoryDialog; dlgSelRoot: TSelectDirectoryDialog;
ViewFinal: TTabSheet;
ViewINI: TTabSheet; ViewINI: TTabSheet;
Units: TPageControl; Units: TPageControl;
swAll: TRadioButton; swAll: TRadioButton;
@ -49,23 +69,31 @@ type
SynXMLSyn1: TSynXMLSyn; SynXMLSyn1: TSynXMLSyn;
ViewXML: TTabSheet; ViewXML: TTabSheet;
ViewUnits: TTabSheet; ViewUnits: TTabSheet;
procedure buMakeDocClick(Sender: TObject);
procedure buNewProfileClick(Sender: TObject);
procedure buRefreshClick(Sender: TObject); procedure buRefreshClick(Sender: TObject);
procedure buTestClick(Sender: TObject); procedure buTestClick(Sender: TObject);
procedure cbFormatSelect(Sender: TObject);
procedure cbProfileSelect(Sender: TObject);
procedure edLogChange(Sender: TObject); procedure edLogChange(Sender: TObject);
procedure edOSExit(Sender: TObject);
procedure edXMLExit(Sender: TObject); procedure edXMLExit(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject); procedure FormResize(Sender: TObject);
procedure lbBackendExit(Sender: TObject);
procedure lbPackagesClick(Sender: TObject); procedure lbPackagesClick(Sender: TObject);
procedure lbUnitsClick(Sender: TObject); procedure lbUnitsClick(Sender: TObject);
procedure mnConfigClick(Sender: TObject); procedure mnConfigClick(Sender: TObject);
procedure mnExitClick(Sender: TObject); procedure mnExitClick(Sender: TObject);
procedure mnImportLpkClick(Sender: TObject); procedure mnImportLpkClick(Sender: TObject);
procedure optUpdItemClick(Sender: TObject; Index: integer);
procedure swShowUpdateChange(Sender: TObject); procedure swShowUpdateChange(Sender: TObject);
procedure swSingleClick(Sender: TObject); procedure swSingleClick(Sender: TObject);
private private
LogName: string; LogName: string;
LogFile: TStream; LogFile: TStream;
Profile: string;
procedure ProjectsChanged(Sender: TObject); procedure ProjectsChanged(Sender: TObject);
procedure LogToFile(Sender: TObject; const msg: string); procedure LogToFile(Sender: TObject; const msg: string);
procedure LogToMsgBox(Sender: TObject; const msg: string); procedure LogToMsgBox(Sender: TObject; const msg: string);
@ -73,6 +101,11 @@ type
procedure LogDone; procedure LogDone;
procedure ShowUpdate; procedure ShowUpdate;
procedure OnParseImport(Sender: TObject; var ASource, ALink: string); procedure OnParseImport(Sender: TObject; var ASource, ALink: string);
procedure SaveOptions;
procedure GetOptions;
procedure GetEngines;
procedure GetProfile(const AName: string);
procedure SelectFormat(AFmt: string);
public public
CurPkg: TDocPackage; CurPkg: TDocPackage;
CurUnit: string; CurUnit: string;
@ -85,7 +118,8 @@ var
implementation implementation
uses uses
fConfig, fLogView, fUpdateView; fConfig, fLogView, fUpdateView,
dWriter;
//dw_HTML, //more writers? //dw_HTML, //more writers?
//uLpk; //uLpk;
@ -132,6 +166,7 @@ begin
end; end;
end; end;
//UpdateDocs; //package objects seem to be missing? //UpdateDocs; //package objects seem to be missing?
GetEngines;
end; end;
procedure TMain.FormResize(Sender: TObject); procedure TMain.FormResize(Sender: TObject);
@ -147,8 +182,8 @@ end;
procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin begin
//is this really required? //is this really required?
//CanClose := CanClose := True; //make compiler happy
Manager.SaveConfig; //what if fails? //Manager.SaveConfig; //what if fails?
end; end;
procedure TMain.mnExitClick(Sender: TObject); procedure TMain.mnExitClick(Sender: TObject);
@ -162,11 +197,6 @@ begin
ShowUpdate; ShowUpdate;
end; end;
procedure TMain.edLogChange(Sender: TObject);
begin
LogName:=edLog.Text;
end;
procedure TMain.LogStart; procedure TMain.LogStart;
begin begin
if LogName = '' then if LogName = '' then
@ -248,6 +278,132 @@ and provide the list of imports.
ALink := '../' + pn + '/'; ALink := '../' + pn + '/';
end; end;
type
SkelOpts = (
soDecl, soOverrides, soErrors, soSeeAlso, soArgs, soResults,
soPriv, soProt, soClassSep
);
procedure TMain.SaveOptions;
begin
Manager.Options.WriteDeclaration := not optUpd.Checked[ord(soDecl)];
Manager.Options.DisableOverride := optUpd.Checked[ord(soOverrides)];
Manager.Options.DisableErrors := optUpd.Checked[ord(soErrors)];
Manager.Options.DisableSeealso := optUpd.Checked[ord(soSeeAlso)];
Manager.Options.DisableArguments := optUpd.Checked[ord(soArgs)];
Manager.Options.DisableFunctionResults := optUpd.Checked[ord(soResults)];
Manager.Options.ShowPrivate := not optUpd.Checked[ord(soPriv)];
Manager.Options.DisableProtected := optUpd.Checked[ord(soProt)];
Manager.Options.EmitClassSeparator := not optUpd.Checked[ord(soClassSep)];
Manager.Options.SortNodes := swSortNodes.Checked;
Manager.Options.Modified := True; //assume!
//Backend
//if cbFormat.Caption = '' then exit; //no valid options
if cbFormat.ItemIndex < 0 then
SelectFormat('html');
Manager.Options.Backend := cbFormat.Items.Names[cbFormat.ItemIndex];
Manager.Options.StopOnParseError := swDocOpts.Checked[0];
Manager.Options.WarnNoNode := swDocOpts.Checked[1];
Manager.Options.HideProtected := swDocOpts.Checked[2];
Manager.Options.ShowPrivate := swDocOpts.Checked[3];
Manager.Options.InterfaceOnly := swDocOpts.Checked[4];
Manager.Options.DontTrim := swDocOpts.Checked[5];
Manager.Options.OSTarget := edOS.Text;
Manager.Options.CPUTarget := edCPU.Text;
Manager.Options.Language := edLang.Text;
Manager.Options.MoDir := edMoDir.Text;
Manager.Options.BackendFromPairs(edBackend.Lines);
end;
procedure TMain.GetOptions;
begin
optUpd.Checked[ord(soDecl)] := not Manager.Options.WriteDeclaration;
optUpd.Checked[ord(soOverrides)] := Manager.Options.DisableOverride;
optUpd.Checked[ord(soErrors)] := Manager.Options.DisableErrors;
optUpd.Checked[ord(soSeeAlso)] := Manager.Options.DisableSeealso;
optUpd.Checked[ord(soArgs)] := Manager.Options.DisableArguments;
optUpd.Checked[ord(soResults)] := Manager.Options.DisableFunctionResults;
optUpd.Checked[ord(soPriv)] := not Manager.Options.ShowPrivate;
optUpd.Checked[ord(soProt)] := Manager.Options.DisableProtected;
optUpd.Checked[ord(soClassSep)] := not Manager.Options.EmitClassSeparator;
swSortNodes.Checked := Manager.Options.SortNodes;
//backend
if Profile = '' then begin
Profile:=Manager.Profile;
cbProfile.Items.CommaText := Manager.Profiles;
cbProfile.Caption := Profile;
end;
GetProfile(Profile);
end;
procedure TMain.GetProfile(const AName: string);
begin
//if Profile = AName then exit; //nothing changed?
Manager.Profile := AName;
//cbFormat.Caption := Manager.Options.Backend; //select from CB?
SelectFormat(Manager.Options.Backend);
swDocOpts.Checked[0] := Manager.Options.StopOnParseError;
swDocOpts.Checked[1] := Manager.Options.WarnNoNode;
swDocOpts.Checked[2] := Manager.Options.HideProtected;
swDocOpts.Checked[3] := Manager.Options.ShowPrivate;
swDocOpts.Checked[4] := Manager.Options.InterfaceOnly;
swDocOpts.Checked[5] := Manager.Options.DontTrim;
//these should be global options?
edOS.Text := Manager.Options.OSTarget;
edCPU.Text := Manager.Options.CPUTarget;
edLang.Text := Manager.Options.Language;
edMoDir.Text := Manager.Options.MoDir;
//backend options
Manager.Options.BackendToPairs(edBackend.Lines);
end;
procedure TMain.SelectFormat(AFmt: string);
var
i: integer;
begin
i := cbFormat.Items.IndexOfName(AFmt);
if i < 0 then
i := cbFormat.Items.Count - 1;
cbFormat.ItemIndex := i;
end;
procedure TMain.edLogChange(Sender: TObject);
begin
LogName:=edLog.Text;
end;
procedure TMain.edOSExit(Sender: TObject);
var
ed: TEdit absolute Sender;
begin
if ed.Modified then begin
SaveOptions;
ed.Modified := False;
end;
end;
procedure TMain.lbBackendExit(Sender: TObject);
begin
//Modified never True???
if edBackend.Modified then begin
SaveOptions;
edBackend.Modified := False;
end;
end;
procedure TMain.cbFormatSelect(Sender: TObject);
begin
SaveOptions;
//edOutput.Text := ???;
end;
procedure TMain.GetEngines;
begin
//should separate: writers (format) and settings!
dWriter.EnumWriters(cbFormat.Items);
cbProfile.Items.CommaText := Manager.Profiles;
cbProfile.Caption := Manager.Profile; //select???
end;
procedure TMain.ProjectsChanged(Sender: TObject); procedure TMain.ProjectsChanged(Sender: TObject);
begin begin
UpdateDocs; //immediately or delayed (OnIdle?) UpdateDocs; //immediately or delayed (OnIdle?)
@ -288,8 +444,12 @@ begin
if pkg = nil then if pkg = nil then
exit; //not really created? exit; //not really created?
fn := pkg.ProjectFile; //initialized where? fn := pkg.ProjectFile; //initialized where?
if fn <> '' then if fn <> '' then begin
edXML.Lines.LoadFromFile(fn); if FileExists(fn) then
edXML.Lines.LoadFromFile(fn)
else
edXML.Lines.Clear;
end;
fn := pkg.IniFileName; fn := pkg.IniFileName;
if FileExists(fn) then if FileExists(fn) then
edINI.Lines.LoadFromFile(fn); edINI.Lines.LoadFromFile(fn);
@ -318,6 +478,11 @@ begin
Manager.ImportLpk(pkName); Manager.ImportLpk(pkName);
end; end;
procedure TMain.optUpdItemClick(Sender: TObject; Index: integer);
begin
SaveOptions;
end;
procedure TMain.edXMLExit(Sender: TObject); procedure TMain.edXMLExit(Sender: TObject);
begin begin
if edXML.Modified then begin if edXML.Modified then begin
@ -367,6 +532,12 @@ begin
LogDone; LogDone;
end; end;
procedure TMain.cbProfileSelect(Sender: TObject);
begin
Profile:=cbProfile.Caption;
GetProfile(Profile);
end;
procedure TMain.buRefreshClick(Sender: TObject); procedure TMain.buRefreshClick(Sender: TObject);
var var
u: string; u: string;
@ -380,5 +551,21 @@ begin
LogDone; LogDone;
end; end;
procedure TMain.buNewProfileClick(Sender: TObject);
begin
Profile := cbProfile.Caption;
if Profile = '' then
exit; //need name
if cbProfile.Items.IndexOf(Profile) < 0 then begin
cbProfile.AddItem(Profile, nil);
Manager.AddProfile(Profile);
end;
end;
procedure TMain.buMakeDocClick(Sender: TObject);
begin
Manager.MakeDoc(Manager.Package, '');
end;
end. end.

184
examples/fpdocmanager/umakeskel.pas
View File

@ -52,6 +52,7 @@ interface
uses uses
SysUtils, Classes, Gettext, SysUtils, Classes, Gettext,
dGlobals, PasTree, PParser,PScanner, dGlobals, PasTree, PParser,PScanner,
IniFiles,
mkfpdoc, fpdocproj; mkfpdoc, fpdocproj;
resourcestring resourcestring
@ -72,10 +73,25 @@ resourcestring
type type
TCmdLineAction = (actionHelp, actionConvert); TCmdLineAction = (actionHelp, actionConvert);
(* Extended INI file
*)
{ TConfigFile }
TConfigFile = class(TIniFile)
public
function IsDirty: boolean;
procedure Flush;
procedure WriteSectionValues(const Section: string; Strings: TStrings);
end;
(* EngineOptions plus MakeSkel options. (* EngineOptions plus MakeSkel options.
Used in the commandline parsers, passed to the Engine. Used in the commandline parsers, passed to the Engine.
Project.Options are ignored by TFDocMaker.(?) Project.Options are ignored by TFDocMaker.(?)
*) *)
{ TCmdOptions }
TCmdOptions = class(TEngineOptions) TCmdOptions = class(TEngineOptions)
public public
WriteDeclaration, WriteDeclaration,
@ -89,6 +105,12 @@ type
DisablePrivate, DisablePrivate,
DisableFunctionResults: Boolean; DisableFunctionResults: Boolean;
EmitClassSeparator: Boolean; EmitClassSeparator: Boolean;
Modified: boolean;
procedure Assign(Source: TPersistent); override;
procedure LoadConfig(cf: TConfigFile; AProfile: string);
procedure SaveConfig(cf: TConfigFile; AProfile: string);
procedure BackendToPairs(Dest: TStrings);
procedure BackendFromPairs(Source: TStrings);
end; end;
{ TSkelEngine } { TSkelEngine }
@ -156,7 +178,7 @@ type
function ParseCommon(var Cmd, Arg: string): TCreatorAction; function ParseCommon(var Cmd, Arg: string): TCreatorAction;
public public
Function DocumentPackage(Const APackageName,AOutputName: string; InputFiles, DescrFiles : TStrings) : String; Function DocumentPackage(Const APackageName,AOutputName: string; InputFiles, DescrFiles : TStrings) : String;
procedure CreateUnitDocumentation(APackage: TFPDocPackage; const AUnit: string; ParseOnly: Boolean); procedure CreateUnitDocumentation(const AUnit: string; ParseOnly: Boolean);
public public
ImportDir: string; ImportDir: string;
SelectedUnit: string; SelectedUnit: string;
@ -316,6 +338,149 @@ type
Property DocNode : TDocNode Read FNode; Property DocNode : TDocNode Read FNode;
end; end;
{ TConfigFile }
function TConfigFile.IsDirty: boolean;
begin
Result := Dirty;
end;
procedure TConfigFile.Flush;
begin
if Dirty then
UpdateFile; //only if dirty
end;
procedure TConfigFile.WriteSectionValues(const Section: string; Strings: TStrings);
var
i: integer;
begin
//add missing: write Strings as a section
if (Strings = nil) or (Strings.Count = 0) then
exit; //nothing to write
for i := 0 to Strings.Count - 1 do begin
WriteString(Section, Strings.Names[i], Strings.ValueFromIndex[i]);
//WriteString(Section, Strings[i], ''); //???
end;
end;
{ TCmdOptions }
procedure TCmdOptions.Assign(Source: TPersistent);
var
s: TCmdOptions absolute Source;
begin
inherited Assign(Source);
if Source is TCmdOptions then begin
WriteDeclaration := s.WriteDeclaration;
DisableOverride := s.DisableOverride;
DisableErrors:=s.DisableErrors;
DisableSeealso:=s.DisableSeealso;
DisableArguments:=s.DisableArguments;
DisableFunctionResults := s.DisableFunctionResults;
ShowPrivate := s.ShowPrivate;
DisableProtected:=s.DisableProtected;
SortNodes := s.SortNodes;
end;
end;
const SecOpts = 'default';
procedure TCmdOptions.LoadConfig(cf: TConfigFile; AProfile: string);
var
s, sec: string;
begin
//MakeSkel
WriteDeclaration := cf.ReadBool(SecOpts, 'WriteDeclaration', True);
DisableOverride := cf.ReadBool(SecOpts, 'DisableOverride', False);
DisableErrors := cf.ReadBool(SecOpts, 'DisableErrors', False);
DisableSeealso := cf.ReadBool(SecOpts, 'DisableSeealso', False);
DisableArguments := cf.ReadBool(SecOpts, 'DisableArguments', False);
DisableFunctionResults := cf.ReadBool(SecOpts, 'DisableFunctionResults', False);
ShowPrivate := cf.ReadBool(SecOpts, 'ShowPrivate', True);
DisableProtected := cf.ReadBool(SecOpts, 'DisableProtected', False);
SortNodes := cf.ReadBool(SecOpts, 'SortNodes', False);
//Engine
StopOnParseError := cf.ReadBool(SecOpts, 'StopOnParseError', False);
WarnNoNode := cf.ReadBool(SecOpts, 'WarnNoNode', True);
InterfaceOnly := cf.ReadBool(SecOpts, 'InterfaceOnly', True);
if AProfile = '' then
AProfile := SecOpts;
OSTarget := cf.ReadString(AProfile, 'OSTarget', DefOSTarget);
CPUTarget := cf.ReadString(AProfile, 'CPUTarget', DefCPUTarget);
Language := cf.ReadString(AProfile, 'Language', '');
Backend := cf.ReadString(AProfile, 'Backend', 'html');
MoDir := cf.ReadString(AProfile, 'MoDir', '');
HideProtected := cf.ReadBool(AProfile, 'HideProtected', False);
ShowPrivate := cf.ReadBool(AProfile, 'ShowPrivate', False);
DontTrim := cf.ReadBool(AProfile, 'DontTrim', False);
//Backend
s := cf.ReadString(AProfile, 'BackendOptions', '');
BackendOptions.CommaText := s;
//finally
Modified := False;
end;
procedure TCmdOptions.SaveConfig(cf: TConfigFile; AProfile: string);
begin
//MakeSkel
cf.WriteBool(SecOpts, 'WriteDeclaration', WriteDeclaration);
cf.WriteBool(SecOpts, 'DisableOverride', DisableOverride);
cf.WriteBool(SecOpts, 'DisableErrors', DisableErrors);
cf.WriteBool(SecOpts, 'DisableSeealso', DisableSeealso);
cf.WriteBool(SecOpts, 'DisableArguments', DisableArguments);
cf.WriteBool(SecOpts, 'DisableFunctionResults', DisableFunctionResults);
cf.WriteBool(SecOpts, 'DisablePrivate', DisablePrivate);
cf.WriteBool(SecOpts, 'DisableProtected', DisableProtected);
cf.WriteBool(SecOpts, 'SortNodes', SortNodes);
//Engine
cf.WriteBool(SecOpts, 'StopOnParseError', StopOnParseError);
cf.WriteBool(SecOpts, 'WarnNoNode', WarnNoNode);
cf.WriteBool(SecOpts, 'DontTrim', DontTrim);
if AProfile = '' then
AProfile := SecOpts;
cf.WriteString(AProfile, 'OSTarget', OSTarget);
cf.WriteString(AProfile, 'CPUTarget', CPUTarget);
cf.WriteString(AProfile, 'Language', Language);
cf.WriteString(AProfile, 'Backend', Backend);
cf.WriteString(AProfile, 'MoDir', MoDir);
cf.WriteBool(AProfile, 'HideProtected', HideProtected);
cf.WriteBool(AProfile, 'ShowPrivate', ShowPrivate);
cf.WriteBool(AProfile, 'InterfaceOnly', InterfaceOnly);
//Backend
if BackendOptions.Count > 0 then
cf.WriteString(AProfile, 'BackendOptions', BackendOptions.CommaText);
//finally
Modified := False;
end;
procedure TCmdOptions.BackendToPairs(Dest: TStrings);
var
i, n: integer;
begin
Dest.Clear;
n := BackendOptions.Count div 2;
if n = 0 then
exit;
Dest.Capacity := n;
for i := 0 to n-1 do begin
Dest.Add(BackendOptions[i*2] + '=' + BackendOptions[i*2 + 1]);
end;
end;
procedure TCmdOptions.BackendFromPairs(Source: TStrings);
var
i: integer;
begin
BackendOptions.Clear;
BackendOptions.Capacity:=Source.Count * 2;
for i := 0 to Source.Count - 1 do begin
BackendOptions.Add(Source.Names[i]);
BackendOptions.Add(Source.ValueFromIndex[i]);
end;
Modified := True; //todo: only if really changed?
end;
Constructor TNodePair.Create(AnElement : TPasElement; ADocNode : TDocNode); Constructor TNodePair.Create(AnElement : TPasElement; ADocNode : TDocNode);
begin begin
@ -701,7 +866,7 @@ end;
procedure TFPDocMaker.SetOptions(AValue: TCmdOptions); procedure TFPDocMaker.SetOptions(AValue: TCmdOptions);
begin begin
if FOptions=AValue then Exit; if FOptions=AValue then Exit;
FOptions:=AValue; FOptions.Assign(AValue);
end; end;
(* Check the options, return errors as message strings. (* Check the options, return errors as message strings.
@ -1043,8 +1208,7 @@ begin
end; end;
end; end;
procedure TFPDocMaker.CreateUnitDocumentation(APackage: TFPDocPackage; procedure TFPDocMaker.CreateUnitDocumentation(const AUnit: string; ParseOnly: Boolean);
const AUnit: string; ParseOnly: Boolean);
var var
il: TStringList; il: TStringList;
spec: string; spec: string;
@ -1053,17 +1217,17 @@ begin
//selected unit only //selected unit only
spec := UnitSpec(AUnit); spec := UnitSpec(AUnit);
il := TStringList.Create; il := TStringList.Create;
il.Assign(APackage.Inputs); il.Assign(Package.Inputs);
APackage.Inputs.Clear; Package.Inputs.Clear;
APackage.Inputs.Add(spec); Package.Inputs.Add(spec);
try try
inherited CreateDocumentation(APackage, ParseOnly); inherited CreateDocumentation(Package, ParseOnly);
finally finally
APackage.Inputs.Assign(il); Package.Inputs.Assign(il);
il.Free; il.Free;
end; end;
end else begin end else begin
CreateDocumentation(APackage,ParseOnly); CreateDocumentation(Package,ParseOnly);
end; end;
end; end;

128
examples/fpdocmanager/umanager.pas
View File

@ -22,7 +22,7 @@ This version is decoupled from the fpdoc classes, introduces the classes
interface interface
uses uses
Classes, SysUtils, IniFiles, Classes, SysUtils,
umakeskel, fpdocproj, dw_HTML; umakeskel, fpdocproj, dw_HTML;
type type
@ -61,12 +61,12 @@ type
procedure SetUnitPath(AValue: string); procedure SetUnitPath(AValue: string);
procedure SetUnits(AValue: TStrings); procedure SetUnits(AValue: TStrings);
protected protected
Config: TIniFile; Config: TConfigFile;
procedure ReadConfig; procedure ReadConfig;
function IniFileName: string;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
function IniFileName: string;
function CreateProject(APrj: TFPDocHelper; const AFile: string): boolean; //new package project function CreateProject(APrj: TFPDocHelper; const AFile: string): boolean; //new package project
function ImportProject(APrj: TFPDocHelper; APkg: TFPDocPackage; const AFile: string): boolean; function ImportProject(APrj: TFPDocHelper; APkg: TFPDocPackage; const AFile: string): boolean;
procedure UpdateConfig; procedure UpdateConfig;
@ -107,6 +107,7 @@ type
function CmdToPrj(const AFileName: string): boolean; function CmdToPrj(const AFileName: string): boolean;
function TestRun(APkg: TDocPackage; AUnit: string): boolean; function TestRun(APkg: TDocPackage; AUnit: string): boolean;
function Update(APkg: TDocPackage; const AUnit: string): boolean; function Update(APkg: TDocPackage; const AUnit: string): boolean;
function MakeDocs(APkg: TDocPackage; const AUnit: string; AOutput: string): boolean;
property ProjectDir: string read FProjectDir write SetProjectDir; property ProjectDir: string read FProjectDir write SetProjectDir;
end; end;
@ -123,14 +124,18 @@ type
FModified: boolean; FModified: boolean;
FOnChange: TNotifyEvent; FOnChange: TNotifyEvent;
FOnLog: TLogHandler; FOnLog: TLogHandler;
FOptions: TCmdOptions;
FPackage: TDocPackage; FPackage: TDocPackage;
FPackages: TStrings; FPackages: TStrings;
FProfile: string;
FProfiles: string; //CSV list of profile names
FRootDir: string; FRootDir: string;
UpdateCount: integer; UpdateCount: integer;
procedure SetFPDocDir(AValue: string); procedure SetFPDocDir(AValue: string);
procedure SetLazarusDir(AValue: string); procedure SetLazarusDir(AValue: string);
procedure SetOnChange(AValue: TNotifyEvent); procedure SetOnChange(AValue: TNotifyEvent);
procedure SetPackage(AValue: TDocPackage); procedure SetPackage(AValue: TDocPackage);
procedure SetProfile(AValue: string);
procedure SetRootDir(AValue: string); procedure SetRootDir(AValue: string);
protected protected
Helper: TFPDocHelper; //temporary Helper: TFPDocHelper; //temporary
@ -140,13 +145,14 @@ type
function RegisterPackage(APkg: TDocPackage): integer; function RegisterPackage(APkg: TDocPackage): integer;
Procedure DoLog(Const Msg : String); Procedure DoLog(Const Msg : String);
public public
Config: TIniFile; //extend class? Config: TConfigFile; //extend class
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
procedure BeginUpdate; procedure BeginUpdate;
procedure EndUpdate; procedure EndUpdate;
function LoadConfig(const ADir: string; Force: boolean = False): boolean; function LoadConfig(const ADir: string; Force: boolean = False): boolean;
function SaveConfig: boolean; function SaveConfig: boolean;
procedure AddProfile(const AName: string);
function AddProject(const APkg, AFile: string; UpdateCfg: boolean): boolean; //from config function AddProject(const APkg, AFile: string; UpdateCfg: boolean): boolean; //from config
function CreateProject(const AFileName: string; APkg: TDocPackage): boolean; function CreateProject(const AFileName: string; APkg: TDocPackage): boolean;
function AddPackage(AName: string): TDocPackage; function AddPackage(AName: string): TDocPackage;
@ -154,13 +160,16 @@ type
procedure ImportProject(APkg: TFPDocPackage; const AFile: string); procedure ImportProject(APkg: TFPDocPackage; const AFile: string);
function ImportCmd(const AFile: string): boolean; function ImportCmd(const AFile: string): boolean;
//actions //actions
//function MakeDoc(APkg: TDocPackage; AUnit: string): boolean; configure??? function MakeDoc(APkg: TDocPackage; AUnit: string): boolean;
function TestRun(APkg: TDocPackage; AUnit: string): boolean; function TestRun(APkg: TDocPackage; AUnit: string): boolean;
function Update(APkg: TDocPackage; const AUnit: string): boolean; function Update(APkg: TDocPackage; const AUnit: string): boolean;
public //published? public //published?
property FpcDocDir: string read FFPDocDir write SetFPDocDir; property FpcDocDir: string read FFPDocDir write SetFPDocDir;
//property LazarusDir: string read FLazarusDir write SetLazarusDir; //property LazarusDir: string read FLazarusDir write SetLazarusDir;
property RootDir: string read FRootDir write SetRootDir; property RootDir: string read FRootDir write SetRootDir;
property Options: TCmdOptions read FOptions;
property Profile: string read FProfile write SetProfile;
property Profiles: string read FProfiles;
property Packages: TStrings read FPackages; property Packages: TStrings read FPackages;
property Package: TDocPackage read FPackage write SetPackage; property Package: TDocPackage read FPackage write SetPackage;
property Modified: boolean read FModified; //app property Modified: boolean read FModified; //app
@ -332,8 +341,11 @@ begin
if FProjectFile=AValue then Exit; if FProjectFile=AValue then Exit;
FProjectFile:=AValue; FProjectFile:=AValue;
//really do more? //really do more?
if FProjectFile <> '' then if FProjectFile = '' then
FProjectDir:=ExtractFilePath(FProjectFile); exit;
FProjectDir:=ExtractFilePath(FProjectFile);
if ExtractFileExt(FProjectFile) <> '.xml' then
; //really change here???
//import requires fpdocproject - must be created by Manager! //import requires fpdocproject - must be created by Manager!
end; end;
@ -408,7 +420,8 @@ begin
APrj.ParseFPDocOption('--import=' + imp); APrj.ParseFPDocOption('--import=' + imp);
end; end;
//add options //add options
pkg.Output := Manager.RootDir + Name; APrj.Options.Assign(Manager.Options);
pkg.Output := Manager.RootDir + Name; //???
pkg.ContentFile := Manager.RootDir + Name + '.xct'; pkg.ContentFile := Manager.RootDir + Name + '.xct';
//now create project file //now create project file
if AFile <> '' then begin if AFile <> '' then begin
@ -455,6 +468,7 @@ begin
end; end;
const const
SecGen = 'dirs';
SecDoc = 'project'; SecDoc = 'project';
procedure TDocPackage.ReadConfig; procedure TDocPackage.ReadConfig;
@ -464,7 +478,7 @@ begin
if Loaded then if Loaded then
exit; exit;
if Config = nil then if Config = nil then
Config := TIniFile.Create(IniFileName); Config := TConfigFile.Create(IniFileName);
//check config //check config
s := Config.ReadString(SecDoc, 'projectdir', ''); s := Config.ReadString(SecDoc, 'projectdir', '');
if s = '' then begin if s = '' then begin
@ -477,8 +491,13 @@ begin
FDescrDir := Config.ReadString(SecDoc, 'descrdir', ''); FDescrDir := Config.ReadString(SecDoc, 'descrdir', '');
Requires.CommaText := Config.ReadString(SecDoc, 'requires', ''); Requires.CommaText := Config.ReadString(SecDoc, 'requires', '');
//units //units
{$IFDEF v0}
Config.ReadSectionRaw('units', Units); Config.ReadSectionRaw('units', Units);
Config.ReadSectionRaw('descrs', Descriptions); Config.ReadSectionRaw('descrs', Descriptions);
{$ELSE}
Config.ReadSectionValues('units', Units);
Config.ReadSectionValues('descrs', Descriptions);
{$ENDIF}
//more? //more?
//all done //all done
Loaded := True; Loaded := True;
@ -488,6 +507,7 @@ end;
*) *)
procedure TDocPackage.UpdateConfig; procedure TDocPackage.UpdateConfig;
{$IFDEF v0}
procedure WriteSection(const SecName: string; AList: TStrings); procedure WriteSection(const SecName: string; AList: TStrings);
var var
j: integer; j: integer;
@ -498,11 +518,13 @@ procedure TDocPackage.UpdateConfig;
Config.WriteString(SecName, AList.Names[j], AList.ValueFromIndex[j]); Config.WriteString(SecName, AList.Names[j], AList.ValueFromIndex[j]);
end; end;
end; end;
{$ELSE}
{$ENDIF}
begin begin
//create ini file, if not already created //create ini file, if not already created
if Config = nil then if Config = nil then
Config := TIniFile.Create(IniFileName); //in document RootDir Config := TConfigFile.Create(IniFileName); //in document RootDir
//general information //general information
Config.WriteString(SecDoc, 'projectdir', ProjectDir); Config.WriteString(SecDoc, 'projectdir', ProjectDir);
Config.WriteString(SecDoc, 'projectfile', ProjectFile); Config.WriteString(SecDoc, 'projectfile', ProjectFile);
@ -511,8 +533,13 @@ begin
Config.WriteString(SecDoc, 'descrdir', DescrDir); Config.WriteString(SecDoc, 'descrdir', DescrDir);
Config.WriteString(SecDoc, 'requires', Requires.CommaText); Config.WriteString(SecDoc, 'requires', Requires.CommaText);
//units //units
{$IFDEF v0}
WriteSection('units', Units); WriteSection('units', Units);
WriteSection('descrs', Descriptions); WriteSection('descrs', Descriptions);
{$ELSE}
Config.WriteSectionValues('units', Units);
Config.WriteSectionValues('descrs', Descriptions);
{$ENDIF}
//all done //all done
Loaded := True; Loaded := True;
end; end;
@ -543,12 +570,15 @@ begin
lst := TStringList.Create; lst := TStringList.Create;
lst.OwnsObjects := True; lst.OwnsObjects := True;
FPackages := lst; FPackages := lst;
FOptions := TCmdOptions.Create;
end; end;
destructor TFPDocManager.Destroy; destructor TFPDocManager.Destroy;
begin begin
SaveConfig;
FreeAndNil(Config); //save? FreeAndNil(Config); //save?
FreeAndNil(FPackages); FreeAndNil(FPackages);
FreeAndNil(FOptions);
inherited Destroy; inherited Destroy;
end; end;
@ -576,6 +606,21 @@ begin
FPackage:=AValue; FPackage:=AValue;
end; end;
procedure TFPDocManager.SetProfile(AValue: string);
begin
if AValue = '' then exit;
if FProfile=AValue then Exit;
if Options.Modified then
Options.SaveConfig(Config, FProfile);
FProfile:=AValue;
if not Config.SectionExists(AValue) then begin
FProfiles := FProfiles + ',' + AValue;
Config.WriteString(SecGen, 'Profiles', FProfiles);
end;
Config.WriteString(SecGen, 'Profile', FProfile);
Options.LoadConfig(Config, Profile);
end;
(* Try load config from new dir - this may fail on the first run. (* Try load config from new dir - this may fail on the first run.
*) *)
procedure TFPDocManager.SetRootDir(AValue: string); procedure TFPDocManager.SetRootDir(AValue: string);
@ -603,6 +648,8 @@ begin
Helper := TFPDocHelper.Create(nil); Helper := TFPDocHelper.Create(nil);
Helper.OnLog := OnLog; Helper.OnLog := OnLog;
Result := Helper.BeginTest(AFile); Result := Helper.BeginTest(AFile);
if Result then
Helper.Options := Options;
end; end;
procedure TFPDocManager.EndTest; procedure TFPDocManager.EndTest;
@ -649,13 +696,12 @@ begin
Config.Free; Config.Free;
//clear packages??? //clear packages???
end; end;
Config := TIniFile.Create(cf); Config := TConfigFile.Create(cf);
Config.CacheUpdates := True; Config.CacheUpdates := True;
//FDirty := True; //to be saved
if not Result then if not Result then
exit; //nothing to read exit; //nothing to read
//read directories //read directories
FFPDocDir := Config.ReadString('dirs', 'fpc', ''); FFPDocDir := Config.ReadString(SecGen, 'fpc', '');
//read packages //read packages
Config.ReadSectionValues(SecProjects, FPackages); //<prj>=<file> Config.ReadSectionValues(SecProjects, FPackages); //<prj>=<file>
//read detailed package information - possibly multiple packages per project! //read detailed package information - possibly multiple packages per project!
@ -670,6 +716,9 @@ begin
end; end;
end; end;
//more? (preferences?) //more? (preferences?)
FProfiles:=Config.ReadString(SecGen, 'Profiles', 'default');
FProfile := Config.ReadString(SecGen,'Profile', 'default');
Options.LoadConfig(Config, Profile);
//done, nothing modified //done, nothing modified
EndUpdate; EndUpdate;
end; end;
@ -679,9 +728,20 @@ begin
(* Protection against excessive saves requires a subclass of TIniFile, (* Protection against excessive saves requires a subclass of TIniFile,
which flushes the file only if Dirty. which flushes the file only if Dirty.
*) *)
//Options? assume saved by application?
if Options.Modified then begin
Options.SaveConfig(Config, Profile);
end;
Config.Flush;
Result := True; //for now Result := True; //for now
end; end;
procedure TFPDocManager.AddProfile(const AName: string);
begin
//add and select - obsolete!
Profile := AName;
end;
(* Add a DocPackage to Packages and INI. (* Add a DocPackage to Packages and INI.
Return package Index. Return package Index.
For exclusive use by Package.SetLoaded! For exclusive use by Package.SetLoaded!
@ -705,6 +765,7 @@ begin
end; end;
if (ExtractFileExt(APkg.ProjectFile) <> '.xml') then begin if (ExtractFileExt(APkg.ProjectFile) <> '.xml') then begin
//create project file //create project file
APkg.ProjectFile := ChangeFileExt(APkg.ProjectFile, '_prj.xml');
CreateProject(APkg.ProjectFile, APkg); CreateProject(APkg.ProjectFile, APkg);
//APkg.UpdateConfig; - required? //APkg.UpdateConfig; - required?
//update Packages[] string //update Packages[] string
@ -862,6 +923,21 @@ begin
Changed; Changed;
end; end;
function TFPDocManager.MakeDoc(APkg: TDocPackage; AUnit: string): boolean;
begin
Result := assigned(APkg) and BeginTest(APkg.ProjectFile);
if not Result then
exit;
try
//output specification depends on the choosen format!
Helper.ParseFPDocOption('--output="' + RootDir + APkg.Name + '"');
//Result :=
Helper.CreateUnitDocumentation(AUnit, False);
finally
EndTest;
end;
end;
function TFPDocManager.TestRun(APkg: TDocPackage; AUnit: string): boolean; function TFPDocManager.TestRun(APkg: TDocPackage; AUnit: string): boolean;
begin begin
BeginTest(APkg.ProjectFile); BeginTest(APkg.ProjectFile);
@ -913,11 +989,13 @@ function TFPDocHelper.BeginTest(APkg: TDocPackage): boolean;
begin begin
if not assigned(APkg) then if not assigned(APkg) then
exit(False); exit(False);
Result := BeginTest(APkg.ProjectFile); Result := BeginTest(APkg.ProjectFile); //directory would be sufficient!
if not Result then if not Result then
exit; exit;
ParseFPDocOption('--project='+APkg.ProjectFile); APkg.CreateProject(self, ''); //create project file?
//ParseFPDocOption('--project='+APkg.ProjectFile);
Package := Packages.FindPackage(APkg.Name); Package := Packages.FindPackage(APkg.Name);
//Options?
//okay, so far //okay, so far
Result := assigned(Package); Result := assigned(Package);
end; end;
@ -977,6 +1055,20 @@ begin
Result := True; Result := True;
end; end;
function TFPDocHelper.MakeDocs(APkg: TDocPackage; const AUnit: string;
AOutput: string): boolean;
begin
Result := BeginTest(APkg); //configure and select package
if not Result then
exit;
try
ParseFPDocOption(Format('--output="%s"', [AOutput]));
CreateDocumentation(Package, False);
finally
EndTest;
end;
end;
function TFPDocHelper.TestRun(APkg: TDocPackage; AUnit: string): boolean; function TFPDocHelper.TestRun(APkg: TDocPackage; AUnit: string): boolean;
begin begin
(* more detailed error handling? (* more detailed error handling?
@ -986,12 +1078,16 @@ begin
if not Result then if not Result then
exit; exit;
try try
//override options for test
ParseFPDocOption('--format=html'); ParseFPDocOption('--format=html');
ParseFPDocOption('-n'); ParseFPDocOption('-n');
{$IFDEF v0}
Package := Packages.FindPackage(APkg.Name); Package := Packages.FindPackage(APkg.Name);
Result := Package <> nil; Result := Package <> nil;
if Result then if Result then
CreateUnitDocumentation(Package, AUnit, True); {$ELSE}
{$ENDIF}
CreateUnitDocumentation(AUnit, True);
finally finally
EndTest; EndTest;
end; end;