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

DocMgr: added additional description directories

Browse Source 
git-svn-id: trunk@35163 -
This commit is contained in:
dodi 2012-02-05 17:19:42 +00:00
parent 8d96082dc1
commit 8f58e393e4
13 changed files with 711 additions and 203 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -3732,6 +3732,7 @@ examples/fpdocmanager/FPDocManager.lpr svneol=native#text/plain
examples/fpdocmanager/FilenameExtension.patch svneol=native#text/pascal
examples/fpdocmanager/README.txt svneol=native#text/plain
examples/fpdocmanager/configfile.pas svneol=native#text/pascal
examples/fpdocmanager/docs/configfile.xml svneol=native#text/plain
examples/fpdocmanager/docs/fconfig.xml svneol=native#text/plain
examples/fpdocmanager/docs/flogview.xml svneol=native#text/plain
examples/fpdocmanager/docs/fmain.xml svneol=native#text/plain

7
examples/fpdocmanager/FPDocManager.lpi
View File

@ -40,7 +40,7 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="10">
<Units Count="11">
<Unit0>
<Filename Value="FPDocManager.lpr"/>
<IsPartOfProject Value="True"/>
@ -98,6 +98,11 @@
<Filename Value="text.txt"/>
<IsPartOfProject Value="True"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\fpc-trunk\packages\fcl-passrc\src\pparser.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="PParser"/>
</Unit10>
</Units>
</ProjectOptions>
<CompilerOptions>

2
examples/fpdocmanager/FPDocManager.lpr
View File

@ -7,7 +7,7 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, umakeskel, fMain, fConfig, uManager, fLogView,
Forms, PParser, umakeskel, fMain, fConfig, uManager, fLogView,
fUpdateView, ulpk, ConfigFile;
{$R *.res}

41
examples/fpdocmanager/docs/configfile.xml Normal file
View File

@ -0,0 +1,41 @@
<?xml version="1.0"?>
<fpdoc-descriptions>
<package name="FPDocManager">
<module name="ConfigFile">
<short>A simple INI file implementation.</short>
<descr>The standard TIniFile has several flaw, so I provided my own implementation.</descr>
<element name="TConfigFile">
<short>An INI file implementation.</short>
<descr>Implemented as a list of Sections, each containing lines of key=value.
Entire sections can read or written without any interpretation.</descr>
</element>
<element name="TConfigFile.Create">
<short>Loads the given file, if it exists.</short>
</element>
<element name="TConfigFile.ReadString">
<short>Reads an string value.</short>
</element>
<element name="TConfigFile.WriteSection">
<short>Writes an entire section. Sets Dirty when the strings are different from the current section values.</short>
</element>
<element name="TConfigFile.WriteSectionValues">
<short>Writes an entire section. Sets Dirty when the strings are different from the current section values.</short>
</element>
<element name="TConfigFile.FindSection">
<short>Returns a Section object, specified as name or [name]. Nil if not found.</short>
</element>
<element name="TConfigFile.SectionExists">
<short>Checks for a Section specified as name or [name].</short>
</element>
<element name="TConfigFile.Sections">
<short>The list of all Sections.</short>
</element>
<element name="TConfigFile.Destroy">
<short>Saves the values if Dirty.</short>
</element>
<element name="TConfigFile.Flush">
<short>Saves the values if Dirty, and if FileName is not empty.</short>
</element>
</module>
</package>
</fpdoc-descriptions>

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

