diff --git a/.gitattributes b/.gitattributes
index 1ad63ca0e5..b16cf4c958 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -3694,6 +3694,22 @@ examples/fontenum/fontenumeration.lpr svneol=native#text/pascal
examples/fontenum/mainunit.lfm svneol=native#text/plain
examples/fontenum/mainunit.lrs svneol=native#text/pascal
examples/fontenum/mainunit.pas svneol=native#text/pascal
+examples/fpdocmanager/FPDocManager.lpi svneol=native#text/plain
+examples/fpdocmanager/FPDocManager.lpr svneol=native#text/plain
+examples/fpdocmanager/README.txt svneol=native#text/plain
+examples/fpdocmanager/fconfig.lfm svneol=native#text/plain
+examples/fpdocmanager/fconfig.pas svneol=native#text/pascal
+examples/fpdocmanager/flogview.lfm svneol=native#text/plain
+examples/fpdocmanager/flogview.pas svneol=native#text/pascal
+examples/fpdocmanager/fmain.lfm svneol=native#text/plain
+examples/fpdocmanager/fmain.pas svneol=native#text/pascal
+examples/fpdocmanager/fpdocengine.lpk svneol=native#text/plain
+examples/fpdocmanager/fupdateview.lfm svneol=native#text/plain
+examples/fpdocmanager/fupdateview.pas svneol=native#text/pascal
+examples/fpdocmanager/ucmdline.pas svneol=native#text/pascal
+examples/fpdocmanager/ulpk.pp svneol=native#text/pascal
+examples/fpdocmanager/umakeskel.pas svneol=native#text/pascal
+examples/fpdocmanager/umanager.pas svneol=native#text/pascal
examples/gridexamples/grid_semaphor/TSemaphorDBGrid.xpm -text svneol=native#image/x-xpixmap
examples/gridexamples/grid_semaphor/example/project1.lpi svneol=native#text/plain
examples/gridexamples/grid_semaphor/example/project1.lpr svneol=native#text/pascal
diff --git a/examples/fpdocmanager/FPDocManager.lpi b/examples/fpdocmanager/FPDocManager.lpi
new file mode 100644
index 0000000000..025a445686
--- /dev/null
+++ b/examples/fpdocmanager/FPDocManager.lpi
@@ -0,0 +1,145 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/fpdocmanager/FPDocManager.lpr b/examples/fpdocmanager/FPDocManager.lpr
new file mode 100644
index 0000000000..edc116b1bd
--- /dev/null
+++ b/examples/fpdocmanager/FPDocManager.lpr
@@ -0,0 +1,24 @@
+program FPDocManager;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, dw_HTML, umakeskel, fMain, fConfig, uCmdLine, uManager, fLogView,
+ fUpdateView, ulpk;
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TMain, Main);
+ Application.CreateForm(TCfgWizard, CfgWizard);
+ Application.CreateForm(TLogView, LogView);
+ Application.CreateForm(TUpdateView, UpdateView);
+ Application.Run;
+end.
+
diff --git a/examples/fpdocmanager/README.txt b/examples/fpdocmanager/README.txt
new file mode 100644
index 0000000000..3532655003
--- /dev/null
+++ b/examples/fpdocmanager/README.txt
@@ -0,0 +1,26 @@
+The FPDoc documentation manager
+===============================
+
+This project simplifies the maintenance of (local) documentation.
+A configuration wizard helps in the setup of the basic RTL, FCL and LCL docs.
+Configuration and output is kept in a single user selectable directory.
+
+A package FPDocEngine is supplied for use in commandline or GUI applications.
+uMakeSkel is a copy of parts of the FPDoc and MakeSkel programs, modified
+with workarounds for known problems with these FPC tools.
+
+Release notes 1.0
+-----------------
+
+The FPDoc Manager requires FPC 2.7 (rev. 19947) for proper operation of the
+FPDoc units.
+
+A package FPDocEngine.lpk has been created for the FPDoc units, please move it
+into your $FPC/utils/fpdoc/ directory and compile the package there.
+
+The project (FPDocManager.lpi) did not fully compile on my machine. Unit
+dw_HTML could not be found, even if all other units of the package worked.
+Adding the unit directly to the project made it compile, please remove or
+update this entry as required, and give hints on how to fix the problem.
+
+DoDi
diff --git a/examples/fpdocmanager/fconfig.lfm b/examples/fpdocmanager/fconfig.lfm
new file mode 100644
index 0000000000..d3524f83a8
--- /dev/null
+++ b/examples/fpdocmanager/fconfig.lfm
@@ -0,0 +1,216 @@
+object CfgWizard: TCfgWizard
+ Left = 362
+ Height = 302
+ Top = 165
+ Width = 318
+ Caption = 'Configuration Assistant'
+ ClientHeight = 302
+ ClientWidth = 318
+ OnShow = FormShow
+ LCLVersion = '0.9.31'
+ object Steps: TPageControl
+ Left = 0
+ Height = 241
+ Top = 0
+ Width = 318
+ ActivePage = MkRTL
+ Align = alClient
+ TabIndex = 2
+ TabOrder = 0
+ object SelRoot: TTabSheet
+ Caption = 'RootDir'
+ ClientHeight = 195
+ ClientWidth = 312
+ OnShow = SelRootShow
+ object Label1: TLabel
+ Left = 10
+ Height = 121
+ Top = 10
+ Width = 264
+ Caption = 'The Root directory contains the configuration '#13#10'and all generated documentation.'#13#10#13#10'You can make this directory the working directory'#13#10'of the Documentation Manager, so that you don''t'#13#10'have to specify the root directory on every start.'#13#10#13#10'Please select this directory now.'
+ ParentColor = False
+ end
+ object buSelRoot: TButton
+ Left = 10
+ Height = 25
+ Top = 152
+ Width = 75
+ Caption = 'Browse...'
+ OnClick = buSelRootClick
+ TabOrder = 0
+ end
+ object edRoot: TEdit
+ Left = 92
+ Height = 23
+ Top = 154
+ Width = 216
+ OnChange = edRootChange
+ TabOrder = 1
+ end
+ end
+ object SelFPDir: TTabSheet
+ Caption = 'FPC'
+ ClientHeight = 195
+ ClientWidth = 312
+ OnShow = SelFPDirShow
+ object Label2: TLabel
+ Left = 10
+ Height = 91
+ 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.'
+ ParentColor = False
+ end
+ object buDownload: TButton
+ Left = 10
+ Height = 25
+ Top = 112
+ Width = 90
+ Caption = 'Download...'
+ Enabled = False
+ TabOrder = 0
+ end
+ object buSelFpc: TButton
+ Left = 12
+ Height = 25
+ Top = 144
+ Width = 75
+ Caption = 'Browse...'
+ OnClick = buSelFpcClick
+ TabOrder = 1
+ end
+ object edFpcDir: TEdit
+ Left = 100
+ Height = 23
+ Top = 144
+ Width = 200
+ Anchors = [akTop, akLeft, akRight]
+ OnChange = edFpcDirChange
+ TabOrder = 2
+ end
+ object Button2: TButton
+ Left = 124
+ Height = 25
+ Top = 112
+ Width = 75
+ Caption = 'Goto LCL'
+ Enabled = False
+ TabOrder = 3
+ end
+ end
+ object MkRTL: TTabSheet
+ Caption = 'RTL'
+ ClientHeight = 213
+ ClientWidth = 310
+ object Label3: TLabel
+ Left = 10
+ Height = 136
+ Top = 10
+ Width = 264
+ Caption = 'Now we''ll create the RTL documentation projects.'#13#10'Please open a console, '#13#10'CD to the FPC documentation directory,'#13#10'and enter "make rtl.chk -n >rtl.bat".'#13#10'Then select the just created file (i.e. rtl.bat), '#13#10'from which the RTL project will be created.'#13#10#13#10'Repeat with "make fcl.chk -n > fcl.bat" '#13#10'and select this file for the FCL project.'
+ ParentColor = False
+ end
+ object buRtlBat: TButton
+ Left = 10
+ Height = 25
+ Top = 152
+ Width = 43
+ Caption = 'RTL'
+ OnClick = buRtlBatClick
+ TabOrder = 0
+ end
+ object edRtlBat: TEdit
+ Left = 60
+ Height = 23
+ Top = 152
+ Width = 238
+ Anchors = [akTop, akLeft, akRight]
+ OnChange = edRtlBatChange
+ TabOrder = 1
+ end
+ object edFclBat: TEdit
+ Left = 60
+ Height = 23
+ Top = 182
+ Width = 238
+ Anchors = [akTop, akLeft, akRight]
+ OnChange = edRtlBatChange
+ TabOrder = 2
+ end
+ object buFclBat: TButton
+ Left = 10
+ Height = 25
+ Top = 182
+ Width = 43
+ Caption = 'FCL'
+ OnClick = buFclBatClick
+ TabOrder = 3
+ end
+ end
+ end
+ object sb: TStatusBar
+ Left = 0
+ Height = 23
+ Top = 279
+ Width = 318
+ Panels = <>
+ end
+ object Panel1: TPanel
+ Left = 0
+ Height = 38
+ Top = 241
+ Width = 318
+ Align = alBottom
+ ClientHeight = 38
+ ClientWidth = 318
+ TabOrder = 2
+ object buBack: TButton
+ Left = 8
+ Height = 25
+ Top = 5
+ Width = 75
+ Caption = 'Back'
+ OnClick = buBackClick
+ TabOrder = 0
+ end
+ object buCancel: TButton
+ Left = 96
+ Height = 25
+ Top = 5
+ Width = 75
+ Cancel = True
+ Caption = 'Cancel'
+ ModalResult = 2
+ TabOrder = 1
+ end
+ object buNext: TButton
+ Left = 230
+ Height = 25
+ Top = 5
+ Width = 75
+ Anchors = [akTop, akRight]
+ Caption = 'Next'
+ OnClick = buNextClick
+ TabOrder = 2
+ end
+ object Button1: TButton
+ Left = 182
+ Height = 25
+ Top = 5
+ Width = 35
+ Anchors = [akTop, akRight]
+ Caption = 'OK'
+ ModalResult = 1
+ TabOrder = 3
+ end
+ end
+ object dlgSelRoot: TSelectDirectoryDialog
+ Title = 'Select Documentation Root Directory'
+ left = 280
+ top = 128
+ end
+ object dlgOpen: TOpenDialog
+ left = 280
+ top = 80
+ end
+end
diff --git a/examples/fpdocmanager/fconfig.pas b/examples/fpdocmanager/fconfig.pas
new file mode 100644
index 0000000000..d7bbb9e7b8
--- /dev/null
+++ b/examples/fpdocmanager/fconfig.pas
@@ -0,0 +1,158 @@
+unit fConfig;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
+ ComCtrls, StdCtrls;
+
+type
+
+ { TCfgWizard }
+
+ TCfgWizard = class(TForm)
+ buBack: TButton;
+ buNext: TButton;
+ buFclBat: TButton;
+ buSelRoot: TButton;
+ buDownload: TButton;
+ buSelFpc: TButton;
+ Button1: TButton;
+ Button2: TButton;
+ buCancel: TButton;
+ buRtlBat: TButton;
+ edFpcDir: TEdit;
+ edRtlBat: TEdit;
+ edRoot: TEdit;
+ edFclBat: TEdit;
+ Label1: TLabel;
+ dlgSelRoot: TSelectDirectoryDialog;
+ Label2: TLabel;
+ Label3: TLabel;
+ dlgOpen: TOpenDialog;
+ Panel1: TPanel;
+ Steps: TPageControl;
+ sb: TStatusBar;
+ SelRoot: TTabSheet;
+ SelFPDir: TTabSheet;
+ MkRTL: TTabSheet;
+ procedure buBackClick(Sender: TObject);
+ procedure buFclBatClick(Sender: TObject);
+ procedure buNextClick(Sender: TObject);
+ procedure buRtlBatClick(Sender: TObject);
+ procedure buSelFpcClick(Sender: TObject);
+ procedure buSelRootClick(Sender: TObject);
+ procedure edFpcDirChange(Sender: TObject);
+ procedure edRootChange(Sender: TObject);
+ procedure edRtlBatChange(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure SelFPDirShow(Sender: TObject);
+ procedure SelRootShow(Sender: TObject);
+ private
+ { private declarations }
+ public
+ { public declarations }
+ end;
+
+var
+ CfgWizard: TCfgWizard;
+
+implementation
+
+uses
+ uManager, uCmdLine;
+
+{$R *.lfm}
+
+{ TCfgWizard }
+
+procedure TCfgWizard.buSelRootClick(Sender: TObject);
+begin
+ dlgSelRoot.Title := 'Documentation Root Directory';
+ if not dlgSelRoot.Execute then
+ exit;
+ edRoot.Text := AppendPathDelim(dlgSelRoot.FileName);
+ //buNext.Enabled := True;
+end;
+
+procedure TCfgWizard.edFpcDirChange(Sender: TObject);
+begin
+ Manager.FpcDocDir := edFpcDir.Text;
+ buNext.Enabled := edFpcDir.Text <> '';
+end;
+
+procedure TCfgWizard.edRootChange(Sender: TObject);
+begin
+ Manager.RootDir:=edRoot.Text;
+ buNext.Enabled := Manager.RootDir <> '';
+end;
+
+procedure TCfgWizard.FormShow(Sender: TObject);
+begin
+ //ModalResult:=mrOK; exits!!!
+ Steps.ActivePage := SelRoot;
+end;
+
+procedure TCfgWizard.SelFPDirShow(Sender: TObject);
+begin
+ edFpcDir.Text := Manager.FpcDocDir;
+ buBack.Enabled := True;
+ //buNext.Enabled := FpcDocDir <> '';
+end;
+
+procedure TCfgWizard.buBackClick(Sender: TObject);
+begin
+ Steps.SelectNextPage(False);
+end;
+
+procedure TCfgWizard.buNextClick(Sender: TObject);
+begin
+ Steps.SelectNextPage(True);
+end;
+
+procedure TCfgWizard.edRtlBatChange(Sender: TObject);
+var
+ fn: string;
+ ed: TEdit absolute Sender;
+begin
+ fn := ed.Text;
+ if fn = '' then
+ exit;
+ uCmdLine.CmdToPrj(fn);
+end;
+
+procedure TCfgWizard.buFclBatClick(Sender: TObject);
+begin
+ dlgOpen.InitialDir := Manager.FpcDocDir;
+ dlgOpen.Title := 'FCL.bat command file';
+ if dlgOpen.Execute then
+ edFclBat.Text := dlgOpen.FileName;
+end;
+
+procedure TCfgWizard.buRtlBatClick(Sender: TObject);
+begin
+ dlgOpen.InitialDir := Manager.FpcDocDir;
+ dlgOpen.Title := 'RTL.bat command file';
+ if dlgOpen.Execute then
+ edRtlBat.Text := dlgOpen.FileName;
+end;
+
+procedure TCfgWizard.buSelFpcClick(Sender: TObject);
+begin
+ dlgSelRoot.Title := 'FPC Documentation Source Directory';
+ if not dlgSelRoot.Execute then
+ exit;
+ edFpcDir.Text := AppendPathDelim(dlgSelRoot.FileName);
+end;
+
+procedure TCfgWizard.SelRootShow(Sender: TObject);
+begin
+ edRoot.Text := Manager.RootDir;
+ buBack.Enabled := False;
+ buNext.Enabled := Manager.RootDir <> '';
+end;
+
+end.
+
diff --git a/examples/fpdocmanager/flogview.lfm b/examples/fpdocmanager/flogview.lfm
new file mode 100644
index 0000000000..8a1a35c164
--- /dev/null
+++ b/examples/fpdocmanager/flogview.lfm
@@ -0,0 +1,20 @@
+object LogView: TLogView
+ Left = 485
+ Height = 394
+ Top = 249
+ Width = 611
+ Caption = 'LogView'
+ ClientHeight = 394
+ ClientWidth = 611
+ OnClose = FormClose
+ LCLVersion = '0.9.31'
+ object edLog: TMemo
+ Left = 0
+ Height = 394
+ Top = 0
+ Width = 611
+ Align = alClient
+ ScrollBars = ssAutoBoth
+ TabOrder = 0
+ end
+end
diff --git a/examples/fpdocmanager/flogview.pas b/examples/fpdocmanager/flogview.pas
new file mode 100644
index 0000000000..fb711ecd27
--- /dev/null
+++ b/examples/fpdocmanager/flogview.pas
@@ -0,0 +1,39 @@
+unit fLogView;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
+
+type
+
+ { TLogView }
+
+ TLogView = class(TForm)
+ edLog: TMemo;
+ procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+ private
+ { private declarations }
+ public
+ { public declarations }
+ end;
+
+var
+ LogView: TLogView;
+
+implementation
+
+{$R *.lfm}
+
+{ TLogView }
+
+procedure TLogView.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+ edLog.Clear;
+ CloseAction := caHide;
+end;
+
+end.
+
diff --git a/examples/fpdocmanager/fmain.lfm b/examples/fpdocmanager/fmain.lfm
new file mode 100644
index 0000000000..ce9ee69bf2
--- /dev/null
+++ b/examples/fpdocmanager/fmain.lfm
@@ -0,0 +1,696 @@
+object Main: TMain
+ Left = 373
+ Height = 290
+ Top = 146
+ Width = 411
+ Align = alClient
+ Caption = 'Main'
+ ClientHeight = 270
+ ClientWidth = 411
+ Menu = MainMenu1
+ OnCloseQuery = FormCloseQuery
+ OnCreate = FormCreate
+ OnResize = FormResize
+ LCLVersion = '0.9.31'
+ object lbPackages: TComboBox
+ Left = 0
+ Height = 270
+ Top = 0
+ Width = 94
+ Align = alLeft
+ ItemHeight = 15
+ OnSelect = lbPackagesClick
+ Style = csSimple
+ TabOrder = 0
+ end
+ object Units: TPageControl
+ Left = 94
+ Height = 270
+ Top = 0
+ Width = 317
+ ActivePage = TabSheet2
+ Align = alClient
+ TabIndex = 1
+ TabOrder = 1
+ object ViewXML: TTabSheet
+ Caption = 'Project'
+ ClientHeight = 242
+ ClientWidth = 309
+ inline edXML: TSynEdit
+ Left = 0
+ Height = 242
+ Top = 0
+ Width = 309
+ Align = alClient
+ Font.Height = -13
+ Font.Name = 'Courier New'
+ Font.Pitch = fpFixed
+ Font.Quality = fqNonAntialiased
+ ParentColor = False
+ ParentFont = False
+ TabOrder = 0
+ OnExit = edXMLExit
+ Gutter.Visible = False
+ Gutter.Width = 57
+ Gutter.MouseActions = <>
+ RightGutter.Width = 0
+ RightGutter.MouseActions = <>
+ Highlighter = SynXMLSyn1
+ Keystrokes = <
+ item
+ Command = ecUp
+ ShortCut = 38
+ end
+ item
+ Command = ecSelUp
+ ShortCut = 8230
+ end
+ item
+ Command = ecScrollUp
+ ShortCut = 16422
+ end
+ item
+ Command = ecDown
+ ShortCut = 40
+ end
+ item
+ Command = ecSelDown
+ ShortCut = 8232
+ end
+ item
+ Command = ecScrollDown
+ ShortCut = 16424
+ end
+ item
+ Command = ecLeft
+ ShortCut = 37
+ end
+ item
+ Command = ecSelLeft
+ ShortCut = 8229
+ end
+ item
+ Command = ecWordLeft
+ ShortCut = 16421
+ end
+ item
+ Command = ecSelWordLeft
+ ShortCut = 24613
+ end
+ item
+ Command = ecRight
+ ShortCut = 39
+ end
+ item
+ Command = ecSelRight
+ ShortCut = 8231
+ end
+ item
+ Command = ecWordRight
+ ShortCut = 16423
+ end
+ item
+ Command = ecSelWordRight
+ ShortCut = 24615
+ end
+ item
+ Command = ecPageDown
+ ShortCut = 34
+ end
+ item
+ Command = ecSelPageDown
+ ShortCut = 8226
+ end
+ item
+ Command = ecPageBottom
+ ShortCut = 16418
+ end
+ item
+ Command = ecSelPageBottom
+ ShortCut = 24610
+ end
+ item
+ Command = ecPageUp
+ ShortCut = 33
+ end
+ item
+ Command = ecSelPageUp
+ ShortCut = 8225
+ end
+ item
+ Command = ecPageTop
+ ShortCut = 16417
+ end
+ item
+ Command = ecSelPageTop
+ ShortCut = 24609
+ end
+ item
+ Command = ecLineStart
+ ShortCut = 36
+ end
+ item
+ Command = ecSelLineStart
+ ShortCut = 8228
+ end
+ item
+ Command = ecEditorTop
+ ShortCut = 16420
+ end
+ item
+ Command = ecSelEditorTop
+ ShortCut = 24612
+ end
+ item
+ Command = ecLineEnd
+ ShortCut = 35
+ end
+ item
+ Command = ecSelLineEnd
+ ShortCut = 8227
+ end
+ item
+ Command = ecEditorBottom
+ ShortCut = 16419
+ end
+ item
+ Command = ecSelEditorBottom
+ ShortCut = 24611
+ end
+ item
+ Command = ecToggleMode
+ ShortCut = 45
+ end
+ item
+ Command = ecCopy
+ ShortCut = 16429
+ end
+ item
+ Command = ecPaste
+ ShortCut = 8237
+ end
+ item
+ Command = ecDeleteChar
+ ShortCut = 46
+ end
+ item
+ Command = ecCut
+ ShortCut = 8238
+ end
+ item
+ Command = ecDeleteLastChar
+ ShortCut = 8
+ end
+ item
+ Command = ecDeleteLastChar
+ ShortCut = 8200
+ end
+ item
+ Command = ecDeleteLastWord
+ ShortCut = 16392
+ end
+ item
+ Command = ecUndo
+ ShortCut = 32776
+ end
+ item
+ Command = ecRedo
+ ShortCut = 40968
+ end
+ item
+ Command = ecLineBreak
+ ShortCut = 13
+ end
+ item
+ Command = ecSelectAll
+ ShortCut = 16449
+ end
+ item
+ Command = ecCopy
+ ShortCut = 16451
+ end
+ item
+ Command = ecBlockIndent
+ ShortCut = 24649
+ end
+ item
+ Command = ecLineBreak
+ ShortCut = 16461
+ end
+ item
+ Command = ecInsertLine
+ ShortCut = 16462
+ end
+ item
+ Command = ecDeleteWord
+ ShortCut = 16468
+ end
+ item
+ Command = ecBlockUnindent
+ ShortCut = 24661
+ end
+ item
+ Command = ecPaste
+ ShortCut = 16470
+ end
+ item
+ Command = ecCut
+ ShortCut = 16472
+ end
+ item
+ Command = ecDeleteLine
+ ShortCut = 16473
+ end
+ item
+ Command = ecDeleteEOL
+ ShortCut = 24665
+ end
+ item
+ Command = ecUndo
+ ShortCut = 16474
+ end
+ item
+ Command = ecRedo
+ ShortCut = 24666
+ end
+ item
+ Command = ecGotoMarker0
+ ShortCut = 16432
+ end
+ item
+ Command = ecGotoMarker1
+ ShortCut = 16433
+ end
+ item
+ Command = ecGotoMarker2
+ ShortCut = 16434
+ end
+ item
+ Command = ecGotoMarker3
+ ShortCut = 16435
+ end
+ item
+ Command = ecGotoMarker4
+ ShortCut = 16436
+ end
+ item
+ Command = ecGotoMarker5
+ ShortCut = 16437
+ end
+ item
+ Command = ecGotoMarker6
+ ShortCut = 16438
+ end
+ item
+ Command = ecGotoMarker7
+ ShortCut = 16439
+ end
+ item
+ Command = ecGotoMarker8
+ ShortCut = 16440
+ end
+ item
+ Command = ecGotoMarker9
+ ShortCut = 16441
+ end
+ item
+ Command = ecSetMarker0
+ ShortCut = 24624
+ end
+ item
+ Command = ecSetMarker1
+ ShortCut = 24625
+ end
+ item
+ Command = ecSetMarker2
+ ShortCut = 24626
+ end
+ item
+ Command = ecSetMarker3
+ ShortCut = 24627
+ end
+ item
+ Command = ecSetMarker4
+ ShortCut = 24628
+ end
+ item
+ Command = ecSetMarker5
+ ShortCut = 24629
+ end
+ item
+ Command = ecSetMarker6
+ ShortCut = 24630
+ end
+ item
+ Command = ecSetMarker7
+ ShortCut = 24631
+ end
+ item
+ Command = ecSetMarker8
+ ShortCut = 24632
+ end
+ item
+ Command = ecSetMarker9
+ ShortCut = 24633
+ end
+ item
+ Command = EcFoldLevel1
+ ShortCut = 41009
+ end
+ item
+ Command = EcFoldLevel2
+ ShortCut = 41010
+ end
+ item
+ Command = EcFoldLevel1
+ ShortCut = 41011
+ end
+ item
+ Command = EcFoldLevel1
+ ShortCut = 41012
+ end
+ item
+ Command = EcFoldLevel1
+ ShortCut = 41013
+ end
+ item
+ Command = EcFoldLevel6
+ ShortCut = 41014
+ end
+ item
+ Command = EcFoldLevel7
+ ShortCut = 41015
+ end
+ item
+ Command = EcFoldLevel8
+ ShortCut = 41016
+ end
+ item
+ Command = EcFoldLevel9
+ ShortCut = 41017
+ end
+ item
+ Command = EcFoldLevel0
+ ShortCut = 41008
+ end
+ item
+ Command = EcFoldCurrent
+ ShortCut = 41005
+ end
+ item
+ Command = EcUnFoldCurrent
+ ShortCut = 41003
+ end
+ item
+ Command = EcToggleMarkupWord
+ ShortCut = 32845
+ end
+ item
+ Command = ecNormalSelect
+ ShortCut = 24654
+ end
+ item
+ Command = ecColumnSelect
+ ShortCut = 24643
+ end
+ item
+ Command = ecLineSelect
+ ShortCut = 24652
+ end
+ item
+ Command = ecTab
+ ShortCut = 9
+ end
+ item
+ Command = ecShiftTab
+ ShortCut = 8201
+ end
+ item
+ Command = ecMatchBracket
+ ShortCut = 24642
+ end
+ item
+ Command = ecColSelUp
+ ShortCut = 40998
+ end
+ item
+ Command = ecColSelDown
+ ShortCut = 41000
+ end
+ item
+ Command = ecColSelLeft
+ ShortCut = 40997
+ end
+ item
+ Command = ecColSelRight
+ ShortCut = 40999
+ end
+ item
+ Command = ecColSelPageDown
+ ShortCut = 40994
+ end
+ item
+ Command = ecColSelPageBottom
+ ShortCut = 57378
+ end
+ item
+ Command = ecColSelPageUp
+ ShortCut = 40993
+ end
+ item
+ Command = ecColSelPageTop
+ ShortCut = 57377
+ end
+ item
+ Command = ecColSelLineStart
+ ShortCut = 40996
+ end
+ item
+ Command = ecColSelLineEnd
+ ShortCut = 40995
+ end
+ item
+ Command = ecColSelEditorTop
+ ShortCut = 57380
+ end
+ item
+ Command = ecColSelEditorBottom
+ ShortCut = 57379
+ end>
+ MouseActions = <>
+ MouseSelActions = <>
+ Lines.Strings = (
+ ''
+ )
+ VisibleSpecialChars = [vscSpace, vscTabAtLast]
+ BracketHighlightStyle = sbhsBoth
+ inline SynLeftGutterPartList1: TSynGutterPartList
+ object SynGutterMarks1: TSynGutterMarks
+ Width = 24
+ MouseActions = <>
+ end
+ object SynGutterLineNumber1: TSynGutterLineNumber
+ Width = 17
+ MouseActions = <>
+ MarkupInfo.Background = clBtnFace
+ MarkupInfo.Foreground = clNone
+ DigitCount = 2
+ ShowOnlyLineNumbersMultiplesOf = 1
+ ZeroStart = False
+ LeadingZeros = False
+ end
+ object SynGutterChanges1: TSynGutterChanges
+ Width = 4
+ MouseActions = <>
+ ModifiedColor = 59900
+ SavedColor = clGreen
+ end
+ object SynGutterSeparator1: TSynGutterSeparator
+ Width = 2
+ MouseActions = <>
+ end
+ object SynGutterCodeFolding1: TSynGutterCodeFolding
+ MouseActions = <>
+ MarkupInfo.Background = clNone
+ MarkupInfo.Foreground = clGray
+ MouseActionsExpanded = <>
+ MouseActionsCollapsed = <>
+ end
+ end
+ end
+ end
+ object TabSheet2: 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
+ end
+ object MainMenu1: TMainMenu
+ left = 10
+ top = 10
+ object MenuItem1: TMenuItem
+ Caption = '&File'
+ object mnConfig: TMenuItem
+ Caption = '&Config'
+ OnClick = mnConfigClick
+ end
+ object MenuItem3: TMenuItem
+ Caption = '-'
+ end
+ object mnExit: TMenuItem
+ Caption = 'E&xit'
+ OnClick = mnExitClick
+ end
+ end
+ object mnPackage: TMenuItem
+ Caption = 'P&ackage'
+ object mnImportLpk: TMenuItem
+ Caption = 'Import &LPK'
+ OnClick = mnImportLpkClick
+ end
+ end
+ end
+ object dlgSelRoot: TSelectDirectoryDialog
+ Title = 'Select Common Documentation Directory'
+ left = 16
+ top = 80
+ end
+ object SynXMLSyn1: TSynXMLSyn
+ DefaultFilter = 'XML Document (*.xml,*.xsd,*.xsl,*.xslt,*.dtd)|*.xml;*.xsd;*.xsl;*.xslt;*.dtd'
+ Enabled = False
+ ElementAttri.FrameEdges = sfeAround
+ AttributeAttri.FrameEdges = sfeAround
+ NamespaceAttributeAttri.FrameEdges = sfeAround
+ AttributeValueAttri.FrameEdges = sfeAround
+ NamespaceAttributeValueAttri.FrameEdges = sfeAround
+ TextAttri.FrameEdges = sfeAround
+ CDATAAttri.FrameEdges = sfeAround
+ EntityRefAttri.FrameEdges = sfeAround
+ ProcessingInstructionAttri.FrameEdges = sfeAround
+ CommentAttri.FrameEdges = sfeAround
+ DocTypeAttri.FrameEdges = sfeAround
+ SpaceAttri.FrameEdges = sfeAround
+ SymbolAttri.FrameEdges = sfeAround
+ WantBracesParsed = False
+ left = 24
+ top = 144
+ end
+ object dlgSelLpk: TOpenDialog
+ Title = 'Open Lazarus package file'
+ Filter = 'Lazarus Package|*.lpk'
+ Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
+ left = 16
+ top = 200
+ end
+end
diff --git a/examples/fpdocmanager/fmain.pas b/examples/fpdocmanager/fmain.pas
new file mode 100644
index 0000000000..6b894c35c2
--- /dev/null
+++ b/examples/fpdocmanager/fmain.pas
@@ -0,0 +1,391 @@
+unit fMain;
+(* Documentation manager GUI.
+ View/Edit configuration, packages
+ Add/Import packages
+ Create/Update skeletons
+ Create documentation (final, test)
+*)
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, SynHighlighterXML, SynEdit, Forms,
+ Controls, Graphics, Dialogs, Menus, StdCtrls, ComCtrls,
+ uManager;
+
+type
+
+ { TMain }
+
+ TMain = class(TForm)
+ buSkel: TButton;
+ buUpdate: TButton;
+ buRefresh: TButton;
+ buShowLog: TButton;
+ buTest: TButton;
+ dlgSelLpk: TOpenDialog;
+ swShowUpdate: TCheckBox;
+ edLog: TEdit;
+ lbPackages: TComboBox;
+ edUnit: TEdit;
+ GroupBox1: TGroupBox;
+ lbUnits: TListBox;
+ MainMenu1: TMainMenu;
+ MenuItem1: TMenuItem;
+ mnImportLpk: TMenuItem;
+ mnPackage: TMenuItem;
+ mnConfig: TMenuItem;
+ MenuItem3: TMenuItem;
+ mnExit: TMenuItem;
+ dlgSelRoot: TSelectDirectoryDialog;
+ Units: TPageControl;
+ swAll: TRadioButton;
+ swSingle: TRadioButton;
+ edXML: TSynEdit;
+ SynXMLSyn1: TSynXMLSyn;
+ ViewXML: TTabSheet;
+ TabSheet2: TTabSheet;
+ procedure buRefreshClick(Sender: TObject);
+ procedure buTestClick(Sender: TObject);
+ procedure edLogChange(Sender: TObject);
+ procedure edXMLExit(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
+ procedure FormCreate(Sender: TObject);
+ procedure FormResize(Sender: TObject);
+ procedure lbPackagesClick(Sender: TObject);
+ procedure lbUnitsClick(Sender: TObject);
+ procedure mnConfigClick(Sender: TObject);
+ procedure mnExitClick(Sender: TObject);
+ procedure mnImportLpkClick(Sender: TObject);
+ procedure swShowUpdateChange(Sender: TObject);
+ procedure swSingleClick(Sender: TObject);
+ private
+ LogName: string;
+ LogFile: TStream;
+ procedure ProjectsChanged(Sender: TObject);
+ procedure LogToFile(Sender: TObject; const msg: string);
+ procedure LogToMsgBox(Sender: TObject; const msg: string);
+ procedure LogStart;
+ procedure LogDone;
+ procedure ShowUpdate;
+ procedure OnParseImport(Sender: TObject; var ASource, ALink: string);
+ public
+ CurPkg: TDocPackage;
+ CurUnit: string;
+ procedure UpdateDocs;
+ end;
+
+var
+ Main: TMain;
+
+implementation
+
+uses
+ fConfig, fLogView, fUpdateView,
+ //dw_HTML, //more writers?
+ uLpk;
+
+{$R *.lfm}
+
+{ TMain }
+
+procedure TMain.FormCreate(Sender: TObject);
+var
+ r: TRect;
+ s: string;
+ l: TStringList;
+begin
+ Manager := TFPDocManager.Create(self);
+ Manager.OnChange := @ProjectsChanged;
+ if not Manager.LoadConfig(GetCurrentDir) then begin
+ //query root directory
+ if not dlgSelRoot.Execute then
+ exit;
+ if not Manager.LoadConfig(dlgSelRoot.FileName, True) then begin
+ //InitConfig(dlgSelRoot.FileName); ?
+ mnConfigClick(self); //does an UpdateDocs
+ exit; //nothing to init from?
+ end;
+ end;
+//init...
+ if Manager.Config.SectionExists('GUI') then begin
+ s := Manager.Config.ReadString('GUI', 'position', '');
+ if s <> '' then begin
+ l := TStringList.Create;
+ try
+ l.DelimitedText := s;
+ if l.Count = 4 then begin
+ //SetBounds(l[0], l[1], );
+ r.Left := StrToInt(l[0]);
+ r.Top := StrToInt(l[1]);
+ r.Right := StrToInt(l[2]);
+ r.Bottom:= StrToInt(l[3]);
+ BoundsRect := r;
+ end;
+ finally
+ l.Free;
+ end;
+ end;
+ end;
+end;
+
+procedure TMain.FormResize(Sender: TObject);
+var
+ r: TRect;
+begin
+ r := BoundsRect;
+ Manager.Config.WriteString('GUI', 'position', Format('%d,%d,%d,%d',[r.Left, r.Top, r.Right, r.Bottom]));
+end;
+
+// --------------- events ------------------
+
+procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: boolean);
+begin
+//is this really required?
+ //CanClose :=
+ Manager.SaveConfig; //what if fails?
+end;
+
+procedure TMain.mnExitClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TMain.swShowUpdateChange(Sender: TObject);
+begin
+ if swShowUpdate.Checked then
+ ShowUpdate;
+end;
+
+procedure TMain.edLogChange(Sender: TObject);
+begin
+ LogName:=edLog.Text;
+end;
+
+procedure TMain.LogStart;
+begin
+ if LogName = '' then
+ edLog.Text := Manager.RootDir + 'doclog.txt';
+ LogFile.Free;
+ LogFile := TFileStream.Create(LogName, fmCreate); //fmWrite
+ Manager.OnLog := @LogToFile;
+ //Manager.OnImport:=@OnParseImport;
+end;
+
+procedure TMain.LogDone;
+begin
+ if not assigned(LogFile) then
+ exit;
+ FreeAndNil(LogFile);
+ Manager.OnLog := @LogToMsgBox;
+//view messages
+ LogView.Caption := 'View ' + LogName;
+ LogView.edLog.Lines.LoadFromFile(LogName); //direct log???
+ LogView.Show;
+end;
+
+procedure TMain.ShowUpdate;
+var
+ v: TUpdateView;
+ fn: string;
+begin
+ if not swShowUpdate.Checked then
+ exit;
+ if lbUnits.ItemIndex < 0 then
+ exit;
+ fn := 'upd.' + edUnit.Text + '.xml';
+ if not FileExists(fn) then
+ exit;
+//problem with files kept open???
+ if UpdateView = nil then
+ v := TUpdateView.Create(self)
+ else
+ v := UpdateView;
+ v.Caption := 'Update of ' + edUnit.Text;
+ v.edUpdate.Lines.LoadFromFile(fn);
+ v.Show;
+end;
+
+procedure TMain.LogToFile(Sender: TObject; const msg: string);
+var
+ s: string;
+begin
+ if assigned(LogFile) then begin
+ s := msg + LineEnding;
+ LogFile.WriteBuffer(s[1], Length(s))
+ end
+ else
+ LogToMsgBox(Sender, msg);
+end;
+
+procedure TMain.LogToMsgBox(Sender: TObject; const msg: string);
+begin
+ ShowMessage(msg);
+end;
+
+procedure TMain.OnParseImport(Sender: TObject; var ASource, ALink: string);
+var
+ i: integer;
+ pn: string;
+begin
+(* Provide ASource-->content file, ALink depends on format.
+ ASource can be a package name (only), or a CSV spec.
+ Sender is Manager.
+An extended model could store a list of required packages,
+and provide the list of imports.
+*)
+ i := Pos(',', ASource);
+ if i > 0 then
+ exit; //default format, handled by caller
+ pn := ExtractFileNameOnly(ASource);
+ ASource := Manager.RootDir + pn + '.xct';
+ //if Manager.Options.??? - where's the output format?
+ ALink := '../' + pn + '/';
+end;
+
+procedure TMain.ProjectsChanged(Sender: TObject);
+begin
+ UpdateDocs; //immediately or delayed (OnIdle?)
+end;
+
+procedure TMain.UpdateDocs;
+var
+ i: integer;
+begin
+ lbPackages.Clear;
+ for i := 0 to Manager.Projects.Count - 1 do begin
+ lbPackages.AddItem(Manager.Projects.Names[i], Manager.Projects.Objects[i]);
+ end;
+end;
+
+procedure TMain.mnConfigClick(Sender: TObject);
+begin
+ Manager.BeginUpdate;
+ if CfgWizard.ShowModal <> mrCancel then begin
+ //UpdateDocs; - by Manager!?
+ //Manager.Config.;
+ end;
+ Manager.EndUpdate;
+end;
+
+// ---------------- pages ------------------
+
+procedure TMain.lbPackagesClick(Sender: TObject);
+var
+ i: integer;
+ pkg: TDocPackage;
+ fn: string;
+begin
+ i := lbPackages.ItemIndex; //clicked?
+ pkg := lbPackages.Items.Objects[i] as TDocPackage;
+ if pkg = nil then
+ exit; //not really created?
+ fn := pkg.ProjectFile; //initialized where?
+ if fn <> '' then
+ edXML.Lines.LoadFromFile(fn);
+ //load units...
+ lbUnits.Items.BeginUpdate;
+ lbUnits.Clear;
+ for i := 0 to pkg.Units.Count - 1 do begin
+ //fn := Manager.UnitName(pkg.Inputs, i);
+ fn := pkg.Units.Names[i];
+ lbUnits.AddItem(fn, nil);
+ end;
+ lbUnits.Sorted := True;
+ lbUnits.Items.EndUpdate;
+//remember selection
+ CurPkg := pkg;
+ CurUnit:='';
+end;
+
+procedure TMain.mnImportLpkClick(Sender: TObject);
+var
+ pkName, pkPrj: string;
+begin
+ if not dlgSelLpk.Execute then
+ exit;
+ pkName:=dlgSelLpk.FileName;
+ Manager.ImportLpk(pkName);
+{
+ Manager.BeginUpdate;
+ try
+ if not uLpk.ImportLpk(pkName) then begin
+ LogToMsgBox(self, 'Import failed on ' + pkName);
+ exit;
+ end;
+ //create project file - preprocess options!?
+ pkPrj:=ChangeFileExt(pkName, '.xml');
+ Manager.CreateProject(pkPrj, Manager.SelectedPackage);
+ finally
+ Manager.EndUpdate; //not modified???
+ end;
+//
+}
+end;
+
+procedure TMain.edXMLExit(Sender: TObject);
+begin
+ if edXML.Modified then begin
+ case MessageDlg('Project was changed', 'Save changes?',
+ mtConfirmation, mbYesNoCancel, 0) of
+ mrYes: edXML.Lines.SaveToFile(CurPkg.ProjectFile);
+ mrNo: exit;
+ else
+ edXML.SetFocus;
+ end;
+ end;
+end;
+
+// ------------------- actions ----------------------
+
+procedure TMain.lbUnitsClick(Sender: TObject);
+var
+ i: integer;
+begin
+ i := lbUnits.ItemIndex;
+ if i < 0 then
+ CurUnit := ''
+ else
+ CurUnit := lbUnits.Items[i];
+ edUnit.Text := CurUnit; //further depends on swSingle
+ swSingle.Checked := True; //assume test single unit
+ ShowUpdate;
+end;
+
+procedure TMain.swSingleClick(Sender: TObject);
+begin
+ edUnit.Enabled := swSingle.Checked;
+end;
+
+(* FPDoc dry run, with logfile
+*)
+procedure TMain.buTestClick(Sender: TObject);
+var
+ u: string;
+begin
+ LogStart;
+ if swSingle.Checked then
+ u := CurUnit
+ else
+ u := '';
+ Manager.TestRun(CurPkg, u);
+ LogDone;
+end;
+
+procedure TMain.buRefreshClick(Sender: TObject);
+var
+ u: string;
+begin
+ LogStart;
+ if swSingle.Checked then
+ u := CurUnit
+ else
+ u := '';
+ Manager.Update(CurPkg, u);
+ LogDone;
+end;
+
+end.
+
diff --git a/examples/fpdocmanager/fpdocengine.lpk b/examples/fpdocmanager/fpdocengine.lpk
new file mode 100644
index 0000000000..b993e356b9
--- /dev/null
+++ b/examples/fpdocmanager/fpdocengine.lpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/fpdocmanager/fupdateview.lfm b/examples/fpdocmanager/fupdateview.lfm
new file mode 100644
index 0000000000..4ff79a6ccd
--- /dev/null
+++ b/examples/fpdocmanager/fupdateview.lfm
@@ -0,0 +1,19 @@
+object UpdateView: TUpdateView
+ Left = 369
+ Height = 273
+ Top = 480
+ Width = 421
+ Caption = 'UpdateView'
+ ClientHeight = 273
+ ClientWidth = 421
+ LCLVersion = '0.9.31'
+ object edUpdate: TMemo
+ Left = 0
+ Height = 273
+ Top = 0
+ Width = 421
+ Align = alClient
+ ScrollBars = ssAutoBoth
+ TabOrder = 0
+ end
+end
diff --git a/examples/fpdocmanager/fupdateview.pas b/examples/fpdocmanager/fupdateview.pas
new file mode 100644
index 0000000000..3c6a78e1e8
--- /dev/null
+++ b/examples/fpdocmanager/fupdateview.pas
@@ -0,0 +1,30 @@
+unit fUpdateView;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
+
+type
+
+ { TUpdateView }
+
+ TUpdateView = class(TForm)
+ edUpdate: TMemo;
+ private
+ { private declarations }
+ public
+ { public declarations }
+ end;
+
+var
+ UpdateView: TUpdateView;
+
+implementation
+
+{$R *.lfm}
+
+end.
+
diff --git a/examples/fpdocmanager/ucmdline.pas b/examples/fpdocmanager/ucmdline.pas
new file mode 100644
index 0000000000..2c012e4326
--- /dev/null
+++ b/examples/fpdocmanager/ucmdline.pas
@@ -0,0 +1,57 @@
+unit uCmdLine;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+function CmdToPrj(const AFileName: string): boolean;
+
+implementation
+
+uses
+ uManager, umakeskel;
+
+(* Create an project file from an FPDoc commandline
+*)
+function CmdToPrj(const AFileName: string): boolean;
+var
+ lst: TStringList;
+ l, w: string;
+ prj: TFPDocMaker;
+begin
+(* Need a temporary project, that only includes the given files etc.
+*)
+ Result := False; //in case of errors
+ lst := TStringList.Create;
+ prj := TFPDocMaker.Create(nil);
+ //prj.OnLog := @prj.LogToStdOut; -->ShowMsg???
+ try
+ lst.LoadFromFile(AFileName);
+ l := lst[0];
+ w := GetNextWord(l);
+ if w <> 'fpdoc' then
+ exit; //expected fpdoc command
+ while l <> '' do begin
+ w := GetNextWord(l);
+ prj.ParseFPDocOption(w);
+ end;
+ w := prj.SelectedPackage.Name;
+ if w = '' then
+ exit; //no project name???
+ l := ChangeFileExt(AFileName, '_prj.xml'); //same directory!!!
+ Result := prj.CreateProject(l, prj.SelectedPackage);
+ //now load the project into the manager
+ if Result then
+ //add package/project to the manager
+ Manager.AddProject(w, l, True); //.Packages.Add(w + '=' + l);
+ finally
+ prj.Free;
+ lst.Free;
+ end;
+end;
+
+end.
+
diff --git a/examples/fpdocmanager/ulpk.pp b/examples/fpdocmanager/ulpk.pp
new file mode 100644
index 0000000000..2f2f3fdf24
--- /dev/null
+++ b/examples/fpdocmanager/ulpk.pp
@@ -0,0 +1,145 @@
+unit uLpk;
+(* Convert LPK package into FPDoc project/package.
+Relevant entries:
+ //here: rename into LCL
+ //-Fi
+ //-Fu
+ ???
+ //Item1..Item291
+ //ignore .inc etc.
+
+
+ //required
+*)
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils,
+ uManager;
+
+//function ImportLpk(const AFile: string): boolean;
+function ImportLpk(const AFile: string): TDocPackage;
+
+implementation
+
+//uses
+
+type
+ eKey = (kvEof, kvName, kvIncl, kvOther, kvFilename, kvDocPaths, kvReq
+ );
+const
+ aKey: array[eKey] of string = (
+ '', 'Name', 'IncludeFiles', 'OtherUnitFiles',
+ 'Filename', 'LazDoc' ,'PackageName'
+ );
+ FirstKeys = 'NIOFLP';
+
+var
+ f: TextFile;
+ ln, value, ext: string;
+ lt, eq, q2: integer;
+ key: eKey;
+
+function ImportCompiled(const LpkFile: string): boolean;
+var
+ mfc: string;
+ f: TextFile;
+begin
+ mfc := ExtractFilePath(LpkFile) + 'Makefile.compiled';
+ Result := FileExists(mfc);
+ if not Result then
+ exit;
+//import Makefile.compiled
+ AssignFile(f, mfc);
+ Reset(f);
+ try
+ //parse
+ ReadLn(f, ln);
+ //todo...
+ finally
+ CloseFile(f);
+ end;
+end;
+
+function GetLine: boolean;
+var
+ i: integer;
+begin
+ while not EOF(f) do begin
+ ReadLn(f, ln);
+ //get key
+ lt := Pos('<', ln);
+ if lt <= 0 then
+ continue;
+ //filter key
+ i := Pos(ln[lt+1], FirstKeys);
+ if i < 1 then
+ continue;
+ key := eKey(i);
+ if Copy(ln, lt+1, Length(aKey[key])) <> aKey[key] then
+ continue;
+ //check value
+ eq := Pos('=', ln);
+ if (eq <= lt) or (ln[eq+1] <> '"') then
+ continue;
+ q2 := Length(ln) - 2;
+ if ln[q2] <> '"' then
+ continue;
+ value:=Copy(ln, eq+2, q2-eq-2);
+ exit(True);
+ end;
+ Result := False;
+end;
+
+function ImportLpk(const AFile: string): TDocPackage;
+var
+ pkg: TDocPackage;
+begin
+ Result := Nil; // False; //assume fail
+ AssignFile(f, AFile);
+ Reset(f);
+ try
+ //read lines
+ //get Name
+ if not GetLine or (key <> kvName) then
+ exit; //missing package name
+ //fix case and LCLBase
+ value := LowerCase(value);
+ if value = 'lclbase' then
+ value := 'lcl';
+ pkg := Manager.AddPackage(value);
+ pkg.LazPkg := AFile;
+ //Manager.Package := pkg; //!DocPkg
+ //remaining keys
+ while GetLine do begin
+ case key of
+ kvName: ; //ignore any but first occurence
+ kvIncl: pkg.IncludePath:=value;
+ kvOther: pkg.UnitPath := value;
+ kvFilename:
+ begin
+ ext := ExtractFileExt(value);
+ if (ext = '.pas') or (ext = '.pp') then
+ pkg.Units.Add(value); //!!! no dupes!?
+ end;
+ kvDocPaths: pkg.DescrDir := value;
+ kvReq: pkg.Requires.Add(LowerCase(value));
+ {
+ begin
+ ext := Manager.RootDir + '/' + value + ',../' + value;
+ pkg.Imports.Add(ext);
+ end;
+ }
+ end;
+ end;
+ Result := pkg; // True;
+ finally
+ CloseFile(f);
+ end;
+end;
+
+end.
+
diff --git a/examples/fpdocmanager/umakeskel.pas b/examples/fpdocmanager/umakeskel.pas
new file mode 100644
index 0000000000..33b04779b6
--- /dev/null
+++ b/examples/fpdocmanager/umakeskel.pas
@@ -0,0 +1,1176 @@
+{
+
+ FPDoc - Free Pascal Documentation Tool
+ Copyright (C) 2000 - 2003 by
+ Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
+
+ * Skeleton XML description file generator
+
+ See the file COPYING, included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+(* --- Version 1.0 ---
+The TFPDocMaker class shall support the following functionality:
+- Project generation from a commandline.
+- FPDoc documentation generation, optionally syntax check only.
+- MakeSkel skeleton generation or update.
+
+Everything else is done in a separate documentation manager.
+The documentation manager maintains its own projects
+and creates temporary TFPDocProjects and TFPDocPackages on demand.
+*)
+
+(* Version 0.0 - requires patched FPDoc units!
+The TFPDocMaker class supports the following functionality:
+- documentation generation (FPDoc),
+ - for all units in a package
+ - for a selected unit (optionally syntax check only)
+- project generation
+ - from input and description directories
+ - from a commandline
+- skeleton generation
+ - for all units in a package
+ - for selected unit (MakeSkel)
+- documentation sync with source (MakeSkel UpdateMode)
+ - for all units in a package
+ - output into one or more files
+ - for selected unit
+- skeleton and sync at once
+*)
+unit umakeskel;
+
+interface
+
+{$mode objfpc}
+{$h+}
+
+uses
+ SysUtils, Classes, Gettext,
+ dGlobals, PasTree, PParser,PScanner,
+ mkfpdoc, fpdocproj;
+
+resourcestring
+ STitle = 'MakeSkel - FPDoc skeleton XML description file generator';
+ SVersion = 'Version %s [%s]';
+ SCopyright = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org';
+ SCmdLineHelp = 'See documentation for usage.';
+ SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
+ SNoPackageNameProvided = 'Please specify a package name with --package=';
+ SOutputMustNotBeDescr = 'Output file must be different from description filenames.';
+ SCreatingNewNode = 'Creating documentation for new node : %s';
+ SNodeNotReferenced = 'Documentation node "%s" no longer used';
+ SDone = 'Done.';
+
+type
+ TCmdLineAction = (actionHelp, actionConvert);
+
+ TCmdOptions = class(TEngineOptions)
+ public
+ WriteDeclaration,
+ UpdateMode,
+ SortNodes,
+ DisableOverride,
+ DisableErrors,
+ DisableSeealso,
+ DisableArguments,
+ DisableProtected,
+ DisablePrivate,
+ DisableFunctionResults: Boolean;
+ EmitClassSeparator: Boolean;
+ end;
+
+ { TSkelEngine }
+
+ TSkelEngine = class(TFPDocEngine)
+ Private
+ FEmittedList,
+ FNodeList,
+ FModules : TStringList;
+ FOptions: TCmdOptions;
+ Procedure DoWriteUnReferencedNodes(N : TDocNode; NodePath : String);
+ procedure SetOptions(AValue: TCmdOptions);
+ public
+ Destructor Destroy; override;
+ Function MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
+ Function WriteElement(Var F : Text; El : TPasElement; ADocNode : TDocNode) : Boolean;
+ function FindModule(const AName: String): TPasModule; override;
+ function CreateElement(AClass: TPTreeElement; const AName: String;
+ AParent: TPasElement; AVisibility :TPasMemberVisibility;
+ const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement; override;
+ procedure WriteUnReferencedNodes;
+ Procedure WriteNodes(Var F : Text; AModule : TPasModule; List : TStrings);
+ Procedure DocumentFile(Var F : Text; Const AFileName,ATarget,ACPU : String);
+ Property NodeList : TStringList Read FNodeList;
+ Property EmittedList : TStringList Read FEmittedList;
+ property Options: TCmdOptions read FOptions write SetOptions;
+ end;
+
+ THandleOption = function(const Cmd, Arg: string): boolean;
+
+ TCreatorAction = (
+ caDefault,
+ caDryRun,
+ caUsage, //explicit or on all errors?
+ caInvalid,
+ caWriteProject
+ );
+
+ { TFPDocMaker }
+(* MakeSkel functionality as a class.
+*)
+ TFPDocMaker = class(TFPDocCreator)
+ private
+ FDescrDir: string;
+ FInputDir: string;
+ FOnOption: THandleOption;
+ FOptions: TCmdOptions;
+ function GetDescrDir: string;
+ function GetInputDir: string;
+ procedure SetDescrDir(AValue: string);
+ procedure SetInputDir(AValue: string);
+ procedure SetOnOption(AValue: THandleOption);
+ procedure SetOptions(AValue: TCmdOptions);
+ protected
+ FCmdAction: TCreatorAction;
+ FDryRun: boolean;
+ FPackage: TFPDocPackage;
+ FProjectFile: boolean;
+ FWriteProjectFile: string;
+ FTranslated: string;
+ procedure SetCmdAction(AValue: TCreatorAction);
+ procedure SetDryRun(AValue: boolean);
+ procedure SetPackage(AValue: TFPDocPackage);
+ procedure SetWriteProjectFile(AValue: string);
+ 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);
+ public
+ ImportDir: string;
+ SelectedUnit: string;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure AddDirToFileList(List: TStrings; const ADirName, AMask: String);
+ procedure AddToFileList(List: TStrings; const FileName: String);
+ function UnitName(AList: TStrings; AIndex: integer): string;
+ function UnitSpec(AUnit: string): string;
+ function ImportName(AIndex: integer): string;
+ procedure LogToStdOut(Sender: TObject; const msg: string);
+ procedure LogToStdErr(Sender: TObject; const msg: string);
+ //parsing
+ function ParseFPDocOption(const S: string): TCreatorAction;
+ function ParseUpdateOption(const S: string): TCreatorAction;
+ function CheckSkelOptions: string;
+ function CreateProject(const AFileName: string; APackage: TFPDocPackage): boolean; virtual;
+ {$IFDEF v0}
+ function ParseOption(const S: string): TCreatorAction;
+ function Exec: string;
+ {$ELSE}
+ {$ENDIF}
+ function SelectedPackage: TFPDocPackage;
+ property Package: TFPDocPackage read SelectedPackage write SetPackage;
+ property CmdAction: TCreatorAction read FCmdAction write SetCmdAction;
+ property DryRun: boolean read FDryRun write SetDryRun;
+ property ReadProject: boolean read FProjectFile;
+ property WriteProjectFile: string read FWriteProjectFile write SetWriteProjectFile;
+ property OnOption: THandleOption read FOnOption write SetOnOption;
+ property InputDir: string read GetInputDir write SetInputDir;
+ property DescrDir: string read GetDescrDir write SetDescrDir;
+ property Options: TCmdOptions read FOptions write SetOptions;
+ end;
+
+{$IFDEF v0}
+var
+ FCreator: TFPDocMaker; //created by application
+ WriteDeclaration,
+ UpdateMode,
+ SortNodes,
+ DisableOverride,
+ DisableErrors,
+ DisableSeealso,
+ DisableArguments,
+ DisableProtected,
+ DisablePrivate,
+ DisableFunctionResults: Boolean;
+ EmitClassSeparator: Boolean;
+{$ELSE}
+{$ENDIF}
+
+Function GetNextWord(Var s : string) : String;
+
+implementation
+
+uses
+ dom,
+ dWriter, fpdocxmlopts;
+
+type
+(* special save/load options
+*)
+
+ { TXMLPackageOptions }
+
+ TXMLPackageOptions = class(TXMLFPDocOptions)
+ public
+ Pkg: TFPDocPackage;
+ procedure SaveOptionsToFile(AProject: TFPDocProject; const AFileName: String; APackage: TFPDocPackage);
+ procedure SaveToXML(AProject: TFPDocProject; ADoc: TXMLDocument); override;
+ end;
+
+ TNodePair = Class(TObject)
+ Private
+ FEl : TPasElement;
+ FNode : TDocNode;
+ Public
+ Constructor Create(AnElement : TPasElement; ADocNode : TDocNode);
+ Property Element : TPasElement Read FEl;
+ Property DocNode : TDocNode Read FNode;
+ end;
+
+{ TXMLPackageOptions }
+
+procedure TXMLPackageOptions.SaveOptionsToFile(AProject: TFPDocProject;
+ const AFileName: String; APackage: TFPDocPackage);
+begin
+ Pkg := APackage; //for use in SaveXML
+ inherited SaveOptionsToFile(AProject, AFileName);
+end;
+
+procedure TXMLPackageOptions.SaveToXML(AProject: TFPDocProject;
+ ADoc: TXMLDocument);
+var
+ i: integer;
+ E,PE: TDOMElement;
+begin
+ if false then inherited SaveToXML(AProject, ADoc);
+ E:=ADoc.CreateElement('docproject');
+ ADoc.AppendChild(E);
+ E:=ADoc.CreateElement('options');
+ ADoc.DocumentElement.AppendChild(E);
+ SaveEngineOptions(AProject.Options,ADoc,E);
+ E:=ADoc.CreateElement('packages');
+ ADoc.DocumentElement.AppendChild(E);
+ if assigned(Pkg) then begin
+ PE:=ADoc.CreateElement('package');
+ E.AppendChild(PE);
+ SavePackage(Pkg,ADoc,PE);
+ end else begin
+ for i := 0 to AProject.Packages.Count - 1 do
+ begin
+ PE:=ADoc.CreateElement('package');
+ E.AppendChild(PE);
+ SavePackage(AProject.Packages[i],ADoc,PE);
+ end;
+ end;
+end;
+
+Constructor TNodePair.Create(AnElement : TPasElement; ADocNode : TDocNode);
+
+begin
+ Fel:=Anelement;
+ FNode:=ADocNode;
+end;
+
+Function GetNextWord(Var s : string) : String;
+Const
+ WhiteSpace = [' ',#9,#10,#13];
+var
+ i,j: integer;
+ quoted: boolean;
+begin
+ I:=1;
+ quoted := False;
+ While (I<=Length(S)) and (S[i] in WhiteSpace) do
+ Inc(I);
+ J:=I;
+{
+ While (J<=Length(S)) and (not (S[J] in WhiteSpace)) do
+ Inc(J);
+}
+ While (J<=Length(S)) do begin
+ if (s[j] = '"') then begin
+ if quoted then
+ break;
+ quoted := True;
+ end else if not quoted and (S[J] in WhiteSpace) then
+ break;
+ Inc(J);
+ end;
+ if (I<=Length(S)) then
+ Result:=Copy(S,I,J-I);
+ Delete(S,1,J);
+end;
+
+function TSkelEngine.FindModule(const AName: String): TPasModule;
+
+Var
+ I : Integer;
+
+begin
+ Result:=Inherited FindModule(AName);
+ If (Result=Nil) then
+ begin // Create dummy list and search in that.
+ If (FModules=Nil) then
+ begin
+ FModules:=TStringList.Create;
+ FModules.Sorted:=True;
+ end;
+ I:=FModules.IndexOf(AName);
+ IF (I=-1) then
+ begin
+ Result:=TPasModule.Create(AName,Nil);
+ FModules.AddObject(AName,Result);
+ end
+ else
+ Result:=FModules.Objects[i] as TPasModule;
+ end;
+end;
+
+Destructor TSkelEngine.Destroy;
+
+Var
+ I : Integer;
+
+begin
+ If Assigned(FModules) then
+ begin
+ For I:=0 to FModules.Count-1 do
+ FModules.Objects[i].Free;
+ FreeAndNil(FModules);
+ end;
+end;
+
+Function TSkelEngine.MustWriteElement(El : TPasElement; Full : Boolean) : Boolean;
+
+Var
+ ParentVisible:Boolean;
+ PT,PP : TPasElement;
+begin
+ ParentVisible:=True;
+ If (El is TPasArgument) or (El is TPasResultElement) then
+ begin
+ PT:=El.Parent;
+ // Skip ProcedureType or PasFunctionType
+ If (PT<>Nil) then
+ begin
+ if (PT is TPasProcedureType) or (PT is TPasFunctionType) then
+ PT:=PT.Parent;
+ If (PT<>Nil) and ((PT is TPasProcedure) or (PT is TPasProcedure)) then
+ PP:=PT.Parent
+ else
+ PP:=Nil;
+ If (PP<>Nil) and (PP is TPasClassType) then
+ begin
+ ParentVisible:=((not Options.DisablePrivate or (PT.Visibility<>visPrivate)) and
+ (not Options.DisableProtected or (PT.Visibility<>visProtected)));
+ end;
+ end;
+ end;
+ Result:=Assigned(El.Parent) and (Length(El.Name) > 0) and
+ (ParentVisible and (not Options.DisableArguments or (El.ClassType <> TPasArgument))) and
+ (ParentVisible and (not Options.DisableFunctionResults or (El.ClassType <> TPasResultElement))) and
+ (not Options.DisablePrivate or (el.Visibility<>visPrivate)) and
+ (not Options.DisableProtected or (el.Visibility<>visProtected));
+ If Result and Full then
+ begin
+ Result:=(Not Assigned(FEmittedList) or (FEmittedList.IndexOf(El.FullName)=-1));
+ If Options.DisableOverride and (El is TPasProcedure) then
+ Result:=Not TPasProcedure(El).IsOverride;
+ end;
+end;
+
+
+function TSkelEngine.CreateElement(AClass: TPTreeElement; const AName: String;
+ AParent: TPasElement; AVisibility : TPasMemberVisibility;
+ const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
+
+Var
+ DN : TDocNode;
+
+begin
+ Result := AClass.Create(AName, AParent);
+ Result.Visibility:=AVisibility;
+ if AClass.InheritsFrom(TPasModule) then
+ CurModule := TPasModule(Result);
+ // Track this element
+ If Options.UpdateMode then
+ begin
+ DN:=FindDocNode(Result);
+ If Assigned(DN) then
+ DN.IncRefCount;
+ end
+ else
+ DN:=Nil;
+ // See if we need to write documentation for it
+ If MustWriteElement(Result,False) then
+ FNodeList.AddObject(Result.PathName,TNodePair.Create(Result,DN));
+end;
+
+Function TSkelEngine.WriteElement(Var F : Text;El : TPasElement; ADocNode : TDocNode) : Boolean;
+
+ Function WriteOnlyShort(APasElement : TPasElement) : Boolean;
+
+ begin
+ Result:=(APasElement.ClassType=TPasArgument) or
+ (APasElement.ClassType=TPasResultElement) or
+ (APasElement.ClassType=TPasEnumValue);
+ end;
+
+ Function IsTypeVarConst(APasElement : TPasElement) : Boolean;
+
+ begin
+ With APasElement do
+ Result:=(InheritsFrom(TPasType) and not InheritsFrom(TPasClassType)) or
+ (InheritsFrom(TPasResString)) or
+ (InheritsFrom(TPasVariable));
+ end;
+
+ Function NeedDeclaration(El : TPasElement) : boolean;
+
+ begin
+ Result:=IsTypeVarConst(El)
+ or WriteOnlyShort(El)
+ or EL.InheritsFrom(TPasProcedure)
+ end;
+
+begin
+ // Check again, this time with full declaration.
+ Result:=MustWriteElement(El,True);
+ If Result and Options.UpdateMode then
+ Result:=(ADocNode=Nil);
+ If Not Result Then
+ Exit;
+ If Options.UpdateMode then
+ DoLog(Format(ScreatingNewNode,[el.PathName]));
+ FEmittedList.Add(El.FullName); // So we don't emit again.
+ WriteLn(f);
+ if Options.EmitClassSeparator and (El.ClassType = TPasClassType) then
+ begin
+ WriteLn(f, '');
+ WriteLn(f);
+ end;
+ If Not (Options.WriteDeclaration and NeedDeclaration(El)) then
+ Writeln(F,'')
+ else
+ begin
+ Writeln(F,'');
+ end;
+ WriteLn(f,'');
+ WriteLn(f, '');
+ if Not WriteOnlyShort(El) then
+ begin
+ WriteLn(f, '');
+ WriteLn(f, '');
+ if not (Options.DisableErrors or IsTypeVarConst(El)) then
+ begin
+ WriteLn(f, '');
+ WriteLn(f, '');
+ end;
+ if not Options.DisableSeealso then
+ begin
+ WriteLn(f, '');
+ WriteLn(f, '');
+ end;
+ end;
+ WriteLn(f, '');
+end;
+
+Procedure TSkelEngine.DoWriteUnReferencedNodes(N : TDocNode; NodePath : String);
+
+begin
+ If (N<>Nil) then
+ begin
+ If (NodePath<>'') then
+ NodePath:=NodePath+'.';
+ DoWriteUnReferencedNodes(N.FirstChild,NodePath+N.Name);
+ While (N<>Nil) do
+ begin
+ if (N.RefCount=0) and (N.Node<>Nil) and (Not N.TopicNode) then
+ DoLog(Format(SNodeNotReferenced,[NodePath+N.Name]));
+ N:=N.NextSibling;
+ end;
+ end;
+end;
+
+procedure TSkelEngine.SetOptions(AValue: TCmdOptions);
+begin
+ if FOptions=AValue then Exit;
+ FOptions:=AValue;
+end;
+
+procedure TSkelEngine.WriteUnReferencedNodes;
+
+begin
+ DoWriteUnReferencedNodes(RootDocNode,'');
+end;
+
+Procedure TSkelEngine.WriteNodes(Var F : Text; AModule : TPasModule; List : TStrings);
+
+Var
+ P : TNodePair;
+ I : integer;
+
+begin
+ WriteLn(f);
+ WriteLn(f, '');
+ WriteLn(f);
+ WriteLn(f, '');
+ if not Options.UpdateMode then
+ begin
+ WriteLn(f, '');
+ WriteLn(f, '');
+ WriteLn(f, '');
+ end;
+ Try
+ For I:=0 to List.Count-1 do
+ begin
+ P:=List.Objects[i] as TNodePair;
+ If (P.Element<>AModule) then
+ WriteElement(F,P.Element,P.DocNode);
+ end;
+ Finally
+ WriteLn(f, '');
+ WriteLn(f, ' ');
+ WriteLn(f, '');
+ end;
+end;
+
+Procedure TSkelEngine.DocumentFile(Var F : Text; Const AFileName,ATarget,ACPU : String);
+
+Var
+ Module : TPasModule;
+ I : Integer;
+ N : TDocNode;
+
+begin
+ FNodeList:=TStringList.Create;
+ Try
+ FEmittedList:=TStringList.Create;
+ FEmittedList.Sorted:=True;
+ try
+ Module:=ParseSource(Self,AFileName,ATarget,ACPU);
+ If Options.UpdateMode then
+ begin
+ N:=FindDocNode(Module);
+ If Assigned(N) then
+ N.IncRefCount;
+ end;
+ If Options.SortNodes then
+ FNodelist.Sorted:=True;
+ WriteNodes(F,Module,FNodeList);
+ If Options.UpdateMode then
+ WriteUnReferencedNodes;
+ Finally
+ FEmittedList.Free;
+ end;
+ Finally
+ For I:=0 to FNodeList.Count-1 do
+ FNodeList.Objects[i].Free;
+ FNodeList.Free;
+ end;
+end;
+
+{ ---------------------------------------------------------------------
+ Main program. Document all units.
+ ---------------------------------------------------------------------}
+
+{ TFPDocMaker }
+
+constructor TFPDocMaker.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOptions := TCmdOptions.Create;
+end;
+
+destructor TFPDocMaker.Destroy;
+begin
+ FreeAndNil(FOptions);
+ inherited Destroy;
+end;
+
+function TFPDocMaker.SelectedPackage: TFPDocPackage;
+begin
+ Result:=FPackage;
+ if (FPackage=Nil) or (FPackage.Name='') then
+ begin
+ DoLog(SNeedPackageName);
+ //Usage(1); - in application
+ end;
+end;
+
+procedure TFPDocMaker.SetOnOption(AValue: THandleOption);
+begin
+ if FOnOption=AValue then Exit;
+ FOnOption:=AValue;
+end;
+
+procedure TFPDocMaker.SetDescrDir(AValue: string);
+begin
+ if FDescrDir=AValue then Exit;
+ FDescrDir:=AValue;
+ AddDirToFileList(SelectedPackage.Descriptions, AValue, '*.xml');
+end;
+
+function TFPDocMaker.GetDescrDir: string;
+begin
+ if FDescrDir = '' then begin
+ if SelectedPackage.Descriptions.Count > 0 then begin
+ Result := FPackage.Descriptions[0];
+ FDescrDir := ExtractFilePath(Result); //include separator
+ end;
+ end;
+ Result := FDescrDir;
+end;
+
+(* Unit name from Inputs[i] or Descriptions[i]
+ Package name from Imports?
+*)
+function TFPDocMaker.UnitName(AList: TStrings; AIndex: integer): string;
+var
+ w: string;
+begin
+ Result := AList[AIndex];
+ while Result <> '' do begin
+ w := GetNextWord(Result);
+ if (w <> '') and (w[1] <> '-') then begin
+ Result := ChangeFileExt(ExtractFileName(w), '');
+ break;
+ end;
+ end;
+end;
+
+function TFPDocMaker.UnitSpec(AUnit: string): string;
+var
+ i: integer;
+ s, w: string;
+begin
+ for i := 0 to SelectedPackage.Inputs.Count - 1 do begin
+ w := UnitName(FPackage.Inputs, i);
+ if CompareText(w, AUnit) = 0 then begin
+ Result := FPackage.Inputs[i];
+ exit;
+ end;
+ end;
+ Result := '';
+end;
+
+function TFPDocMaker.ImportName(AIndex: integer): string;
+var
+ i: integer;
+begin
+ Result := SelectedPackage.Imports[AIndex];
+ i := Pos(',', Result);
+ if i > 1 then
+ SetLength(Result, i-1);
+ Result := ExtractFileName(Result);
+ Result := ChangeFileExt(Result, '');
+end;
+
+function TFPDocMaker.GetInputDir: string;
+var
+ W: string;
+begin
+ if (FInputDir = '') and (SelectedPackage.Inputs.Count > 0) then begin
+ Result := FPackage.Inputs[0];
+ while Result <> '' do begin
+ w := GetNextWord(Result);
+ if (w <> '') and (w[1] <> '-') then begin
+ FInputDir := ExtractFilePath(W); //include separator
+ break;
+ end;
+ end;
+ end;
+ Result := FInputDir;
+end;
+
+procedure TFPDocMaker.SetInputDir(AValue: string);
+begin
+ if FInputDir=AValue then Exit;
+ FInputDir:=AValue;
+ AddDirToFileList(SelectedPackage.Inputs, AValue, '*.pp');
+ AddDirToFileList(SelectedPackage.Inputs, AValue, '*.pas');
+end;
+
+procedure TFPDocMaker.SetOptions(AValue: TCmdOptions);
+begin
+ if FOptions=AValue then Exit;
+ FOptions:=AValue;
+end;
+
+(* Check the options, return errors as message strings.
+*)
+function TFPDocMaker.CheckSkelOptions: string;
+
+Const
+{$IFDEF Unix}
+ MoFileTemplate = '/usr/local/share/locale/%s/LC_MESSAGES/makeskel.mo';
+{$ELSE}
+ MoFileTemplate ='intl/makeskel.%s.mo';
+{$ENDIF}
+
+Var
+ MOFilename: string;
+
+begin
+ Result := '';
+//translate strings - only once?
+ If (Options.Language<>FTranslated) then begin
+ MOFilename:=Format(MOFileTemplate,[Options.Language]);
+ if FileExists(MOFilename) then
+ gettext.TranslateResourceStrings(MoFileName)
+ else begin
+ Result := ('NOTE: unable to find translation file ' + MOFilename);
+ exit;
+ end;
+ // Translate internal documentation strings
+ TranslateDocStrings(Options.Language);
+ FTranslated:=Options.Language;
+ end;
+ // Action is to create the XML skeleton
+ if (Package.Name = '') and (CmdAction<>caUsage) then begin
+ Result := (SNoPackageNameProvided);
+ exit;
+ end;
+ if Options.UpdateMode
+ and (SelectedPackage.Descriptions.IndexOf(Package.Output)<>-1) then begin
+ Result := (SOutputMustNotBeDescr);
+ exit;
+ end;
+end;
+
+function TFPDocMaker.CreateProject(const AFileName: string; APackage: TFPDocPackage): boolean;
+var
+ f: TXMLPackageOptions;
+begin
+ try
+ f := TXMLPackageOptions.Create(nil);
+ try
+ f.SaveOptionsToFile(Project, AFileName, APackage);
+ Result := True;
+ finally
+ f.Free;
+ end;
+ except
+ Result := False;
+ end;
+end;
+
+procedure TFPDocMaker.SetCmdAction(AValue: TCreatorAction);
+begin
+ if FCmdAction=AValue then Exit;
+ FCmdAction:=AValue;
+end;
+
+procedure TFPDocMaker.SetDryRun(AValue: boolean);
+begin
+ if FDryRun=AValue then Exit;
+ FDryRun:=AValue;
+end;
+
+procedure TFPDocMaker.SetPackage(AValue: TFPDocPackage);
+begin
+ if FPackage=AValue then Exit;
+ FPackage:=AValue;
+end;
+
+procedure TFPDocMaker.SetWriteProjectFile(AValue: string);
+begin
+ if FWriteProjectFile=AValue then Exit;
+ FWriteProjectFile:=AValue;
+end;
+
+procedure TFPDocMaker.AddDirToFileList(List: TStrings; const ADirName, AMask: String);
+
+Var
+ Info : TSearchRec;
+ D : String;
+
+begin
+ if (ADirName<>'') and not DirectoryExists(ADirName) then
+ DoLog('Directory '+ADirName+' does not exist')
+ else
+ begin
+ if (ADirName='.') or (ADirName='') then
+ D:=''
+ else
+ D:=IncludeTrailingPathDelimiter(ADirName);
+ If (FindFirst(D+AMask,0,Info)=0) then
+ try
+ Repeat
+ If (Info.Attr and faDirectory)=0 then
+ List.Add(D+Info.name);
+ Until FindNext(Info)<>0;
+ finally
+ FindClose(Info);
+ end;
+ end;
+end;
+
+procedure TFPDocMaker.AddToFileList(List: TStrings; const FileName: String);
+var
+ f: Text;
+ s: String;
+begin
+ if Copy(FileName, 1, 1) = '@' then
+ begin
+ AssignFile(f, Copy(FileName, 2, Length(FileName)));
+ Reset(f);
+ while not EOF(f) do
+ begin
+ ReadLn(f, s);
+ List.Add(s);
+ end;
+ Close(f);
+ end else
+ List.Add(FileName);
+end;
+
+function TFPDocMaker.ParseCommon(var Cmd, Arg: string): TCreatorAction;
+var
+ i: Integer;
+begin
+ if (Cmd = '-h') or (Cmd = '--help') then begin
+ //Usage(0)
+ CmdAction := caUsage;
+ exit(caUsage);
+ end;
+{$IFDEF v0}
+ if Cmd = '--makeskel' then
+ Options.CreateSkeleton := True
+ else
+{$ELSE}
+{$ENDIF}
+ if Cmd = '--update' then
+ Options.UpdateMode := True
+ else if (Cmd = '-n') or (Cmd = '--dry-run') then
+ begin
+ DryRun:=True;
+ CmdAction := caDryRun;
+ end
+//project options
+ else if Cmd = '--hide-protected' then
+ Options.HideProtected := True
+ else if Cmd = '--warn-no-node' then
+ Options.WarnNoNode := True
+ else if Cmd = '--show-private' then
+ Options.ShowPrivate := True //DoDi: was False???
+ else if Cmd = '--stop-on-parser-error' then
+ Options.StopOnParseError := True
+ else if Cmd = '--dont-trim' then
+ Options.DontTrim := True
+ else if Cmd = '--parse-impl' then
+ Options.InterfaceOnly:=false //is default really True???
+ else begin
+ //split option
+ i := Pos('=', Cmd);
+ if i > 0 then begin
+ Arg := Copy(Cmd, i + 1, Length(Cmd));
+ SetLength(Cmd, i - 1);
+ if (Arg <> '') and (Arg[1] = '"') then begin
+ //remove quotes
+ Arg := StringReplace(Arg, '"', '', [rfReplaceAll]);
+ end;
+ end else begin
+ SetLength(Arg, 0);
+ exit(caInvalid); //options without values unhandled here!
+ end;
+ //more options
+ Result := caDefault; //assume succ
+ if (Cmd = '--project') or (Cmd='-p') then begin
+ FProjectFile:=True; //means: project loaded
+ WriteProjectFile := Arg; //do *not* normally overwrite!
+ LoadProjectFile(Arg);
+ end else if (Cmd = '--descr') then begin
+ if FileExists(Arg) then
+ AddToFileList(SelectedPackage.Descriptions, Arg)
+ end else if (Cmd = '--descr-dir') then
+ DescrDir:=Arg
+ else if (Cmd = '-i') or (Cmd = '--input') then
+ AddToFileList(SelectedPackage.Inputs, Arg)
+ else if (Cmd = '--input-dir') then
+ InputDir:=Arg
+ else if Cmd = '--package' then begin
+ If FProjectFile then
+ FPackage:=Packages.FindPackage(Arg)
+ else begin
+ if FPackage = nil then
+ FPackage := (Packages.Add) as TFPDocPackage;
+ FPackage.Name:=Arg;
+ end
+ end else if Cmd = '--ostarget' then
+ Options.OSTarget := Arg
+ else if Cmd = '--cputarget' then
+ Options.CPUTarget := Arg
+ else if (Cmd = '-l') or (Cmd = '--lang') then
+ Options.Language := Arg
+ {$IFDEF new}
+ else if (Cmd = '--common-options') then
+ SelectedPackage.CommonOptions:=Arg
+ {$ELSE}
+ {$ENDIF}
+ else if Cmd = '--mo-dir' then
+ Options.modir := Arg
+ else if (Cmd = '-o') or (Cmd = '--output') then
+ SelectedPackage.Output := Arg
+ else if (Cmd = '--unit') then //-u= UpdateMode
+ SelectedUnit:= Arg
+ else if (Cmd = '-v') or (Cmd = '--verbose') then
+ Verbose:=true
+ else if Cmd = '--write-project' then begin
+ CmdAction := caWriteProject;
+ WriteProjectFile:=Arg
+ end
+ //else no match
+ else
+ Result := caInvalid;
+ end;
+end;
+
+function TFPDocMaker.ParseFPDocOption(const S: string): TCreatorAction;
+//procedure TFPDocAplication.Parseoption(Const S : String);
+var
+ Cmd, Arg: String;
+begin
+ Cmd:=S;
+ Result := ParseCommon(Cmd, Arg);
+ if Result <> caInvalid then
+ exit;
+ Result := caDefault; //assume succ
+ if Cmd = '--content' then
+ SelectedPackage.ContentFile := Arg
+ else if Cmd = '--import' then
+ SelectedPackage.Imports.Add(Arg)
+//this should not be a project option
+ else if (Cmd = '-f') or (Cmd = '--format') then
+ begin
+ Arg:=UpperCase(Arg);
+ If FindWriterClass(Arg)=-1 then
+ WriteLn(StdErr, Format(SCmdLineInvalidFormat, [Arg]))
+ else
+ Options.BackEnd:=Arg;
+ end
+ else
+ begin
+ Options.BackendOptions.Add(Cmd);
+ Options.BackendOptions.Add(Arg);
+ end;
+end;
+
+procedure TFPDocMaker.LogToStdOut(Sender: TObject; const msg: string);
+begin
+ WriteLn(msg);
+end;
+
+procedure TFPDocMaker.LogToStdErr(Sender: TObject; const msg: string);
+begin
+ WriteLn(stderr, msg);
+end;
+
+(* Write *all* updates into AOutputName (=DescrFile for Create, UpdFile for Update).
+*)
+Function TFPDocMaker.DocumentPackage(Const APackageName,AOutputName: string; InputFiles, DescrFiles : TStrings) : String;
+Var
+ F : Text;
+ I,J : Integer;
+ Engine: TSkelEngine;
+begin
+ Result:='';
+ AssignFile(f, AOutputName);
+ Rewrite(f);
+ Try
+ WriteLn(f, '');
+ WriteLn(f, '');
+ WriteLn(f, '');
+ I:=0;
+ While (Result='') And (I');
+ WriteLn(f, '');
+ Close(f);
+ end;
+end;
+
+procedure TFPDocMaker.CreateUnitDocumentation(APackage: TFPDocPackage;
+ const AUnit: string; ParseOnly: Boolean);
+var
+ il: TStringList;
+ spec: string;
+begin
+ if AUnit <> '' then begin
+ //selected unit only
+ spec := UnitSpec(AUnit);
+ il := TStringList.Create;
+ il.Assign(APackage.Inputs);
+ APackage.Inputs.Clear;
+ APackage.Inputs.Add(spec);
+ try
+ inherited CreateDocumentation(APackage, ParseOnly);
+ finally
+ APackage.Inputs.Assign(il);
+ il.Free;
+ end;
+ end else begin
+ CreateDocumentation(APackage,ParseOnly);
+ end;
+end;
+
+
+function TFPDocMaker.ParseUpdateOption(const s: String): TCreatorAction;
+//procedure ParseOption(const s: String; Options: TEngineOptions);
+var
+ Cmd, Arg: String;
+begin
+ Cmd:=S;
+ Result := ParseCommon(Cmd, Arg);
+ if Result <> caInvalid then
+ exit;
+ Result := caDefault; //assume succ
+ if s = '--disable-arguments' then
+ Options.DisableArguments := True
+ else if s = '--disable-errors' then
+ Options.DisableErrors := True
+ else if s = '--disable-function-results' then
+ Options.DisableFunctionResults := True
+ else if s = '--disable-seealso' then
+ Options.DisableSeealso := True
+ else if s = '--disable-private' then
+ Options.DisablePrivate := True
+ else if s = '--disable-override' then
+ Options.DisableOverride := True
+ else if s = '--disable-protected' then
+ begin
+ Options.DisableProtected := True;
+ Options.DisablePrivate :=True;
+ end
+ else if (s = '--emitclassseparator') or (s='--emit-class-separator') then
+ Options.EmitClassSeparator := True
+ else if (s = '--emit-declaration') then
+ Options.WriteDeclaration := True
+ else if (s = '--sort-nodes') then
+ Options.SortNodes := True
+ else if (Cmd = '-i') or (Cmd = '--input') then
+ AddToFileList(SelectedPackage.Inputs, Arg)
+ else if not assigned(OnOption) or not OnOption(Cmd, Arg) then begin
+ DoLog(SCmdLineInvalidOption, [s]);
+ CmdAction := caInvalid;
+ Result := caInvalid;
+ end;
+end;
+
+{$IFDEF v0}
+function TFPDocMaker.ParseOption(const S: string): TCreatorAction;
+begin
+ if Options.CreateSkeleton or Options.UpdateMode then
+ Result := ParseUpdateOption(s)
+ else
+ Result := ParseFPDocOption(s);
+end;
+
+(* An experimental version for executing all functionality.
+ Applications better should use the basic methods, and implement the framework
+ for all handled cases.
+*)
+function TFPDocMaker.Exec: string;
+var
+ Pkg: TFPDocPackage;
+ s, OutputName: string;
+ i: integer;
+begin
+ if Options.UpdateMode or Options.CreateSkeleton then begin
+ //MakeSkel
+ Result := CheckSkelOptions;
+ if Result <> '' then
+ exit;
+ end else
+ Result := '';
+ if SelectedUnit <> '' then begin
+ //create fake package
+ Pkg := TFPDocPackage.Create(nil);
+ try
+ Pkg.Name := Package.Name;
+ s := UnitSpec(SelectedUnit);
+ Pkg.Inputs.Add(s);
+
+ Pkg.Output := Package.Output; //fpdoc
+ OutputName:=DescrDir + SelectedUnit + '.xml';
+ if Options.UpdateMode then begin
+ if not FileExists(OutputName) then begin
+ Result := 'Not found: ' + OutputName;
+ exit;
+ end;
+ Pkg.Descriptions.Add(OutputName);
+ OutputName := 'upd.' + SelectedUnit + '.xml';
+ Result := DocumentPackage(Package.Name, OutputName, Pkg.Inputs, Pkg.Descriptions);
+ exit;
+ end;
+ if Options.CreateSkeleton then begin
+ if FileExists(OutputName) then begin
+ Result := 'File already exists: ' + OutputName;
+ exit;
+ end;
+ Result := DocumentPackage(Package.Name, OutputName, Pkg.Inputs, Pkg.Descriptions);
+ end else begin //fpdoc
+ CreateDocumentation(Pkg, DryRun);
+ end;
+ finally
+ Pkg.Free;
+ end;
+ exit;
+ end;
+//process package
+ if Options.UpdateMode or Options.CreateSkeleton then begin
+ Result := DocumentPackage(Package.Name, Package.Output, Package.Inputs, Package.Descriptions);
+ end else begin
+ //FPDoc
+ //todo: all or single unit?
+ CreateDocumentation(SelectedPackage, DryRun);
+ end;
+end;
+{$ELSE}
+{$ENDIF}
+
+end.
+
diff --git a/examples/fpdocmanager/umanager.pas b/examples/fpdocmanager/umanager.pas
new file mode 100644
index 0000000000..32c3da0e58
--- /dev/null
+++ b/examples/fpdocmanager/umanager.pas
@@ -0,0 +1,694 @@
+unit uManager;
+(* Manager object for FPDoc GUI, by DoDi
+Holds configuration and packages.
+
+Packages (shall) contain extended descriptions for:
+- default OSTarget (FPCDocs: Unix/Linux)
+- inputs: by OSTarget
+- directories: project(file), InputDir, DescrDir[by language?]
+- FPCVersion, LazVersion: variations of inputs
+- Skeleton and Output options, depending on DocType/Level and Format.
+Units can be described in multiple XML docs, so that it's possible to
+have specific parts depending on Laz/FPC version, OSTarget, Language, Widgetset.
+
+Since the package (collection item) class is hardwired in the Packages collection,
+a variable PackageClass has been introduced in FPDocProj.
+*)
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, IniFiles,
+ umakeskel, fpdocproj, dw_HTML;
+
+type
+
+ { TDocPackage }
+
+(* TDocPackage describes a package documentation project.
+*)
+ TDocPackage = class(TComponent) // (TFPDocPackage)
+ private
+ FDescrDir: string;
+ FDocPkg: TFPDocPackage;
+ FIncludePath: string;
+ FInputDir: string;
+ FLazPkg: string;
+ FName: string;
+ FProjectFile: string;
+ FRequires: TStrings;
+ FUnitPath: string;
+ FUnits: TStrings;
+ procedure SetDescrDir(AValue: string);
+ procedure SetDocPkg(AValue: TFPDocPackage);
+ procedure SetIncludePath(AValue: string);
+ procedure SetInputDir(AValue: string);
+ procedure SetLazPkg(AValue: string);
+ procedure SetName(AValue: string);
+ procedure SetProjectFile(AValue: string);
+ procedure SetRequires(AValue: TStrings);
+ procedure SetUnitPath(AValue: string);
+ procedure SetUnits(AValue: TStrings);
+ protected
+ FPackage: TFPDocPackage;
+ procedure ReadConfig(cf: TIniFile);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function CreateProject: TFPDocPackage;
+ procedure UpdateConfig(cf: TIniFile; APkg: TFPDocPackage);
+ property Name: string read FName write SetName;
+ property DocPkg: TFPDocPackage read FDocPkg write SetDocPkg;
+ property ProjectFile: string read FProjectFile write SetProjectFile; //xml?
+ //from LazPkg
+ property LazPkg: string read FLazPkg write SetLazPkg; //LPK name?
+ property DescrDir: string read FDescrDir write SetDescrDir;
+ property InputDir: string read FInputDir write SetInputDir;
+ property Units: TStrings read FUnits write SetUnits;
+ property Requires: TStrings read FRequires write SetRequires; //only string?
+ property IncludePath: string read FIncludePath write SetIncludePath; //-Fi
+ property UnitPath: string read FUnitPath write SetUnitPath; //-Fu
+ //property DefOS: string; - variations!
+ end;
+
+ { TFPDocManager }
+
+(* Holds configuration, projects and packages.
+ Projects[] effectively represents packages.
+*)
+ TFPDocManager = class(TFPDocMaker)
+ private
+ FDirty: boolean;
+ FFPDocDir: string;
+ FLazarusDir: string;
+ FModified: boolean;
+ FOnChange: TNotifyEvent;
+ FProjects: TStrings;
+ FRootDir: string;
+ UpdateCount: integer;
+ procedure SetFPDocDir(AValue: string);
+ procedure SetLazarusDir(AValue: string);
+ procedure SetOnChange(AValue: TNotifyEvent);
+ procedure SetRootDir(AValue: string);
+ protected
+ InputList, DescrList: TStringList;
+ procedure Changed;
+ function BeginTest(APkg: TDocPackage): boolean;
+ procedure EndTest;
+ public
+ Config: TIniFile;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure BeginUpdate;
+ procedure EndUpdate;
+ function LoadConfig(const ADir: string; Force: boolean = False): boolean;
+ function SaveConfig: boolean;
+ function AddProject(const APkg, AFile: string; UpdateCfg: boolean): boolean; //from config
+ {$IFDEF v0}
+ function CreateProject(const AFileName: string; APackage: TFPDocPackage): boolean;
+ {$ELSE}
+ //function CreateProject(const AFileName: string; APackage: TFPDocPackage): boolean;
+ {$ENDIF}
+ function AddPackage(AName: string): TDocPackage;
+ function ImportLpk(const AName: string): TDocPackage;
+ //actions
+ //function MakeDoc(APkg: TDocPackage; AUnit: string): boolean; configure???
+ function TestRun(APkg: TDocPackage; AUnit: string): boolean;
+ function Update(APkg: TDocPackage; const AUnit: string): boolean;
+ procedure CleanXML(const FileName: string);
+ public //published?
+ property FpcDocDir: string read FFPDocDir write SetFPDocDir;
+ property LazarusDir: string read FLazarusDir write SetLazarusDir;
+ property RootDir: string read FRootDir write SetRootDir;
+ //property Packages: TStrings read FPackages;
+ property Projects: TStrings read FProjects;
+ property Dirty: boolean read FDirty; //inifile
+ property Modified: boolean read FModified; //app
+ property OnChange: TNotifyEvent read FOnChange write SetOnChange;
+ end;
+
+var
+ Manager: TFPDocManager = nil; //init by application
+
+implementation
+
+uses
+ uLpk;
+
+const
+ ConfigName = 'docmgr.ini';
+ SecProjects = 'projects';
+
+{ TDocPackage }
+
+procedure TDocPackage.SetDescrDir(AValue: string);
+begin
+ if FDescrDir=AValue then Exit;
+ FDescrDir:=AValue;
+end;
+
+(* Init from package
+*)
+procedure TDocPackage.SetDocPkg(AValue: TFPDocPackage);
+var
+ s: string;
+begin
+ if FDocPkg=AValue then Exit;
+ FDocPkg:=AValue;
+//init using Manager
+ Manager.Package := DocPkg;
+ FDescrDir := Manager.DescrDir;
+ FInputDir := Manager.InputDir;
+end;
+
+procedure TDocPackage.SetIncludePath(AValue: string);
+begin
+ if FIncludePath=AValue then Exit;
+ FIncludePath:=AValue;
+end;
+
+procedure TDocPackage.SetInputDir(AValue: string);
+begin
+ if FInputDir=AValue then Exit;
+ FInputDir:=AValue;
+end;
+
+procedure TDocPackage.SetLazPkg(AValue: string);
+begin
+ if FLazPkg=AValue then Exit;
+ FLazPkg:=AValue;
+ //todo: import
+end;
+
+procedure TDocPackage.SetName(AValue: string);
+begin
+ if FName=AValue then Exit;
+ FName:=AValue;
+end;
+
+procedure TDocPackage.SetProjectFile(AValue: string);
+begin
+ if FProjectFile=AValue then Exit;
+ FProjectFile:=AValue;
+ //todo: import?
+ //FDocPkg; - must be created IN Manager
+end;
+
+procedure TDocPackage.SetRequires(AValue: TStrings);
+begin
+ if FRequires=AValue then Exit;
+ FRequires:=AValue;
+end;
+
+procedure TDocPackage.SetUnitPath(AValue: string);
+begin
+ if FUnitPath=AValue then Exit;
+ FUnitPath:=AValue;
+end;
+
+procedure TDocPackage.SetUnits(AValue: TStrings);
+begin
+ if FUnits=AValue then Exit;
+ FUnits:=AValue;
+end;
+
+procedure TDocPackage.ReadConfig(cf: TIniFile);
+begin
+ //FProjectFile := cf.ReadString(Name, 'projectfile', '');
+ FDescrDir := cf.ReadString(Name, 'descrdir', '');
+ FInputDir := cf.ReadString(Name, 'inputdir', '');
+//more?
+end;
+
+constructor TDocPackage.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FUnits := TStringList.Create;
+ FRequires := TStringList.Create;
+end;
+
+destructor TDocPackage.Destroy;
+begin
+ FreeAndNil(FUnits);
+ FreeAndNil(FRequires);
+ inherited Destroy;
+end;
+
+(* Create new(?) package and project.
+*)
+function TDocPackage.CreateProject: TFPDocPackage;
+var
+ s, imp: string;
+ pkg: TFPDocPackage;
+ i: integer;
+begin
+//get the package
+ Result := DocPkg;
+ if Result <> nil then
+ exit; //for now, implement update later
+//create new pkg
+ Result := Manager.Packages.FindPackage(Name);
+ if Result = nil then begin
+ //create pkg
+ Manager.Package := nil; //!!!nothing selected!!!
+ Manager.ParseFPDocOption('--package=' + Name); //selects or creates the pkg
+ pkg := Manager.SelectedPackage;
+ //add Inputs
+ if pkg.Inputs.Count = 0 then begin //else pkg exists already?
+ //if Units.Count = 0 then ???; --input-dir?
+ //todo: common options? OS options?
+ for i := 0 to Units.Count - 1 do begin
+ pkg.Inputs.Add(Units.ValueFromIndex[i]);
+ end;
+ end;
+ //add Descriptions
+ if pkg.Descriptions.Count = 0 then begin
+ if DescrDir <> '' then begin
+ //first check for existing directory
+ if not DirectoryExists(DescrDir) then begin
+ MkDir(DescrDir); //exclude \?
+ end else begin
+ Manager.ParseFPDocOption('--descr-dir=' + DescrDir);
+ end;
+ end;
+ end;
+ //add Imports
+ if (pkg.Imports.Count = 0) then begin
+ for i := 0 to Requires.Count - 1 do begin
+ s := Requires[i];
+ imp := Manager.RootDir + s + '.xct,../' + s + '/';
+ Manager.ParseFPDocOption('--import=' + imp);
+ end;
+ end;
+ //add options
+ pkg.Output := Manager.RootDir + Name;
+ pkg.ContentFile := Manager.RootDir + Name + '.xct';
+ //upate result when reached this
+ Result := pkg;
+ end;
+ DocPkg := Result;
+//create project file?
+ if (ProjectFile = '') and (LazPkg <> '') then begin
+ s := ChangeFileExt(LazPkg, '.xml');
+ if Manager.CreateProject(s, DocPkg) then
+ ProjectFile := s;
+ //let manager register?
+ end;
+end;
+
+(* Initialize the package, write global config (+local?)
+*)
+procedure TDocPackage.UpdateConfig(cf: TIniFile; APkg: TFPDocPackage);
+begin
+ //to come?
+end;
+
+{ TFPDocManager }
+
+constructor TFPDocManager.Create(AOwner: TComponent);
+begin
+ //PackageClass:=TDocPackage; //extended package class
+ FProjects := TStringList.Create;
+ InputList := TStringList.Create;
+ DescrList := TStringList.Create;
+ inherited Create(AOwner);
+end;
+
+destructor TFPDocManager.Destroy;
+begin
+ FreeAndNil(Config); //save?
+ FreeAndNil(FProjects);
+ FreeAndNil(InputList);
+ FreeAndNil(DescrList);
+ inherited Destroy;
+end;
+
+procedure TFPDocManager.SetFPDocDir(AValue: string);
+begin
+ if FFPDocDir=AValue then Exit;
+ FFPDocDir:=AValue;
+ FDirty := True;
+end;
+
+procedure TFPDocManager.SetLazarusDir(AValue: string);
+begin
+ if FLazarusDir=AValue then Exit;
+ FLazarusDir:=AValue;
+ FDirty := True;
+end;
+
+procedure TFPDocManager.SetOnChange(AValue: TNotifyEvent);
+begin
+ if FOnChange=AValue then Exit;
+ FOnChange:=AValue;
+end;
+
+(* Try load config from new dir - this may fail on the first run.
+*)
+procedure TFPDocManager.SetRootDir(AValue: string);
+var
+ s: string;
+begin
+ s := IncludeTrailingPathDelimiter(AValue);
+ if FRootDir=s then Exit; //prevent recursion
+ FRootDir:=s;
+//load config?
+ //LoadConfig(s, False);
+ FDirty := True;
+end;
+
+procedure TFPDocManager.Changed;
+begin
+ if not Modified or (UpdateCount > 0) then
+ exit; //should not be called directly
+ FModified := False;
+ if Assigned(OnChange) then
+ FOnChange(self);
+end;
+
+procedure TFPDocManager.BeginUpdate;
+begin
+ inc(UpdateCount);
+end;
+
+procedure TFPDocManager.EndUpdate;
+begin
+ dec(UpdateCount);
+ if UpdateCount <= 0 then begin
+ UpdateCount := 0;
+ if Modified then
+ Changed;
+ end;
+end;
+
+(* Try load config.
+Init RootDir (only when config found?)
+*)
+function TFPDocManager.LoadConfig(const ADir: string; Force: boolean): boolean;
+var
+ s, pf, cf: string;
+ i: integer;
+ pkg: TDocPackage;
+begin
+ s := IncludeTrailingPathDelimiter(ADir);
+ cf := s + ConfigName;
+ Result := FileExists(cf);
+ if not Result and not Force then
+ exit;
+ RootDir:=s; //recurse if RootDir changed
+//sanity check: only one config file!
+ if assigned(Config) then begin
+ if (Config.FileName = cf) then
+ exit(false) //nothing new?
+ else
+ Config.Free;
+ //clear packages???
+ end;
+ Config := TIniFile.Create(cf);
+ FDirty := True; //to be saved
+ if not Result then
+ exit; //nothing to read
+//read directories
+ FFPDocDir := Config.ReadString('dirs', 'fpc', '');
+//read packages
+ Config.ReadSectionValues(SecProjects, Projects); //=
+//read detailed package information - possibly multiple packages per project!
+ BeginUpdate; //turn of app notification!
+ for i := 0 to Projects.Count - 1 do begin
+ //read package config (=project file name?)
+ s := Projects.Names[i];
+ pf := Projects.ValueFromIndex[i];
+ if pf <> '' then begin
+ AddProject(s, pf, False); //add and load project file, don't update config!
+ FModified := True; //force app notification
+ end;
+ end;
+//more? (preferences?)
+//done, nothing modified
+ EndUpdate;
+ FDirty := False;
+end;
+
+function TFPDocManager.SaveConfig: boolean;
+begin
+ if Dirty then begin
+ Config.UpdateFile;
+ FDirty := False;
+ end;
+ Result := not Dirty;
+end;
+
+(* Load FPDoc (XML) project file.
+ Not Dirty when loaded from INI!
+*)
+function TFPDocManager.AddProject(const APkg, AFile: string; UpdateCfg: boolean): boolean;
+var
+ i, j, ipkg: integer;
+ pn, s: string;
+ pkg: TDocPackage;
+ fpkg: TFPDocPackage;
+begin
+{$IFDEF v0}
+//load the project
+ LoadProjectFile(AFile); //override for init project/packages?
+//update contained packages
+ for i := 0 to Packages.Count - 1 do begin
+ pkg := Packages[i] as TDocPackage;
+ if pkg.ProjectFile = '' then
+ pkg.ProjectFile := AFile;
+ end;
+ Config.WriteString(SecProjects, APkg, AFile); //unique entry!?
+ FModified := true;
+ FDirty:=true;
+{$ELSE}
+//load the project
+ LoadProjectFile(AFile); //override for init project/packages?
+//update contained packages
+ for i := 0 to Packages.Count - 1 do begin
+ Package := Packages[i];
+ pkg := AddPackage(Package.Name);
+ if pkg.ProjectFile = '' then begin
+ pkg.ProjectFile := AFile;
+ pkg.DocPkg := Package;
+ //init Units
+ for j := 0 to Package.Inputs.Count - 1 do begin
+ s := UnitName(Package.Inputs, j);
+ pkg.Units.Add(s + '=' + Package.Inputs[j]);
+ //strip OS -Fi?
+ end;
+ //init imports
+ for j := 0 to Package.Imports.Count - 1 do begin
+ //s := Package.Imports[j];
+ s := ImportName(j);
+ //package reference?
+ pkg.Requires.AddObject(s, AddPackage(s));
+ end;
+ if UpdateCfg then begin //update config?
+ Config.WriteString(SecProjects, pkg.Name, AFile);
+ FModified := true;
+ FDirty:=true;
+ end;
+ end;
+ end;
+{$ENDIF}
+//notify app?
+ Changed;
+end;
+
+{$IFDEF v0}
+(* Creates an FPDoc project file, adds the project to Projects[]
+*)
+function TFPDocManager.CreateProject(const AFileName: string;
+ APackage: TFPDocPackage): boolean;
+var
+ APkg: TDocPackage absolute APackage;
+begin
+ Result:=inherited CreateProject(AFileName, APackage);
+ if not Result then
+ exit;
+ if APkg.ProjectFile = AFileName then
+ exit; //already done
+ APkg.ProjectFile := AFileName;
+ Config.WriteString(SecProjects, APackage.Name, AFileName); //unique entry!?
+ FDirty:=true;
+ FModified:=true;
+ Changed;
+end;
+{$ELSE}
+{$ENDIF}
+
+(* Return the named package, create if not found.
+ Rename: GetPackage?
+*)
+function TFPDocManager.AddPackage(AName: string): TDocPackage;
+var
+ i: integer;
+begin
+ AName := LowerCase(AName);
+{$IFDEF v0}
+ Result := Packages.FindPackage(AName) as TDocPackage;
+ if assigned(Result) then
+ exit;
+//create new package
+ Result := Packages.Add as TDocPackage;
+ Result.Name := AName;
+ fDirty := True;
+ fModified := True;
+ Changed;
+{$ELSE}
+ i := FProjects.IndexOfName(AName);
+ if i < 0 then
+ i := FProjects.Add(AName); //create new entry
+ Result := FProjects.Objects[i] as TDocPackage;
+ if Result = nil then begin
+ Result := TDocPackage.Create(self);
+ Result.Name := AName;
+ FProjects.Objects[i] := Result; //add object
+ end;
+{$ENDIF}
+end;
+
+function TFPDocManager.ImportLpk(const AName: string): TDocPackage;
+begin
+ BeginUpdate;
+//import the LPK file into
+ Result := uLpk.ImportLpk(AName);
+ if Result = nil then
+ DoLog('Import failed on ' + AName)
+ else begin
+ if Result.CreateProject <> nil then begin //create new(?) package project
+ Config.WriteString(SecProjects, Result.Name, Result.ProjectFile);
+ FDirty := True;
+ end;
+ FModified := True; //always?
+ Changed;
+ end;
+ EndUpdate;
+end;
+
+function TFPDocManager.BeginTest(APkg: TDocPackage): boolean;
+var
+ pf, dir: string;
+begin
+ if not assigned(APkg) then
+ exit(False);
+ pf := APkg.ProjectFile;
+ if pf = '' then
+ exit(False);
+ Package := APkg.DocPkg;
+ dir := ExtractFileDir(pf);
+ SetCurrentDir(dir);
+ ParseFPDocOption('--project='+APkg.ProjectFile);
+//okay, so far
+ Result := True;
+end;
+
+procedure TFPDocManager.EndTest;
+begin
+ SetCurrentDir(ExtractFileDir(RootDir));
+end;
+
+function TFPDocManager.TestRun(APkg: TDocPackage; AUnit: string): boolean;
+var
+ pf, dir: string;
+begin
+(* more detailed error handling?
+ Must CD to the project file directory!?
+*)
+ Result := BeginTest(APkg);
+ if not Result then
+ exit;
+ ParseFPDocOption('--format=html');
+ ParseFPDocOption('-n');
+{$IFDEF v0}
+ if AUnit <> '' then begin
+ InputList.Clear;
+ InputList.Add(Maker.UnitSpec(AUnit));
+ DescrList.Clear;
+ DescrList.Add(APkg.DescrDir + AUnit+'.xml');
+ CreateUnitDocumentation(APkg, InputList, DescrList, True);
+ end else begin
+ CreateDocumentation(APkg,True);
+ end;
+{$ELSE}
+ CreateUnitDocumentation(APkg.DocPkg, AUnit, True);
+{$ENDIF}
+ EndTest;
+end;
+
+(* MakeSkel functionality - create skeleton or update file
+*)
+function TFPDocManager.Update(APkg: TDocPackage; const AUnit: string): boolean;
+
+ function DocumentUnit(const AUnit: string): boolean;
+ var
+ OutName, msg: string;
+ begin
+ InputList.Clear;
+ InputList.Add(UnitSpec(AUnit));
+ DescrList.Clear;
+ OutName := DescrDir + AUnit + '.xml';
+ Options.UpdateMode := FileExists(OutName);
+ if Options.UpdateMode then begin
+ DescrList.Add(APkg.DescrDir + AUnit + '.xml');
+ OutName:=RootDir + 'upd.' + AUnit + '.xml';
+ DoLog('Update ' + OutName);
+ end else begin
+ DoLog('Create ' + OutName);
+ end;
+ msg := DocumentPackage(APkg.Name, OutName, InputList, DescrList);
+ Result := msg = '';
+ if not Result then
+ DoLog(msg) //+unit?
+ else if Options.UpdateMode then begin
+ CleanXML(OutName);
+ end;
+ end;
+
+var
+ i: integer;
+ u: string;
+begin
+ Result := BeginTest(APkg);
+ if not Result then
+ exit;
+ if AUnit <> '' then begin
+ Result := DocumentUnit(AUnit);
+ end else begin
+ for i := 0 to Package.Inputs.Count - 1 do begin
+ u := UnitName(Package.Inputs, i);
+ DocumentUnit(u);
+ end;
+ end;
+ EndTest;
+end;
+
+(* Kill file if no " 0 then
+ exit; //file not empty
+ end;
+ finally
+ CloseFile(f);
+ end;
+//nothing found, delete the file
+ if DeleteFile(FileName) then
+ DoLog('File ' + FileName + ' has no elements. Deleted.')
+ else
+ DoLog('File ' + FileName + ' has no elements. Delete failed.');
+end;
+
+end.
+