From 21de341ae225913097fd899bbefc568a31da042b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= Date: Sun, 5 Jan 2025 23:16:49 +0100 Subject: [PATCH] * Project wizards for client/server openapi projects --- .../openapi/fraopenapiprojectsettings.lfm | 110 ++ .../openapi/fraopenapiprojectsettings.pas | 85 ++ components/openapi/fraopenapisettings.lfm | 584 ++++++--- components/openapi/fraopenapisettings.pas | 98 +- components/openapi/frmopenapiproject.lfm | 309 +++++ components/openapi/frmopenapiproject.pas | 175 +++ components/openapi/lazopenapi.lpk | 21 + components/openapi/lazopenapi.pas | 3 +- components/openapi/lazopenapictrl.pas | 246 ++++ components/openapi/lazopenapistr.pas | 34 + components/openapi/reglazopenapi.pas | 1059 +++++++++++++++-- 11 files changed, 2439 insertions(+), 285 deletions(-) create mode 100644 components/openapi/fraopenapiprojectsettings.lfm create mode 100644 components/openapi/fraopenapiprojectsettings.pas create mode 100644 components/openapi/frmopenapiproject.lfm create mode 100644 components/openapi/frmopenapiproject.pas create mode 100644 components/openapi/lazopenapictrl.pas create mode 100644 components/openapi/lazopenapistr.pas diff --git a/components/openapi/fraopenapiprojectsettings.lfm b/components/openapi/fraopenapiprojectsettings.lfm new file mode 100644 index 0000000000..d5c481113a --- /dev/null +++ b/components/openapi/fraopenapiprojectsettings.lfm @@ -0,0 +1,110 @@ +object LazOpenAPIProjectOptions: TLazOpenAPIProjectOptions + Left = 0 + Height = 302 + Top = 0 + Width = 567 + ClientHeight = 302 + ClientWidth = 567 + TabOrder = 0 + DesignLeft = 468 + DesignTop = 287 + object lblOpenAPIFile: TLabel + AnchorSideTop.Control = FEOpenAPI + AnchorSideRight.Control = FEOpenAPI + AnchorSideBottom.Control = FEOpenAPI + AnchorSideBottom.Side = asrBottom + Left = 104 + Height = 28 + Top = 16 + Width = 80 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 + Caption = 'Open API File' + Layout = tlCenter + end + object lblBaseUnitFile: TLabel + AnchorSideTop.Control = FEBaseUnitFile + AnchorSideRight.Control = FEBaseUnitFile + AnchorSideBottom.Control = FEBaseUnitFile + AnchorSideBottom.Side = asrBottom + Left = 67 + Height = 28 + Top = 88 + Width = 117 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 + Caption = 'Base unit filename' + Layout = tlCenter + end + object lblConfig: TLabel + AnchorSideTop.Control = FEConfig + AnchorSideRight.Control = FEConfig + AnchorSideBottom.Control = FEConfig + AnchorSideBottom.Side = asrBottom + Left = 32 + Height = 28 + Top = 52 + Width = 152 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 + Caption = 'Generator configuration' + Layout = tlCenter + end + object FEOpenAPI: TFileNameEdit + AnchorSideTop.Control = Owner + Left = 192 + Height = 28 + Top = 16 + Width = 360 + FilterIndex = 0 + HideDirectories = False + ButtonWidth = 23 + NumGlyphs = 1 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 16 + MaxLength = 0 + TabOrder = 0 + end + object FEConfig: TFileNameEdit + AnchorSideTop.Control = FEOpenAPI + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = FEOpenAPI + AnchorSideRight.Side = asrBottom + Left = 192 + Height = 28 + Top = 52 + Width = 360 + FilterIndex = 0 + HideDirectories = False + ButtonWidth = 23 + NumGlyphs = 1 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + MaxLength = 0 + TabOrder = 1 + end + object FEBaseUnitFile: TFileNameEdit + AnchorSideTop.Control = FEConfig + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = FEConfig + AnchorSideRight.Side = asrBottom + Left = 192 + Height = 28 + Top = 88 + Width = 360 + FilterIndex = 0 + HideDirectories = False + ButtonWidth = 23 + NumGlyphs = 1 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + MaxLength = 0 + TabOrder = 2 + end +end diff --git a/components/openapi/fraopenapiprojectsettings.pas b/components/openapi/fraopenapiprojectsettings.pas new file mode 100644 index 0000000000..2f028c9168 --- /dev/null +++ b/components/openapi/fraopenapiprojectsettings.pas @@ -0,0 +1,85 @@ +unit fraopenapiprojectsettings; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, StdCtrls, EditBtn, + // IdeIntf + LazIDEIntf, ProjectIntf, CompOptsIntf, IDEOptionsIntf, IDEOptEditorIntf, + // Openapi + lazopenapistr, lazopenapictrl + ; + +type + + { TLazOpenAPIProjectOptions } + + TLazOpenAPIProjectOptions = class(TAbstractIDEOptionsEditor) + FEOpenAPI: TFileNameEdit; + FEBaseUnitFile: TFileNameEdit; + FEConfig: TFileNameEdit; + lblBaseUnitFile: TLabel; + lblConfig: TLabel; + lblOpenAPIFile: TLabel; + private + + public + function GetTitle: string; override; + procedure Setup({%H-}ADialog: TAbstractOptionsEditorDialog); override; + procedure ReadSettings(AOptions: TAbstractIDEOptions); override; + procedure WriteSettings(AOptions: TAbstractIDEOptions); override; + class function SupportedOptionsClass: TAbstractIDEOptionsClass; override; + end; + +implementation + + +{$R *.lfm} + +{ TLazOpenAPIProjectOptions } + +function TLazOpenAPIProjectOptions.GetTitle: string; +begin + Result:=SOpenAPIProjectOptionsCaption; +end; + +procedure TLazOpenAPIProjectOptions.Setup(ADialog: TAbstractOptionsEditorDialog); +var + lPath : String; +begin + lPath:=ExtractFilePath(LazarusIDE.ActiveProject.ProjectInfoFile); + FEConfig.InitialDir:=lPath; + FEBaseUnitFile.InitialDir:=lPath; + FEOpenAPI.InitialDir:=lPath; +end; + +procedure TLazOpenAPIProjectOptions.ReadSettings(AOptions: TAbstractIDEOptions); +var + lOpenAPI,lConfig,lBaseFile : String; +begin + OpenAPIHandler.GetProjectData(LazarusIDE.ActiveProject,lConfig,lOpenAPI,lBaseFile); + FEConfig.FileName:=lConfig; + FEOpenAPI.FileName:=lOpenAPI; + FEBaseUnitFile.FileName:=lBaseFile; +end; + +procedure TLazOpenAPIProjectOptions.WriteSettings(AOptions: TAbstractIDEOptions); +var + lOpenAPI,lConfig,lBaseFile : String; +begin + lConfig:=FEConfig.FileName; + lOpenAPI:=FEOpenAPI.FileName; + lBaseFile:=FEBaseUnitFile.FileName; + OpenAPIHandler.SetProjectData(LazarusIDE.ActiveProject,lConfig,lOpenAPI,lBaseFile); + +end; + +class function TLazOpenAPIProjectOptions.SupportedOptionsClass: TAbstractIDEOptionsClass; +begin + Result:=TAbstractIDEProjectOptions; +end; + +end. + diff --git a/components/openapi/fraopenapisettings.lfm b/components/openapi/fraopenapisettings.lfm index 43f1e14f19..89d82cdec2 100644 --- a/components/openapi/fraopenapisettings.lfm +++ b/components/openapi/fraopenapisettings.lfm @@ -1,10 +1,10 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame Left = 0 - Height = 500 + Height = 479 Top = 0 - Width = 711 - ClientHeight = 500 - ClientWidth = 711 + Width = 753 + ClientHeight = 479 + ClientWidth = 753 TabOrder = 0 DesignLeft = 495 DesignTop = 272 @@ -12,7 +12,7 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame Left = 104 Height = 28 Top = 8 - Width = 591 + Width = 633 FileName = 'edtFile' DialogOptions = [ofFileMustExist, ofEnableSizing, ofViewDetail] Filter = 'JSON files|*.json|All files|*.*' @@ -76,21 +76,22 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame AnchorSideBottom.Control = Owner AnchorSideBottom.Side = asrBottom Left = 16 - Height = 409 + Height = 388 Top = 75 - Width = 679 - ActivePage = TSGeneral + Width = 721 + ActivePage = TSServiceMap Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 16 BorderSpacing.Top = 8 BorderSpacing.Right = 16 BorderSpacing.Bottom = 16 - TabIndex = 0 + TabIndex = 5 TabOrder = 3 object TSGeneral: TTabSheet Caption = 'General' - ClientHeight = 379 - ClientWidth = 669 + ClientHeight = 358 + ClientWidth = 711 + OnContextPopup = TSGeneralContextPopup object CBDelphiCode: TCheckBox AnchorSideLeft.Control = TSGeneral AnchorSideTop.Control = TSGeneral @@ -132,21 +133,20 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame AnchorSideTop.Control = CBEnums AnchorSideTop.Side = asrBottom Left = 16 - Height = 147 + Height = 99 Top = 101 - Width = 560 + Width = 683 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 Caption = 'Automatic file naming' - ClientHeight = 130 - ClientWidth = 558 + ClientHeight = 82 + ClientWidth = 681 TabOrder = 3 object edtUnitSuffix: TEdit - AnchorSideLeft.Control = lblUnitSuffix - AnchorSideTop.Control = lblUnitSuffix - AnchorSideTop.Side = asrBottom - Left = 16 + AnchorSideTop.Control = GBAutoNaming + Left = 180 Height = 28 - Top = 32 + Top = 8 Width = 176 BorderSpacing.Top = 8 TabOrder = 0 @@ -154,141 +154,179 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame end object lblUnitSuffix: TLabel AnchorSideLeft.Control = GBAutoNaming - AnchorSideTop.Control = GBAutoNaming - Left = 16 - Height = 16 + AnchorSideTop.Control = edtUnitSuffix + AnchorSideRight.Control = edtUnitSuffix + AnchorSideBottom.Control = edtUnitSuffix + AnchorSideBottom.Side = asrBottom + Left = 8 + Height = 28 Top = 8 - Width = 156 - BorderSpacing.Left = 16 - BorderSpacing.Top = 8 + Width = 164 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Left = 8 + BorderSpacing.Right = 8 Caption = 'Unit name suffix template' + Layout = tlCenter end object edtUnitExtension: TEdit - AnchorSideLeft.Control = lblUnitNameExtension - AnchorSideTop.Control = lblUnitNameExtension + AnchorSideLeft.Control = edtUnitSuffix + AnchorSideTop.Control = edtUnitSuffix AnchorSideTop.Side = asrBottom - Left = 16 + Left = 180 Height = 28 - Top = 92 - Width = 80 + Top = 44 + Width = 176 BorderSpacing.Top = 8 TabOrder = 1 Text = 'edtUnitExtension' end object lblUnitNameExtension: TLabel - AnchorSideLeft.Control = edtUnitSuffix - AnchorSideTop.Control = edtUnitSuffix - AnchorSideTop.Side = asrBottom - Left = 16 - Height = 16 - Top = 68 - Width = 123 - BorderSpacing.Top = 8 + AnchorSideLeft.Control = GBAutoNaming + AnchorSideTop.Control = edtUnitExtension + AnchorSideRight.Control = edtUnitExtension + AnchorSideBottom.Control = edtUnitExtension + AnchorSideBottom.Side = asrBottom + Left = 0 + Height = 28 + Top = 44 + Width = 172 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 Caption = 'Unit name extension' + Layout = tlCenter end end object edtServiceNameSuffix: TEdit - AnchorSideLeft.Control = lblServiceNameSuffix - AnchorSideTop.Control = lblServiceNameSuffix + AnchorSideTop.Control = GBAutoNaming AnchorSideTop.Side = asrBottom - Left = 16 + Left = 198 Height = 28 - Top = 280 + Top = 208 Width = 136 BorderSpacing.Top = 8 TabOrder = 4 Text = 'edtServiceNameSuffix' end object edtServiceNamePrefix: TEdit - AnchorSideLeft.Control = Label1 - AnchorSideTop.Control = Label1 + AnchorSideLeft.Control = edtServiceNameSuffix + AnchorSideTop.Control = edtServiceNameSuffix AnchorSideTop.Side = asrBottom - Left = 16 + Left = 198 Height = 28 - Top = 340 - Width = 144 + Top = 244 + Width = 134 BorderSpacing.Top = 8 TabOrder = 5 Text = 'edtServiceNamePrefix' end object lblServiceNameSuffix: TLabel AnchorSideLeft.Control = GBAutoNaming - AnchorSideTop.Control = GBAutoNaming - AnchorSideTop.Side = asrBottom - Left = 16 - Height = 16 - Top = 256 - Width = 116 - BorderSpacing.Top = 8 - Caption = 'Service name suffix' - end - object Label1: TLabel - AnchorSideLeft.Control = edtServiceNameSuffix AnchorSideTop.Control = edtServiceNameSuffix - AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edtServiceNameSuffix + AnchorSideBottom.Control = edtServiceNameSuffix + AnchorSideBottom.Side = asrBottom Left = 16 - Height = 16 - Top = 316 - Width = 117 - BorderSpacing.Top = 8 + Height = 28 + Top = 208 + Width = 174 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 + Caption = 'Service name suffix' + Layout = tlCenter + end + object lblServiceNamePrefix: TLabel + AnchorSideLeft.Control = GBAutoNaming + AnchorSideTop.Control = edtServiceNamePrefix + AnchorSideRight.Control = edtServiceNamePrefix + AnchorSideBottom.Control = edtServiceNamePrefix + AnchorSideBottom.Side = asrBottom + Left = 16 + Height = 28 + Top = 244 + Width = 174 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 Caption = 'Service name prefix' + Layout = tlCenter end end object TSData: TTabSheet Caption = 'Data' - ClientHeight = 379 - ClientWidth = 669 + ClientHeight = 358 + ClientWidth = 711 object edtDtoUnit: TEdit - AnchorSideLeft.Control = lblDtoUnitName - AnchorSideTop.Control = lblDtoUnitName AnchorSideTop.Side = asrBottom - Left = 16 + Left = 160 Height = 28 - Top = 32 + Top = 8 Width = 160 BorderSpacing.Top = 8 TabOrder = 0 Text = 'edtDtoUnit' end object edtSerializeUnit: TEdit - AnchorSideLeft.Control = lblDtoUnitName - AnchorSideTop.Control = lblSerializeUnit + AnchorSideLeft.Control = edtDtoUnit + AnchorSideTop.Control = edtDtoUnit AnchorSideTop.Side = asrBottom - Left = 16 + AnchorSideRight.Control = edtDtoUnit + AnchorSideRight.Side = asrBottom + Left = 160 Height = 28 - Top = 92 + Top = 44 Width = 160 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 TabOrder = 1 Text = 'edtSerializeUnit' end object lblDtoUnitName: TLabel AnchorSideLeft.Control = TSData - AnchorSideTop.Control = TSData + AnchorSideTop.Control = edtDtoUnit + AnchorSideRight.Control = edtDtoUnit + AnchorSideBottom.Control = edtDtoUnit + AnchorSideBottom.Side = asrBottom Left = 16 - Height = 16 + Height = 28 Top = 8 - Width = 86 + Width = 136 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False BorderSpacing.Left = 16 - BorderSpacing.Top = 8 + BorderSpacing.Right = 8 Caption = 'Dto unit name' + Layout = tlCenter end object lblSerializeUnit: TLabel AnchorSideLeft.Control = lblDtoUnitName - AnchorSideTop.Control = edtDtoUnit - AnchorSideTop.Side = asrBottom + AnchorSideTop.Control = edtSerializeUnit + AnchorSideRight.Control = edtSerializeUnit + AnchorSideBottom.Control = edtSerializeUnit + AnchorSideBottom.Side = asrBottom Left = 16 - Height = 16 - Top = 68 - Width = 81 - BorderSpacing.Top = 8 + Height = 28 + Top = 44 + Width = 136 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 Caption = 'Serializer unit' + Layout = tlCenter end end object TSClient: TTabSheet Caption = 'Client' - ClientHeight = 379 - ClientWidth = 669 + ClientHeight = 358 + ClientWidth = 711 object CBAsyncService: TCheckBox AnchorSideLeft.Control = TSClient AnchorSideTop.Control = TSClient @@ -316,24 +354,26 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame TabOrder = 1 end object edtClientServiceImplementationUnit: TEdit - AnchorSideLeft.Control = CBAsyncService - AnchorSideTop.Control = lblClientServiceImplementationUnit + AnchorSideLeft.Control = edtClientServiceInterfaceUnit + AnchorSideTop.Control = edtClientServiceInterfaceUnit AnchorSideTop.Side = asrBottom - Left = 16 + AnchorSideRight.Control = edtClientServiceInterfaceUnit + AnchorSideRight.Side = asrBottom + Left = 340 Height = 28 - Top = 154 + Top = 168 Width = 208 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 TabOrder = 2 Text = 'edtClientServiceImplementationUnit' end object edtClientServiceInterfaceUnit: TEdit - AnchorSideLeft.Control = CBAsyncService - AnchorSideTop.Control = lblClientServiceInterfaceUnit + AnchorSideTop.Control = cbProxyModuleFormFile AnchorSideTop.Side = asrBottom - Left = 16 + Left = 340 Height = 28 - Top = 94 + Top = 132 Width = 208 BorderSpacing.Top = 8 TabOrder = 3 @@ -341,77 +381,193 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame end object lblClientServiceInterfaceUnit: TLabel AnchorSideLeft.Control = CBAsyncService - AnchorSideTop.Control = cbCancelRequest - AnchorSideTop.Side = asrBottom - Left = 16 - Height = 16 - Top = 70 - Width = 198 - BorderSpacing.Top = 8 + AnchorSideTop.Control = edtClientServiceInterfaceUnit + AnchorSideRight.Control = edtClientServiceInterfaceUnit + AnchorSideBottom.Control = edtClientServiceInterfaceUnit + AnchorSideBottom.Side = asrBottom + Left = 102 + Height = 28 + Top = 132 + Width = 230 + Alignment = taRightJustify + Anchors = [akTop, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 Caption = 'Client service interface unit name' + Layout = tlCenter end object lblClientServiceImplementationUnit: TLabel AnchorSideLeft.Control = CBAsyncService - AnchorSideTop.Control = edtClientServiceInterfaceUnit - AnchorSideTop.Side = asrBottom - Left = 16 - Height = 16 - Top = 130 - Width = 278 - BorderSpacing.Top = 8 - Caption = 'Client service proxy implementation unit name' - end - object edtClientServiceParentClass: TEdit - AnchorSideLeft.Control = CBAsyncService - AnchorSideTop.Control = lblClientServiceParentClass - AnchorSideTop.Side = asrBottom + AnchorSideTop.Control = edtClientServiceImplementationUnit + AnchorSideRight.Control = edtClientServiceImplementationUnit + AnchorSideBottom.Control = edtClientServiceImplementationUnit + AnchorSideBottom.Side = asrBottom Left = 16 Height = 28 - Top = 214 + Top = 168 + Width = 316 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 + Caption = 'Client service proxy implementation unit name' + Layout = tlCenter + end + object edtClientServiceParentClass: TEdit + AnchorSideLeft.Control = edtClientServiceImplementationUnit + AnchorSideTop.Control = edtClientServiceImplementationUnit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edtClientServiceImplementationUnit + AnchorSideRight.Side = asrBottom + Left = 340 + Height = 28 + Top = 204 Width = 208 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 TabOrder = 4 Text = 'edtClientServiceParentClass' end object edtClientServiceParentUnit: TEdit - AnchorSideLeft.Control = CBAsyncService - AnchorSideTop.Control = lblClientServiceParentUnit + AnchorSideLeft.Control = edtClientServiceParentClass + AnchorSideTop.Control = edtClientServiceParentClass AnchorSideTop.Side = asrBottom - Left = 16 + AnchorSideRight.Control = edtClientServiceParentClass + AnchorSideRight.Side = asrBottom + Left = 340 Height = 28 - Top = 274 + Top = 240 Width = 208 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 TabOrder = 5 Text = 'edtClientServiceParentUnit' end object lblClientServiceParentClass: TLabel AnchorSideLeft.Control = CBAsyncService - AnchorSideTop.Control = edtClientServiceImplementationUnit - AnchorSideTop.Side = asrBottom + AnchorSideTop.Control = edtClientServiceParentClass + AnchorSideRight.Control = edtClientServiceParentClass + AnchorSideBottom.Control = edtClientServiceParentClass + AnchorSideBottom.Side = asrBottom Left = 16 - Height = 16 - Top = 190 - Width = 154 - BorderSpacing.Top = 8 + Height = 28 + Top = 204 + Width = 316 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Right = 8 Caption = 'Client service parent class' + Layout = tlCenter end object lblClientServiceParentUnit: TLabel AnchorSideLeft.Control = CBAsyncService - AnchorSideTop.Control = edtClientServiceParentClass + AnchorSideTop.Control = edtClientServiceParentUnit + AnchorSideRight.Control = edtClientServiceParentUnit + AnchorSideBottom.Control = edtClientServiceParentUnit + AnchorSideBottom.Side = asrBottom + Left = 16 + Height = 28 + Top = 240 + Width = 316 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + Caption = 'Client service parent unit name' + Layout = tlCenter + end + object cbGenerateServerProxyModule: TCheckBox + AnchorSideLeft.Control = CBAsyncService + AnchorSideTop.Control = cbCancelRequest AnchorSideTop.Side = asrBottom Left = 16 - Height = 16 - Top = 250 - Width = 185 + Height = 23 + Top = 70 + Width = 208 BorderSpacing.Top = 8 - Caption = 'Client service parent unit name' + Caption = 'Generate server proxy module' + TabOrder = 6 + OnChange = cbGenerateServerProxyModuleChange + end + object Label2: TLabel + AnchorSideLeft.Control = CBAsyncService + AnchorSideTop.Control = edtServerProxyModule + AnchorSideRight.Control = edtServerProxyModule + AnchorSideBottom.Control = edtServerProxyModule + AnchorSideBottom.Side = asrBottom + Left = 16 + Height = 28 + Top = 276 + Width = 316 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Right = 8 + Caption = 'Client Serverproxy module unit' + Layout = tlCenter + end + object edtServerProxyModule: TEdit + AnchorSideLeft.Control = edtClientServiceParentUnit + AnchorSideTop.Control = edtClientServiceParentUnit + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edtClientServiceParentUnit + AnchorSideRight.Side = asrBottom + Left = 340 + Height = 28 + Top = 276 + Width = 208 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 7 + Text = 'edtServerProxyModule' + end + object lblServerProxyUnit: TLabel + AnchorSideLeft.Control = CBAsyncService + AnchorSideTop.Control = edtServerProxyUnit + AnchorSideRight.Control = edtServerProxyUnit + AnchorSideBottom.Control = edtServerProxyUnit + AnchorSideBottom.Side = asrBottom + Left = 16 + Height = 28 + Top = 312 + Width = 316 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 + Caption = 'Server Proxy unit name' + Layout = tlCenter + end + object edtServerProxyUnit: TEdit + AnchorSideLeft.Control = edtServerProxyModule + AnchorSideTop.Control = edtServerProxyModule + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = edtServerProxyModule + AnchorSideRight.Side = asrBottom + Left = 340 + Height = 28 + Top = 312 + Width = 208 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 8 + TabOrder = 8 + Text = 'edtServerProxyUnit' + end + object cbProxyModuleFormFile: TCheckBox + AnchorSideLeft.Control = cbCancelRequest + AnchorSideTop.Control = cbGenerateServerProxyModule + AnchorSideTop.Side = asrBottom + Left = 40 + Height = 23 + Top = 101 + Width = 212 + BorderSpacing.Top = 8 + Caption = 'Generate datamodule form file' + TabOrder = 9 end end object TSServer: TTabSheet Caption = 'Server' - ClientHeight = 379 - ClientWidth = 669 + ClientHeight = 358 + ClientWidth = 711 object CBSkipImplementation: TCheckBox AnchorSideLeft.Control = CBAbstractCalls AnchorSideTop.Control = CBAbstractCalls @@ -439,107 +595,139 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame OnChange = HandleAbstract end object edtServerHandlerUnitName: TEdit - AnchorSideLeft.Control = CBAbstractCalls - AnchorSideTop.Control = lblServerHandlerUnitName + AnchorSideTop.Control = CBSkipImplementation AnchorSideTop.Side = asrBottom - Left = 16 + Left = 240 Height = 28 - Top = 94 + Top = 70 Width = 242 BorderSpacing.Top = 8 TabOrder = 2 Text = 'edtServerHandlerUnitName' end object edtServerImplementationUnitName: TEdit - AnchorSideLeft.Control = CBAbstractCalls - AnchorSideTop.Control = lblServerImplementationUnitName + AnchorSideLeft.Control = edtServerHandlerUnitName + AnchorSideTop.Control = edtServerHandlerUnitName AnchorSideTop.Side = asrBottom - Left = 16 + AnchorSideRight.Control = edtServerHandlerUnitName + AnchorSideRight.Side = asrBottom + Left = 240 Height = 28 - Top = 154 - Width = 240 + Top = 106 + Width = 242 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 TabOrder = 3 Text = 'edtServerImplementationUnitName' end object edtServerServiceParentClass: TEdit - AnchorSideLeft.Control = CBAbstractCalls - AnchorSideTop.Control = lblServerServiceParentClass + AnchorSideLeft.Control = edtServerImplementationUnitName + AnchorSideTop.Control = edtServerImplementationUnitName AnchorSideTop.Side = asrBottom - Left = 16 + AnchorSideRight.Control = edtServerHandlerUnitName + AnchorSideRight.Side = asrBottom + Left = 240 Height = 28 - Top = 214 - Width = 216 + Top = 142 + Width = 242 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 TabOrder = 4 Text = 'edtServerServiceParentClass' end object edtServerServiceParentUnit: TEdit - AnchorSideLeft.Control = CBAbstractCalls - AnchorSideTop.Control = lblServerServiceParentUnit + AnchorSideLeft.Control = edtServerServiceParentClass + AnchorSideTop.Control = edtServerServiceParentClass AnchorSideTop.Side = asrBottom - Left = 16 + AnchorSideRight.Control = edtServerHandlerUnitName + AnchorSideRight.Side = asrBottom + Left = 240 Height = 28 - Top = 275 - Width = 208 + Top = 178 + Width = 242 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 8 TabOrder = 5 Text = 'edtServerServiceParentUnit' end object lblServerHandlerUnitName: TLabel AnchorSideLeft.Control = CBAbstractCalls - AnchorSideTop.Control = CBSkipImplementation - AnchorSideTop.Side = asrBottom + AnchorSideTop.Control = edtServerHandlerUnitName + AnchorSideRight.Control = edtServerHandlerUnitName + AnchorSideBottom.Control = edtServerHandlerUnitName + AnchorSideBottom.Side = asrBottom Left = 16 - Height = 16 + Height = 28 Top = 70 - Width = 151 - BorderSpacing.Top = 8 + Width = 216 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 Caption = 'Server handler unit name' + Layout = tlCenter end object lblServerImplementationUnitName: TLabel AnchorSideLeft.Control = CBAbstractCalls - AnchorSideTop.Control = edtServerHandlerUnitName - AnchorSideTop.Side = asrBottom + AnchorSideTop.Control = edtServerImplementationUnitName + AnchorSideRight.Control = edtServerImplementationUnitName + AnchorSideBottom.Control = edtServerImplementationUnitName + AnchorSideBottom.Side = asrBottom Left = 16 - Height = 16 - Top = 130 - Width = 199 - BorderSpacing.Top = 8 + Height = 28 + Top = 106 + Width = 216 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 Caption = 'Server implementation unit name' + Layout = tlCenter end object lblServerServiceParentClass: TLabel AnchorSideLeft.Control = CBAbstractCalls - AnchorSideTop.Control = edtServerImplementationUnitName - AnchorSideTop.Side = asrBottom + AnchorSideTop.Control = edtServerServiceParentClass + AnchorSideRight.Control = edtServerServiceParentClass + AnchorSideBottom.Control = edtServerServiceParentClass + AnchorSideBottom.Side = asrBottom Left = 16 - Height = 16 - Top = 190 - Width = 157 - BorderSpacing.Top = 8 + Height = 28 + Top = 142 + Width = 216 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 Caption = 'Server service parent class' + Layout = tlCenter end object lblServerServiceParentUnit: TLabel AnchorSideLeft.Control = CBAbstractCalls - AnchorSideTop.Control = edtServerServiceParentClass - AnchorSideTop.Side = asrBottom + AnchorSideTop.Control = edtServerServiceParentUnit + AnchorSideRight.Control = edtServerServiceParentUnit + AnchorSideBottom.Control = edtServerServiceParentUnit + AnchorSideBottom.Side = asrBottom Left = 16 - Height = 16 - Top = 251 - Width = 187 - BorderSpacing.Top = 9 + Height = 28 + Top = 178 + Width = 216 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 Caption = 'server service parent unit name' + Layout = tlCenter end end object TSUUIDMap: TTabSheet Caption = 'GUID map' - ClientHeight = 379 - ClientWidth = 669 + ClientHeight = 358 + ClientWidth = 711 object VLEUUIDMap: TValueListEditor Left = 8 - Height = 316 + Height = 298 Top = 16 - Width = 653 + Width = 695 Anchors = [akTop, akLeft, akRight, akBottom] DefaultColWidth = 200 FixedCols = 0 @@ -553,15 +741,15 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame 'GUID' ) ColWidths = ( - 325 - 324 + 346 + 345 ) end object edtUUIDMap: TFileNameEdit Left = 112 Height = 28 - Top = 343 - Width = 461 + Top = 325 + Width = 503 DialogKind = dkSave DialogOptions = [ofPathMustExist, ofEnableSizing, ofViewDetail] FilterIndex = 0 @@ -580,7 +768,7 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame AnchorSideBottom.Side = asrBottom Left = 8 Height = 28 - Top = 343 + Top = 325 Width = 96 Alignment = taRightJustify Anchors = [akTop, akLeft, akRight, akBottom] @@ -589,9 +777,9 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame Layout = tlCenter end object btnLoadUUIDMap: TButton - Left = 586 + Left = 628 Height = 25 - Top = 343 + Top = 325 Width = 75 Anchors = [akRight, akBottom] Caption = 'Load' @@ -601,13 +789,13 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame end object TSServiceMap: TTabSheet Caption = 'Service name map' - ClientHeight = 379 - ClientWidth = 669 + ClientHeight = 358 + ClientWidth = 711 object VLEServiceMap: TValueListEditor Left = 8 - Height = 316 + Height = 298 Top = 16 - Width = 653 + Width = 695 Anchors = [akTop, akLeft, akRight, akBottom] DefaultColWidth = 200 FixedCols = 0 @@ -617,12 +805,12 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame KeyOptions = [keyEdit, keyAdd, keyDelete, keyUnique] Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing, goEditing, goAutoAddRows, goAlwaysShowEditor, goThumbTracking] TitleCaptions.Strings = ( - 'Interface' - 'GUID' + 'ServiceOperation' + 'Service.Method' ) ColWidths = ( - 325 - 324 + 347 + 346 ) end object lblUUIDMap1: TLabel @@ -632,7 +820,7 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame AnchorSideBottom.Side = asrBottom Left = 8 Height = 28 - Top = 343 + Top = 325 Width = 96 Alignment = taRightJustify Anchors = [akTop, akLeft, akRight, akBottom] @@ -643,8 +831,8 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame object edtServiceMapFile: TFileNameEdit Left = 112 Height = 28 - Top = 343 - Width = 461 + Top = 325 + Width = 503 DialogKind = dkSave DialogOptions = [ofPathMustExist, ofEnableSizing, ofViewDetail] FilterIndex = 0 @@ -657,9 +845,9 @@ object GeneratorSettingsFrame: TGeneratorSettingsFrame TabOrder = 1 end object btnLoadUUIDMap1: TButton - Left = 586 + Left = 628 Height = 25 - Top = 343 + Top = 325 Width = 75 Anchors = [akRight, akBottom] Caption = 'Load' diff --git a/components/openapi/fraopenapisettings.pas b/components/openapi/fraopenapisettings.pas index 3cd0998d90..608622d8a5 100644 --- a/components/openapi/fraopenapisettings.pas +++ b/components/openapi/fraopenapisettings.pas @@ -5,7 +5,7 @@ unit fraopenapisettings; interface uses - Classes, SysUtils, Forms, Controls, EditBtn, StdCtrls, ComCtrls, ValEdit, fpopenapi.codegen; + Classes, SysUtils, Forms, Controls, EditBtn, StdCtrls, ComCtrls, ValEdit, fpopenapi.codegen, Types; type @@ -25,6 +25,10 @@ type CBSkipImplementation: TCheckBox; CBAbstractCalls: TCheckBox; cbAddToProject: TCheckBox; + cbGenerateServerProxyModule: TCheckBox; + cbProxyModuleFormFile: TCheckBox; + edtServerProxyUnit: TEdit; + edtServerProxyModule: TEdit; edtClientServiceImplementationUnit: TEdit; edtClientServiceInterfaceUnit: TEdit; edtClientServiceParentClass: TEdit; @@ -42,7 +46,9 @@ type edtUUIDMap: TFileNameEdit; edtServiceMapFile: TFileNameEdit; GBAutoNaming: TGroupBox; - Label1: TLabel; + lblServerProxyUnit: TLabel; + lblServiceNamePrefix: TLabel; + Label2: TLabel; lblUUIDMap: TLabel; lblServerServiceParentUnit: TLabel; lblServerServiceParentClass: TLabel; @@ -71,12 +77,15 @@ type VLEServiceMap: TValueListEditor; procedure btnLoadUUIDMap1Click(Sender: TObject); procedure btnLoadUUIDMapClick(Sender: TObject); + procedure cbGenerateServerProxyModuleChange(Sender: TObject); procedure HandleAbstract(Sender: TObject); procedure HandleSyncCheck(Sender: TObject); + procedure TSGeneralContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); private FGenerator: TOpenAPICodeGen; procedure CheckAbstract; procedure CheckAsync; + procedure CheckProxyModule; function GetAddToProject: Boolean; function GetOpenAPIFileName: String; function GetOpenGeneratedFiles: Boolean; @@ -85,9 +94,11 @@ type procedure SetOpenAPIFileName(AValue: String); procedure SetOpenGeneratedFiles(AValue: Boolean); public + procedure Clear; procedure InitFileNameEdits(Const aBaseDir : string); Procedure SaveSettings; procedure ShowSettings; + procedure HideAdditionalControls(ShowClient: Boolean;ShowServer: Boolean); function Modified : Boolean; Property OpenAPIFileName : String Read GetOpenAPIFileName Write SetOpenAPIFileName; Property OpenGeneratedFiles : Boolean Read GetOpenGeneratedFiles Write SetOpenGeneratedFiles; @@ -132,6 +143,30 @@ begin edtDtoUnit.Text:=DtoUnit; edtUnitExtension.Text:=UnitExtension; edtUnitSuffix.Text:=UnitSuffix; + cbGenerateServerProxyModule.Checked:=GenerateServerProxyModule; + edtServerProxyModule.Text:=ServerProxyModuleName; + edtServerProxyUnit.Text:=ServerProxyUnit; + cbProxyModuleFormFile.Checked:=ServerProxyFormFile; + CheckProxyModule; + end; +end; + +procedure TGeneratorSettingsFrame.HideAdditionalControls(ShowClient: Boolean; ShowServer: Boolean); +begin + PCSettings.AnchorSideTop.Control:=edtFile; + CBGenClient.Visible:=False; + CBGenServer.Visible:=False; + cbOpenFiles.Visible:=False; + cbAddToProject.Visible:=False; + if not ShowClient then + begin + PCSettings.ActivePage:=TSServer; + TSClient.TabVisible:=False; + end; + if Not ShowServer then + begin + PCSettings.ActivePage:=TSClient; + TSServer.TabVisible:=False; end; end; @@ -162,6 +197,13 @@ begin Result:=Result or (edtDtoUnit.Text<>DtoUnit); Result:=Result or (edtUnitExtension.Text<>UnitExtension); Result:=Result or (edtUnitSuffix.Text<>UnitSuffix); + Result:=Result or (cbGenerateServerProxyModule.Checked<>GenerateServerProxyModule); + if GenerateServerProxyModule then + begin + Result:=Result or (edtServerProxyModule.Text<>ServerProxyModuleName); + Result:=Result or (ServerProxyUnit<>edtServerProxyUnit.Text); + Result:=Result or (ServerProxyFormFile<>cbProxyModuleFormFile.Checked); + end; end; end; @@ -197,6 +239,11 @@ begin CheckAsync end; +procedure TGeneratorSettingsFrame.TSGeneralContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); +begin + +end; + procedure TGeneratorSettingsFrame.HandleAbstract(Sender: TObject); begin CheckAbstract; @@ -225,6 +272,28 @@ begin cbOpenFiles.Checked:=aValue; end; +procedure TGeneratorSettingsFrame.Clear; +begin + edtFile.FileName:=''; + edtUUIDMap.FileName:=''; + edtServiceMapFile.FileName:=''; + edtClientServiceImplementationUnit.Text:=''; + edtClientServiceInterfaceUnit.Text:=''; + edtClientServiceParentClass.Text:=''; + edtClientServiceParentUnit.Text:=''; + edtServerHandlerUnitName.Text:=''; + edtServerImplementationUnitName.Text:=''; + edtServerServiceParentClass.Text:=''; + edtServerServiceParentUnit.Text:=''; + edtServerProxyModule.Text:=''; + edtServiceNameSuffix.Text:=''; + edtServiceNamePrefix.Text:=''; + edtSerializeUnit.Text:=''; + edtDtoUnit.Text:=''; + edtUnitExtension.Text:=''; + edtUnitSuffix.Text:=''; +end; + procedure TGeneratorSettingsFrame.InitFileNameEdits(const aBaseDir: string); begin edtFile.InitialDir:=aBaseDir; @@ -237,6 +306,25 @@ begin LoadFileToEditor(VLEUUIDMap,edtUUIDMap.FileName,'GUID map'); end; +procedure TGeneratorSettingsFrame.cbGenerateServerProxyModuleChange(Sender: TObject); +begin + CheckProxyModule; +end; + +procedure TGeneratorSettingsFrame.CheckProxyModule; + +begin + edtServerProxyModule.Enabled:=cbGenerateServerProxyModule.Checked; + if not edtServerProxyModule.Enabled then + edtServerProxyModule.Text:=''; + edtServerProxyUnit.Enabled:=cbGenerateServerProxyModule.Checked; + if not edtServerProxyUnit.Enabled then + edtServerProxyUnit.Text:=''; + cbProxyModuleFormFile.Enabled:=cbGenerateServerProxyModule.Checked; + if not cbProxyModuleFormFile.Enabled then + cbProxyModuleFormFile.Checked:=False; +end; + procedure TGeneratorSettingsFrame.btnLoadUUIDMap1Click(Sender: TObject); begin LoadFileToEditor(VLEServiceMap,edtServiceMapFile.FileName,'service map'); @@ -269,7 +357,11 @@ begin DtoUnit:=edtDtoUnit.Text; UnitExtension:=edtUnitExtension.Text; UnitSuffix:=edtUnitSuffix.Text; - end; + GenerateServerProxyModule:=cbGenerateServerProxyModule.Checked; + ServerProxyModuleName:=edtServerProxyModule.Text; + ServerProxyUnit:=edtServerProxyUnit.Text; + ServerProxyFormFile:=cbProxyModuleFormFile.Checked; + end; end; end. diff --git a/components/openapi/frmopenapiproject.lfm b/components/openapi/frmopenapiproject.lfm new file mode 100644 index 0000000000..f932aceee7 --- /dev/null +++ b/components/openapi/frmopenapiproject.lfm @@ -0,0 +1,309 @@ +object OpenAPIProjectForm: TOpenAPIProjectForm + Left = 405 + Height = 641 + Top = 268 + Width = 802 + Caption = 'OpenAPI project' + ClientHeight = 641 + ClientWidth = 802 + LCLVersion = '4.99.0.0' + OnClose = FormClose + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + object PCProjects: TPageControl + AnchorSideTop.Control = edtUnitsBaseName + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = BPOpenAPIProject + Left = 16 + Height = 501 + Top = 88 + Width = 754 + ActivePage = TSServer + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Top = 8 + BorderSpacing.Bottom = 8 + TabIndex = 2 + TabOrder = 0 + object TSAPI: TTabSheet + Caption = 'API definitions' + ClientHeight = 471 + ClientWidth = 744 + inline fraSettings: TGeneratorSettingsFrame + Height = 471 + Width = 744 + Align = alClient + ClientHeight = 471 + ClientWidth = 744 + inherited edtFile: TFileNameEdit + Width = 602 + end + inherited lblOpenAPIFile: TLabel + AnchorSideLeft.Control = fraSettings + end + inherited PCSettings: TPageControl + AnchorSideLeft.Control = fraSettings + AnchorSideRight.Control = fraSettings + AnchorSideBottom.Control = fraSettings + Height = 380 + Width = 712 + inherited TSGeneral: TTabSheet + ClientHeight = 347 + ClientWidth = 702 + inherited GBAutoNaming: TGroupBox + Width = 674 + ClientWidth = 672 + end + end + inherited TSData: TTabSheet + ClientHeight = 347 + ClientWidth = 702 + end + inherited TSClient: TTabSheet + ClientHeight = 347 + ClientWidth = 702 + inherited edtClientServiceImplementationUnit: TEdit + Left = 334 + end + inherited edtClientServiceInterfaceUnit: TEdit + Left = 334 + end + inherited lblClientServiceInterfaceUnit: TLabel + Left = 108 + Width = 218 + end + inherited lblClientServiceImplementationUnit: TLabel + Width = 310 + end + inherited edtClientServiceParentClass: TEdit + Left = 334 + end + inherited edtClientServiceParentUnit: TEdit + Left = 334 + end + inherited lblClientServiceParentClass: TLabel + Width = 310 + end + inherited lblClientServiceParentUnit: TLabel + Width = 310 + end + inherited Label2: TLabel + Width = 310 + end + inherited edtServerProxyModule: TEdit + Left = 334 + end + inherited lblServerProxyUnit: TLabel + Width = 310 + end + inherited edtServerProxyUnit: TEdit + Left = 334 + end + end + inherited TSServer: TTabSheet + ClientHeight = 347 + ClientWidth = 702 + end + inherited TSUUIDMap: TTabSheet + ClientHeight = 347 + ClientWidth = 702 + inherited VLEUUIDMap: TValueListEditor + Height = 284 + Width = 686 + ColWidths = ( + 341 + 341 + ) + end + inherited edtUUIDMap: TFileNameEdit + Top = 311 + Width = 494 + end + inherited lblUUIDMap: TLabel + Top = 311 + end + inherited btnLoadUUIDMap: TButton + Left = 619 + Top = 311 + end + end + inherited TSServiceMap: TTabSheet + ClientHeight = 347 + ClientWidth = 702 + inherited VLEServiceMap: TValueListEditor + Height = 284 + Width = 686 + ColWidths = ( + 341 + 341 + ) + end + inherited lblUUIDMap1: TLabel + Top = 311 + end + inherited edtServiceMapFile: TFileNameEdit + Top = 311 + Width = 494 + end + inherited btnLoadUUIDMap1: TButton + Left = 619 + Top = 311 + end + end + end + end + end + object TSClient: TTabSheet + Caption = 'Client' + ClientHeight = 471 + ClientWidth = 744 + object rbClientGUI: TRadioButton + Left = 8 + Height = 23 + Top = 8 + Width = 93 + Caption = 'GUI project' + Checked = True + TabOrder = 0 + TabStop = True + end + object rbClientCommandLine: TRadioButton + Left = 8 + Height = 23 + Top = 40 + Width = 120 + Caption = 'Console project' + TabOrder = 1 + end + end + object TSServer: TTabSheet + Caption = 'Server' + ClientHeight = 471 + ClientWidth = 744 + object SEPort: TSpinEdit + Left = 81 + Height = 28 + Top = 112 + Width = 112 + MinValue = 1024 + TabOrder = 0 + Value = 8080 + end + object lblPort: TLabel + Left = 8 + Height = 16 + Top = 120 + Width = 62 + Caption = 'HTTP Port' + end + object RBServerHTTP: TRadioButton + Left = 8 + Height = 23 + Top = 16 + Width = 144 + Caption = 'HTTP server project' + Checked = True + TabOrder = 1 + TabStop = True + end + object RBServerGUI: TRadioButton + Left = 8 + Height = 23 + Top = 48 + Width = 93 + Caption = 'GUI Project' + TabOrder = 2 + end + object CBServerConsole: TRadioButton + Left = 8 + Height = 23 + Top = 80 + Width = 120 + Caption = 'Console project' + TabOrder = 3 + end + object cbThreadedServer: TCheckBox + Left = 7 + Height = 23 + Top = 152 + Width = 125 + Caption = 'Threaded Server' + Checked = True + State = cbChecked + TabOrder = 4 + end + end + end + object BPOpenAPIProject: TButtonPanel + Left = 6 + Height = 38 + Top = 597 + Width = 790 + OKButton.Name = 'OKButton' + OKButton.DefaultCaption = True + HelpButton.Name = 'HelpButton' + HelpButton.DefaultCaption = True + CloseButton.Name = 'CloseButton' + CloseButton.DefaultCaption = True + CancelButton.Name = 'CancelButton' + CancelButton.DefaultCaption = True + TabOrder = 1 + ShowButtons = [pbOK, pbCancel] + end + object DEBaseDir: TDirectoryEdit + Left = 200 + Height = 28 + Top = 16 + Width = 574 + DialogOptions = [ofCreatePrompt, ofEnableSizing, ofViewDetail] + ShowHidden = False + ButtonWidth = 23 + NumGlyphs = 1 + Anchors = [akTop, akLeft, akRight] + MaxLength = 0 + TabOrder = 2 + OnEditingDone = DEBaseDirEditingDone + end + object lblBaseDir: TLabel + AnchorSideTop.Control = DEBaseDir + AnchorSideRight.Control = DEBaseDir + AnchorSideBottom.Control = DEBaseDir + AnchorSideBottom.Side = asrBottom + Left = 16 + Height = 28 + Top = 16 + Width = 176 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 + Caption = 'Project base directory' + Layout = tlCenter + end + object edtUnitsBaseName: TEdit + AnchorSideTop.Control = DEBaseDir + AnchorSideTop.Side = asrBottom + Left = 200 + Height = 28 + Top = 52 + Width = 128 + BorderSpacing.Top = 8 + TabOrder = 3 + end + object lblUnitsBaseName: TLabel + AnchorSideTop.Control = edtUnitsBaseName + AnchorSideRight.Control = edtUnitsBaseName + AnchorSideBottom.Control = edtUnitsBaseName + AnchorSideBottom.Side = asrBottom + Left = 72 + Height = 28 + Top = 52 + Width = 120 + Alignment = taRightJustify + Anchors = [akTop, akLeft, akRight, akBottom] + AutoSize = False + BorderSpacing.Right = 8 + Caption = 'Base name for units' + Layout = tlCenter + end +end diff --git a/components/openapi/frmopenapiproject.pas b/components/openapi/frmopenapiproject.pas new file mode 100644 index 0000000000..fa1a175994 --- /dev/null +++ b/components/openapi/frmopenapiproject.pas @@ -0,0 +1,175 @@ +unit frmopenapiproject; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, EditBtn, ComCtrls, ButtonPanel, Spin, + fpopenapi.codegen, fraopenapisettings, lazopenapictrl; + +type + { TOpenAPIProjectForm } + + TOpenAPIProjectForm = class(TForm) + BPOpenAPIProject: TButtonPanel; + cbThreadedServer: TCheckBox; + DEBaseDir: TDirectoryEdit; + edtUnitsBaseName: TEdit; + fraSettings: TGeneratorSettingsFrame; + lblUnitsBaseName: TLabel; + lblBaseDir: TLabel; + lblPort: TLabel; + PCProjects: TPageControl; + RBServerHTTP: TRadioButton; + CBServerConsole: TRadioButton; + rbClientGUI: TRadioButton; + rbClientCommandLine: TRadioButton; + RBServerGUI: TRadioButton; + SEPort: TSpinEdit; + TSClient: TTabSheet; + TSServer: TTabSheet; + TSAPI: TTabSheet; + procedure DEBaseDirEditingDone(Sender: TObject); + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure FormCreate(Sender: TObject); + private + FallowedTypes: TOpenAPIProjectTypes; + FGenerator: TOpenAPICodeGen; + function GetBaseDir: String; + function GetClientProjectType: TIDEProjectType; + function GetHTTPPort: Word; + function GetOpenAPIFileName: String; + function GetServerProjectType: TIDEProjectType; + function GetThreadedServer: Boolean; + function GetUnitsBaseName: String; + procedure SetAllowedTypes(AValue: TOpenAPIProjectTypes); + procedure SetBaseDir(AValue: String); + procedure SetGenerator(AValue: TOpenAPICodeGen); + procedure SetOpenAPIFileName(AValue: String); + procedure SetUnitsBaseName(AValue: String); + public + Property Generator : TOpenAPICodeGen read FGenerator Write SetGenerator; + Property BaseDir : String Read GetBaseDir Write SetBaseDir; + Property UnitsBaseName : String Read GetUnitsBaseName Write SetUnitsBaseName; + Property OpenAPIFileName : String Read GetOpenAPIFileName Write SetOpenAPIFileName; + Property AllowedTypes : TOpenAPIProjectTypes Read FallowedTypes Write SetAllowedTypes; + Property ClientProjectType : TIDEProjectType Read GetClientProjectType; + Property ServerProjectType : TIDEProjectType Read GetServerProjectType; + Property HTTPPort : Word Read GetHTTPPort; + Property ThreadedServer : Boolean Read GetThreadedServer; + end; + +var + OpenAPIProjectForm: TOpenAPIProjectForm; + +implementation + +{$R *.lfm} + +{ TOpenAPIProjectForm } + +procedure TOpenAPIProjectForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); +begin + if ModalResult=mrOK then + FraSettings.SaveSettings; +end; + +procedure TOpenAPIProjectForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +begin + CanClose:=(ModalResult<>mrOK); + CanClose:=CanClose or ((DEBaseDir.Directory<>'') and (fraSettings.OpenAPIFileName<>'')) +end; + +procedure TOpenAPIProjectForm.FormCreate(Sender: TObject); +begin + fraSettings.Clear; +end; + +procedure TOpenAPIProjectForm.DEBaseDirEditingDone(Sender: TObject); +begin + fraSettings.InitFileNameEdits(BaseDir); +end; + +function TOpenAPIProjectForm.GetOpenAPIFileName: String; +begin + Result:=fraSettings.OpenAPIFileName; +end; + +function TOpenAPIProjectForm.GetClientProjectType: TIDEProjectType; +begin + if rbClientGUI.Checked then + Result:=iptGUI + else + Result:=iptCmdLine; +end; + +function TOpenAPIProjectForm.GetHTTPPort: Word; +begin + Result:=SEPort.Value; +end; + +function TOpenAPIProjectForm.GetBaseDir: String; +begin + Result:=DEBaseDir.Directory; +end; + +function TOpenAPIProjectForm.GetServerProjectType: TIDEProjectType; +begin + if rbServerGUI.Checked then + Result:=iptGUI + else if RBServerHTTP.Checked then + Result:=iptHTTPServer + else + Result:=iptCmdLine; +end; + +function TOpenAPIProjectForm.GetThreadedServer: Boolean; +begin + Result:=cbThreadedServer.Checked; +end; + +function TOpenAPIProjectForm.GetUnitsBaseName: String; +begin + Result:=edtUnitsBaseName.Text; +end; + +procedure TOpenAPIProjectForm.SetAllowedTypes(AValue: TOpenAPIProjectTypes); +var + lClient,lServer : Boolean; +begin + FallowedTypes:=AValue; + lClient:=optClient in aValue; + lServer:=optServer in aValue; + TSServer.TabVisible:=lServer; + TSClient.TabVisible:=lClient; + fraSettings.HideAdditionalControls(lClient,lServer); +end; + +procedure TOpenAPIProjectForm.SetBaseDir(AValue: String); +begin + DEBaseDir.Directory:=aValue; + fraSettings.InitFileNameEdits(aValue); +end; + +procedure TOpenAPIProjectForm.SetGenerator(AValue: TOpenAPICodeGen); +begin + if FGenerator=AValue then Exit; + FGenerator:=AValue; + fraSettings.Generator:=AValue; + fraSettings.ShowSettings; +end; + +procedure TOpenAPIProjectForm.SetOpenAPIFileName(AValue: String); +begin + fraSettings.OpenAPIFileName:=aValue; +end; + +procedure TOpenAPIProjectForm.SetUnitsBaseName(AValue: String); +begin + edtUnitsBaseName.Text:=aValue; +end; + +end. + diff --git a/components/openapi/lazopenapi.lpk b/components/openapi/lazopenapi.lpk index 70795ed085..c6bf3640f7 100644 --- a/components/openapi/lazopenapi.lpk +++ b/components/openapi/lazopenapi.lpk @@ -32,8 +32,29 @@ + + + + + + + + + + + + + + + + + + + + + diff --git a/components/openapi/lazopenapi.pas b/components/openapi/lazopenapi.pas index 1ef34a5063..da797a80f8 100644 --- a/components/openapi/lazopenapi.pas +++ b/components/openapi/lazopenapi.pas @@ -8,7 +8,8 @@ unit lazopenapi; interface uses - fraopenapisettings, frmopenapiwizard, reglazopenapi, LazarusPackageIntf; + fraopenapisettings, frmopenapiwizard, reglazopenapi, frmopenapiproject, lazopenapictrl, lazopenapistr, + fraopenapiprojectsettings, LazarusPackageIntf; implementation diff --git a/components/openapi/lazopenapictrl.pas b/components/openapi/lazopenapictrl.pas new file mode 100644 index 0000000000..13e114353c --- /dev/null +++ b/components/openapi/lazopenapictrl.pas @@ -0,0 +1,246 @@ +unit lazopenapictrl; + +{$mode objfpc}{$H+} + +interface + +uses + Types, Classes, SysUtils, fpjson, fpopenapi.types, fpopenapi.pascaltypes, fpopenapi.objects, fpopenapi.codegen, IDECommands, ProjectIntf, MenuIntf; + +Type + TOpenAPIProjectType = (optClient,optServer); + TOpenAPIProjectTypes = set of TOpenAPIProjectType; + + TIDEProjectType = (iptGUI,iptCmdLine,iptHTTPServer); + + { TLazOpenAPICodeGen } + + TLazOpenAPICodeGen = class(TOpenAPICodeGen) + private + FServerServiceModules, + FServerURLS: TStringDynArray; + Protected + procedure PrepareAPIData(aData: TAPIData); override; + Public + Function ResolveUnitName(aKind : TUnitKind; aFull: Boolean = True) : String; + Property ServerURLS : TStringDynArray Read FServerURLS; + Property ServerServiceModules : TStringDynArray Read FServerServiceModules; + end; + + { TOpenAPIHandler } + + TOpenAPIHandler = Class(TObject) + public + CmdToolsMenu : TIDECommandCategory; + RefreshMenu : TIDEmenuCommand; + OpenAPIWizardCommand : TIDECommand; + procedure GenerateFiles(const aOpenAPIFile, aBaseOutputFile: string; aGenerator: TLazOpenAPICodeGen); + function GetJSONFromYAML(const aOpenAPIFile: string): TJSONStringType; + function OpenAPIConfigOK(out aOpenAPI, aConfig: string): Boolean; + procedure SetProjectData(aProject: TLazProject; const aConfig, aOpenAPIFileName, aBaseFileName: string); + procedure GetProjectData(aProject: TLazProject; out aConfig, aOpenAPIFileName, aBaseFileName: string); + Procedure HandleRefreshOpenAPI(Sender : TObject); + Procedure HandleProjectInspectorPopup(Sender : TObject); + Function IsOpenAPIProject : Boolean; + Function OpenAPIConfigOK : Boolean; + end; + +var + OpenAPIHandler : TOpenAPIHandler; + +implementation + +uses + fpyaml.parser, + fpyaml.data, + fpyaml.json, + fpopenapi.reader, + lazopenapistr, + lazideintf, + ideintf, + IDEMsgIntf, + IDEExternToolIntf; + + +{ TLazOpenAPICodeGen } + +procedure TLazOpenAPICodeGen.PrepareAPIData(aData: TAPIData); +var + I : Integer; +begin + Inherited; + SetLength(FServerURLS,0); + if API.HasKeyWord(oakServers) then + begin + SetLength(FServerURLS,API.Servers.Count); + For I:=0 to API.Servers.Count-1 do + FServerURLS[i]:=API.Servers[I].Url; + end; + if GenerateServer then + begin + SetLength(FServerServiceModules,aData.ServiceCount); + for I:=0 to aData.ServiceCount-1 do + FServerServiceModules[i]:='T'+aData.Services[i].ServiceName+'Module'; + end; +end; + +function TLazOpenAPICodeGen.ResolveUnitName(aKind: TUnitKind; aFull: Boolean): String; +begin + Result:=ResolveUnit(aKind,aFull); +end; + +{ TOpenAPIHandler } + +Function TOpenAPIHandler.GetJSONFromYAML(const aOpenAPIFile : string) : TJSONStringType; + +var + lParser : TYAMLParser; + lYAML : TYAMLStream; + lJSON : TJSONData; + +begin + lYAML:=Nil; + lJSON:=Nil; + lParser:=TYAMLParser.Create(aOpenAPIFile); + try + lYAML:=lParser.Parse; + lJSON:=YamlToJSON(lYAML); + Result:=lJSON.FormatJSON(); + finally + lYAML.Free; + lJSON.Free; + lParser.Free; + end; +end; + +Procedure TOpenAPIHandler.GenerateFiles(const aOpenAPIFile, aBaseOutputFile : string; aGenerator : TLazOpenAPICodeGen); + +var + Loader : TOpenAPIReader; + API : TOpenAPI; + lJSON : String; + +begin + Loader:=Nil; + API:=TOpenAPI.Create; + try + Loader:=TOpenAPIReader.Create(Nil); + if TYAMLParser.IsYamlFileName(aOpenAPIFile) then + begin + lJSON:=GetJSONFromYAML(aOpenAPIFile); + Loader.ReadFromString(API,lJSON); + end + else + // Assume JSON + Loader.ReadFromFile(API,aOpenAPIFile); + + aGenerator.API:=API; + aGenerator.BaseOutputFileName:=aBaseOutputFile; + aGenerator.Execute; + finally + Loader.Free; + API.Free; + end; +end; + +function TOpenAPIHandler.IsOpenAPIProject: Boolean; +begin + Result:=(LazarusIDE.ActiveProject.CustomData.Values[SDataOpenAPIFile]<>''); +end; + +function TOpenAPIHandler.OpenAPIConfigOK: Boolean; + +var + a,b : string; + +begin + Result:=OpenAPIConfigOK(a,b); +end; + +function TOpenAPIHandler.OpenAPIConfigOK(out aOpenAPI,aConfig : string) : Boolean; + + +var + lPath,lFileName : String; + +begin + lFileName:=LazarusIDE.ActiveProject.CustomData.Values[SDataOpenAPIFile]; + Result:=(lFileName<>''); + if Not Result then + Exit; + lPath:=ExtractFilePath(LazarusIDE.ActiveProject.ProjectInfoFile); + lFileName:=ExpandFileName(lPath+lFileName); + Result:=FileExists(lFileName); + if Not Result then + begin + AddIDEMessage(mluFatal,format(SErrInvalidOpenAPIFile,[lFileName]),'',0,0,SOpenAPICodeGenerator); + Exit; + end; + aOpenAPI:=lFileName; + lFileName:=LazarusIDE.ActiveProject.CustomData.Values[SDataOpenAPIConfig]; + lFileName:=ExpandFileName(lPath+lFileName); + Result:=FileExists(lFileName); + if Not Result then + AddIDEMessage(mluFatal,format(SErrInvalidOpenAPIConfigFile,[lFileName]),'',0,0,SOpenAPICodeGenerator) + else + aConfig:=lFileName; +end; + +procedure TOpenAPIHandler.GetProjectData(aProject: TLazProject; out aConfig, aOpenAPIFileName, aBaseFileName: string); + +var + lPath: String; +begin + lPath:=ExtractFilePath(aProject.ProjectInfoFile); + With aProject.CustomData do + begin + aConfig:=ExpandFileName(lPath+Values[SDataOpenAPIConfig]); + aOpenAPIFileName:=ExpandFileName(lPath+Values[SDataOpenAPIFile]); + aBaseFileName:=ExpandFileName(lPath+Values[SDataOpenAPIBaseFileName]); + end; +end; + +procedure TOpenAPIHandler.SetProjectData(aProject: TLazProject; const aConfig, aOpenAPIFileName, aBaseFileName: string); +var + lPath : String; + +begin + lPath:=ExtractFilePath(aProject.ProjectInfoFile); + With aProject.CustomData do + begin + Add(SDataOpenAPIFile,ExtractRelativePath(lPath,aOpenAPIFileName)); + Add(SDataOpenAPIConfig,ExtractRelativePath(lPath,aConfig)); + Add(SDataOpenAPIBaseFileName,ExtractRelativePath(lPath,aBaseFileName)); + end; +end; + +procedure TOpenAPIHandler.HandleRefreshOpenAPI(Sender: TObject); + +var + lPath,lBaseFileName,lOpenAPIFileName,lConfigFileName : String; + lGen : TLazOpenAPICodeGen; + +begin + if not OpenAPIConfigOK(lOpenAPIFileName,lConfigFileName) then + exit; + lPath:=ExtractFilePath(LazarusIDE.ActiveProject.ProjectInfoFile); + lBaseFileName:=ExpandFileName(lPath+LazarusIDE.ActiveProject.CustomData.Values[SDataOpenAPIBaseFileName]); + lGen:=TLazOpenAPICodeGen.Create(Nil); + try + lGen.LoadConfig(lConfigFileName); + lGen.SkipServerServiceImplementationModule:=True; + GenerateFiles(lOpenAPIFileName,lBaseFileName,lGen); + finally + lGen.Free; + end; +end; + +procedure TOpenAPIHandler.HandleProjectInspectorPopup(Sender: TObject); + +begin + RefreshMenu.Visible:=IsOpenAPIProject; +end; + + +end. + diff --git a/components/openapi/lazopenapistr.pas b/components/openapi/lazopenapistr.pas new file mode 100644 index 0000000000..9554bfb58a --- /dev/null +++ b/components/openapi/lazopenapistr.pas @@ -0,0 +1,34 @@ +unit lazopenapistr; + +{$mode objfpc}{$H+} + +interface + +const + SProjectRefreshOpenAPIName = 'PrjRefreshOpenAPI'; + SDataOpenAPIFile = 'OpenAPIFile'; + SDataOpenAPIConfig = 'OpenAPIConfig'; + SDataOpenAPIBaseFileName = 'OpenAPIBase'; + SConfigFileName = 'lazopenapi.cfg'; + +Resourcestring + SCMDOpenAPIWizard = 'ShowOpenAPICodeGenerator'; + SCMDOpenAPIWizardCaption = 'OpenAPI code generator...'; + SOpenAPICodeGenerator = 'OpenAPI code generation'; + SErrFailedToGenerateAPI = 'Failed to generate OpenAPI files. Unexpected error %s with message: %s'; + SProjectOpenAPIClient = 'OpenAPI client application'; + SProjectOpenAPIClientDescription = 'A client application to consume a REST service described by an OpenAPI file.'; + SProjectOpenAPIServer = 'OpenAPI server application'; + SProjectOpenAPIServerDescription = 'A server application to offer an REST service consume a REST service described by an OpenAPI file.'; + SProjectOpenAPIClientServer = 'OpenAPI client and server applications'; + SProjectOpenAPIClientServerDescription = 'Client and server applications to consume and offer a REST service described by an OpenAPI file.'; + SErrFailedToCreateProjectDir = 'Failed to create project directory "%s"'; + SErrInvalidOpenAPIFile = 'Invalid OpenAPI description file: "%s"'; + SErrInvalidOpenAPIConfigFile = 'Invalid OpenAPI code generation config file: "%s"'; + SRegenerateOpenAPI = 'Regenerate OpenAPI units'; + SOpenAPIProjectOptionsCaption = 'Open API options'; + +implementation + +end. + diff --git a/components/openapi/reglazopenapi.pas b/components/openapi/reglazopenapi.pas index 50e188eceb..6c4eeba67e 100644 --- a/components/openapi/reglazopenapi.pas +++ b/components/openapi/reglazopenapi.pas @@ -5,77 +5,142 @@ unit reglazopenapi; interface uses - Classes, SysUtils, LazIDEIntf, IDECommands; + Classes, SysUtils, system.uitypes, fpopenapi.codegen, lazopenapictrl, LazIDEIntf, IDECommands, ProjectIntf; + +Type + { TOpenAPIProject } + + TOpenAPIProject = class(TProjectDescriptor) + private + FBaseDir: String; + FGenerator: TLazOpenAPICodeGen; + FHTTPPort: Word; + FOpenAPIFileName : string; + FUnitsBaseName : string; + FHTTPThreaded : Boolean; + FClientProgramType : TIDEProjectType; + FServerProgramType : TIDEProjectType; + procedure GenerateAPIRoutesRegistration(aSrc: TStrings); + function GetBaseFileName: string; + protected + function DefaultBaseURL : String; virtual; + function GetAllowedTypes : TOpenAPIProjectTypes; virtual; abstract; + function CreateProjectSource(const aFileName : string): string; virtual; abstract; + procedure GenerateServerCmdLineProjectSource(aSrc: TStrings); + procedure GenerateClientCmdLineProjectSource(aSrc: TStrings); + procedure GenerateHTTPServerProjectSource(aSrc: TStrings); + procedure GenerateGUIProjectSource(aType : TOpenAPIProjectType; aSrc : TStrings); + function ShowWizard(aTypes : TOpenAPIProjectTypes) : boolean; + function EnsureFileSaved(const aFilename : String) : Boolean; + Public + constructor Create; override; + destructor destroy; override; + procedure Clear; virtual; + function GetUnitNames(aType: TOpenAPIProjectType; forProject: Boolean): String; + function DoInitDescriptor: TModalResult; override; + function InitProject(AProject: TLazProject): TModalResult; override; + function CreateStartFiles(AProject: TLazProject): TModalResult; override; + Property Generator : TLazOpenAPICodeGen read FGenerator; + Property OpenAPIFileName : string Read FOpenAPIFileName; + Property ClientProgramType : TIDEProjectType Read FClientProgramType; + Property ServerProgramType : TIDEProjectType Read FServerProgramType; + Property BaseDir : string Read FBaseDir; + property UnitsBaseName : string read FUnitsBaseName; + Property HTTPPort : Word Read FHTTPPort; + Property HTTPThreaded : Boolean Read FHTTPThreaded; + end; + + { TOpenAPIFormDescriptor } + + TOpenAPIFormDescriptor = class (TFileDescPascalUnitWithResource) + private + FProject: TOpenAPIProject; + Public + constructor Create(aProject : TOpenAPIProject); + function GetInterfaceUsesSection: string; override; + procedure AddClassDeclarations(aSrc : TStrings); virtual; abstract; + function ProjectType : TOpenAPIProjectType; virtual; abstract; + function GetInterfaceSource(const Filename, SourceName, ResourceName: string): string; override; + Property Project : TOpenAPIProject Read FProject; + end; + + { TClientOpenAPIFormDescriptor } + + TClientOpenAPIFormDescriptor = class (TOpenAPIFormDescriptor) + function GetResourceSource(const {%H-}ResourceName: string): string; override; + function GetInterfaceUsesSection: string; override; + function GetImplementationSource(const Filename, {%H-}SourceName, {%H-}ResourceName: string): string; override; + function ProjectType : TOpenAPIProjectType; override; + procedure AddClassDeclarations(aSrc : TStrings); override; + end; + + { TServerOpenAPIFormDescriptor } + + TServerOpenAPIFormDescriptor = class (TOpenAPIFormDescriptor) + function GetResourceSource(const {%H-}ResourceName: string): string; override; + function GetInterfaceUsesSection: string; override; + function GetImplementationSource(const Filename, {%H-}SourceName, {%H-}ResourceName: string): string; override; + function ProjectType : TOpenAPIProjectType; override; + procedure AddClassDeclarations(aSrc : TStrings); override; + end; + + + { TProjectOpenAPIClient } + + TProjectOpenAPIClient = Class (TOpenAPIProject) + public + constructor Create; override; + function CreateProjectSource(const aFileName : string) : string; override; + function GetAllowedTypes : TOpenAPIProjectTypes; override; + function GetLocalizedName: string; override; + function GetLocalizedDescription: string; override; + end; + + { TProjectOpenAPIServer } + + TProjectOpenAPIServer = Class (TOpenAPIProject) + public + constructor Create; override; + function CreateProjectSource(const aFileName : string) : string; override; + function GetAllowedTypes : TOpenAPIProjectTypes; override; + function GetLocalizedName: string; override; + function GetLocalizedDescription: string; override; + end; + + { TProjectOpenAPIClientAndServer } + + TProjectOpenAPIClientAndServer = Class (TOpenAPIProject) + public + constructor Create; override; + function CreateProjectSource(const aFileName : string) : string; override; + function GetAllowedTypes : TOpenAPIProjectTypes; override; + function GetLocalizedName: string; override; + function GetLocalizedDescription: string; override; + end; procedure register; + implementation -uses MenuIntf, frmopenapiwizard, forms, controls, fpopenapi.reader, fpopenapi.objects, fpopenapi.codegen, fpjson, fpyaml.parser, fpyaml.data, fpyaml.json; +uses + CodeToolManager, + CodeCache, + MenuIntf, + IDEMsgIntf, + IDEExternToolIntf, + IDEOptEditorIntf, + IDEOptionsIntf, + lazopenapistr, + frmopenapiproject, + frmopenapiwizard, + fraopenapiprojectsettings, + forms, + controls; -Resourcestring - SCMDOpenAPIWizard = 'ShowOpenAPICodeGenerator'; - SCMDOpenAPIWizardCaption = 'OpenAPI code generator...'; - -Type - - { TLazOpenAPICodeGen } - - TLazOpenAPICodeGen = class(TOpenAPICodeGen) - Function ResolveFullFileName(aKind : TUnitKind) : String; - end; - -Function GetJSONFromYAML(const aOpenAPIFile : string) : TJSONStringType; - -var - lParser : TYAMLParser; - lYAML : TYAMLStream; - lJSON : TJSONData; - -begin - lYAML:=Nil; - lJSON:=Nil; - lParser:=TYAMLParser.Create(aOpenAPIFile); - try - lYAML:=lParser.Parse; - lJSON:=YamlToJSON(lYAML); - Result:=lJSON.FormatJSON(); - finally - lYAML.Free; - lJSON.Free; - lParser.Free; - end; -end; - -Procedure GenerateFiles(const aOpenAPIFile, aBaseOutputFile : string; aGenerator : TLazOpenAPICodeGen); - -var - Loader : TOpenAPIReader; - API : TOpenAPI; - lJSON : String; - -begin - Loader:=Nil; - API:=TOpenAPI.Create; - try - Loader:=TOpenAPIReader.Create(Nil); - if (ExtractFileExt(aOpenAPIFile)='.yaml') then - begin - lJSON:=GetJSONFromYAML(aOpenAPIFile); - Loader.ReadFromString(API,lJSON); - end - else - // Assume JSON - Loader.ReadFromFile(API,aOpenAPIFile); - - aGenerator.API:=API; - aGenerator.BaseOutputFileName:=aBaseOutputFile; - aGenerator.Execute; - finally - Loader.Free; - API.Free; - end; -end; +Const + OpenAPIOptionsIndex = ProjectOptionsMisc + 200; + Bools : Array[Boolean] of string = ('False','True'); procedure ShowOpenAPIWizard(Sender: TObject); @@ -99,20 +164,20 @@ begin begin if frm.AddToProject then Include(opts,ofAddToProject); - GenerateFiles(frm.OpenAPIFileName,frm.BaseFileName,lGenerator); + OpenAPIHandler.GenerateFiles(frm.OpenAPIFileName,frm.BaseFileName,lGenerator); if frm.OpenGeneratedFiles then begin - LazarusIDE.DoOpenEditorFile(lGenerator.ResolveFullFileName(ukDto),-1,-1,opts); - LazarusIDE.DoOpenEditorFile(lGenerator.ResolveFullFileName(ukSerialize),-1,-1,opts); + LazarusIDE.DoOpenEditorFile(lGenerator.ResolveUnitName(ukDto),-1,-1,opts); + LazarusIDE.DoOpenEditorFile(lGenerator.ResolveUnitName(ukSerialize),-1,-1,opts); if lGenerator.GenerateClient then begin - LazarusIDE.DoOpenEditorFile(lGenerator.ResolveFullFileName(ukClientServiceIntf),-1,-1,opts); - LazarusIDE.DoOpenEditorFile(lGenerator.ResolveFullFileName(ukClientServiceImpl),-1,-1,opts); + LazarusIDE.DoOpenEditorFile(lGenerator.ResolveUnitName(ukClientServiceIntf),-1,-1,opts); + LazarusIDE.DoOpenEditorFile(lGenerator.ResolveUnitName(ukClientServiceImpl),-1,-1,opts); end; if lGenerator.GenerateServer then begin - LazarusIDE.DoOpenEditorFile(lGenerator.ResolveFullFileName(ukServerServiceHandler),-1,-1,opts); - LazarusIDE.DoOpenEditorFile(lGenerator.ResolveFullFileName(ukServerServiceImpl),-1,-1,opts); + LazarusIDE.DoOpenEditorFile(lGenerator.ResolveUnitName(ukServerServiceHandler),-1,-1,opts); + LazarusIDE.DoOpenEditorFile(lGenerator.ResolveUnitName(ukServerServiceImpl),-1,-1,opts); end; end; end; @@ -123,18 +188,18 @@ begin end; - procedure register; -var - CmdToolsMenu : TIDECommandCategory; - OpenAPIWizardCommand : TIDECommand; - begin + OpenAPIHandler:=TOpenAPIHandler.Create; + RegisterProjectDescriptor(TProjectOpenAPIClient.Create); + RegisterProjectDescriptor(TProjectOpenAPIServer.Create); + // Todo + // RegisterProjectDescriptor(TProjectOpenAPIClientAndServer.Create); // search shortcut category - CmdToolsMenu:=IDECommandList.FindCategoryByName(CommandCategoryToolMenuName); + OpenAPIHandler.CmdToolsMenu:=IDECommandList.FindCategoryByName(CommandCategoryToolMenuName); // register shortcut - OpenAPIWizardCommand:=RegisterIDECommand(CmdToolsMenu, + OpenAPIHandler.OpenAPIWizardCommand:=RegisterIDECommand(OpenAPIHandler.CmdToolsMenu, SCMDOpenAPIWizard, SCMDOpenAPIWizardCaption, CleanIDEShortCut, @@ -142,15 +207,843 @@ begin // register menu item in View menu RegisterIDEMenuCommand(itmCustomTools, SCMDOpenAPIWizard, - SCMDOpenAPIWizardCaption, nil, nil, OpenAPIWizardCommand); + SCMDOpenAPIWizardCaption, nil, nil, OpenAPIHandler.OpenAPIWizardCommand); + // Add refresh to popup menu + OpenAPIHandler.RefreshMenu:=RegisterIDEMenuCommand(ProjInspMenuSectionFiles, + SProjectRefreshOpenAPIName,SRegenerateOpenAPI,@OpenAPIHandler.HandleRefreshOpenAPI); + ProjectInspectorItemsMenuRoot.AddHandlerOnShow(@OpenAPIHandler.HandleProjectInspectorPopup); + RegisterIDEOptionsEditor(GroupProject,TLazOpenAPIProjectOptions, OpenAPIOptionsIndex); end; -{ TLazOpenAPICodeGen } -function TLazOpenAPICodeGen.ResolveFullFileName(aKind: TUnitKind): String; +{ TOpenAPIProject } + +destructor TOpenAPIProject.destroy; begin - Result:=ResolveUnit(aKind,True); + FreeAndNil(FGenerator); + Inherited; +end; + +function TOpenAPIProject.GetBaseFileName : string; + +var + lBaseFileName : String; + +begin + lBaseFileName:=IncludeTrailingPathDelimiter(BaseDir); + if GetAllowedTypes<>[optClient,optServer] then + lBaseFileName:=lBaseFileName+UnitsBaseName + else + lBaseFileName:=IncludeTrailingPathDelimiter(lBaseFileName+'common')+UnitsBaseName; + Result:=lBaseFileName; +end; + +function TOpenAPIProject.DefaultBaseURL: String; +begin + Result:='http://localhost:8080/REST/'; +end; + +function TOpenAPIProject.DoInitDescriptor: TModalResult; + + function TryCreateDir(const aDir : string) : Boolean; + var + lMsg : string; + begin + Result:=ForceDirectories(aDir); + lMsg:=Format(SErrFailedToCreateProjectDir,[aDir]); + AddIDEMessage(mluFatal,lMsg,'',0,0,SOpenAPICodeGenerator); + end; + +var + lMsg : String; + lBaseFileName : String; + +begin + if Not ShowWizard(GetAllowedTypes) then + Exit(mrCancel); + If not TryCreateDir(BaseDir) then + Exit(mrAbort); + lBaseFileName:=GetBaseFileName; + if GetAllowedTypes=[optClient,optServer] then + begin + If not TryCreateDir(BaseDir+'client') then + Exit(mrAbort); + If not TryCreateDir(BaseDir+'server') then + Exit(mrAbort); + If not TryCreateDir(BaseDir+'common') then + Exit(mrAbort); + lBaseFileName:=IncludeTrailingPathDelimiter(BaseDir)+UnitsBaseName + end + else If not TryCreateDir(BaseDir) then + Exit(mrAbort); + try + Generator.GenerateClient:=optClient in GetAllowedTypes; + Generator.GenerateServer:=optServer in GetAllowedTypes; + OpenAPIHandler.GenerateFiles(OpenAPIFileName,lBaseFileName,Generator); + Result:=mrOK; + except + on E : Exception do + begin + lMsg:=Format(SErrFailedToGenerateAPI,[E.ClassName,E.Message]); + AddIDEMessage(mluFatal,lMsg,'',0,0,SOpenAPICodeGenerator); + Result:=mrAbort; + end; + end; +end; + + +function TOpenAPIProject.InitProject(AProject: TLazProject): TModalResult; +var + lFileName,lConfig : string; +begin + if optClient in GetAllowedTypes then + lFileName:=BaseDir+'client.lpi' + else + lFileName:=BaseDir+'server.lpi'; + AProject.ProjectInfoFile:=lFileName; + AProject.LazCompilerOptions.OtherUnitFiles:=BaseDir; + lConfig:=ExtractFilePath(GetBaseFileName)+SConfigFileName; + FGenerator.SaveConfig(lConfig); + OpenAPIHandler.SetProjectData(aProject,lConfig,OpenApiFileName,GetBaseFileName); + Result:=mrOK; +end; + +function TOpenAPIProject.GetUnitNames(aType: TOpenAPIProjectType; forProject: Boolean): String; + + procedure AddToResult(aUnit : string); + + begin + Result:=Result+', '+aUnit; + end; + +begin + Result:=Generator.ResolveUnitName(ukDto,False); + AddToResult(Generator.ResolveUnitName(ukSerialize,False)); + if aType=optClient then + begin + AddToResult(Generator.ResolveUnitName(ukClientServiceIntf,False)); + AddToResult(Generator.ResolveUnitName(ukClientServiceImpl,False)); + if Generator.GenerateServerProxyModule then + AddToResult(Generator.ResolveUnitName(ukServerProxy,False)); + if ForProject then + begin + AddToResult('fpwebclient'); + AddToResult('fphttpwebclient'); + end; + end + else + begin + AddToResult(Generator.ResolveUnitName(ukServerServiceHandler,False)); + AddToResult(Generator.ResolveUnitName(ukServerServiceImpl,False)); + end; +end; + +procedure TOpenAPIProject.GenerateAPIRoutesRegistration(aSrc: TStrings); + +var + aModule : string; + +begin + // Todo: add possibility of creating a form. + For aModule in Generator.ServerServiceModules do + aSrc.Add(' %s.RegisterAPIRoutes(BaseURL,%s);',[aModule,'False']); +end; + +procedure TOpenAPIProject.GenerateHTTPServerProjectSource(aSrc: TStrings); + + procedure AddLn(const fmt : string; const aArgs : Array of const); + begin + aSrc.Add(fmt,aArgs); + end; + + procedure AddLn(const aLine : string); + begin + aSrc.Add(aLine); + end; + +begin + Addln('uses'); + Addln(' {$IFDEF UNIX}'); + Addln(' cthreads, cwstring,'); + Addln(' {$ENDIF}'); + Addln(' {$IFDEF HASAMIGA}'); + Addln(' athreads,'); + Addln(' {$ENDIF}'); + Addln(' Classes, fpHTTPApp, %s;',[GetUnitNames(optServer,True)]); + Addln(''); + Addln('const'); + Addln(' BaseURL = ''REST/'';'); + Addln(''); + Addln('begin'); + GenerateAPIRoutesRegistration(aSrc); + Addln(' Application.Title:=''OpenAPI server project'';'); + Addln(' Application.Port:=%d;',[HTTPPort]); + Addln(' Application.Threaded:=%s;',[Bools[HTTPThreaded]]); + Addln(' // Uncomment this if you wish to use SSL'); + Addln(' // Application.UseSSL:=True;'); + Addln(' Application.Initialize;'); + Addln(' Application.Run;'); + Addln('end.'); +end; + +procedure TOpenAPIProject.GenerateServerCmdLineProjectSource(aSrc: TStrings); + + procedure AddLn(const fmt : string; const aArgs : Array of const); + begin + aSrc.Add(fmt,aArgs); + end; + + procedure AddLn(const aLine : string); + begin + aSrc.Add(aLine); + end; + +begin + Addln('uses'); + Addln(' {$IFDEF UNIX}'); + Addln(' cthreads, cwstring,'); + Addln(' {$ENDIF}'); + Addln(' {$IFDEF HASAMIGA}'); + Addln(' athreads,'); + Addln(' {$ENDIF}'); + Addln(' Classes, CustApp, fphttpserver, httproute, %s;',[GetUnitNames(optServer,True)]); + Addln(''); + Addln('Type'); + Addln(' TApplication = Class(TCustomApplication)'); + Addln(' FServer : TFPHttpServer;'); + Addln(' procedure HandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);'); + Addln(' protected'); + Addln(' procedure DoRun; override;'); + Addln(' public'); + Addln(' constructor Create(aOwner : TComponent); override;'); + Addln(' Property Server : TFPHttpServer Read FServer;'); + Addln(' end;'); + Addln(''); + Addln('constructor TApplication.Create(aOwner : TComponent);'); + Addln(''); + Addln('const'); + Addln(' BaseURL = ''/REST'';'); + Addln(''); + Addln('begin'); + Addln(' inherited;'); + GenerateAPIRoutesRegistration(aSrc); + Addln(' FServer:=TFPHttpServer.Create(Self);'); + Addln(' FServer.Port:=%d;',[HTTPPort]); + Addln(' FServer.OnRequest:=@HandleRequest;'); + Addln(' FServer.Threaded:=%s;',[Bools[HTTPThreaded]]); + Addln('end;'); + Addln(''); + Addln('procedure TApplication.DoRun; '); + Addln(''); + Addln('begin'); + Addln(' FServer.Active:=True;'); + if not HTTPThreaded then + Addln(' // Note: code here will only be executed after the server stops!'); + Addln('end;'); + Addln(''); + Addln('procedure TApplication.HandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);'); + Addln('begin'); + Addln(' HTTPRouter.RouteRequest(aRequest,aResponse);'); + Addln('end;'); + Addln(''); + Addln('var'); + Addln(' Application : TApplication;'); + Addln(''); + Addln('begin'); + Addln(' Application:=TApplication.Create(Nil);'); + Addln(' Application.Initialize;'); + Addln(' Application.Run;'); + Addln(' Application.Free;'); + Addln('end.'); +end; + +procedure TOpenAPIProject.GenerateClientCmdLineProjectSource(aSrc: TStrings); + + procedure AddLn(const fmt : string; const aArgs : Array of const); + begin + aSrc.Add(fmt,aArgs); + end; + + procedure AddLn(const aLine : string); + begin + aSrc.Add(aLine); + end; + +var + S : String; + +begin + Addln('uses'); + Addln(' {$IFDEF UNIX}'); + Addln(' cthreads, cwstring,'); + Addln(' {$ENDIF}'); + Addln(' {$IFDEF HASAMIGA}'); + Addln(' athreads,'); + Addln(' {$ENDIF}'); + Addln(' Classes, CustApp, %s;',[GetUnitNames(optClient,True)]); + Addln(''); + Addln('Type'); + Addln(' TApplication = Class(TCustomApplication)'); + if Generator.GenerateServerProxyModule then + AddLn(' FProxy : %s;',[Generator.ServerProxyModuleName]); + Addln(' protected'); + Addln(' procedure DoRun; override;'); + Addln(' public'); + Addln(' constructor Create(aOwner : TComponent); override;'); + if Generator.GenerateServerProxyModule then + AddLn(' Property Proxy : %s read FProxy;',[Generator.ServerProxyModuleName]); + Addln(' end;'); + Addln(''); + Addln('constructor TApplication.Create(aOwner : TComponent);'); + Addln(''); + Addln('begin'); + Addln(' inherited;'); + Addln(' DefaultWebClientClass:=TFPHTTPWebClient;'); + if Generator.GenerateServerProxyModule then + Addln(' FProxy:=%s.Create(Self);',[Generator.ServerProxyModuleName]); + Addln('end;'); + Addln(''); + Addln('procedure TApplication.DoRun; '); + Addln(''); + Addln('begin'); + if Generator.GenerateServerProxyModule then + begin + Addln(' // here you can configure the proxy.'); + Addln(' // after it is configured, you can make calls to the service.'); + Addln(' // Typically you will want to set the base URL of the service.'); + S:=DefaultBaseURL; + if Length(Generator.ServerURLs)>0 then + S:=Generator.ServerURLs[0]; + Addln(' Proxy.BaseURL:=''%s'';',[S]); + end; + Addln('end;'); + Addln(''); + Addln('var'); + Addln(' Application : TApplication;'); + Addln(''); + Addln('begin'); + Addln(' Application:=TApplication.Create(Nil);'); + Addln(' Application.Initialize;'); + Addln(' Application.Run;'); + Addln(' Application.Free;'); + Addln('end.'); +end; + +procedure TOpenAPIProject.GenerateGUIProjectSource(aType: TOpenAPIProjectType; aSrc: TStrings); + + procedure AddLn(const fmt : string; const aArgs : Array of const); + begin + aSrc.Add(fmt,aArgs); + end; + + procedure AddLn(const aLine : string); + begin + aSrc.Add(aLine); + end; + +var + lModule,lVar : String; + +begin + Addln('uses'); + Addln(' {$IFDEF UNIX}'); + Addln(' cthreads, cwstring,'); + Addln(' {$ENDIF}'); + Addln(' {$IFDEF HASAMIGA}'); + Addln(' athreads,'); + Addln(' {$ENDIF}'); + AddLn(' Interfaces,'); + AddLn(' Forms,'); + AddLn(' %s;',[GetUnitNames(aType,True)]); + Addln(''); + if (aType=optServer) then + begin + Addln('const'); + Addln(' BaseURL = ''/REST/'';'); + Addln(''); + end; + Addln('begin'); + if aType=optClient then + Addln(' DefaultWebClientClass:=TFPHTTPWebClient;') + else + GenerateAPIRoutesRegistration(aSrc); + Addln(' Application.Initialize;'); + if (aType=optClient) and Generator.ServerProxyFormFile then + begin + lModule:=Generator.ServerProxyModuleName; + lVar:=Copy(lModule,2,Length(lModule)-1); + Addln(' Application.CreateForm(%s,%s);',[lModule,lVar]); + end; + Addln(' Application.Run;'); + Addln(' Application.Free;'); + Addln('end.'); +end; + +constructor TOpenAPIProject.Create; +begin + Inherited; + Clear; +end; + +procedure TOpenAPIProject.Clear; + +begin + FreeAndNil(FGenerator); + FGenerator:=TLazOpenAPICodeGen.Create(Nil); + FOpenAPIFileName:=''; + FBaseDir:=''; + FUnitsBaseName:=''; + FClientProgramType:=Default(TIDEProjectType); + FServerProgramType:=Default(TIDEProjectType); +end; + +function TOpenAPIProject.ShowWizard(aTypes: TOpenAPIProjectTypes): boolean; + +var + Frm : TOpenAPIProjectForm; + +begin +// TOpenAPIProjectType = (optClient,optServer); + Frm:=TOpenAPIProjectForm.Create(Application); + try + frm.AllowedTypes:=aTypes; + frm.Generator:=Self.Generator; + frm.BaseDir:=LazarusIDE.GetTestBuildDirectory; + frm.OpenAPIFileName:='/home/michael/fpc/packages/fcl-openapi/examples/simpleservice.json'; + Result:=frm.ShowModal=mrOK; + if Result then + begin + FOpenAPIFileName:=frm.OpenAPIFileName; + FClientProgramType:=Frm.ClientProjectType; + FServerProgramType:=Frm.ServerProjectType; + FBaseDir:=IncludeTrailingPathDelimiter(Frm.BaseDir); + FUnitsBaseName:=Frm.UnitsBaseName; + FHTTPPort:=frm.HTTPPort; + FHTTPThreaded:=frm.ThreadedServer; + end; + finally + Frm.Free; + end; +end; + +function TOpenAPIProject.EnsureFileSaved(const aFilename: String): Boolean; + +var + Code: TCodeBuffer; +begin + Code:=CodeToolBoss.FindFile(aFilename); + Result:=Code<>nil; + if not Result then + AddIDEMessage(mluFatal,'File missing in codetools: "'+aFilename+'"','',0,0,SOpenAPICodeGenerator) + else + begin + Result:=Code.Save; + if not Result then + AddIDEMessage(mluFatal,'Unable to write file "'+aFilename+'"','',0,0,SOpenAPICodeGenerator); + end; +end; + +function TOpenAPIProject.CreateStartFiles(AProject: TLazProject): TModalResult; + + Procedure AddFileToProject(aFileName : string); + + var + lFile : TLazProjectFile; + + begin + lFile:=aProject.CreateProjectFile(aFileName); + lFile.IsPartOfProject:=True; + aProject.AddFile(lFile,False); + end; + +var + aFile : TLazProjectFile; + lFileName : string; + lForm : TOpenAPIFormDescriptor; + +begin + lFileName:=ChangeFileExt(AProject.ProjectInfoFile,'.lpr'); + aFile:=aProject.CreateProjectFile(lFileName); + aFile.IsPartOfProject:=True; + aProject.AddFile(aFile,False); + aProject.MainFileID:=0; + aProject.MainFile.SetSourceText(CreateProjectSource(lFileName),true); + EnsureFileSaved(lFileName); + if LazarusIDE.DoSaveProject([sfQuietUnitCheck])<>mrOk then exit; + AddFileToProject(Generator.ResolveUnitName(ukDto)); + AddFileToProject(Generator.ResolveUnitName(ukSerialize)); + if optClient in GetAllowedTypes then + begin + AddFileToProject(Generator.ResolveUnitName(ukClientServiceIntf)); + AddFileToProject(Generator.ResolveUnitName(ukClientServiceImpl)); + if Generator.GenerateServerProxyModule then + AddFileToProject(Generator.ResolveUnitName(ukServerProxy)); + if (ClientProgramType=iptGUI) then + begin + lForm:=TClientOpenAPIFormDescriptor.Create(Self); + try + LazarusIDE.DoNewEditorFile(lForm,'','', + [nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]); + finally + lForm.Free; + end; + end; + end + else + begin + AddFileToProject(Generator.ResolveUnitName(ukServerServiceHandler)); + if not Generator.SkipServerServiceImplementationModule then + AddFileToProject(Generator.ResolveUnitName(ukServerServiceImpl)); + if (ServerProgramType=iptGUI) then + begin + lForm:=TServerOpenAPIFormDescriptor.Create(Self); + try + LazarusIDE.DoNewEditorFile(lForm,'','', + [nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]); + finally + lForm.Free; + end; + end; + end; + Result:=mrOK; +end; + +{ TOpenAPIFormDescriptor } + +constructor TOpenAPIFormDescriptor.Create(aProject: TOpenAPIProject); +begin + Inherited Create; + FProject:=aProject; + ResourceClass:=TForm; + UseCreateFormStatements:=True; +end; + +function TOpenAPIFormDescriptor.GetInterfaceUsesSection: string; +begin + Result:=inherited GetInterfaceUsesSection; + Result:=Result+', '+Project.GetUnitNames(ProjectType,False); +end; + +function TOpenAPIFormDescriptor.GetInterfaceSource(const Filename, SourceName, ResourceName: string): string; +var + Src : TStrings; +begin + Src:=TStringList.Create; + try + With Src do + begin + Add('type'); + Add(' T%s = class(%s)',[ResourceName,ResourceClass.ClassName]); + AddClassDeclarations(Src); + Add(' end;'); + Add(''); + if DeclareClassVariable then + begin + Add('var'); + Add(' %s: T%s;',[ResourceName,ResourceName]); + Add(''); + end; + end; + Result:=Src.Text; + finally + Src.Free; + end; +end; + +{ TClientOpenAPIFormDescriptor } + +function TClientOpenAPIFormDescriptor.GetResourceSource(const ResourceName: string): string; +var + Src : TStrings; + +begin + Src:=TStringList.Create; + try + With Src do + begin + Add('object %s : T%s',[ResourceName,ResourceName]); + Add(' Left = 320'); + Add(' Height = 480'); + Add(' Top = 320'); + Add(' Width = 640'); + Add(' OnCreate = HandleCreate'); + Add('end'); + end; + Result:=Src.Text; + finally + Src.Free; + end; +end; + +function TClientOpenAPIFormDescriptor.GetInterfaceUsesSection: string; +begin + Result:=Inherited GetInterfaceUsesSection; + Result:=Result+', Forms, Dialogs, Controls'; +end; + +function TClientOpenAPIFormDescriptor.GetImplementationSource(const Filename, SourceName, ResourceName: string): string; +var + src : TStrings; + lModule,lURL : string; + +begin + Src:=TStringList.Create; + try + With Src do + begin + if GetResourceType=rtRes then + begin + Add(''); + Add('{$R *.lfm}'); + end; + Add(''); + Add('procedure T%s.HandleCreate(Sender: TObject);',[ResourceName]); + Add('begin'); + lModule:=Project.Generator.ServerProxyModuleName; + lModule:=Copy(lModule,2,Length(lModule)-1); + if not Project.Generator.ServerProxyFormFile then + Add('%s:=T%s.Create(Self);',[lModule,lModule]); + lURL:=Project.DefaultBaseURL; + if Length(Project.Generator.ServerURLS)>0 then + lURL:=Project.Generator.ServerURLS[0]; + Add(' %s.BaseURL:=''%s'';',[lModule,lURL]); + Add('end;'); + Add(''); + end; + Result:=Src.Text; + finally + Src.free; + end; + if GetResourceType=rtLRS then + Result:=Result+inherited GetImplementationSource(Filename, SourceName, ResourceName); +end; + +function TClientOpenAPIFormDescriptor.ProjectType: TOpenAPIProjectType; +begin + Result:=optClient; +end; + +procedure TClientOpenAPIFormDescriptor.AddClassDeclarations(aSrc: TStrings); +var + lModule : String; +begin + With aSrc do + begin + Add(' procedure HandleCreate(Sender : TObject);'); + Add(' Private'); + if not Project.Generator.ServerProxyFormFile then + begin + lModule:=Project.Generator.ServerProxyModuleName; + lModule:=Copy(lModule,2,Length(lModule)-1); + Add(' %s : T%s;',[lModule,lModule]); + end; + Add(''); + Add(' Public'); + Add(''); + end; +end; + +{ TServerOpenAPIFormDescriptor } + +function TServerOpenAPIFormDescriptor.GetResourceSource(const ResourceName: string): string; +var + Src : TStrings; + +begin + Src:=TStringList.Create; + try + With Src do + begin + Add('object %s : T%s',[ResourceName,ResourceName]); + Add(' Left = 320'); + Add(' Height = 480'); + Add(' Top = 320'); + Add(' Width = 640'); + Add(' object HTTPServer: TFPHTTPServer'); + Add(' Port = %d',[Project.HTTPPort]); + Add(' Threaded = %s',[Bools[Project.HTTPThreaded]]); + Add(' OnRequest = HandleRequest'); + Add(' Left = 56'); + Add(' Top = 48'); + Add(' end'); + Add('end'); + end; + Result:=Src.Text; + finally + Src.Free; + end; +end; + +function TServerOpenAPIFormDescriptor.GetInterfaceUsesSection: string; +begin + Result:=inherited GetInterfaceUsesSection; + Result:=Result+', Forms, Dialogs, Controls'; +end; + +function TServerOpenAPIFormDescriptor.GetImplementationSource(const Filename, SourceName, ResourceName: string): string; +var + src : TStrings; +begin + Src:=TStringList.Create; + try + With Src do + begin + if GetResourceType=rtRes then + begin + Add(''); + Add('{$R *.lfm}'); + end; + Add(''); + Add('procedure T%s.HandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);',[ResourceName]); + Add('begin'); + Add(' HTTPRouter.RouteRequest(aRequest, aResponse);'); + Add('end;'); + Add(''); + end; + Result:=Src.Text; + finally + Src.free; + end; + if GetResourceType=rtLRS then + Result:=Result+inherited GetImplementationSource(Filename, SourceName, ResourceName); +end; + +function TServerOpenAPIFormDescriptor.ProjectType: TOpenAPIProjectType; +begin + Result:=optServer; +end; + +procedure TServerOpenAPIFormDescriptor.AddClassDeclarations(aSrc: TStrings); +begin + With aSrc do + begin + Add(' HTTPServer : TFPHTTPServer;'); + Add(' procedure HandleRequest(Sender: TObject; var ARequest: TFPHTTPConnectionRequest; var AResponse: TFPHTTPConnectionResponse);'); + Add(' private'); + Add(''); + Add(' public'); + Add(''); + end; +end; + +{ TProjectOpenAPIClient } + +constructor TProjectOpenAPIClient.Create; +begin + Inherited; + Name:='OpenAPIClient'; +end; + +function TProjectOpenAPIClient.CreateProjectSource(const aFileName : string): string; +var + Src : TStrings; +begin + Src:=TStringList.Create; + try + Src.Add('program project1;'); + Src.Add(''); + Src.Add('{$mode objfpc}'); + Src.Add('{$h+}'); + Src.Add(''); + Case ClientProgramType of + iptGUI : GenerateGUIProjectSource(optClient,Src); + iptCmdLine : GenerateClientCmdLineProjectSource(Src); + end; + Src.SaveToFile(aFileName); + Result:=Src.Text; + finally + Src.Free; + end; +end; + +function TProjectOpenAPIClient.GetAllowedTypes: TOpenAPIProjectTypes; +begin + Result:=[optClient]; +end; + +function TProjectOpenAPIClient.GetLocalizedName: string; +begin + Result:=SProjectOpenAPIClient; +end; + +function TProjectOpenAPIClient.GetLocalizedDescription: string; +begin + Result:=SProjectOpenAPIClientDescription; +end; + +{ TProjectOpenAPIServer } + +constructor TProjectOpenAPIServer.Create; +begin + inherited Create; + Name:='OpenAPIServer'; +end; + +function TProjectOpenAPIServer.CreateProjectSource(const aFileName: string): string; +var + Src : TStrings; +begin + Src:=TStringList.Create; + try + Src.Add('program project1;'); + Src.Add(''); + Src.Add('{$mode objfpc}'); + Src.Add('{$h+}'); + Src.Add(''); + Case ServerProgramType of + iptGUI : GenerateGUIProjectSource(optServer,Src); + iptCmdLine : GenerateServerCmdLineProjectSource(Src); + iptHTTPServer : GenerateHTTPServerProjectSource(Src); + end; + Src.SaveToFile(aFileName); + Result:=Src.Text; + finally + Src.Free; + end; +end; + +function TProjectOpenAPIServer.GetAllowedTypes: TOpenAPIProjectTypes; +begin + Result:=[optServer]; +end; + +function TProjectOpenAPIServer.GetLocalizedName: string; +begin + Result:=SProjectOpenAPIServer; +end; + +function TProjectOpenAPIServer.GetLocalizedDescription: string; +begin + Result:=SProjectOpenAPIServerDescription; +end; + +{ TProjectOpenAPIClientAndServer } + +constructor TProjectOpenAPIClientAndServer.Create; +begin + inherited Create; + Name:='OpenAPIClientAndServer'; +end; + +function TProjectOpenAPIClientAndServer.CreateProjectSource(const aFileName: string): string; +begin + Result:=''; +end; + +function TProjectOpenAPIClientAndServer.GetAllowedTypes: TOpenAPIProjectTypes; +begin + Result:=[optClient,optServer]; +end; + +function TProjectOpenAPIClientAndServer.GetLocalizedName: string; +begin + Result:=SProjectOpenAPIClientServer; +end; + +function TProjectOpenAPIClientAndServer.GetLocalizedDescription: string; +begin + Result:=SProjectOpenAPIClientServerDescription; end; end.