@ -174,7 +174,7 @@
<!-- class Visibility: default -->
<element name="TSkelEngine">
<short>The MakeSkel engine, used to create documentation skeleton or update files.</short>
<descr/>
<descr>It is based on TFPDocEngine, used by FPDoc.</descr>
<errors/>
<seealso/>
</element>
@ -279,7 +279,7 @@
</element>
<!-- function Visibility: public -->
<element name="TSkelEngine.FindModule">
<short/>
<short>Provides dummy modules for all external units.</short>
<descr/>
<errors/>
<seealso/>
@ -415,28 +415,28 @@
<!-- enumeration type Visibility: default -->
<element name="TCreatorAction">
<short>The action to perform after all FPDoc commandline options have been parsed.</short>
<descr/>
<descr>Values returned by the option parsers for every single option. In this case caInvalid indicates an unhandled option.</descr>
<seealso/>
</element>
<!-- enumeration value Visibility: default -->
<element name="TCreatorAction.caDefault">
<short/>
<short>Default processing, option parsed successfully.</short>
</element>
<!-- enumeration value Visibility: default -->
<element name="TCreatorAction.caDryRun">
<short/>
<short>DryRun option (-n) found.</short>
</element>
<!-- enumeration value Visibility: default -->
<element name="TCreatorAction.caUsage">
<short/>
<short>Show usage, after option errors.</short>
</element>
<!-- enumeration value Visibility: default -->
<element name="TCreatorAction.caInvalid">
<short/>
<short>Unhandled option found.</short>
</element>
<!-- enumeration value Visibility: default -->
<element name="TCreatorAction.caWriteProject">
<short/>
<short>Write project file instead of documents.</short>
</element>
<!-- class Visibility: default -->
<element name="TFPDocMaker">
@ -617,8 +617,8 @@
</element>
<!-- function Visibility: protected -->
<element name="TFPDocMaker.ParseCommon">
<short/>
<descr/>
<short>Parses options common to FPDoc and MakeSkel. Returns caInvalid for unknown options.</short>
<descr>Raw options, where Cmd contains name=value, are splitted into Cmd and Arg. Quotes around/in Arg are removed, needed to process scripts.</descr>
<errors/>
<seealso/>
</element>
@ -636,7 +636,7 @@
</element>
<!-- function Visibility: public -->
<element name="TFPDocMaker.DocumentPackage">
<short>Creates or updates XML documentation sources.</short>
<short>Creates or updates XML documentation sources (MakeSkel emulation)</short>
<descr/>
<errors/>
<seealso/>
@ -663,8 +663,9 @@
</element>
<!-- procedure Visibility: public -->
<element name="TFPDocMaker.CreateUnitDocumentation">
<short>Creates final documentation, for a package or a single unit.</short>
<descr/>
<short>Creates final documentation, for a package or a single unit (FPDoc emulation).</short>
<descr>When an description file exists already for a unit, an <rootdir/>/upd.<unit/>.xml file is created, containing all updates. Empty files are destroyed afterwards.
Otherwise a skeleton file is created in the descriptions directory.</descr>
<errors/>
<seealso/>
</element>
@ -674,7 +675,7 @@
</element>
<!-- argument Visibility: default -->
<element name="TFPDocMaker.CreateUnitDocumentation.AUnit">
<short/>
<short>Update only AUnit if not empty, else the entire package.</short>
</element>
<!-- argument Visibility: default -->
<element name="TFPDocMaker.CreateUnitDocumentation.ParseOnly">
@ -845,8 +846,8 @@
</element>
<!-- function Visibility: public -->
<element name="TFPDocMaker.CleanXML">
<short>Return True and (try) kill file if no element tag found.</short>
<descr/>
<short>Return True and (try) kill file if no element tag found in it.</short>
<descr>Used to remove empty update files after DocumentPackage.</descr>
<errors/>
<seealso/>
</element>
@ -862,7 +863,7 @@
<element name="TFPDocMaker.SelectedPackage">
<short>Returns the currently selected package.</short>
<descr/>
<errors/>
<errors>When no package was specified, a message is logged.</errors>
<seealso/>
</element>
<!-- function result Visibility: default -->
@ -908,13 +909,13 @@
<!-- property Visibility: public -->
<element name="TFPDocMaker.InputDir">
<short>The directory containing Inputs files. Writing adds all source files in the directory to Inputs[].</short>
<descr/>
<descr>Can be written more than once, to specify multiple input directories (cumulative).</descr>
<seealso/>
</element>
<!-- property Visibility: public -->
<element name="TFPDocMaker.DescrDir">
<short>The directory containing Description files. Writing adds all XML files in the directory to Descriptions[].</short>
<descr/>
<descr>Can be written more than once, to specify multiple Description directories (cumulative). The first[?] directory is assumed the default directory, for creating and searching description files. [intended to merge files from multiple packages]</descr>
<seealso/>
</element>
<!-- property Visibility: public -->
@ -995,6 +996,9 @@
<element name="ExtractUnitName.s">
<short/>
</element>
<element name="TFPDocMaker.CmdOptions">
<short>Combined FPDoc and MakeSkel options. Writing copies the given object into both option sets.</short>
</element>
</module>
<!-- umakeskel -->
</package>

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

@ -969,7 +969,7 @@
</element>
<!-- property Visibility: public -->
<element name="TFPDocManager.LazarusDir">
<short/>
<short>Lazarus root dir, used to create LCL and add FCL docs.</short>
<descr/>
<seealso/>
</element>
@ -1018,6 +1018,24 @@
<element name="TFPDocManager.OptsFile">
<short>File to use for output options (FPDoc).</short>
</element>
<element name="TFPDocManager.FpcDir">
<short>FPC root directory, used to find source files.</short>
</element>
<element name="TFPDocManager.Options">
<short>All documentation options.</short>
</element>
<element name="TFPDocManager.Profile">
<short>The current FPDoc profile (settings).</short>
</element>
<element name="TFPDocManager.Profiles">
<short>All defined FPDoc profiles.</short>
</element>
<element name="TFPDocManager.MakeDoc">
<short>Create documentation for AUnit or the entire package.</short>
</element>
<element name="TFPDocManager.UpdatePackage">
<short>Add Lazarus description directory to RTL/FCL.</short>
</element>
</module>
<!-- uManager -->
</package>

147
examples/fpdocmanager/fconfig.lfm
View File

