paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 05:29:26 +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>
<!-- variable Visibility: public -->
<element name="TCmdOptions.WriteDeclaration">
<short>[?]</short>
<short>Emit declaration for elements (--emit-declaration).</short>
<descr/>
<seealso/>
</element>
@ -125,7 +125,7 @@
</element>
<!-- variable Visibility: public -->
<element name="TCmdOptions.DisableOverride">
<short>[?]</short>
<short>Do not create nodes for override methods.</short>
<descr/>
<seealso/>
</element>

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

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

477
examples/fpdocmanager/fmain.lfm
View File

@ -1,20 +1,19 @@
object Main: TMain
Left = 373
Height = 290
Left = 335
Height = 423
Top = 146
Width = 411
Width = 569
Align = alClient
Caption = 'Main'
ClientHeight = 270
ClientWidth = 411
ClientHeight = 403
ClientWidth = 569
Menu = MainMenu1
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnResize = FormResize
LCLVersion = '0.9.31'
object lbPackages: TComboBox
Left = 0
Height = 270
Height = 403
Top = 0
Width = 94
Align = alLeft
@ -25,22 +24,348 @@ object Main: TMain
end
object Units: TPageControl
Left = 94
Height = 270
Height = 403
Top = 0
Width = 317
Width = 475
ActivePage = ViewUnits
Align = alClient
TabIndex = 1
TabIndex = 0
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
Caption = 'Project'
ClientHeight = 242
ClientWidth = 309
ClientHeight = 315
ClientWidth = 467
inline edXML: TSynEdit
Left = 0
Height = 242
Height = 315
Top = 0
Width = 309
Width = 467
Align = alClient
Font.Height = -13
Font.Name = 'Courier New'
@ -520,131 +845,15 @@ object Main: TMain
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
Caption = 'INI'
ClientHeight = 242
ClientWidth = 309
ClientHeight = 375
ClientWidth = 467
object edINI: TMemo
Left = 0
Height = 242
Height = 375
Top = 0
Width = 309
Width = 467
Align = alClient
Lines.Strings = (
'edINI'

215
examples/fpdocmanager/fmain.pas
View File

@ -11,8 +11,8 @@ unit fMain;
interface
uses
Classes, SysUtils, FileUtil, SynHighlighterXML, SynEdit, Forms,
Controls, Graphics, Dialogs, Menus, StdCtrls, ComCtrls,
Classes, SysUtils, FileUtil, SynHighlighterXML, SynEdit, Forms, Controls,
Graphics, Dialogs, Menus, StdCtrls, ComCtrls, ExtCtrls,
uManager;
type
@ -20,11 +20,30 @@ type
{ TMain }
TMain = class(TForm)
buSkel: TButton;
buUpdate: TButton;
buRefresh: TButton;
buShowLog: 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;
edINI: TMemo;
swShowUpdate: TCheckBox;
@ -41,6 +60,7 @@ type
MenuItem3: TMenuItem;
mnExit: TMenuItem;
dlgSelRoot: TSelectDirectoryDialog;
ViewFinal: TTabSheet;
ViewINI: TTabSheet;
Units: TPageControl;
swAll: TRadioButton;
@ -49,23 +69,31 @@ type
SynXMLSyn1: TSynXMLSyn;
ViewXML: TTabSheet;
ViewUnits: TTabSheet;
procedure buMakeDocClick(Sender: TObject);
procedure buNewProfileClick(Sender: TObject);
procedure buRefreshClick(Sender: TObject);
procedure buTestClick(Sender: TObject);
procedure cbFormatSelect(Sender: TObject);
procedure cbProfileSelect(Sender: TObject);
procedure edLogChange(Sender: TObject);
procedure edOSExit(Sender: TObject);
procedure edXMLExit(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure lbBackendExit(Sender: TObject);
procedure lbPackagesClick(Sender: TObject);
procedure lbUnitsClick(Sender: TObject);
procedure mnConfigClick(Sender: TObject);
procedure mnExitClick(Sender: TObject);
procedure mnImportLpkClick(Sender: TObject);
procedure optUpdItemClick(Sender: TObject; Index: integer);
procedure swShowUpdateChange(Sender: TObject);
procedure swSingleClick(Sender: TObject);
private
LogName: string;
LogFile: TStream;
Profile: string;
procedure ProjectsChanged(Sender: TObject);
procedure LogToFile(Sender: TObject; const msg: string);
procedure LogToMsgBox(Sender: TObject; const msg: string);
@ -73,6 +101,11 @@ type
procedure LogDone;
procedure ShowUpdate;
procedure OnParseImport(Sender: TObject; var ASource, ALink: string);
procedure SaveOptions;
procedure GetOptions;
procedure GetEngines;
procedure GetProfile(const AName: string);
procedure SelectFormat(AFmt: string);
public
CurPkg: TDocPackage;
CurUnit: string;
@ -85,7 +118,8 @@ var
implementation
uses
fConfig, fLogView, fUpdateView;
fConfig, fLogView, fUpdateView,
dWriter;
//dw_HTML, //more writers?
//uLpk;
@ -132,6 +166,7 @@ begin
end;
end;
//UpdateDocs; //package objects seem to be missing?
GetEngines;
end;
procedure TMain.FormResize(Sender: TObject);
@ -147,8 +182,8 @@ end;
procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
//is this really required?
//CanClose :=
Manager.SaveConfig; //what if fails?
CanClose := True; //make compiler happy
//Manager.SaveConfig; //what if fails?
end;
procedure TMain.mnExitClick(Sender: TObject);
@ -162,11 +197,6 @@ begin
ShowUpdate;
end;
procedure TMain.edLogChange(Sender: TObject);
begin
LogName:=edLog.Text;
end;
procedure TMain.LogStart;
begin
if LogName = '' then
@ -248,6 +278,132 @@ and provide the list of imports.
ALink := '../' + pn + '/';
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);
begin
UpdateDocs; //immediately or delayed (OnIdle?)
@ -288,8 +444,12 @@ begin
if pkg = nil then
exit; //not really created?
fn := pkg.ProjectFile; //initialized where?
if fn <> '' then
edXML.Lines.LoadFromFile(fn);
if fn <> '' then begin
if FileExists(fn) then
edXML.Lines.LoadFromFile(fn)
else
edXML.Lines.Clear;
end;
fn := pkg.IniFileName;
if FileExists(fn) then
edINI.Lines.LoadFromFile(fn);
@ -318,6 +478,11 @@ begin
Manager.ImportLpk(pkName);
end;
procedure TMain.optUpdItemClick(Sender: TObject; Index: integer);
begin
SaveOptions;
end;
procedure TMain.edXMLExit(Sender: TObject);
begin
if edXML.Modified then begin
@ -367,6 +532,12 @@ begin
LogDone;
end;
procedure TMain.cbProfileSelect(Sender: TObject);
begin
Profile:=cbProfile.Caption;
GetProfile(Profile);
end;
procedure TMain.buRefreshClick(Sender: TObject);
var
u: string;
@ -380,5 +551,21 @@ begin
LogDone;
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.

184
examples/fpdocmanager/umakeskel.pas
View File

@ -52,6 +52,7 @@ interface
uses
SysUtils, Classes, Gettext,
dGlobals, PasTree, PParser,PScanner,
IniFiles,
mkfpdoc, fpdocproj;
resourcestring
@ -72,10 +73,25 @@ resourcestring
type
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.
Used in the commandline parsers, passed to the Engine.
Project.Options are ignored by TFDocMaker.(?)
*)
{ TCmdOptions }
TCmdOptions = class(TEngineOptions)
public
WriteDeclaration,
@ -89,6 +105,12 @@ type
DisablePrivate,
DisableFunctionResults: 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;
{ TSkelEngine }
@ -156,7 +178,7 @@ type
function ParseCommon(var Cmd, Arg: string): TCreatorAction;
public
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
ImportDir: string;
SelectedUnit: string;
@ -316,6 +338,149 @@ type
Property DocNode : TDocNode Read FNode;
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);
begin
@ -701,7 +866,7 @@ end;
procedure TFPDocMaker.SetOptions(AValue: TCmdOptions);
begin
if FOptions=AValue then Exit;
FOptions:=AValue;
FOptions.Assign(AValue);
end;
(* Check the options, return errors as message strings.
@ -1043,8 +1208,7 @@ begin
end;
end;
procedure TFPDocMaker.CreateUnitDocumentation(APackage: TFPDocPackage;
const AUnit: string; ParseOnly: Boolean);
procedure TFPDocMaker.CreateUnitDocumentation(const AUnit: string; ParseOnly: Boolean);
var
il: TStringList;
spec: string;
@ -1053,17 +1217,17 @@ begin
//selected unit only
spec := UnitSpec(AUnit);
il := TStringList.Create;
il.Assign(APackage.Inputs);
APackage.Inputs.Clear;
APackage.Inputs.Add(spec);
il.Assign(Package.Inputs);
Package.Inputs.Clear;
Package.Inputs.Add(spec);
try
inherited CreateDocumentation(APackage, ParseOnly);
inherited CreateDocumentation(Package, ParseOnly);
finally
APackage.Inputs.Assign(il);
Package.Inputs.Assign(il);
il.Free;
end;
end else begin
CreateDocumentation(APackage,ParseOnly);
CreateDocumentation(Package,ParseOnly);
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
uses
Classes, SysUtils, IniFiles,
Classes, SysUtils,
umakeskel, fpdocproj, dw_HTML;
type
@ -61,12 +61,12 @@ type
procedure SetUnitPath(AValue: string);
procedure SetUnits(AValue: TStrings);
protected
Config: TIniFile;
Config: TConfigFile;
procedure ReadConfig;
function IniFileName: string;
public
constructor Create;
destructor Destroy; override;
function IniFileName: string;
function CreateProject(APrj: TFPDocHelper; const AFile: string): boolean; //new package project
function ImportProject(APrj: TFPDocHelper; APkg: TFPDocPackage; const AFile: string): boolean;
procedure UpdateConfig;
@ -107,6 +107,7 @@ type
function CmdToPrj(const AFileName: string): boolean;
function TestRun(APkg: TDocPackage; 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;
end;
@ -123,14 +124,18 @@ type
FModified: boolean;
FOnChange: TNotifyEvent;
FOnLog: TLogHandler;
FOptions: TCmdOptions;
FPackage: TDocPackage;
FPackages: TStrings;
FProfile: string;
FProfiles: string; //CSV list of profile names
FRootDir: string;
UpdateCount: integer;
procedure SetFPDocDir(AValue: string);
procedure SetLazarusDir(AValue: string);
procedure SetOnChange(AValue: TNotifyEvent);
procedure SetPackage(AValue: TDocPackage);
procedure SetProfile(AValue: string);
procedure SetRootDir(AValue: string);
protected
Helper: TFPDocHelper; //temporary
@ -140,13 +145,14 @@ type
function RegisterPackage(APkg: TDocPackage): integer;
Procedure DoLog(Const Msg : String);
public
Config: TIniFile; //extend class?
Config: TConfigFile; //extend class
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginUpdate;
procedure EndUpdate;
function LoadConfig(const ADir: string; Force: boolean = False): boolean;
function SaveConfig: boolean;
procedure AddProfile(const AName: string);
function AddProject(const APkg, AFile: string; UpdateCfg: boolean): boolean; //from config
function CreateProject(const AFileName: string; APkg: TDocPackage): boolean;
function AddPackage(AName: string): TDocPackage;
@ -154,13 +160,16 @@ type
procedure ImportProject(APkg: TFPDocPackage; const AFile: string);
function ImportCmd(const AFile: string): boolean;
//actions
//function MakeDoc(APkg: TDocPackage; AUnit: string): boolean; configure???
function MakeDoc(APkg: TDocPackage; AUnit: string): boolean;
function TestRun(APkg: TDocPackage; AUnit: string): boolean;
function Update(APkg: TDocPackage; const AUnit: string): boolean;
public //published?
property FpcDocDir: string read FFPDocDir write SetFPDocDir;
//property LazarusDir: string read FLazarusDir write SetLazarusDir;
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 Package: TDocPackage read FPackage write SetPackage;
property Modified: boolean read FModified; //app
@ -332,8 +341,11 @@ begin
if FProjectFile=AValue then Exit;
FProjectFile:=AValue;
//really do more?
if FProjectFile <> '' then
FProjectDir:=ExtractFilePath(FProjectFile);
if FProjectFile = '' then
exit;
FProjectDir:=ExtractFilePath(FProjectFile);
if ExtractFileExt(FProjectFile) <> '.xml' then
; //really change here???
//import requires fpdocproject - must be created by Manager!
end;
@ -408,7 +420,8 @@ begin
APrj.ParseFPDocOption('--import=' + imp);
end;
//add options
pkg.Output := Manager.RootDir + Name;
APrj.Options.Assign(Manager.Options);
pkg.Output := Manager.RootDir + Name; //???
pkg.ContentFile := Manager.RootDir + Name + '.xct';
//now create project file
if AFile <> '' then begin
@ -455,6 +468,7 @@ begin
end;
const
SecGen = 'dirs';
SecDoc = 'project';
procedure TDocPackage.ReadConfig;
@ -464,7 +478,7 @@ begin
if Loaded then
exit;
if Config = nil then
Config := TIniFile.Create(IniFileName);
Config := TConfigFile.Create(IniFileName);
//check config
s := Config.ReadString(SecDoc, 'projectdir', '');
if s = '' then begin
@ -477,8 +491,13 @@ begin
FDescrDir := Config.ReadString(SecDoc, 'descrdir', '');
Requires.CommaText := Config.ReadString(SecDoc, 'requires', '');
//units
{$IFDEF v0}
Config.ReadSectionRaw('units', Units);
Config.ReadSectionRaw('descrs', Descriptions);
{$ELSE}
Config.ReadSectionValues('units', Units);
Config.ReadSectionValues('descrs', Descriptions);
{$ENDIF}
//more?
//all done
Loaded := True;
@ -488,6 +507,7 @@ end;
*)
procedure TDocPackage.UpdateConfig;
{$IFDEF v0}
procedure WriteSection(const SecName: string; AList: TStrings);
var
j: integer;
@ -498,11 +518,13 @@ procedure TDocPackage.UpdateConfig;
Config.WriteString(SecName, AList.Names[j], AList.ValueFromIndex[j]);
end;
end;
{$ELSE}
{$ENDIF}
begin
//create ini file, if not already created
if Config = nil then
Config := TIniFile.Create(IniFileName); //in document RootDir
Config := TConfigFile.Create(IniFileName); //in document RootDir
//general information
Config.WriteString(SecDoc, 'projectdir', ProjectDir);
Config.WriteString(SecDoc, 'projectfile', ProjectFile);
@ -511,8 +533,13 @@ begin
Config.WriteString(SecDoc, 'descrdir', DescrDir);
Config.WriteString(SecDoc, 'requires', Requires.CommaText);
//units
{$IFDEF v0}
WriteSection('units', Units);
WriteSection('descrs', Descriptions);
{$ELSE}
Config.WriteSectionValues('units', Units);
Config.WriteSectionValues('descrs', Descriptions);
{$ENDIF}
//all done
Loaded := True;
end;
@ -543,12 +570,15 @@ begin
lst := TStringList.Create;
lst.OwnsObjects := True;
FPackages := lst;
FOptions := TCmdOptions.Create;
end;
destructor TFPDocManager.Destroy;
begin
SaveConfig;
FreeAndNil(Config); //save?
FreeAndNil(FPackages);
FreeAndNil(FOptions);
inherited Destroy;
end;
@ -576,6 +606,21 @@ begin
FPackage:=AValue;
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.
*)
procedure TFPDocManager.SetRootDir(AValue: string);
@ -603,6 +648,8 @@ begin
Helper := TFPDocHelper.Create(nil);
Helper.OnLog := OnLog;
Result := Helper.BeginTest(AFile);
if Result then
Helper.Options := Options;
end;
procedure TFPDocManager.EndTest;
@ -649,13 +696,12 @@ begin
Config.Free;
//clear packages???
end;
Config := TIniFile.Create(cf);
Config := TConfigFile.Create(cf);
Config.CacheUpdates := True;
//FDirty := True; //to be saved
if not Result then
exit; //nothing to read
//read directories
FFPDocDir := Config.ReadString('dirs', 'fpc', '');
FFPDocDir := Config.ReadString(SecGen, 'fpc', '');
//read packages
Config.ReadSectionValues(SecProjects, FPackages); //<prj>=<file>
//read detailed package information - possibly multiple packages per project!
@ -670,6 +716,9 @@ begin
end;
end;
//more? (preferences?)
FProfiles:=Config.ReadString(SecGen, 'Profiles', 'default');
FProfile := Config.ReadString(SecGen,'Profile', 'default');
Options.LoadConfig(Config, Profile);
//done, nothing modified
EndUpdate;
end;
@ -679,9 +728,20 @@ begin
(* Protection against excessive saves requires a subclass of TIniFile,
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
end;
procedure TFPDocManager.AddProfile(const AName: string);
begin
//add and select - obsolete!
Profile := AName;
end;
(* Add a DocPackage to Packages and INI.
Return package Index.
For exclusive use by Package.SetLoaded!
@ -705,6 +765,7 @@ begin
end;
if (ExtractFileExt(APkg.ProjectFile) <> '.xml') then begin
//create project file
APkg.ProjectFile := ChangeFileExt(APkg.ProjectFile, '_prj.xml');
CreateProject(APkg.ProjectFile, APkg);
//APkg.UpdateConfig; - required?
//update Packages[] string
@ -862,6 +923,21 @@ begin
Changed;
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;
begin
BeginTest(APkg.ProjectFile);
@ -913,11 +989,13 @@ function TFPDocHelper.BeginTest(APkg: TDocPackage): boolean;
begin
if not assigned(APkg) then
exit(False);
Result := BeginTest(APkg.ProjectFile);
Result := BeginTest(APkg.ProjectFile); //directory would be sufficient!
if not Result then
exit;
ParseFPDocOption('--project='+APkg.ProjectFile);
APkg.CreateProject(self, ''); //create project file?
//ParseFPDocOption('--project='+APkg.ProjectFile);
Package := Packages.FindPackage(APkg.Name);
//Options?
//okay, so far
Result := assigned(Package);
end;
@ -977,6 +1055,20 @@ begin
Result := True;
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;
begin
(* more detailed error handling?
@ -986,12 +1078,16 @@ begin
if not Result then
exit;
try
//override options for test
ParseFPDocOption('--format=html');
ParseFPDocOption('-n');
{$IFDEF v0}
Package := Packages.FindPackage(APkg.Name);
Result := Package <> nil;
if Result then
CreateUnitDocumentation(Package, AUnit, True);
{$ELSE}
{$ENDIF}
CreateUnitDocumentation(AUnit, True);
finally
EndTest;
end;