From 1f1b6ec141a0611f1383ffbb78fc87d00b5e7ebe Mon Sep 17 00:00:00 2001 From: tombo Date: Wed, 3 Oct 2007 15:35:25 +0000 Subject: [PATCH] Added FPDoc Updater: a GUI tool for updating FPDoc files git-svn-id: trunk@12302 - --- .gitattributes | 9 + .gitignore | 4 + doceditor/fpdocupdater/fpdocfiles.pas | 549 ++++++++++++++++++++++++ doceditor/fpdocupdater/fpdocupdater.lpi | 119 +++++ doceditor/fpdocupdater/fpdocupdater.lpr | 19 + doceditor/fpdocupdater/mainunit.lfm | 220 ++++++++++ doceditor/fpdocupdater/mainunit.lrs | 68 +++ doceditor/fpdocupdater/mainunit.pas | 474 ++++++++++++++++++++ doceditor/fpdocupdater/unitmove.lfm | 92 ++++ doceditor/fpdocupdater/unitmove.lrs | 31 ++ doceditor/fpdocupdater/unitmove.pas | 69 +++ 11 files changed, 1654 insertions(+) create mode 100644 doceditor/fpdocupdater/fpdocfiles.pas create mode 100644 doceditor/fpdocupdater/fpdocupdater.lpi create mode 100644 doceditor/fpdocupdater/fpdocupdater.lpr create mode 100644 doceditor/fpdocupdater/mainunit.lfm create mode 100644 doceditor/fpdocupdater/mainunit.lrs create mode 100644 doceditor/fpdocupdater/mainunit.pas create mode 100644 doceditor/fpdocupdater/unitmove.lfm create mode 100644 doceditor/fpdocupdater/unitmove.lrs create mode 100644 doceditor/fpdocupdater/unitmove.pas diff --git a/.gitattributes b/.gitattributes index c4d033db68..abd1effe5b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1092,6 +1092,15 @@ doceditor/fmmakeskel.lfm svneol=native#text/plain doceditor/fmmakeskel.lrs svneol=native#text/pascal doceditor/fmmakeskel.pp svneol=native#text/pascal doceditor/fpdeutil.pp svneol=native#text/pascal +doceditor/fpdocupdater/fpdocfiles.pas svneol=native#text/pascal +doceditor/fpdocupdater/fpdocupdater.lpi svneol=native#text/plain +doceditor/fpdocupdater/fpdocupdater.lpr svneol=native#text/pascal +doceditor/fpdocupdater/mainunit.lfm svneol=native#text/plain +doceditor/fpdocupdater/mainunit.lrs svneol=native#text/pascal +doceditor/fpdocupdater/mainunit.pas svneol=native#text/pascal +doceditor/fpdocupdater/unitmove.lfm svneol=native#text/plain +doceditor/fpdocupdater/unitmove.lrs svneol=native#text/pascal +doceditor/fpdocupdater/unitmove.pas svneol=native#text/pascal doceditor/frmabout.lfm svneol=native#text/plain doceditor/frmabout.lrs svneol=native#text/pascal doceditor/frmabout.pp svneol=native#text/pascal diff --git a/.gitignore b/.gitignore index f3e834eae8..118d5e2907 100644 --- a/.gitignore +++ b/.gitignore @@ -186,6 +186,10 @@ designer/jitform/*.bak designer/jitform/units designer/units doceditor/*.bak +doceditor/fpdocupdater/*.bak +doceditor/fpdocupdater/units +doceditor/fpdocupdater/units/*.bak +doceditor/fpdocupdater/units/units doceditor/images/*.bak doceditor/images/units doceditor/units diff --git a/doceditor/fpdocupdater/fpdocfiles.pas b/doceditor/fpdocupdater/fpdocfiles.pas new file mode 100644 index 0000000000..92785cc9fc --- /dev/null +++ b/doceditor/fpdocupdater/fpdocfiles.pas @@ -0,0 +1,549 @@ +{ + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** + + Author: Tom Gregorovic +} +unit FPDocFiles; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Contnrs, DOM, XMLWrite, XMLRead; + +type + { TFPDocNode } + + TFPDocNode = class + private + FName: String; + FNode: TDOMNode; + function GetNodeValue(const AName: String): String; + function GetDescription: String; + function GetShort: String; + procedure SetNodeValue(const AName, AValue: String); + procedure SetDescription(const AValue: String); + procedure SetShort(const AValue: String); + public + constructor Create(ANode: TDOMNode); + procedure Assign(ASource: TFPDocNode); + public + property Name: String read FName; + property Description: String read GetDescription write SetDescription; + property Short: String read GetShort write SetShort; + end; + + { TFPDocElement } + + TFPDocElement = class(TFPDocNode) + function GetEmpty: Boolean; + private + function GetErrors: String; + function GetSeaAlso: String; + procedure SetErrors(const AValue: String); + procedure SetSeaAlso(const AValue: String); + public + procedure Assign(ASource: TFPDocElement); + public + property Errors: String read GetErrors write SetErrors; + property SeaAlso: String read GetSeaAlso write SetSeaAlso; + property Empty: Boolean read GetEmpty; + end; + + { TFPDocModule } + + TFPDocModule = class(TFPDocNode) + private + FElements: TObjectList; + FNames: TStringList; + function GetCount: Integer; + function GetElement(Index: Integer): TFPDocElement; + function GetElementByName(const Index: String): TFPDocElement; + public + constructor Create(ANode: TDOMNode); + destructor Destroy; override; + procedure ParseElements; + procedure Add(const AElement: TFPDocElement); + public + property Elements[Index: Integer]: TFPDocElement read GetElement; + property ElementsByName[const Index: String]: TFPDocElement read GetElementByName; + property Count: Integer read GetCount; + property Names: TStringList read FNames; + end; + + { TFPDocPackage } + + TFPDocPackage = class(TFPDocNode) + private + FModules: TObjectList; + FNames: TStringList; + function GetCount: Integer; + function GetModule(Index: Integer): TFPDocModule; + function GetModuleByName(const Index: String): TFPDocModule; + public + constructor Create(ANode: TDOMNode); + destructor Destroy; override; + procedure ParseModules; + public + property Modules[Index: Integer]: TFPDocModule read GetModule; + property ModulesByName[const Index: String]: TFPDocModule read GetModuleByName; + property Count: Integer read GetCount; + property Names: TStringList read FNames; + end; + + TMoveElementEvent = procedure (const SrcPackage: TFPDocPackage; + const SrcModule: TFPDocModule; const Src: TFPDocElement; + const DestList: TStrings; var Dest: String) of object; + + { TFPDocFile } + + TFPDocFile = class + private + FDocument: TXMLDocument; + FPackages: TObjectList; + FNames: TStringList; + function GetCount: Integer; + function GetPackage(Index: Integer): TFPDocPackage; + function GetPackageByName(const Index: String): TFPDocPackage; + public + constructor Create(const FileName: String); + constructor Create(Stream: TStream); + destructor Destroy; override; + procedure ParsePackages; + procedure SaveToFile(const FileName: String); + procedure AssignToSkeleton(const SkeletonFile: TFPDocFile; + OnMoveElement: TMoveElementEvent); + public + property Packages[Index: Integer]: TFPDocPackage read GetPackage; + property PackagesByName[const Index: String]: TFPDocPackage read GetPackageByName; + property Count: Integer read GetCount; + property Names: TStringList read FNames; + end; + +implementation + +uses LCLProc; + +{ TFPDocNode } + +function TFPDocNode.GetNodeValue(const AName: String): String; +var + N: TDOMNode; + S: TStringStream; +begin + Result := ''; + N := FNode.FindNode(AName); + if N = nil then Exit; + if N.FirstChild = nil then Exit; + + S := TStringStream.Create(''); + try + WriteXML(N.FirstChild, S); + Result := S.DataString; + finally + S.Free; + end; +end; + +function TFPDocNode.GetDescription: String; +begin + Result := GetNodeValue('descr'); +end; + +function TFPDocNode.GetShort: String; +begin + Result := GetNodeValue('short'); +end; + +procedure TFPDocNode.SetNodeValue(const AName, AValue: String); +var + N: TDOMNode; + S: TStringStream; +begin + N := FNode.FindNode(AName); + + if N = nil then + begin + if AValue = '' then Exit; + N := FNode.OwnerDocument.CreateElement(AName); + FNode.AppendChild(N); + end; + + while N.FirstChild <> nil do N.RemoveChild(N.FirstChild); + + S := TStringStream.Create(AValue); + try + ReadXMLFragment(N, S); + finally + S.Free; + end; +end; + +procedure TFPDocNode.SetDescription(const AValue: String); +begin + SetNodeValue('descr', AValue); +end; + +procedure TFPDocNode.SetShort(const AValue: String); +begin + SetNodeValue('short', AValue); +end; + +constructor TFPDocNode.Create(ANode: TDOMNode); +begin + FNode := ANode; + FName := FNode.Attributes.GetNamedItem('name').NodeValue; +end; + +procedure TFPDocNode.Assign(ASource: TFPDocNode); +begin + Description := ASource.Description; + Short := ASource.Short; +end; + +{ TFPDocElement } + +function TFPDocElement.GetEmpty: Boolean; +begin + Result := (Description = '') and (Short = '') and (Errors = '') and + (SeaAlso = ''); +end; + +function TFPDocElement.GetErrors: String; +begin + Result := GetNodeValue('errors'); +end; + +function TFPDocElement.GetSeaAlso: String; +begin + Result := GetNodeValue('seaalso'); +end; + +procedure TFPDocElement.SetErrors(const AValue: String); +begin + SetNodeValue('errors', AValue); +end; + +procedure TFPDocElement.SetSeaAlso(const AValue: String); +begin + SetNodeValue('seaalso', AValue); +end; + + +procedure TFPDocElement.Assign(ASource: TFPDocElement); +begin + inherited Assign(ASource); + + Errors := ASource.Errors; + SeaAlso := ASource.SeaAlso; +end; + +{ TFPDocModule } + +function TFPDocModule.GetCount: Integer; +begin + Result := FElements.Count; +end; + +function TFPDocModule.GetElement(Index: Integer): TFPDocElement; +begin + Result := FElements[Index] as TFPDocElement; +end; + +function TFPDocModule.GetElementByName(const Index: String): TFPDocElement; +var + I: Integer; +begin + I := FNames.IndexOf(Index); + if I = -1 then + Result := nil + else + Result := FNames.Objects[I] as TFPDocElement; +end; + +constructor TFPDocModule.Create(ANode: TDOMNode); +begin + inherited; + + FElements := TObjectList.Create(True); + FNames := TStringList.Create; + FNames.Sorted := True; + + ParseElements; +end; + +destructor TFPDocModule.Destroy; +begin + FNames.Free; + FElements.Free; + + inherited Destroy; +end; + +procedure TFPDocModule.ParseElements; +var + I: TDOMNode; + E: TFPDocElement; +begin + FElements.Clear; + FNames.Clear; + + I := FNode.FirstChild; + while I <> nil do + begin + if I.NodeName = 'element' then + begin + E := TFPDocElement.Create(I); + FElements.Add(E); + FNames.AddObject(E.Name, E); + end; + + I := I.NextSibling; + end; +end; + +procedure TFPDocModule.Add(const AElement: TFPDocElement); +var + E: TFPDocElement; + N: TDOMElement; +begin + E := ElementsByName[AElement.Name]; + + if E = nil then + begin + N := FNode.OwnerDocument.CreateElement('element'); + N.AttribStrings['name'] := AElement.Name; + + E := TFPDocElement.Create(FNode.AppendChild(N)); + FElements.Add(E); + FNames.AddObject(E.Name, E); + end; + + E.Assign(AElement); +end; + +{ TFPDocPackage } + +function TFPDocPackage.GetCount: Integer; +begin + Result := FModules.Count; +end; + +function TFPDocPackage.GetModule(Index: Integer): TFPDocModule; +begin + Result := FModules[Index] as TFPDocModule; +end; + +function TFPDocPackage.GetModuleByName(const Index: String): TFPDocModule; +var + I: Integer; +begin + I := FNames.IndexOf(Index); + if I = -1 then + Result := nil + else + Result := FNames.Objects[I] as TFPDocModule; +end; + +constructor TFPDocPackage.Create(ANode: TDOMNode); +begin + inherited; + + FModules := TObjectList.Create(True); + FNames := TStringList.Create; + FNames.Sorted := True; + + ParseModules; +end; + +destructor TFPDocPackage.Destroy; +begin + FNames.Free; + FModules.Free; + + inherited Destroy; +end; + +procedure TFPDocPackage.ParseModules; +var + I: TDOMNode; + M: TFPDocModule; +begin + FModules.Clear; + + I := FNode.FirstChild; + while I <> nil do + begin + if I.NodeName = 'module' then + begin + M := TFPDocModule.Create(I); + FModules.Add(M); + FNames.AddObject(M.Name, M); + end; + + I := I.NextSibling; + end; +end; + +{ TFPDocFile } + +function TFPDocFile.GetCount: Integer; +begin + Result := FPackages.Count; +end; + +function TFPDocFile.GetPackage(Index: Integer): TFPDocPackage; +begin + Result := FPackages[Index] as TFPDocPackage; +end; + +function TFPDocFile.GetPackageByName(const Index: String): TFPDocPackage; +var + I: Integer; +begin + I := FNames.IndexOf(Index); + if I = -1 then + Result := nil + else + Result := FNames.Objects[I] as TFPDocPackage; +end; + +constructor TFPDocFile.Create(const FileName: String); +var + F: TFileStream; +begin + F := TFileStream.Create(FileName, fmOpenRead); + try + Create(F); + finally + F.Free; + end; +end; + +constructor TFPDocFile.Create(Stream: TStream); +begin + ReadXMLFile(FDocument, Stream); + + FPackages := TObjectList.Create(True); + FNames := TStringList.Create; + FNames.Sorted := True; + + ParsePackages; +end; + +destructor TFPDocFile.Destroy; +begin + FNames.Free; + FPackages.Free; + FDocument.Free; + + inherited Destroy; +end; + +procedure TFPDocFile.ParsePackages; +var + I, R: TDOMNode; + P: TFPDocPackage; +begin + FPackages.Clear; + + R := FDocument.FindNode('fpdoc-descriptions'); + if R = nil then + raise Exception.Create('Invalid FPDoc file!'); + + I := R.FirstChild; + while I <> nil do + begin + if I.NodeName = 'package' then + begin + P := TFPDocPackage.Create(I); + FPackages.Add(P); + FNames.AddObject(P.Name, P); + end; + + I := I.NextSibling; + end; +end; + +procedure TFPDocFile.SaveToFile(const FileName: String); +begin + WriteXMLFile(FDocument, FileName); +end; + +procedure TFPDocFile.AssignToSkeleton(const SkeletonFile: TFPDocFile; + OnMoveElement: TMoveElementEvent); +var + I, J, K: Integer; + P1, P2: TFPDocPackage; + M1, M2: TFPDocModule; + E1, E2: TFPDocElement; + DestList: TStringList; + Dest: String; +begin + for I := 0 to Count - 1 do + begin + P1 := Packages[I]; + P2 := SkeletonFile.PackagesByName[P1.Name]; + P2.Assign(P1); + + for J := 0 to P1.Count - 1 do + begin + M1 := P1.Modules[J]; + M2 := P2.ModulesByName[M1.Name]; + M2.Assign(M1); + + DestList := TStringList.Create; + try + for K := 0 to M2.Count - 1 do + begin + E2 := M2.Elements[K]; + if M1.ElementsByName[E2.Name] = nil then DestList.Add(E2.Name); + end; + + for K := 0 to M1.Count - 1 do + begin + E1 := M1.Elements[K]; + if E1.Empty then Continue; + + E2 := M2.ElementsByName[E1.Name]; + + if E2 = nil then + begin + Dest := ''; + if Assigned(OnMoveElement) then + OnMoveElement(P1, M1, E1, DestList, Dest); + + E2 := M2.ElementsByName[Dest]; + if E2 <> nil then E2.Assign(E1); + end + else + E2.Assign(E1); + end; + finally + DestList.Free; + end; + end; + end; +end; + + +end. + diff --git a/doceditor/fpdocupdater/fpdocupdater.lpi b/doceditor/fpdocupdater/fpdocupdater.lpi new file mode 100644 index 0000000000..aff827637b --- /dev/null +++ b/doceditor/fpdocupdater/fpdocupdater.lpi @@ -0,0 +1,119 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/doceditor/fpdocupdater/fpdocupdater.lpr b/doceditor/fpdocupdater/fpdocupdater.lpr new file mode 100644 index 0000000000..ac31546963 --- /dev/null +++ b/doceditor/fpdocupdater/fpdocupdater.lpr @@ -0,0 +1,19 @@ +program FPDocUpdater; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { add your units here }, MainUnit, UnitMove; + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.CreateForm(TFormMove, FormMove); + Application.Run; +end. + diff --git a/doceditor/fpdocupdater/mainunit.lfm b/doceditor/fpdocupdater/mainunit.lfm new file mode 100644 index 0000000000..e9c8d8ec08 --- /dev/null +++ b/doceditor/fpdocupdater/mainunit.lfm @@ -0,0 +1,220 @@ +object Form1: TForm1 + Left = 253 + Height = 484 + Top = 156 + Width = 531 + HorzScrollBar.Page = 530 + VertScrollBar.Page = 483 + ActiveControl = EditDocs + Caption = 'FPDoc Updater' + ClientHeight = 484 + ClientWidth = 531 + Constraints.MinHeight = 464 + Constraints.MinWidth = 300 + OnCreate = FormCreate + OnDestroy = FormDestroy + OnShow = FormShow + object LabelDocs: TLabel + Left = 12 + Height = 14 + Top = 18 + Width = 82 + Caption = 'FPDoc files path:' + ParentColor = False + end + object LabelUnits: TLabel + Left = 12 + Height = 14 + Top = 51 + Width = 54 + Caption = 'Units path:' + ParentColor = False + end + object LabelBackup: TLabel + Left = 395 + Height = 14 + Top = 246 + Width = 89 + Anchors = [akTop, akRight] + Caption = 'Backup extension:' + ParentColor = False + end + object LabelPackage: TLabel + Left = 395 + Height = 14 + Top = 161 + Width = 45 + Anchors = [akTop, akRight] + Caption = 'Package:' + ParentColor = False + end + object LabelMakeSkel: TLabel + Left = 11 + Height = 14 + Top = 124 + Width = 95 + Caption = 'MakeSkel tool path:' + ParentColor = False + end + object LabelInclude: TLabel + Left = 11 + Height = 14 + Top = 90 + Width = 87 + Caption = 'Include files path:' + ParentColor = False + end + object EditDocs: TDirectoryEdit + Left = 126 + Height = 23 + Top = 12 + Width = 347 + Directory = 'D:\Projects\Lazarus\Docs\xml\lcl\' + OnAcceptDirectory = EditDocsAcceptDirectory + ButtonWidth = 45 + NumGlyphs = 1 + Anchors = [akTop, akLeft, akRight] + ParentColor = False + TabOrder = 0 + OnEditingDone = EditDocsEditingDone + end + object EditUnits: TDirectoryEdit + Left = 126 + Height = 23 + Top = 48 + Width = 347 + Directory = 'D:\Projects\Lazarus\LCL\' + OnAcceptDirectory = EditUnitsAcceptDirectory + ButtonWidth = 45 + NumGlyphs = 1 + Anchors = [akTop, akLeft, akRight] + ParentColor = False + TabOrder = 1 + OnEditingDone = EditDocsEditingDone + end + object ButtonUpdate: TButton + Left = 395 + Height = 25 + Top = 354 + Width = 122 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Caption = 'Update' + OnClick = ButtonUpdateClick + TabOrder = 2 + end + object ButtonUpdateAll: TButton + Left = 395 + Height = 25 + Top = 426 + Width = 122 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Caption = 'Update All' + OnClick = ButtonUpdateAllClick + TabOrder = 3 + end + object ButtonUpdateNew: TButton + Left = 395 + Height = 25 + Top = 390 + Width = 122 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Caption = 'Update New' + Font.Color = clRed + OnClick = ButtonUpdateNewClick + TabOrder = 4 + end + object ButtonRefresh: TButton + Left = 395 + Height = 25 + Top = 312 + Width = 122 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Caption = 'Refresh' + OnClick = ButtonRefreshClick + TabOrder = 5 + end + object ListBox: TListBox + Left = 12 + Height = 295 + Top = 156 + Width = 371 + Anchors = [akTop, akLeft, akRight, akBottom] + MultiSelect = True + OnDrawItem = ListBoxDrawItem + Style = lbOwnerDrawFixed + TabOrder = 6 + end + object CheckBoxBackup: TCheckBox + Left = 395 + Height = 13 + Top = 222 + Width = 114 + Anchors = [akTop, akRight] + Caption = 'Backup FPDoc files' + Checked = True + State = cbChecked + TabOrder = 7 + end + object EditBackup: TEdit + Left = 407 + Height = 23 + Top = 270 + Width = 80 + Anchors = [akTop, akRight] + TabOrder = 8 + Text = 'bak' + end + object EditPackage: TEdit + Left = 407 + Height = 23 + Top = 186 + Width = 80 + Anchors = [akTop, akRight] + TabOrder = 9 + Text = 'LCL' + end + object EditMakeSkel: TFileNameEdit + Left = 125 + Height = 23 + Top = 120 + Width = 347 + FileName = 'D:\Projects\fpcbeta\bin\i386-win32\makeskel' + ButtonWidth = 45 + NumGlyphs = 1 + Anchors = [akTop, akLeft, akRight] + ParentColor = False + TabOrder = 10 + end + object EditInclude: TDirectoryEdit + Left = 125 + Height = 23 + Top = 84 + Width = 348 + Directory = 'D:\Projects\Lazarus\LCL\Include' + OnAcceptDirectory = EditIncludeAcceptDirectory + ButtonWidth = 45 + NumGlyphs = 1 + Anchors = [akTop, akLeft, akRight] + ParentColor = False + TabOrder = 11 + OnEditingDone = EditDocsEditingDone + end + object StatusBar: TStatusBar + Height = 20 + Top = 464 + Width = 531 + Panels = <> + end + object OpenDialog: TOpenDialog + Title = 'Open FPDoc file' + DefaultExt = '.xml' + Filter = 'FPDoc file (*.xml)|*.xml|All files|*.*' + Options = [ofFileMustExist, ofEnableSizing, ofViewDetail] + left = 24 + top = 168 + end +end diff --git a/doceditor/fpdocupdater/mainunit.lrs b/doceditor/fpdocupdater/mainunit.lrs new file mode 100644 index 0000000000..9934f6b7c2 --- /dev/null +++ b/doceditor/fpdocupdater/mainunit.lrs @@ -0,0 +1,68 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#253#0#6'Height'#3#228#1#3'Top'#3#156#0#5 + +'Width'#3#19#2#18'HorzScrollBar.Page'#3#18#2#18'VertScrollBar.Page'#3#227#1 + +#13'ActiveControl'#7#8'EditDocs'#7'Caption'#6#13'FPDoc Updater'#12'ClientHei' + +'ght'#3#228#1#11'ClientWidth'#3#19#2#21'Constraints.MinHeight'#3#208#1#20'Co' + +'nstraints.MinWidth'#3','#1#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'F' + +'ormDestroy'#6'OnShow'#7#8'FormShow'#0#6'TLabel'#9'LabelDocs'#4'Left'#2#12#6 + +'Height'#2#14#3'Top'#2#18#5'Width'#2'R'#7'Caption'#6#17'FPDoc files path:'#11 + +'ParentColor'#8#0#0#6'TLabel'#10'LabelUnits'#4'Left'#2#12#6'Height'#2#14#3'T' + +'op'#2'3'#5'Width'#2'6'#7'Caption'#6#11'Units path:'#11'ParentColor'#8#0#0#6 + +'TLabel'#11'LabelBackup'#4'Left'#3#139#1#6'Height'#2#14#3'Top'#3#246#0#5'Wid' + +'th'#2'Y'#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#17'Backup extensi' + +'on:'#11'ParentColor'#8#0#0#6'TLabel'#12'LabelPackage'#4'Left'#3#139#1#6'Hei' + +'ght'#2#14#3'Top'#3#161#0#5'Width'#2'-'#7'Anchors'#11#5'akTop'#7'akRight'#0#7 + +'Caption'#6#8'Package:'#11'ParentColor'#8#0#0#6'TLabel'#13'LabelMakeSkel'#4 + +'Left'#2#11#6'Height'#2#14#3'Top'#2'|'#5'Width'#2'_'#7'Caption'#6#19'MakeSke' + +'l tool path:'#11'ParentColor'#8#0#0#6'TLabel'#12'LabelInclude'#4'Left'#2#11 + +#6'Height'#2#14#3'Top'#2'Z'#5'Width'#2'W'#7'Caption'#6#19'Include files path' + +':'#11'ParentColor'#8#0#0#14'TDirectoryEdit'#8'EditDocs'#4'Left'#2'~'#6'Heig' + +'ht'#2#23#3'Top'#2#12#5'Width'#3'['#1#9'Directory'#6'!D:\Projects\Lazarus\Do' + +'cs\xml\lcl\'#17'OnAcceptDirectory'#7#23'EditDocsAcceptDirectory'#11'ButtonW' + +'idth'#2'-'#9'NumGlyphs'#2#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#11 + +'ParentColor'#8#8'TabOrder'#2#0#13'OnEditingDone'#7#19'EditDocsEditingDone'#0 + +#0#14'TDirectoryEdit'#9'EditUnits'#4'Left'#2'~'#6'Height'#2#23#3'Top'#2'0'#5 + +'Width'#3'['#1#9'Directory'#6#24'D:\Projects\Lazarus\LCL\'#17'OnAcceptDirect' + +'ory'#7#24'EditUnitsAcceptDirectory'#11'ButtonWidth'#2'-'#9'NumGlyphs'#2#1#7 + +'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#11'ParentColor'#8#8'TabOrder'#2 + +#1#13'OnEditingDone'#7#19'EditDocsEditingDone'#0#0#7'TButton'#12'ButtonUpdat' + +'e'#4'Left'#3#139#1#6'Height'#2#25#3'Top'#3'b'#1#5'Width'#2'z'#7'Anchors'#11 + +#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#6'Upda' + +'te'#7'OnClick'#7#17'ButtonUpdateClick'#8'TabOrder'#2#2#0#0#7'TButton'#15'Bu' + +'ttonUpdateAll'#4'Left'#3#139#1#6'Height'#2#25#3'Top'#3#170#1#5'Width'#2'z'#7 + +'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Capti' + +'on'#6#10'Update All'#7'OnClick'#7#20'ButtonUpdateAllClick'#8'TabOrder'#2#3#0 + +#0#7'TButton'#15'ButtonUpdateNew'#4'Left'#3#139#1#6'Height'#2#25#3'Top'#3#134 + +#1#5'Width'#2'z'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerB' + +'order'#2#4#7'Caption'#6#10'Update New'#10'Font.Color'#7#5'clRed'#7'OnClick' + +#7#20'ButtonUpdateNewClick'#8'TabOrder'#2#4#0#0#7'TButton'#13'ButtonRefresh' + +#4'Left'#3#139#1#6'Height'#2#25#3'Top'#3'8'#1#5'Width'#2'z'#7'Anchors'#11#5 + +'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#7'Refres' + +'h'#7'OnClick'#7#18'ButtonRefreshClick'#8'TabOrder'#2#5#0#0#8'TListBox'#7'Li' + +'stBox'#4'Left'#2#12#6'Height'#3''''#1#3'Top'#3#156#0#5'Width'#3's'#1#7'Anch' + +'ors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#11'MultiSelect'#9#10'On' + +'DrawItem'#7#15'ListBoxDrawItem'#5'Style'#7#16'lbOwnerDrawFixed'#8'TabOrder' + +#2#6#0#0#9'TCheckBox'#14'CheckBoxBackup'#4'Left'#3#139#1#6'Height'#2#13#3'To' + +'p'#3#222#0#5'Width'#2'r'#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#18 + +'Backup FPDoc files'#7'Checked'#9#5'State'#7#9'cbChecked'#8'TabOrder'#2#7#0#0 + +#5'TEdit'#10'EditBackup'#4'Left'#3#151#1#6'Height'#2#23#3'Top'#3#14#1#5'Widt' + +'h'#2'P'#7'Anchors'#11#5'akTop'#7'akRight'#0#8'TabOrder'#2#8#4'Text'#6#3'bak' + +#0#0#5'TEdit'#11'EditPackage'#4'Left'#3#151#1#6'Height'#2#23#3'Top'#3#186#0#5 + +'Width'#2'P'#7'Anchors'#11#5'akTop'#7'akRight'#0#8'TabOrder'#2#9#4'Text'#6#3 + +'LCL'#0#0#13'TFileNameEdit'#12'EditMakeSkel'#4'Left'#2'}'#6'Height'#2#23#3'T' + +'op'#2'x'#5'Width'#3'['#1#8'FileName'#6'+D:\Projects\fpcbeta\bin\i386-win32\' + +'makeskel'#11'ButtonWidth'#2'-'#9'NumGlyphs'#2#1#7'Anchors'#11#5'akTop'#6'ak' + +'Left'#7'akRight'#0#11'ParentColor'#8#8'TabOrder'#2#10#0#0#14'TDirectoryEdit' + +#11'EditInclude'#4'Left'#2'}'#6'Height'#2#23#3'Top'#2'T'#5'Width'#3'\'#1#9'D' + +'irectory'#6#31'D:\Projects\Lazarus\LCL\Include'#17'OnAcceptDirectory'#7#26 + +'EditIncludeAcceptDirectory'#11'ButtonWidth'#2'-'#9'NumGlyphs'#2#1#7'Anchors' + +#11#5'akTop'#6'akLeft'#7'akRight'#0#11'ParentColor'#8#8'TabOrder'#2#11#13'On' + +'EditingDone'#7#19'EditDocsEditingDone'#0#0#10'TStatusBar'#9'StatusBar'#6'He' + +'ight'#2#20#3'Top'#3#208#1#5'Width'#3#19#2#6'Panels'#14#0#0#0#11'TOpenDialog' + +#10'OpenDialog'#5'Title'#6#15'Open FPDoc file'#10'DefaultExt'#6#4'.xml'#6'Fi' + +'lter'#6'&FPDoc file (*.xml)|*.xml|All files|*.*'#7'Options'#11#15'ofFileMus' + +'tExist'#14'ofEnableSizing'#12'ofViewDetail'#0#4'left'#2#24#3'top'#3#168#0#0 + +#0#0 +]); diff --git a/doceditor/fpdocupdater/mainunit.pas b/doceditor/fpdocupdater/mainunit.pas new file mode 100644 index 0000000000..f36667a616 --- /dev/null +++ b/doceditor/fpdocupdater/mainunit.pas @@ -0,0 +1,474 @@ +{ + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** + + Author: Tom Gregorovic +} +unit MainUnit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, + FPDocFiles, StdCtrls, ComCtrls, Masks, FileUtil, ExtCtrls, + LCLIntf, LCLType, LCLProc, Process, EditBtn, XMLCfg; + +type + + { TForm1 } + + TForm1 = class(TForm) + ButtonRefresh: TButton; + ButtonUpdateNew: TButton; + ButtonUpdate: TButton; + ButtonUpdateAll: TButton; + CheckBoxBackup: TCheckBox; + EditInclude: TDirectoryEdit; + EditMakeSkel: TFileNameEdit; + EditPackage: TEdit; + EditBackup: TEdit; + EditUnits: TDirectoryEdit; + EditDocs: TDirectoryEdit; + Label1: TLabel; + LabelInclude: TLabel; + LabelMakeSkel: TLabel; + LabelPackage: TLabel; + LabelBackup: TLabel; + LabelUnits: TLabel; + LabelDocs: TLabel; + ListBox: TListBox; + OpenDialog: TOpenDialog; + StatusBar: TStatusBar; + procedure ButtonRefreshClick(Sender: TObject); + procedure ButtonUpdateAllClick(Sender: TObject); + procedure ButtonUpdateClick(Sender: TObject); + procedure ButtonUpdateNewClick(Sender: TObject); + procedure EditDocsAcceptDirectory(Sender: TObject; var Value: String); + procedure EditDocsEditingDone(Sender: TObject); + procedure EditIncludeAcceptDirectory(Sender: TObject; var Value: String); + procedure EditUnitsAcceptDirectory(Sender: TObject; var Value: String); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormShow(Sender: TObject); + procedure ListBoxDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); + private + { private declarations } + public + procedure BeginUpdate; + procedure EndUpdate; + procedure UpdateList; + procedure UpdateFile(const AFileName: String); + procedure BackupFile(const AFileName: String); + procedure WriteStatus(const S: String); + + procedure MoveElement(const SrcPackage: TFPDocPackage; + const SrcModule: TFPDocModule; const Src: TFPDocElement; + const DestList: TStrings; var Dest: String); + end; + +var + Form1: TForm1; + XMLConfig: TXMLConfig; + BackupList: TStringList; + +implementation + +uses + UnitMove; + +function FindFiles(const Path, Mask: String; WithPath: Boolean = True; + WithExt: Boolean = True): TStringList; +var + MaskList: TMaskList; + Info: TSearchRec; + S: String; +begin + Result := TStringList.Create; + MaskList := TMaskList.Create(Mask); + try + if SysUtils.FindFirst(Path + GetAllFilesMask, faAnyFile, Info) = 0 then + repeat + if MaskList.Matches(Info.Name) then + begin + if WithPath then S := Path + else S := ''; + if WithExt then S := S + Info.Name + else S := S + ExtractFileNameOnly(Info.Name); + + Result.Add(S); + end; + until SysUtils.FindNext(Info) <> 0; + + SysUtils.FindClose(Info); + finally + MaskList.Free; + end; +end; + +{ TForm1 } + +procedure TForm1.FormShow(Sender: TObject); +begin + UpdateList; +end; + +procedure TForm1.ListBoxDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); +begin + if (Index < 0) or (Index >= ListBox.Items.Count) then Exit; + + with ListBox.Canvas do + begin + if odSelected in State then + Brush.Color := clHighlight + else + begin + Brush.Color := ListBox.Color; + case Integer(ListBox.Items.Objects[Index]) of + 0: SetTextColor(ListBox.Canvas.Handle, ListBox.Canvas.Font.Color); // normal + 1: SetTextColor(ListBox.Canvas.Handle, clRed); // new + end; + end; + + FillRect(ARect); + TextRect(ARect, ARect.Left + 8, ARect.Top, ExtractFileNameOnly(ListBox.Items[Index])); + end; +end; + +procedure TForm1.BeginUpdate; +begin + BackupList := TStringList.Create; + BackupList.Sorted := True; + WriteStatus('Updating started.'); +end; + +procedure TForm1.EndUpdate; +begin + BackupList.Free; + UpdateList; + WriteStatus('Updating done.'); + Sleep(1000); + WriteStatus(''); +end; + +procedure TForm1.ButtonRefreshClick(Sender: TObject); +begin + UpdateList; +end; + +procedure TForm1.ButtonUpdateAllClick(Sender: TObject); +var + I: Integer; +begin + BeginUpdate; + try + for I := 0 to ListBox.Items.Count - 1 do + UpdateFile(ListBox.Items[I]); + finally + EndUpdate; + end; +end; + +procedure TForm1.ButtonUpdateClick(Sender: TObject); +var + I: Integer; +begin + BeginUpdate; + try + for I := 0 to ListBox.Items.Count - 1 do + if ListBox.Selected[I] then UpdateFile(ListBox.Items[I]); + finally + EndUpdate; + end; +end; + +procedure TForm1.ButtonUpdateNewClick(Sender: TObject); +var + I: Integer; +begin + BeginUpdate; + try + for I := 0 to ListBox.Items.Count - 1 do + if Integer(ListBox.items.Objects[I]) = 1 then UpdateFile(ListBox.Items[I]); + finally + EndUpdate; + end; +end; + +procedure TForm1.EditDocsAcceptDirectory(Sender: TObject; var Value: String); +begin + EditDocs.Directory := AppendPathDelim(Value); + EditDocs.SetFocus; + UpdateList; + Value := ''; +end; + +procedure TForm1.EditDocsEditingDone(Sender: TObject); +begin + UpdateList; +end; + +procedure TForm1.EditIncludeAcceptDirectory(Sender: TObject; var Value: String); +begin + Value := AppendPathDelim(Value); +end; + +procedure TForm1.EditUnitsAcceptDirectory(Sender: TObject; var Value: String); +begin + EditUnits.Directory := AppendPathDelim(Value); + EditUnits.SetFocus; + UpdateList; + Value := ''; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + XMLConfig := TXMLConfig.Create(nil); + XMLConfig.RootName := 'Config'; + XMLConfig.Filename := 'FPDocUpdater.xml'; + + EditDocs.Directory := XMLConfig.GetValue('FPDocsPath/Value', 'D:\Projects\lazarus\docs\xml\lcl\'); + EditUnits.Directory := XMLConfig.GetValue('UnitsPath/Value', 'D:\Projects\lazarus\lcl\'); + EditInclude.Directory := XMLConfig.GetValue('IncludePath/Value', 'D:\Projects\lazarus\lcl\include\'); + EditMakeSkel.FileName := XMLConfig.GetValue('MakeSkelPath/Value', 'D:\Projects\fpcbeta\bin\i386-win32\makeskel.exe'); + CheckBoxBackup.Checked := XMLConfig.GetValue('BackupFPDocs/Value', True); + EditBackup.Text := XMLConfig.GetValue('BackupExt/Value', 'bak'); + EditPackage.Text := XMLConfig.GetValue('Package/Value', 'LCL'); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + XMLConfig.Clear; + XMLConfig.SetValue('FPDocsPath/Value', EditDocs.Directory); + XMLConfig.SetValue('UnitsPath/Value', EditUnits.Directory); + XMLConfig.SetValue('IncludePath/Value', EditInclude.Directory); + XMLConfig.SetValue('MakeSkelPath/Value', EditMakeSkel.FileName); + XMLConfig.SetValue('BackupFPDocs/Value', CheckBoxBackup.Checked); + XMLConfig.SetValue('BackupExt/Value', EditBackup.Text); + XMLConfig.SetValue('Package/Value', EditPackage.Text); + + XMLConfig.Free; +end; + +procedure TForm1.UpdateList; +var + Docs, Units: TStringList; + I: Integer; + N: String; + State: Integer; +begin + ListBox.Items.BeginUpdate; + try + ListBox.Items.Clear; + + Docs := FindFiles(EditDocs.Directory, '*.xml', False, False); + Units := FindFiles(EditUnits.Directory, '*.pas;*.pp'); + try + Units.Sorted := True; + for I := 0 to Units.Count - 1 do + begin + N := ExtractFileNameOnly(Units[I]); + + if Docs.IndexOf(N) = -1 then State := 1 + else + State := 0; + + ListBox.Items.AddObject(Units[I], TObject(State)); + end; + finally + Units.Free; + Docs.Free; + end; + finally + ListBox.Items.EndUpdate; + end; + ListBox.SetFocus; +end; + +procedure ShowError(const S: String); +begin + DebugLn(S); + raise Exception.Create(S); +end; + +procedure TForm1.UpdateFile(const AFileName: String); +var + DocFileName: String; + MakeSkelPath: String; + AProcess: TProcess; + AStringList: TStringList; + M: TMemoryStream; + N, BytesRead: LongInt; + OldDoc, NewDoc: TFPDocFile; +const + READ_BYTES = 2048; + +begin + if not FileExists(AFileName) then + begin + ShowError('Update ' + AFileName + ' failed!'); + Exit; + end; + + MakeSkelPath := FindDefaultExecutablePath(EditMakeSkel.FileName); + + if not FileIsExecutable(MakeSkelPath) then + ShowError('Unable to find MakeSkel tool executable "' + EditMakeSkel.Text +'"!'); + + DocFileName := EditDocs.Directory + ExtractFileNameOnly(AFileName) + '.xml'; + + if CheckBoxBackup.Checked then BackupFile(DocFileName); + + WriteStatus('Updating ' + AFileName); + + AProcess := TProcess.Create(nil); + AStringList := TStringList.Create; + M := TMemoryStream.Create; + try + AProcess.CommandLine := + Format(MakeSkelPath + ' --package="%s" --input="%s -Fi%s"', + [EditPackage.Text, AFileName, EditInclude.Directory]); + AProcess.Options := AProcess.Options + [poUsePipes]; + AProcess.Execute; + + BytesRead := 0; + while AProcess.Running do + begin + M.SetSize(BytesRead + READ_BYTES); + N := AProcess.Output.Read((M.Memory + BytesRead)^, READ_BYTES); + if N > 0 then Inc(BytesRead, N) + else Sleep(100); + end; + + repeat + M.SetSize(BytesRead + READ_BYTES); + N := AProcess.Output.Read((M.Memory + BytesRead)^, READ_BYTES); + if N > 0 then Inc(BytesRead, N); + until N <= 0; + M.SetSize(BytesRead); + + AStringList.LoadFromStream(M); + if AStringList.Strings[AStringList.Count - 1] <> 'Done.' then + begin + ShowError('Update ' + AFileName + ' failed! ' + AStringList.Strings[AStringList.Count - 1]); + Exit; + end; + + while (AStringList.Count > 0) and + (AStringList.Strings[AStringList.Count - 1] <> '') do + AStringList.Delete(AStringList.Count - 1); + + M.Clear; + AStringList.SaveToStream(M); + M.Position := 0; + NewDoc := TFPDocFile.Create(M); + if FileExists(DocFileName) then OldDoc := TFPDocFile.Create(DocFileName) + else OldDoc := nil; + try + if OldDoc <> nil then OldDoc.AssignToSkeleton(NewDoc, @MoveElement); + NewDoc.SaveToFile(DocFileName); + finally + if OldDoc <> nil then OldDoc.Free; + NewDoc.Free; + end; + + WriteStatus('Update ' + AFileName + ' in ' + DocFileName + ' succeeds!'); + finally + M.Free; + AStringList.Free; + AProcess.Free; + end; +end; + +procedure TForm1.BackupFile(const AFileName: String); +var + BackupFileName: String; +begin + if not FileExists(AFileName) then Exit; + + if BackupList.IndexOf(AFileName) = -1 then + begin + BackupFileName := ChangeFileExt(AFileName, '.' + EditBackup.Text); + + if CopyFile(AFileName, BackupFileName, True) then + begin + WriteStatus('Backup ' + AFileName + ' to ' + BackupFileName + ' succeeds.'); + BackupList.Add(AFileName); + end + else + ShowError('Backup ' + AFileName + ' to ' + BackupFileName + ' failed!'); + end; +end; + +procedure TForm1.WriteStatus(const S: String); +begin + DebugLn(S); + StatusBar.SimpleText := S; +end; + +procedure TForm1.MoveElement(const SrcPackage: TFPDocPackage; + const SrcModule: TFPDocModule; const Src: TFPDocElement; + const DestList: TStrings; var Dest: String); +var + F: TFPDocFile; +begin + FormMove.LabelSrc.Caption := Format('Package: %sModule: %s', + [SrcPackage.Name + LineEnding, SrcModule.Name]); + FormMove.LabelSrcElement.Caption := 'Element: ' + Src.Name; + + FormMove.ComboBoxDest.Items.Assign(DestList); + FormMove.ComboBoxDest.Sorted := True; + + case FormMove.ShowModal of + mrYes: + Dest := FormMove.ComboBoxDest.Text; + mrCancel: + begin // Move to another file + OpenDialog.InitialDir := ExtractFileDir(EditDocs.Directory); + if OpenDialog.Execute then + begin + if CheckBoxBackup.Checked then BackupFile(OpenDialog.FileName); + + F := TFPDocFile.Create(OpenDialog.FileName); + try + F.PackagesByName[EditPackage.Text].Modules[0].Add(Src); + F.SaveToFile(OpenDialog.FileName); + + WriteStatus('Move Element: ' + SrcPackage.Name + '\' + SrcModule.Name + + '\' + Src.Name + ' Dest file: ' + OpenDialog.FileName); + Exit; + finally + F.Free; + end; + end; + end; + end; + + WriteStatus('Move Element: ' + SrcPackage.Name + '\' + SrcModule.Name + '\' + Src.Name + + ' Dest: ' + Dest); +end; + +initialization + {$I mainunit.lrs} + +end. + diff --git a/doceditor/fpdocupdater/unitmove.lfm b/doceditor/fpdocupdater/unitmove.lfm new file mode 100644 index 0000000000..b7407e6133 --- /dev/null +++ b/doceditor/fpdocupdater/unitmove.lfm @@ -0,0 +1,92 @@ +object FormMove: TFormMove + Left = 299 + Height = 235 + Top = 153 + Width = 400 + HorzScrollBar.Page = 399 + VertScrollBar.Page = 234 + ActiveControl = ButtonYes + BorderIcons = [biSystemMenu, biMinimize] + BorderStyle = bsSingle + Caption = 'Move Element' + ChildSizing.LeftRightSpacing = 10 + ChildSizing.TopBottomSpacing = 10 + ClientHeight = 235 + ClientWidth = 400 + object LabelSrc: TLabel + Left = 10 + Height = 42 + Top = 66 + Width = 379 + AutoSize = False + ParentColor = False + end + object LabelDest: TLabel + Left = 10 + Height = 14 + Top = 156 + Width = 100 + Caption = 'Destination element:' + ParentColor = False + end + object LabelSrcElement: TLabel + Left = 10 + Height = 18 + Top = 120 + Width = 42 + Font.Style = [fsBold] + ParentColor = False + end + object ButtonYes: TButton + Left = 66 + Height = 25 + Top = 199 + Width = 75 + Anchors = [akRight, akBottom] + BorderSpacing.InnerBorder = 4 + Caption = 'Yes' + ModalResult = 6 + TabOrder = 0 + end + object ButtonNo: TButton + Left = 150 + Height = 25 + Top = 199 + Width = 75 + Anchors = [akRight, akBottom] + BorderSpacing.InnerBorder = 4 + Caption = 'No' + ModalResult = 7 + TabOrder = 1 + end + object StaticText: TStaticText + Left = 10 + Height = 42 + Top = 10 + Width = 380 + Align = alTop + Caption = 'The following FPDoc element is not present in the skeleton. Move its contents into different one?' + Color = clBtnFace + Font.Style = [fsBold] + end + object ComboBoxDest: TComboBox + Left = 132 + Height = 21 + Top = 150 + Width = 258 + AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] + ItemHeight = 13 + Style = csDropDownList + TabOrder = 2 + end + object ButtonMove: TButton + Left = 234 + Height = 25 + Top = 199 + Width = 155 + BorderSpacing.InnerBorder = 4 + Caption = 'Move to another file...' + OnClick = ButtonMoveClick + TabOrder = 3 + end +end diff --git a/doceditor/fpdocupdater/unitmove.lrs b/doceditor/fpdocupdater/unitmove.lrs new file mode 100644 index 0000000000..5cae5520e5 --- /dev/null +++ b/doceditor/fpdocupdater/unitmove.lrs @@ -0,0 +1,31 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TFormMove','FORMDATA',[ + 'TPF0'#9'TFormMove'#8'FormMove'#4'Left'#3'+'#1#6'Height'#3#235#0#3'Top'#3#153 + +#0#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3 + +#234#0#13'ActiveControl'#7#9'ButtonYes'#11'BorderIcons'#11#12'biSystemMenu' + +#10'biMinimize'#0#11'BorderStyle'#7#8'bsSingle'#7'Caption'#6#12'Move Element' + +#28'ChildSizing.LeftRightSpacing'#2#10#28'ChildSizing.TopBottomSpacing'#2#10 + +#12'ClientHeight'#3#235#0#11'ClientWidth'#3#144#1#0#6'TLabel'#8'LabelSrc'#4 + +'Left'#2#10#6'Height'#2'*'#3'Top'#2'B'#5'Width'#3'{'#1#8'AutoSize'#8#11'Pare' + +'ntColor'#8#0#0#6'TLabel'#9'LabelDest'#4'Left'#2#10#6'Height'#2#14#3'Top'#3 + +#156#0#5'Width'#2'd'#7'Caption'#6#20'Destination element:'#11'ParentColor'#8 + +#0#0#6'TLabel'#15'LabelSrcElement'#4'Left'#2#10#6'Height'#2#18#3'Top'#2'x'#5 + +'Width'#2'*'#10'Font.Style'#11#6'fsBold'#0#11'ParentColor'#8#0#0#7'TButton'#9 + +'ButtonYes'#4'Left'#2'B'#6'Height'#2#25#3'Top'#3#199#0#5'Width'#2'K'#7'Ancho' + +'rs'#11#7'akRight'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption' + +#6#3'Yes'#11'ModalResult'#2#6#8'TabOrder'#2#0#0#0#7'TButton'#8'ButtonNo'#4'L' + +'eft'#3#150#0#6'Height'#2#25#3'Top'#3#199#0#5'Width'#2'K'#7'Anchors'#11#7'ak' + +'Right'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#2'No'#11 + +'ModalResult'#2#7#8'TabOrder'#2#1#0#0#11'TStaticText'#10'StaticText'#4'Left' + +#2#10#6'Height'#2'*'#3'Top'#2#10#5'Width'#3'|'#1#5'Align'#7#5'alTop'#7'Capti' + +'on'#6'aThe following FPDoc element is not present in the skeleton. Move its' + +' contents into different one?'#5'Color'#7#9'clBtnFace'#10'Font.Style'#11#6 + +'fsBold'#0#0#0#9'TComboBox'#12'ComboBoxDest'#4'Left'#3#132#0#6'Height'#2#21#3 + +'Top'#3#150#0#5'Width'#3#2#1#16'AutoCompleteText'#11#22'cbactEndOfLineComple' + +'te'#20'cbactSearchAscending'#0#10'ItemHeight'#2#13#5'Style'#7#14'csDropDown' + +'List'#8'TabOrder'#2#2#0#0#7'TButton'#10'ButtonMove'#4'Left'#3#234#0#6'Heigh' + +'t'#2#25#3'Top'#3#199#0#5'Width'#3#155#0#25'BorderSpacing.InnerBorder'#2#4#7 + +'Caption'#6#23'Move to another file...'#7'OnClick'#7#15'ButtonMoveClick'#8'T' + +'abOrder'#2#3#0#0#0 +]); diff --git a/doceditor/fpdocupdater/unitmove.pas b/doceditor/fpdocupdater/unitmove.pas new file mode 100644 index 0000000000..38cf6763e2 --- /dev/null +++ b/doceditor/fpdocupdater/unitmove.pas @@ -0,0 +1,69 @@ +{ + *************************************************************************** + * * + * This source is free software; you can redistribute it and/or modify * + * it under the terms of the GNU General Public License as published by * + * the Free Software Foundation; either version 2 of the License, or * + * (at your option) any later version. * + * * + * This code is distributed in the hope that it will be useful, but * + * WITHOUT ANY WARRANTY; without even the implied warranty of * + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * + * General Public License for more details. * + * * + * A copy of the GNU General Public License is available on the World * + * Wide Web at . You can also * + * obtain it by writing to the Free Software Foundation, * + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * + * * + *************************************************************************** + + Author: Tom Gregorovic +} +unit UnitMove; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + ExtCtrls; + +type + + { TFormMove } + + TFormMove = class(TForm) + ButtonMove: TButton; + ButtonYes: TButton; + ButtonNo: TButton; + ComboBoxDest: TComboBox; + LabelSrcElement: TLabel; + LabelDest: TLabel; + LabelSrc: TLabel; + StaticText: TStaticText; + procedure ButtonMoveClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + FormMove: TFormMove; + +implementation + +{ TFormMove } + +procedure TFormMove.ButtonMoveClick(Sender: TObject); +begin + ModalResult := mrCancel; +end; + +initialization + {$I unitmove.lrs} + +end. +