@ -1,26 +1,26 @@
object CfgWizard: TCfgWizard
Left = 362
Height = 302
Height = 300
Top = 165
Width = 318
Width = 317
Caption = 'Configuration Assistant'
ClientHeight = 302
ClientWidth = 318
ClientHeight = 300
ClientWidth = 317
OnShow = FormShow
LCLVersion = '0.9.31'
object Steps: TPageControl
Left = 0
Height = 241
Height = 239
Top = 0
Width = 318
ActivePage = MkRTL
Width = 317
ActivePage = SelRoot
Align = alClient
TabIndex = 2
TabIndex = 0
TabOrder = 0
object SelRoot: TTabSheet
Caption = 'RootDir'
ClientHeight = 195
ClientWidth = 312
ClientHeight = 211
ClientWidth = 309
OnShow = SelRootShow
object Label1: TLabel
Left = 10
@ -50,21 +50,21 @@ object CfgWizard: TCfgWizard
end
object SelFPDir: TTabSheet
Caption = 'FPC'
ClientHeight = 213
ClientWidth = 310
ClientHeight = 211
ClientWidth = 309
OnShow = SelFPDirShow
object Label2: TLabel
Left = 10
Height = 91
Height = 46
Top = 10
Width = 272
Caption = 'The Free Pascal documentation is used everywhere.'#13#10'If you didn''t download the documentation sources'#13#10'already, you should do so now.'#13#10#13#10'Select the FPC documentation directory,'#13#10'or skip to the Lazarus configuration page.'
Caption = 'The Free Pascal documentation is used everywhere.'#13#10'If you didn''t download the documentation sources'#13#10'already, you should do so now.'
ParentColor = False
end
object buDownload: TButton
Left = 10
Height = 25
Top = 112
Top = 64
Width = 90
Caption = 'Download...'
Enabled = False
@ -73,35 +73,53 @@ object CfgWizard: TCfgWizard
object buSelFpc: TButton
Left = 12
Height = 25
Top = 144
Width = 75
Caption = 'Browse...'
Top = 136
Width = 72
Caption = 'Source...'
OnClick = buSelFpcClick
TabOrder = 1
end
object edFpcDir: TEdit
Left = 100
Height = 23
Top = 144
Width = 198
Hint = 'The FPC source directory contains subdirectories'#13#10'compiler, packages etc.'
Top = 136
Width = 197
Anchors = [akTop, akLeft, akRight]
OnChange = edFpcDirChange
TabOrder = 2
end
object Button2: TButton
Left = 124
object Label5: TLabel
Left = 12
Height = 31
Top = 96
Width = 234
Caption = 'Now select the FPC source directory and the'#13#10'FPC documentation directory in it.'
ParentColor = False
end
object buSelFpcDocs: TButton
Left = 12
Height = 25
Top = 112
Width = 75
Caption = 'Goto LCL'
Enabled = False
Top = 168
Width = 72
Caption = 'Docs...'
OnClick = buSelFpcDocsClick
TabOrder = 3
end
object edFpcDocs: TEdit
Left = 100
Height = 23
Top = 168
Width = 197
Anchors = [akTop, akLeft, akRight]
OnChange = edFpcDocsChange
TabOrder = 4
end
end
object MkRTL: TTabSheet
Caption = 'RTL'
ClientHeight = 213
ClientWidth = 310
ClientHeight = 211
ClientWidth = 309
OnShow = MkRTLShow
object Label3: TLabel
Left = 10
@ -124,7 +142,7 @@ object CfgWizard: TCfgWizard
Left = 60
Height = 23
Top = 152
Width = 238
Width = 237
Anchors = [akTop, akLeft, akRight]
OnChange = edRtlBatChange
TabOrder = 1
@ -133,7 +151,7 @@ object CfgWizard: TCfgWizard
Left = 60
Height = 23
Top = 182
Width = 238
Width = 237
Anchors = [akTop, akLeft, akRight]
OnChange = edRtlBatChange
TabOrder = 2
@ -148,22 +166,77 @@ object CfgWizard: TCfgWizard
TabOrder = 3
end
end
object MkLCL: TTabSheet
Caption = 'LCL'
ClientHeight = 211
ClientWidth = 309
OnShow = MkLCLShow
object Label4: TLabel
Left = 10
Height = 31
Top = 10
Width = 226
Caption = 'Now we''ll register the LCL documentation.'#13#10'Please select your Lazarus directory.'
ParentColor = False
end
object buLazDir: TButton
Left = 12
Height = 25
Top = 64
Width = 75
Caption = 'Browse...'
OnClick = buLazDirClick
TabOrder = 0
end
object edLazDir: TEdit
Left = 100
Height = 23
Top = 66
Width = 200
Anchors = [akTop, akLeft, akRight]
OnChange = edLazDirChange
TabOrder = 1
end
end
object MkFCL: TTabSheet
Caption = 'FCL'
ClientHeight = 211
ClientWidth = 309
OnShow = MkFCLShow
object Label6: TLabel
Left = 10
Height = 31
Top = 10
Width = 251
Caption = 'You can add the Lazarus FCL documentation to'#13#10'the FPC FCL docs.'
ParentColor = False
end
object swFCLads: TCheckBox
Left = 12
Height = 19
Top = 56
Width = 169
Caption = 'Add Lazarus docs to the FCL'
OnChange = swFCLadsChange
TabOrder = 0
end
end
end
object sb: TStatusBar
Left = 0
Height = 23
Top = 279
Width = 318
Top = 277
Width = 317
Panels = <>
end
object Panel1: TPanel
Left = 0
Height = 38
Top = 241
Width = 318
Top = 239
Width = 317
Align = alBottom
ClientHeight = 38
ClientWidth = 318
ClientWidth = 317
TabOrder = 2
object buBack: TButton
Left = 8
@ -185,7 +258,7 @@ object CfgWizard: TCfgWizard
TabOrder = 1
end
object buNext: TButton
Left = 230
Left = 229
Height = 25
Top = 5
Width = 75
@ -195,7 +268,7 @@ object CfgWizard: TCfgWizard
TabOrder = 2
end
object Button1: TButton
Left = 182
Left = 181
Height = 25
Top = 5
Width = 35

104
examples/fpdocmanager/fconfig.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
ComCtrls, StdCtrls;
ComCtrls, StdCtrls, CheckLst;
type
@ -16,14 +16,18 @@ type
buBack: TButton;
buNext: TButton;
buFclBat: TButton;
buSelFpcDocs: TButton;
buSelRoot: TButton;
buDownload: TButton;
buSelFpc: TButton;
Button1: TButton;
Button2: TButton;
buCancel: TButton;
buRtlBat: TButton;
buLazDir: TButton;
swFCLads: TCheckBox;
edFpcDir: TEdit;
edFpcDocs: TEdit;
edLazDir: TEdit;
edRtlBat: TEdit;
edRoot: TEdit;
edFclBat: TEdit;
@ -32,25 +36,37 @@ type
Label2: TLabel;
Label3: TLabel;
dlgOpen: TOpenDialog;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Panel1: TPanel;
Steps: TPageControl;
sb: TStatusBar;
SelRoot: TTabSheet;
SelFPDir: TTabSheet;
MkRTL: TTabSheet;
MkLCL: TTabSheet;
MkFCL: TTabSheet;
procedure buBackClick(Sender: TObject);
procedure buFclBatClick(Sender: TObject);
procedure buLazDirClick(Sender: TObject);
procedure buNextClick(Sender: TObject);
procedure buRtlBatClick(Sender: TObject);
procedure buSelFpcClick(Sender: TObject);
procedure buSelFpcDocsClick(Sender: TObject);
procedure buSelRootClick(Sender: TObject);
procedure edFpcDirChange(Sender: TObject);
procedure edFpcDocsChange(Sender: TObject);
procedure edLazDirChange(Sender: TObject);
procedure edRootChange(Sender: TObject);
procedure edRtlBatChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure MkFCLShow(Sender: TObject);
procedure MkLCLShow(Sender: TObject);
procedure MkRTLShow(Sender: TObject);
procedure SelFPDirShow(Sender: TObject);
procedure SelRootShow(Sender: TObject);
procedure swFCLadsChange(Sender: TObject);
private
NoRun: boolean;
public
@ -80,12 +96,32 @@ end;
procedure TCfgWizard.edFpcDirChange(Sender: TObject);
begin
Manager.FpcDocDir := edFpcDir.Text;
buNext.Enabled := edFpcDir.Text <> '';
if NoRun then exit;
Manager.FpcDir := edFpcDir.Text;
end;
procedure TCfgWizard.edFpcDocsChange(Sender: TObject);
begin
if NoRun then exit;
Manager.FpcDocDir := edFpcDocs.Text;
buNext.Enabled := edFpcDocs.Text <> '';
end;
procedure TCfgWizard.edLazDirChange(Sender: TObject);
begin
if NoRun then exit;
if edLazDir.Text = '' then
exit;
Manager.LazarusDir := edLazDir.Text;
//import LazUtils
Manager.ImportLpk(Manager.LazarusDir + 'components/lazutils/lazutils.lpk');
//import LCLBase
Manager.ImportLpk(Manager.LazarusDir + 'lcl/lclbase.lpk');
end;
procedure TCfgWizard.edRootChange(Sender: TObject);
begin
if NoRun then exit;
Manager.RootDir:=edRoot.Text;
buNext.Enabled := Manager.RootDir <> '';
end;
@ -94,14 +130,42 @@ procedure TCfgWizard.FormShow(Sender: TObject);
begin
//ModalResult:=mrOK; exits!!!
Steps.ActivePage := SelRoot;
//init edits
NoRun:=True;
edRoot.Text := Manager.RootDir;
edFpcDocs.Text := Manager.FpcDocDir;
edFpcDir.Text := Manager.FpcDir;
edRtlBat.Text := Manager.Packages.Values['rtl'];
edFclBat.Text := Manager.Packages.Values['fcl'];
edLazDir.Text := Manager.LazarusDir;
swFCLads.Checked := Manager.IsExtended('fcl') <> '';
NoRun:=False;
end;
procedure TCfgWizard.MkFCLShow(Sender: TObject);
var
ok: boolean;
begin
ok := (edFpcDir.Text <> '') and (edLazDir.Text <> '');
ok := ok and DirectoryExists(edFpcDir.Text);
ok := ok and DirectoryExists(edLazDir.Text);
swFCLads.Enabled := ok;
if not ok then begin
swFCLads.Checked := False;
ShowMessage('Please select FPC and Lazarus directories first!');
end;
end;
procedure TCfgWizard.MkLCLShow(Sender: TObject);
begin
end;
procedure TCfgWizard.MkRTLShow(Sender: TObject);
begin
NoRun:=True; //lock updates!
edRtlBat.Text := Manager.Packages.Values['rtl'];
edFclBat.Text := Manager.Packages.Values['fcl'];
NoRun:=False;
end;
procedure TCfgWizard.SelFPDirShow(Sender: TObject);
@ -142,6 +206,14 @@ begin
edFclBat.Text := dlgOpen.FileName;
end;
procedure TCfgWizard.buLazDirClick(Sender: TObject);
begin
dlgSelRoot.InitialDir := Manager.LazarusDir;
dlgSelRoot.Title := 'Lazarus Directory';
if dlgSelRoot.Execute then
edLazDir.Text := AppendPathDelim(dlgSelRoot.FileName);
end;
procedure TCfgWizard.buRtlBatClick(Sender: TObject);
begin
dlgOpen.InitialDir := Manager.FpcDocDir;
@ -152,12 +224,21 @@ end;
procedure TCfgWizard.buSelFpcClick(Sender: TObject);
begin
dlgSelRoot.Title := 'FPC Documentation Source Directory';
dlgSelRoot.Title := 'FPC Source Directory';
if not dlgSelRoot.Execute then
exit;
edFpcDir.Text := AppendPathDelim(dlgSelRoot.FileName);
end;
procedure TCfgWizard.buSelFpcDocsClick(Sender: TObject);
begin
dlgSelRoot.Title := 'FPC Documentation Source Directory';
dlgSelRoot.InitialDir := edFpcDir.Text;
if not dlgSelRoot.Execute then
exit;
edFpcDocs.Text := AppendPathDelim(dlgSelRoot.FileName);
end;
procedure TCfgWizard.SelRootShow(Sender: TObject);
begin
edRoot.Text := Manager.RootDir;
@ -165,5 +246,10 @@ begin
buNext.Enabled := Manager.RootDir <> '';
end;
procedure TCfgWizard.swFCLadsChange(Sender: TObject);
begin
Manager.UpdateFCL(swFCLads.Checked);
end;
end.

285
examples/fpdocmanager/fmain.lfm
View File

@ -45,128 +45,183 @@ object Main: TMain
OnClick = lbUnitsClick
TabOrder = 0
end
object GroupBox1: TGroupBox
object Panel1: TPanel
Left = 100
Height = 436
Top = 0
Width = 367
Align = alClient
Caption = 'Actions'
ClientHeight = 418
ClientWidth = 363
Caption = 'Panel1'
ClientHeight = 436
ClientWidth = 367
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
object GroupBox1: TGroupBox
Left = 1
Height = 339
Top = 96
Width = 78
Caption = 'Sort Nodes'
TabOrder = 9
Width = 365
Align = alClient
Caption = 'Actions'
ClientHeight = 321
ClientWidth = 361
TabOrder = 0
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 = 260
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 = 267
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
object GroupBox2: TGroupBox
Left = 1
Height = 95
Top = 1
Width = 365
Align = alTop
Caption = 'Descriptions'
ClientHeight = 77
ClientWidth = 361
TabOrder = 1
object Label8: TLabel
Left = 10
Height = 16
Top = 10
Width = 39
Caption = 'Default'
ParentColor = False
end
object Label9: TLabel
Left = 10
Height = 16
Top = 39
Width = 40
Caption = 'Lazarus'
ParentColor = False
end
object edDescrDir: TEdit
Left = 63
Height = 23
Top = 7
Width = 288
Anchors = [akTop, akLeft, akRight]
ReadOnly = True
TabOrder = 0
end
object edDescrLaz: TEdit
Left = 63
Height = 23
Top = 35
Width = 288
Anchors = [akTop, akLeft, akRight]
TabOrder = 1
end
end
end
end

30
examples/fpdocmanager/fmain.pas
View File

@ -20,19 +20,25 @@ type
{ TMain }
TMain = class(TForm)
buMakeDoc: TButton;
buNewProfile: TButton;
buRefresh: TButton;
buShowLog: TButton;
buTest: TButton;
buMakeDoc: TButton;
buNewProfile: TButton;
cbFormat: TComboBox;
cbProfile: TComboBox;
edDescrDir: TEdit;
edDescrLaz: TEdit;
edLog: TEdit;
edOutput: TEdit;
edOS: TEdit;
edCPU: TEdit;
edLang: TEdit;
edMoDir: TEdit;
edDefOut: TEdit;
edUnit: TEdit;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
@ -40,20 +46,19 @@ type
Label6: TLabel;
Label7: TLabel;
edBackend: TMemo;
Label8: TLabel;
Label9: TLabel;
optUpd: TCheckGroup;
Panel1: TPanel;
StatusBar1: TStatusBar;
swAll: TRadioButton;
swOutput: TRadioButton;
swDefOut: TRadioButton;
swDocOpts: TCheckGroup;
Label1: TLabel;
swSortNodes: TCheckBox;
optUpd: TCheckGroup;
dlgSelLpk: TOpenDialog;
edINI: TMemo;
swShowUpdate: TCheckBox;
edLog: TEdit;
lbPackages: TComboBox;
edUnit: TEdit;
GroupBox1: TGroupBox;
lbUnits: TListBox;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
@ -63,11 +68,12 @@ type
MenuItem3: TMenuItem;
mnExit: TMenuItem;
dlgSelRoot: TSelectDirectoryDialog;
swShowUpdate: TCheckBox;
swSingle: TRadioButton;
swSortNodes: TCheckBox;
ViewFinal: TTabSheet;
ViewINI: TTabSheet;
Units: TPageControl;
swAll: TRadioButton;
swSingle: TRadioButton;
edXML: TSynEdit;
SynXMLSyn1: TSynXMLSyn;
ViewXML: TTabSheet;
@ -126,7 +132,7 @@ implementation
uses
fConfig, fLogView, fUpdateView,
dwlinear,
//dwlinear,
dWriter;
{$R *.lfm}
@ -475,6 +481,8 @@ begin
Manager.Package := pkg;
edDefOut.Text := Manager.RootDir + pkg.Name;
fn := pkg.ProjectFile; //initialized where?
edDescrDir.Text := pkg.DescrDir; //value?
edDescrLaz.Text := pkg.AltDir;
if fn <> '' then begin
if FileExists(fn) then
edXML.Lines.LoadFromFile(fn)

1
examples/fpdocmanager/ulpk.pp
View File

@ -21,7 +21,6 @@ uses
uManager;
function ImportLpk(const AFile: string): TDocPackage;
//function ImportCompiled(const LpkFile: string): boolean;
implementation

1
examples/fpdocmanager/umakeskel.pas
View File

@ -160,7 +160,6 @@ type
Function DocumentPackage(Const APackageName,AOutputName: string; InputFiles, DescrFiles : TStrings) : String;
procedure CreateUnitDocumentation(const AUnit: string; ParseOnly: Boolean);
public
ImportDir: string;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddDirToFileList(List: TStrings; const ADirName, AMask: String);

233
examples/fpdocmanager/umanager.pas
View File

@ -58,6 +58,7 @@ type
*)
TDocPackage = class
private
FAltDir: string;
FCompOpts: string;
FDescrDir: string;
FDescriptions: TStrings;
@ -71,6 +72,7 @@ type
FRequires: TStrings;
FUnitPath: string;
FUnits: TStrings;
procedure SetAltDir(AValue: string);
procedure SetCompOpts(AValue: string);
procedure SetDescrDir(AValue: string);
procedure SetDescriptions(AValue: TStrings);
@ -91,7 +93,7 @@ type
constructor Create;
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; virtual; //new package project
function ImportProject(APrj: TFPDocHelper; APkg: TFPDocPackage; const AFile: string): boolean;
procedure UpdateConfig;
property Name: string read FName write SetName;
@ -104,6 +106,7 @@ type
property ProjectDir: string read FProjectDir write SetProjectDir;
property DescrDir: string read FDescrDir write SetDescrDir;
property Descriptions: TStrings read FDescriptions write SetDescriptions;
property AltDir: string read FAltDir write SetAltDir;
property InputDir: string read FInputDir write SetInputDir;
property Units: TStrings read FUnits write SetUnits;
property Requires: TStrings read FRequires write SetRequires; //only string?
@ -111,6 +114,13 @@ type
property UnitPath: string read FUnitPath write SetUnitPath; //-Fu
end;
{ TFCLDocPackage }
TFCLDocPackage = class(TDocPackage)
public
function CreateProject(APrj: TFPDocHelper; const AFile: string): boolean; override;
end;
{ TFPDocHelper }
//holds temporary project
@ -142,6 +152,7 @@ type
*)
TFPDocManager = class(TComponent)
private
FFpcDir: string;
FFPDocDir: string;
FLazarusDir: string;
FModified: boolean;
@ -154,7 +165,9 @@ type
FProfiles: string; //CSV list of profile names
FRootDir: string;
UpdateCount: integer;
procedure SetFpcDir(AValue: string);
procedure SetFPDocDir(AValue: string);
procedure SetLazarusDir(AValue: string);
procedure SetOnChange(AValue: TNotifyEvent);
procedure SetPackage(AValue: TDocPackage);
procedure SetProfile(AValue: string);
@ -178,15 +191,20 @@ type
function AddProject(const APkg, AFile: string): boolean; //from config
function CreateProject(const AFileName: string; APkg: TDocPackage): boolean;
function AddPackage(AName: string): TDocPackage;
function IsExtended(const APkg: string): string;
function ImportLpk(const AFile: string): TDocPackage;
procedure ImportProject(APkg: TFPDocPackage; const AFile: string);
function ImportCmd(const AFile: string): boolean;
procedure UpdatePackage(const AName: string);
function UpdateFCL(enabled: boolean): boolean;
//actions
function MakeDoc(APkg: TDocPackage; const AUnit, AOutput: string): boolean;
function TestRun(APkg: TDocPackage; AUnit: string): boolean;
function Update(APkg: TDocPackage; const AUnit: string): boolean;
public //published?
property FpcDir: string read FFpcDir write SetFpcDir;
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;
@ -209,6 +227,121 @@ uses
const
ConfigName = 'docmgr.ini';
SecProjects = 'projects';
SecGen = 'dirs';
SecDoc = 'project';
function FixPath(const s: string): string;
var
c: string;
begin
if DirectorySeparator = '/' then
c := '\'
else
c := '/';
Result := StringReplace(s, c, DirectorySeparator, [rfReplaceAll]);
end;
procedure ListDirs(const ARoot: string; AList: TStrings);
var
Info : TSearchRec;
s: string;
begin
if FindFirst (ARoot+'/*',faDirectory,Info)=0 then begin
repeat
if not ((Info.Attr and faDirectory) = faDirectory) then
continue;
s := Info.Name;
if s[1] <> '.' then
AList.Add(s); //name only, allow to create relative refs
until FindNext(info)<>0;
end;
FindClose(Info);
end;
procedure ListUnits(const AMask: string; AList: TStrings);
var
Info : TSearchRec;
s: string;
begin
if FindFirst (AMask,faArchive,Info)=0 then begin
repeat
s := Info.Name;
if s[1] <> '.' then
AList.Add(ChangeFileExt(s, '')); //unit name only
until FindNext(info)<>0;
end;
FindClose(Info);
end;
function MatchUnits(const ADir: string; AList: TStrings): integer;
var
Info : TSearchRec;
s, ext: string;
begin
Result := -1;
if FindFirst(ADir+DirectorySeparator+'*',faArchive,Info)=0 then begin
repeat
//If (Attr and faDirectory) = faDirectory then
s := Info.Name;
ext := ExtractFileExt(s);
if (ext = '.pas') or (ext = '.pp') then begin
ext := ChangeFileExt(s, '');
if ext='bmpcomn' then
s := AList[0]; //full name!!!
Result := AList.IndexOf(ext); //ChangeFileExt(s, '.xml'));
if Result >= 0 then begin
AList.Delete(Result); //don't search any more
break;
end;
end;
Until FindNext(info)<>0;
end;
FindClose(Info);
end;
{ TFCLDocPackage }
function TFCLDocPackage.CreateProject(APrj: TFPDocHelper; const AFile: string
): boolean;
var
i: integer;
s, d, f: string;
dirs, descs: TStringList;
begin
Result:=inherited CreateProject(APrj, AFile);
//add lazdir
if AltDir = '' then exit;
dirs := TStringList.Create;
descs := TStringList.Create;
s := Manager.LazarusDir + 'docs' + DirectorySeparator + 'xml' + DirectorySeparator + 'fcl';
//APrj.ParseFPDocOption(Format('--descr-dir="%s"', [s])); //todo: add includes
//APrj.AddDirToFileList(descs, s, '*.xml');
ListUnits(s+ DirectorySeparator+ '*.xml', descs);
descs.Sorted := True;
//scan fcl dirs
s := Manager.FFpcDir + 'packages' + DirectorySeparator;
ListDirs(s, dirs);
//now match all files in the source dirs
for i := dirs.Count - 1 downto 0 do begin
d := s + dirs[i] + DirectorySeparator + 'src';
if pos('fcl-image', d) > 0 then
f := 'debug!';
if not DirectoryExists(d) then continue;
if MatchUnits(d, descs) >= 0 then begin
//add dir
APrj.ParseFPDocOption(Format('--input-dir="%s"', [d])); //todo: add includes?
end;
end;
//re-create project?
if AFile <> '' then begin
f := ChangeFileExt(AFile, '_ext.xml');
APrj.CreateProjectFile(f); //preserve unmodified project?
end else
APrj.CreateProjectFile(Manager.RootDir + 'fcl_ext.xml'); //preserve unmodified project?
//finally
dirs.Free;
descs.Free;
end;
{ TDocPackage }
@ -230,6 +363,14 @@ begin
FCompOpts:= FCompOpts + ' ' + AValue;
end;
procedure TDocPackage.SetAltDir(AValue: string);
begin
if FAltDir=AValue then Exit;
FAltDir:=AValue;
//we must signal config updated
Config.WriteString(SecDoc, 'AltDir', AltDir);
end;
procedure TDocPackage.SetDescriptions(AValue: TStrings);
(* Shall we allow for multiple descriptions? (general + OS specific!?)
*)
@ -415,6 +556,13 @@ begin
pkg.Descriptions.Add(s);
end;
end;
if AltDir <> '' then begin
//add descr files
s := Manager.LazarusDir + AltDir;
s := FixPath(s);
APrj.ParseFPDocOption(Format('--descr-dir="%s"', [s]));
//add source files!?
end;
//add Imports
for i := 0 to Requires.Count - 1 do begin
s := Requires[i];
@ -476,10 +624,6 @@ begin
Result := Loaded;
end;
const
SecGen = 'dirs';
SecDoc = 'project';
procedure TDocPackage.ReadConfig;
var
s: string;
@ -498,6 +642,7 @@ begin
FInputDir := Config.ReadString(SecDoc, 'inputdir', '');
FCompOpts := Config.ReadString(SecDoc, 'options', '');
FDescrDir := Config.ReadString(SecDoc, 'descrdir', '');
FAltDir := Config.ReadString(SecDoc, 'AltDir', '');
Requires.CommaText := Config.ReadString(SecDoc, 'requires', '');
//units
Config.ReadSection('units', Units);
@ -520,6 +665,7 @@ begin
Config.WriteString(SecDoc, 'inputdir', InputDir);
Config.WriteString(SecDoc, 'options', CompOpts);
Config.WriteString(SecDoc, 'descrdir', DescrDir);
Config.WriteString(SecDoc, 'AltDir', AltDir);
Config.WriteString(SecDoc, 'requires', Requires.CommaText);
//units
Config.WriteSectionValues('units', Units);
@ -562,6 +708,7 @@ destructor TFPDocManager.Destroy;
begin
SaveConfig;
FreeAndNil(Config);
FPackages.Clear;
FreeAndNil(FPackages);
FreeAndNil(FOptions);
inherited Destroy;
@ -571,6 +718,62 @@ procedure TFPDocManager.SetFPDocDir(AValue: string);
begin
if FFPDocDir=AValue then Exit;
FFPDocDir:=AValue;
Config.WriteString(SecGen, 'FpcDocDir', FpcDocDir);
end;
procedure TFPDocManager.SetFpcDir(AValue: string);
begin
if FFpcDir=AValue then Exit;
FFpcDir:=AValue;
Config.WriteString(SecGen, 'FpcDir', FpcDir);
end;
procedure TFPDocManager.UpdatePackage(const AName: string);
var
pkg: TDocPackage;
i: integer;
s: string;
begin
if LazarusDir = '' then exit;
s := {LazarusDir +} 'docs/xml/'+AName;
if not DirectoryExists(LazarusDir + s) then
exit;
i := Packages.IndexOfName('rtl'); //???
//i := Packages.IndexOf(AName);
if i < 0 then
exit;
pkg := Packages.Objects[i] as TDocPackage;
pkg.AltDir := s; //add descriptors when configuring the project/helper
end;
function TFPDocManager.UpdateFCL(enabled: boolean): boolean;
var
pkg: TFCLDocPackage;
begin
(* Adding to the FCL requires valid FPC and Lazarus directories (caller checks).
Then laz/docs/xml/fcl/ is added to fpc descr-dirs.
The related units have to be added as input-dirs.
Scan fpc/packages/ for candidates.
*)
//todo: implement
pkg := AddPackage('fcl') as TFCLDocPackage;
if pkg = nil then
exit(False);
if enabled then
pkg.AltDir := {LazarusDir +} FixPath('docs/xml/fcl')
else
pkg.AltDir := '';
Result := True;
end;
procedure TFPDocManager.SetLazarusDir(AValue: string);
begin
if FLazarusDir=AValue then Exit;
FLazarusDir:=AValue;
Config.WriteString(SecGen, 'LazarusDir', FLazarusDir);
//update RTL and FCL - if exist and Dir exists
UpdatePackage('rtl');
UpdatePackage('fcl');
end;
procedure TFPDocManager.SetOnChange(AValue: TNotifyEvent);
@ -680,7 +883,9 @@ begin
if not Result then
exit; //nothing to read
//read directories
FFPDocDir := Config.ReadString(SecGen, 'fpc', '');
FFpcDir := Config.ReadString(SecGen, 'FpcDir', '');
FFPDocDir := Config.ReadString(SecGen, 'FpcDocDir', '');
FLazarusDir:=Config.ReadString(SecGen, 'LazarusDir', '');
//read packages
Config.ReadSection(SecProjects, FPackages); //<prj>=<file>
//read detailed package information - possibly multiple packages per project!
@ -834,7 +1039,10 @@ begin
else
Result := FPackages.Objects[i] as TDocPackage;
if Result = nil then begin
Result := TDocPackage.Create;
if AName = 'fcl' then
Result := TFCLDocPackage.Create
else
Result := TDocPackage.Create;
Result.Name := AName; //triggers load config --> register
i := FPackages.IndexOfName(AName); //already registered?
end;
@ -844,6 +1052,17 @@ begin
end;
end;
function TFPDocManager.IsExtended(const APkg: string): string;
var
pkg: TDocPackage;
begin
pkg := AddPackage(APkg);
if pkg = nil then
Result := ''
else
Result := pkg.AltDir;
end;
function TFPDocManager.ImportLpk(const AFile: string): TDocPackage;
begin
BeginUpdate;