From 63754badc0d1c7ae62ef6de1f9742ee4055671a7 Mon Sep 17 00:00:00 2001 From: inoussa Date: Sun, 24 Jun 2007 23:33:51 +0000 Subject: [PATCH] switching the internal pascal parser to fcl-passrc type_lib_edtr: type library editor git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@190 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_service_intf.pas | 1 + wst/trunk/soap_formatter.pas | 2 + wst/trunk/tests/amazon/amazon.lpi | 211 +-- wst/trunk/tests/ebay/ebay.pas | 2 +- wst/trunk/tests/ebay/test_ebay_gui.lpi | 273 ++- wst/trunk/tests/ebay/test_ebay_gui.lpr | 2 +- wst/trunk/tests/ebay/umain.lfm | 26 +- wst/trunk/tests/ebay/umain.lrs | 61 +- wst/trunk/tests/ebay/umain.pas | 52 +- wst/trunk/type_lib_edtr/edit_helper.pas | 338 ++++ wst/trunk/type_lib_edtr/finterfaceedit.lfm | 10 + wst/trunk/type_lib_edtr/finterfaceedit.lrs | 8 + wst/trunk/type_lib_edtr/finterfaceedit.pas | 31 + wst/trunk/type_lib_edtr/typ_lib_edtr.lpi | 485 ++++++ wst/trunk/type_lib_edtr/typ_lib_edtr.lpr | 21 + wst/trunk/type_lib_edtr/uabout.lfm | 54 + wst/trunk/type_lib_edtr/uabout.lrs | 19 + wst/trunk/type_lib_edtr/uabout.pas | 35 + wst/trunk/type_lib_edtr/udm.lfm | 642 +++++++ wst/trunk/type_lib_edtr/udm.lrs | 395 +++++ wst/trunk/type_lib_edtr/udm.pas | 31 + wst/trunk/type_lib_edtr/ufclassedit.lfm | 200 +++ wst/trunk/type_lib_edtr/ufclassedit.lrs | 56 + wst/trunk/type_lib_edtr/ufclassedit.pas | 339 ++++ wst/trunk/type_lib_edtr/ufenumedit.lfm | 103 ++ wst/trunk/type_lib_edtr/ufenumedit.lrs | 29 + wst/trunk/type_lib_edtr/ufenumedit.pas | 168 ++ wst/trunk/type_lib_edtr/ufpropedit.lfm | 113 ++ wst/trunk/type_lib_edtr/ufpropedit.lrs | 33 + wst/trunk/type_lib_edtr/ufpropedit.pas | 221 +++ wst/trunk/type_lib_edtr/uinterfaceedit.lfm | 105 ++ wst/trunk/type_lib_edtr/uinterfaceedit.lrs | 30 + wst/trunk/type_lib_edtr/uinterfaceedit.pas | 170 ++ wst/trunk/type_lib_edtr/umain.lfm | 1719 +++++++++++++++++++ wst/trunk/type_lib_edtr/umain.lrs | 303 ++++ wst/trunk/type_lib_edtr/umain.pas | 552 ++++++ wst/trunk/type_lib_edtr/view_helper.pas | 680 ++++++++ wst/trunk/type_lib_edtr/wsdl_generator.pas | 922 ++++++++++ wst/trunk/ws_helper/generator.pas | 1317 ++++++++------ wst/trunk/ws_helper/logger_intf.pas | 78 + wst/trunk/ws_helper/metadata_generator.pas | 80 +- wst/trunk/ws_helper/parserutils.pas | 29 + wst/trunk/ws_helper/pascal_parser_intf.pas | 719 ++++++++ wst/trunk/ws_helper/source_utils.pas | 34 +- wst/trunk/ws_helper/ws_helper.lpi | 698 ++++---- wst/trunk/ws_helper/ws_helper.pas | 46 +- wst/trunk/ws_helper/wsdl2pas_imp.pas | 838 +++++---- wst/trunk/ws_helper/wst_resources_utils.pas | 2 +- wst/trunk/wst_rtti_filter/cursor_intf.pas | 14 - wst/trunk/wst_rtti_filter/rtti_filters.pas | 1 + 50 files changed, 10730 insertions(+), 1568 deletions(-) create mode 100644 wst/trunk/type_lib_edtr/edit_helper.pas create mode 100644 wst/trunk/type_lib_edtr/finterfaceedit.lfm create mode 100644 wst/trunk/type_lib_edtr/finterfaceedit.lrs create mode 100644 wst/trunk/type_lib_edtr/finterfaceedit.pas create mode 100644 wst/trunk/type_lib_edtr/typ_lib_edtr.lpi create mode 100644 wst/trunk/type_lib_edtr/typ_lib_edtr.lpr create mode 100644 wst/trunk/type_lib_edtr/uabout.lfm create mode 100644 wst/trunk/type_lib_edtr/uabout.lrs create mode 100644 wst/trunk/type_lib_edtr/uabout.pas create mode 100644 wst/trunk/type_lib_edtr/udm.lfm create mode 100644 wst/trunk/type_lib_edtr/udm.lrs create mode 100644 wst/trunk/type_lib_edtr/udm.pas create mode 100644 wst/trunk/type_lib_edtr/ufclassedit.lfm create mode 100644 wst/trunk/type_lib_edtr/ufclassedit.lrs create mode 100644 wst/trunk/type_lib_edtr/ufclassedit.pas create mode 100644 wst/trunk/type_lib_edtr/ufenumedit.lfm create mode 100644 wst/trunk/type_lib_edtr/ufenumedit.lrs create mode 100644 wst/trunk/type_lib_edtr/ufenumedit.pas create mode 100644 wst/trunk/type_lib_edtr/ufpropedit.lfm create mode 100644 wst/trunk/type_lib_edtr/ufpropedit.lrs create mode 100644 wst/trunk/type_lib_edtr/ufpropedit.pas create mode 100644 wst/trunk/type_lib_edtr/uinterfaceedit.lfm create mode 100644 wst/trunk/type_lib_edtr/uinterfaceedit.lrs create mode 100644 wst/trunk/type_lib_edtr/uinterfaceedit.pas create mode 100644 wst/trunk/type_lib_edtr/umain.lfm create mode 100644 wst/trunk/type_lib_edtr/umain.lrs create mode 100644 wst/trunk/type_lib_edtr/umain.pas create mode 100644 wst/trunk/type_lib_edtr/view_helper.pas create mode 100644 wst/trunk/type_lib_edtr/wsdl_generator.pas create mode 100644 wst/trunk/ws_helper/logger_intf.pas create mode 100644 wst/trunk/ws_helper/pascal_parser_intf.pas diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index b40aff717..d71dee6e0 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -1475,6 +1475,7 @@ begin FElementClass := AElementClass; FAttributeFieldList := TStringList.Create(); FAttributeFieldList.Duplicates := dupIgnore; + FAttributeFieldList.Sorted := True; end; destructor TSerializeOptions.Destroy(); diff --git a/wst/trunk/soap_formatter.pas b/wst/trunk/soap_formatter.pas index 3426e5c52..4deee7476 100644 --- a/wst/trunk/soap_formatter.pas +++ b/wst/trunk/soap_formatter.pas @@ -164,7 +164,9 @@ begin end; eltName := nsShortName + 'Fault'; If SameText(eltName,bdyNd.FirstChild.NodeName) Then Begin + Self.Style := RPC; fltNd := bdyNd.FirstChild; + PushStack(fltNd); excpt_Obj := ESOAPException.Create(''); Try eltName := 'faultcode'; diff --git a/wst/trunk/tests/amazon/amazon.lpi b/wst/trunk/tests/amazon/amazon.lpi index 491f11fe2..a9b16faa7 100644 --- a/wst/trunk/tests/amazon/amazon.lpi +++ b/wst/trunk/tests/amazon/amazon.lpi @@ -7,7 +7,7 @@ - + @@ -31,14 +31,14 @@ - + - + @@ -46,10 +46,10 @@ - - + + - + @@ -58,13 +58,11 @@ - - + - @@ -72,7 +70,7 @@ - + @@ -80,8 +78,8 @@ - - + + @@ -92,8 +90,8 @@ - - + + @@ -108,9 +106,7 @@ - - @@ -124,8 +120,8 @@ - - + + @@ -133,8 +129,8 @@ - - + + @@ -216,135 +212,72 @@ + + + + + + + + + - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + diff --git a/wst/trunk/tests/ebay/ebay.pas b/wst/trunk/tests/ebay/ebay.pas index 8dc59c9e4..6f1e7db8e 100644 --- a/wst/trunk/tests/ebay/ebay.pas +++ b/wst/trunk/tests/ebay/ebay.pas @@ -557,6 +557,6 @@ begin end; initialization - RegisterEbayTypes(); + //RegisterEbayTypes(); end. diff --git a/wst/trunk/tests/ebay/test_ebay_gui.lpi b/wst/trunk/tests/ebay/test_ebay_gui.lpi index 0a945b18b..638467eb2 100644 --- a/wst/trunk/tests/ebay/test_ebay_gui.lpi +++ b/wst/trunk/tests/ebay/test_ebay_gui.lpi @@ -7,7 +7,7 @@ - + @@ -26,14 +26,16 @@ - + - + - + + + @@ -41,45 +43,47 @@ - - + + - + - - - + + + + + - - - - + + + + - - - - + + + + - - - - + + + + @@ -87,15 +91,17 @@ + + - - - - + + + + @@ -111,12 +117,11 @@ - - - - - + + + + @@ -131,8 +136,8 @@ - - + + @@ -140,12 +145,11 @@ - - - - - + + + + @@ -248,26 +252,24 @@ - - - - + + - - - - + + + + @@ -287,9 +289,11 @@ - - - + + + + + @@ -319,55 +323,176 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + @@ -386,7 +511,7 @@ - + @@ -427,10 +552,6 @@ - - - - diff --git a/wst/trunk/tests/ebay/test_ebay_gui.lpr b/wst/trunk/tests/ebay/test_ebay_gui.lpr index 9bc754f0b..8d0ef0279 100644 --- a/wst/trunk/tests/ebay/test_ebay_gui.lpr +++ b/wst/trunk/tests/ebay/test_ebay_gui.lpr @@ -8,7 +8,7 @@ uses {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset Forms - { add your units here }, umain, synapse_http_protocol, ebay, ebay_proxy; + { add your units here }, umain, synapse_http_protocol; begin Application.Initialize; diff --git a/wst/trunk/tests/ebay/umain.lfm b/wst/trunk/tests/ebay/umain.lfm index 0f7db7488..528338db3 100644 --- a/wst/trunk/tests/ebay/umain.lfm +++ b/wst/trunk/tests/ebay/umain.lfm @@ -7,44 +7,48 @@ object Form1: TForm1 VertScrollBar.Page = 387 ActiveControl = Button1 Caption = 'Form1' + ClientHeight = 388 + ClientWidth = 400 OnCreate = FormCreate object Panel1: TPanel Height = 184 Width = 400 Align = alTop + ClientHeight = 184 + ClientWidth = 400 TabOrder = 0 object Label1: TLabel Left = 16 - Height = 18 + Height = 14 Top = 53 - Width = 98 + Width = 77 Caption = 'eBayAuthToken' Color = clNone ParentColor = False end object Label2: TLabel Left = 16 - Height = 18 + Height = 14 Top = 79 - Width = 37 + Width = 30 Caption = 'AppId' Color = clNone ParentColor = False end object Label3: TLabel Left = 16 - Height = 18 + Height = 14 Top = 111 - Width = 38 + Width = 30 Caption = 'DevId' Color = clNone ParentColor = False end object Label4: TLabel Left = 16 - Height = 18 + Height = 14 Top = 144 - Width = 56 + Width = 45 Caption = 'AuthCert' Color = clNone ParentColor = False @@ -84,6 +88,7 @@ object Form1: TForm1 Width = 288 Anchors = [akTop, akLeft, akRight] TabOrder = 2 + Text = 'AgAAAA**AQAAAA**aAAAAA**OeGvRA**nY+sHZ2PrBmdj6wVnY+sEZ2PrA2dj6wJnY+lAZOEpgqdj6x9nY+seQ**uoUAAA**AAMAAA**z5djiOw1a7Tk12KGGPqSpvnxxNYOVUtaSbmQ7hYd4pX4XfafLKBtImKsW9SUsbmBS9fXOyBnXA3k0jLelpiMptvlZ8N52UQA/ePc6+JE7LJFrARMoBaW5lHEQOMESJLAdFJiGmLwrnagdeo6WRI89gu' end object edtAppId: TEdit Left = 96 @@ -92,6 +97,7 @@ object Form1: TForm1 Width = 288 Anchors = [akTop, akLeft, akRight] TabOrder = 3 + Text = 'INOUSSAOUEU258CIC9Z5E83UXC1BE5' end object edtDevId: TEdit Left = 96 @@ -100,6 +106,7 @@ object Form1: TForm1 Width = 288 Anchors = [akTop, akLeft, akRight] TabOrder = 4 + Text = 'L11ZDC63VDJ1FPLJL5EA161OQ2MS95' end object edtAuthCert: TEdit Left = 96 @@ -108,6 +115,7 @@ object Form1: TForm1 Width = 288 Anchors = [akTop, akLeft, akRight] TabOrder = 5 + Text = 'A266GKZC9F5$HI2HIH58A-D3JH2YA4' end end object trvOut: TTreeView @@ -115,7 +123,7 @@ object Form1: TForm1 Top = 184 Width = 400 Align = alClient - DefaultItemHeight = 19 + DefaultItemHeight = 15 TabOrder = 1 end end diff --git a/wst/trunk/tests/ebay/umain.lrs b/wst/trunk/tests/ebay/umain.lrs index d7e60b0ba..d85ae0d81 100644 --- a/wst/trunk/tests/ebay/umain.lrs +++ b/wst/trunk/tests/ebay/umain.lrs @@ -3,31 +3,38 @@ LazarusResources.Add('TForm1','FORMDATA',[ 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'-'#1#6'Height'#3#132#1#3'Top'#3#159#0#5'W' +'idth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3#131#1 - +#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#8'OnCreate'#7#10'FormC' - +'reate'#0#6'TPanel'#6'Panel1'#6'Height'#3#184#0#5'Width'#3#144#1#5'Align'#7#5 - +'alTop'#8'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#18#3 - +'Top'#2'5'#5'Width'#2'b'#7'Caption'#6#13'eBayAuthToken'#5'Color'#7#6'clNone' - +#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#16#6'Height'#2#18#3'Top' - +#2'O'#5'Width'#2'%'#7'Caption'#6#5'AppId'#5'Color'#7#6'clNone'#11'ParentColo' - +'r'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#16#6'Height'#2#18#3'Top'#2'o'#5'Widt' - +'h'#2'&'#7'Caption'#6#5'DevId'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6 - +'TLabel'#6'Label4'#4'Left'#2#16#6'Height'#2#18#3'Top'#3#144#0#5'Width'#2'8'#7 - +'Caption'#6#8'AuthCert'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TBevel' - +#6'Bevel1'#4'Left'#2#10#6'Height'#3#170#0#3'Top'#2#4#5'Width'#3'|'#1#7'Ancho' - +'rs'#11#5'akTop'#6'akLeft'#7'akRight'#0#0#0#7'TButton'#7'Button1'#4'Left'#3 - +' '#1#6'Height'#2#25#3'Top'#2#8#5'Width'#2'c'#25'BorderSpacing.InnerBorder'#2 - +#4#7'Caption'#6#13'GetCategories'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2 - +#0#7'Visible'#8#0#0#7'TButton'#7'Button3'#4'Left'#2#16#6'Height'#2#25#3'Top' - +#2#8#5'Width'#3#136#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#18'GetP' - +'opularKeywords'#7'OnClick'#7#12'Button3Click'#8'TabOrder'#2#1#0#0#5'TEdit' - +#16'edteBayAuthToken'#4'Left'#2'`'#6'Height'#2#23#3'Top'#2'0'#5'Width'#3' '#1 - +#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#2#0#0#5'TEdit'#8 - +'edtAppId'#4'Left'#2'`'#6'Height'#2#23#3'Top'#2'M'#5'Width'#3' '#1#7'Anchors' - +#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#3#0#0#5'TEdit'#8'edtDevId' - +#4'Left'#2'`'#6'Height'#2#23#3'Top'#2'l'#5'Width'#3' '#1#7'Anchors'#11#5'akT' - +'op'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#4#0#0#5'TEdit'#11'edtAuthCert'#4'L' - +'eft'#2'`'#6'Height'#2#23#3'Top'#3#136#0#5'Width'#3' '#1#7'Anchors'#11#5'akT' - +'op'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#5#0#0#0#9'TTreeView'#6'trvOut'#6'H' - +'eight'#3#204#0#3'Top'#3#184#0#5'Width'#3#144#1#5'Align'#7#8'alClient'#17'De' - +'faultItemHeight'#2#19#8'TabOrder'#2#1#0#0#0 + +#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'ClientHeight'#3#132 + +#1#11'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#0#6'TPanel'#6'Panel1' + +#6'Height'#3#184#0#5'Width'#3#144#1#5'Align'#7#5'alTop'#12'ClientHeight'#3 + +#184#0#11'ClientWidth'#3#144#1#8'TabOrder'#2#0#0#6'TLabel'#6'Label1'#4'Left' + +#2#16#6'Height'#2#14#3'Top'#2'5'#5'Width'#2'M'#7'Caption'#6#13'eBayAuthToken' + +#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#16 + +#6'Height'#2#14#3'Top'#2'O'#5'Width'#2#30#7'Caption'#6#5'AppId'#5'Color'#7#6 + +'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label3'#4'Left'#2#16#6'Height'#2 + +#14#3'Top'#2'o'#5'Width'#2#30#7'Caption'#6#5'DevId'#5'Color'#7#6'clNone'#11 + +'ParentColor'#8#0#0#6'TLabel'#6'Label4'#4'Left'#2#16#6'Height'#2#14#3'Top'#3 + +#144#0#5'Width'#2'-'#7'Caption'#6#8'AuthCert'#5'Color'#7#6'clNone'#11'Parent' + +'Color'#8#0#0#6'TBevel'#6'Bevel1'#4'Left'#2#10#6'Height'#3#170#0#3'Top'#2#4#5 + +'Width'#3'|'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#0#0#7'TButton'#7 + +'Button1'#4'Left'#3' '#1#6'Height'#2#25#3'Top'#2#8#5'Width'#2'c'#25'BorderSp' + +'acing.InnerBorder'#2#4#7'Caption'#6#13'GetCategories'#7'OnClick'#7#12'Butto' + +'n1Click'#8'TabOrder'#2#0#7'Visible'#8#0#0#7'TButton'#7'Button3'#4'Left'#2#16 + +#6'Height'#2#25#3'Top'#2#8#5'Width'#3#136#0#25'BorderSpacing.InnerBorder'#2#4 + +#7'Caption'#6#18'GetPopularKeywords'#7'OnClick'#7#12'Button3Click'#8'TabOrde' + +'r'#2#1#0#0#5'TEdit'#16'edteBayAuthToken'#4'Left'#2'`'#6'Height'#2#23#3'Top' + +#2'0'#5'Width'#3' '#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrd' + +'er'#2#2#4'Text'#6#255'AgAAAA**AQAAAA**aAAAAA**OeGvRA**nY+sHZ2PrBmdj6wVnY+sE' + +'Z2PrA2dj6wJnY+lAZOEpgqdj6x9nY+seQ**uoUAAA**AAMAAA**z5djiOw1a7Tk12KGGPqSpvnx' + +'xNYOVUtaSbmQ7hYd4pX4XfafLKBtImKsW9SUsbmBS9fXOyBnXA3k0jLelpiMptvlZ8N52UQA/eP' + +'c6+JE7LJFrARMoBaW5lHEQOMESJLAdFJiGmLwrnagdeo6WRI89gu'#0#0#5'TEdit'#8'edtApp' + +'Id'#4'Left'#2'`'#6'Height'#2#23#3'Top'#2'M'#5'Width'#3' '#1#7'Anchors'#11#5 + +'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#3#4'Text'#6#30'INOUSSAOUEU258CI' + +'C9Z5E83UXC1BE5'#0#0#5'TEdit'#8'edtDevId'#4'Left'#2'`'#6'Height'#2#23#3'Top' + +#2'l'#5'Width'#3' '#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrd' + +'er'#2#4#4'Text'#6#30'L11ZDC63VDJ1FPLJL5EA161OQ2MS95'#0#0#5'TEdit'#11'edtAut' + +'hCert'#4'Left'#2'`'#6'Height'#2#23#3'Top'#3#136#0#5'Width'#3' '#1#7'Anchors' + +#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#5#4'Text'#6#30'A266GKZC9F5' + +'$HI2HIH58A-D3JH2YA4'#0#0#0#9'TTreeView'#6'trvOut'#6'Height'#3#204#0#3'Top'#3 + +#184#0#5'Width'#3#144#1#5'Align'#7#8'alClient'#17'DefaultItemHeight'#2#15#8 + +'TabOrder'#2#1#0#0#0 ]); diff --git a/wst/trunk/tests/ebay/umain.pas b/wst/trunk/tests/ebay/umain.pas index c0b0e983e..648046a7d 100644 --- a/wst/trunk/tests/ebay/umain.pas +++ b/wst/trunk/tests/ebay/umain.pas @@ -6,7 +6,8 @@ interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, - Buttons, StdCtrls, ComCtrls, eBayWSDL; + Buttons, StdCtrls, ComCtrls, + eBayWSDL, eBayWSDL_proxy; type @@ -43,38 +44,38 @@ uses TypInfo, StrUtils, httpsend, ssl_openssl, service_intf, soap_formatter, base_service_intf, base_soap_formatter, - ebay, ebay_proxy, + //ebay, ebay_proxy, synapse_http_protocol; - +const sEBAY_VERSION = '503'; { TForm1 } procedure TForm1.Button1Click(Sender: TObject); var - locService : IeBayAPIInterfaceService; - locHdr : TCustomSecurityHeaderType; - r : TGetCategoriesRequestType; - rsp : TGetCategoriesResponseType; + locService : eBayAPIInterface; + locHdr : CustomSecurityHeaderType; + r : GetCategoriesRequestType; + rsp : GetCategoriesResponseType; begin try r := nil; rsp := nil; - locHdr := TCustomSecurityHeaderType.Create(); + locHdr := CustomSecurityHeaderType.Create(); try locHdr.eBayAuthToken := edteBayAuthToken.Text; locHdr.Credentials.AppId := edtAppId.Text; locHdr.Credentials.DevId := edtDevId.Text; locHdr.Credentials.AuthCert := edtAuthCert.Text; - locService := TeBayAPIInterfaceService_Proxy.Create( + locService := TeBayAPIInterface_Proxy.Create( 'eBayAPIInterfaceService', - 'SOAP:Style=Document;EncodingStyle=Litteral;UniqueAddress=false', + 'SOAP:Style=Document;EncodingStyle=Literal;UniqueAddress=false', 'http:Address=https://api.sandbox.ebay.com/wsapi' ); (locService as ICallContext).AddHeader(locHdr,True); - r := TGetCategoriesRequestType.Create(); + r := GetCategoriesRequestType.Create(); r.Version := sEBAY_VERSION; - locService.GetCategories(r,rsp); + rsp := locService.GetCategories(r); if Assigned(rsp) then ShowMessageFmt('CategoryCount=%d; Message=%s; Version = %s',[rsp.CategoryCount,rsp.Message,rsp.Version]) else @@ -92,11 +93,11 @@ end; procedure TForm1.Button3Click(Sender: TObject); - procedure ShowResponse(ARsp : TGetPopularKeywordsResponseType); + procedure ShowResponse(ARsp : GetPopularKeywordsResponseType); var nd, an, nn, pn : TTreeNode; k : Integer; - ci : TCategoryType; + ci : CategoryType_Type; begin trvOut.BeginUpdate(); try @@ -104,7 +105,7 @@ procedure TForm1.Button3Click(Sender: TObject); if not Assigned(ARsp) then Exit; nd := trvOut.Items.AddChild(nil,'Response'); - trvOut.Items.AddChild(nd,'Ack = ' + GetEnumName(TypeInfo(TAckCodeType),Ord(ARsp.Ack))); + trvOut.Items.AddChild(nd,'Ack = ' + GetEnumName(TypeInfo(AckCodeType_Type),Ord(ARsp.Ack))); trvOut.Items.AddChild(nd,'Version = ' + ARsp.Version); trvOut.Items.AddChild(nd,'HasMore = ' + IfThen(ARsp.HasMore,'True','False')); @@ -117,7 +118,8 @@ procedure TForm1.Button3Click(Sender: TObject); ci := ARsp.CategoryArray[k]; nn := trvOut.Items.AddChild(an,'Category ( ' + IntToStr(k) + ' )'); trvOut.Items.AddChild(nn,'CategoryID = ' + ci.CategoryID); - trvOut.Items.AddChild(nn,'CategoryParentID = ' + ci.CategoryParentID); + if ( ci.CategoryParentID.Length > 0 ) then + trvOut.Items.AddChild(nn,'CategoryParentID = ' + ci.CategoryParentID[0]); trvOut.Items.AddChild(nn,'Keywords = ' + ci.Keywords); end; finally @@ -126,17 +128,17 @@ procedure TForm1.Button3Click(Sender: TObject); end; var - locService : IeBayAPIInterfaceService; - locHdr : TCustomSecurityHeaderType; - r : TGetPopularKeywordsRequestType; - rsp : TGetPopularKeywordsResponseType; + locService : eBayAPIInterface; + locHdr : CustomSecurityHeaderType; + r : GetPopularKeywordsRequestType; + rsp : GetPopularKeywordsResponseType; kpCrs : TCursor; begin try r := nil; rsp := nil; kpCrs := Screen.Cursor; - locHdr := TCustomSecurityHeaderType.Create(); + locHdr := CustomSecurityHeaderType.Create(); try Screen.Cursor := crHourGlass; locHdr.eBayAuthToken := edteBayAuthToken.Text; @@ -144,16 +146,16 @@ begin locHdr.Credentials.AppId := edtAppId.Text; locHdr.Credentials.DevId := edtDevId.Text; locHdr.Credentials.AuthCert := edtAuthCert.Text; - locService := TeBayAPIInterfaceService_Proxy.Create( + locService := TeBayAPIInterface_Proxy.Create( 'eBayAPIInterfaceService', - 'SOAP:Style=Document;EncodingStyle=Litteral;UniqueAddress=false', + 'SOAP:Style=Document;EncodingStyle=Literal;UniqueAddress=false', 'http:Address=https://api.sandbox.ebay.com/wsapi' ); (locService as ICallContext).AddHeader(locHdr,True); - r := TGetPopularKeywordsRequestType.Create(); + r := GetPopularKeywordsRequestType.Create(); r.Version := sEBAY_VERSION; r.IncludeChildCategories := True; - locService.GetPopularKeywords(r,rsp); + rsp := locService.GetPopularKeywords(r); if Assigned(rsp) then begin ShowResponse(rsp); end else begin diff --git a/wst/trunk/type_lib_edtr/edit_helper.pas b/wst/trunk/type_lib_edtr/edit_helper.pas new file mode 100644 index 000000000..b9d77503c --- /dev/null +++ b/wst/trunk/type_lib_edtr/edit_helper.pas @@ -0,0 +1,338 @@ +unit edit_helper; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + pastree, pascal_parser_intf; + +type + + TEditType = ( etCreate, etUpdate, etDelete ); + + { TObjectUpdater } + + TObjectUpdater = class + public + class function CanHandle(AObject : TObject):Boolean;virtual; + class function UpdateObject( + AObject : TPasElement; + ASymbolTable : TwstPasTreeContainer + ):Boolean;virtual;abstract; + end; + TObjectUpdaterClass = class of TObjectUpdater; + + function CreateEnum(AContainer : TwstPasTreeContainer) : TPasEnumType; + function CreateCompoundObject(ASymbolTable : TwstPasTreeContainer) : TPasClassType; + function CreateInterface(ASymbolTable : TwstPasTreeContainer) : TPasClassType; + + function HasEditor(AObject : TPasElement):Boolean; + function UpdateObject( + AObject : TPasElement; + ASymbolTable : TwstPasTreeContainer + ):Boolean; + + procedure FillList(ALs : TStrings;AContainer : TwstPasTreeContainer); + +implementation +uses Contnrs, Forms, ufEnumedit, ufclassedit, uinterfaceedit; + +type + + { TUpdaterRegistry } + + TUpdaterRegistry = class + private + FList : TClassList; + private + function FindHanlderIndex(AObj : TObject):Integer; + public + constructor Create(); + destructor Destroy();override; + procedure RegisterHandler(AHandlerClass : TObjectUpdaterClass); + function FindHandler(AObj : TObject; out AHandler : TObjectUpdaterClass) : Boolean; + end; + +var UpdaterRegistryInst : TUpdaterRegistry; + +function CreateInterface(ASymbolTable: TwstPasTreeContainer): TPasClassType; +var + f : TfInterfaceEdit; +begin + Result := nil; + f := TfInterfaceEdit.Create(Application); + try + f.UpdateObject(Result,etCreate,ASymbolTable); + finally + f.Release(); + end; +end; + +function HasEditor(AObject: TPasElement): Boolean; +var + h : TObjectUpdaterClass; +begin + Result := UpdaterRegistryInst.FindHandler(AObject,h); +end; + +function UpdateObject( + AObject : TPasElement; + ASymbolTable : TwstPasTreeContainer +):Boolean; +var + h : TObjectUpdaterClass; +begin + if not UpdaterRegistryInst.FindHandler(AObject,h) then begin + raise Exception.Create('No handler found.'); + end; + Result := h.UpdateObject(AObject,ASymbolTable); +end; + +type + { TEnumUpdater } + + TEnumUpdater = class(TObjectUpdater) + public + class function CanHandle(AObject : TObject):Boolean;override; + class function UpdateObject( + AObject : TPasElement; + ASymbolTable : TwstPasTreeContainer + ):Boolean;override; + end; + + { TClassUpdater } + + TClassUpdater = class(TObjectUpdater) + public + class function CanHandle(AObject : TObject):Boolean;override; + class function UpdateObject( + AObject : TPasElement; + ASymbolTable : TwstPasTreeContainer + ):Boolean;override; + end; + + { TInterfaceUpdater } + + TInterfaceUpdater = class(TObjectUpdater) + public + class function CanHandle(AObject : TObject):Boolean;override; + class function UpdateObject( + AObject : TPasElement; + ASymbolTable : TwstPasTreeContainer + ):Boolean;override; + end; + +{ TInterfaceUpdater } + +class function TInterfaceUpdater.CanHandle(AObject: TObject): Boolean; +begin + Result := ( inherited CanHandle(AObject) ) and + ( AObject.InheritsFrom(TPasClassType) and ( TPasClassType(AObject).ObjKind = okInterface ) ); +end; + +class function TInterfaceUpdater.UpdateObject(AObject: TPasElement; ASymbolTable: TwstPasTreeContainer): Boolean; +var + f : TfInterfaceEdit; + e : TPasClassType; +begin + e := AObject as TPasClassType; + f := TfInterfaceEdit.Create(Application); + try + Result := f.UpdateObject(e,etUpdate,ASymbolTable); + finally + f.Release(); + end; +end; + +{ TClassUpdater } + +class function TClassUpdater.CanHandle(AObject: TObject): Boolean; +begin + Result := ( inherited CanHandle(AObject) ) and + ( AObject.InheritsFrom(TPasClassType) and ( TPasClassType(AObject).ObjKind = okClass ) ); +end; + +class function TClassUpdater.UpdateObject( + AObject : TPasElement; + ASymbolTable : TwstPasTreeContainer +): Boolean; +var + f : TfClassEdit; + e : TPasClassType; +begin + e := AObject as TPasClassType; + f := TfClassEdit.Create(Application); + try + Result := f.UpdateObject(e,etUpdate,ASymbolTable); + finally + f.Release(); + end; +end; + +{ TUpdaterRegistry } + +function TUpdaterRegistry.FindHanlderIndex(AObj : TObject): Integer; +var + i : Integer; +begin + for i := 0 to Pred(FList.Count) do begin + if TObjectUpdaterClass(FList[i]).CanHandle(AObj) then begin + Result := i; + Exit; + end; + end; + Result := -1; +end; + +constructor TUpdaterRegistry.Create(); +begin + FList := TClassList.Create(); +end; + +destructor TUpdaterRegistry.Destroy(); +begin + FreeAndNil(FList); + inherited Destroy(); +end; + +procedure TUpdaterRegistry.RegisterHandler(AHandlerClass : TObjectUpdaterClass); +begin + if ( FList.IndexOf(AHandlerClass) < 0 ) then begin + FList.Add(AHandlerClass); + end; +end; + +function TUpdaterRegistry.FindHandler( + AObj : TObject; + out AHandler : TObjectUpdaterClass +): Boolean; +var + i : Integer; +begin + AHandler := nil; + i := FindHanlderIndex(AObj); + Result := ( i >= 0 ); + if Result then begin + AHandler := TObjectUpdaterClass(FList[i]); + end; +end; + +{ TEnumUpdater } + +class function TEnumUpdater.CanHandle(AObject: TObject): Boolean; +begin + Result := ( inherited CanHandle(AObject) ) and AObject.InheritsFrom(TPasEnumType); +end; + +class function TEnumUpdater.UpdateObject( + AObject : TPasElement; + ASymbolTable : TwstPasTreeContainer +): Boolean; +var + f : TfEnumEdit; + e : TPasEnumType; +begin + e := AObject as TPasEnumType; + f := TfEnumEdit.Create(Application); + try + Result := f.UpdateObject(e,etUpdate,ASymbolTable); + finally + f.Release(); + end; +end; + +function CreateEnum(AContainer : TwstPasTreeContainer) : TPasEnumType; +var + f : TfEnumEdit; +begin + Result := nil; + f := TfEnumEdit.Create(Application); + try + f.UpdateObject(Result,etCreate,AContainer); + finally + f.Release(); + end; +end; + +function CreateCompoundObject(ASymbolTable : TwstPasTreeContainer) : TPasClassType; +var + f : TfClassEdit; +begin + Result := nil; + f := TfClassEdit.Create(Application); + try + f.UpdateObject(Result,etCreate,ASymbolTable); + finally + f.Release(); + end; +end; + + +{ TObjectUpdater } + +class function TObjectUpdater.CanHandle(AObject: TObject): Boolean; +begin + Result := Assigned(AObject); +end; + +procedure InternalFillList( + ALs : TStrings; + AContainer : TwstPasTreeContainer +); +var + i : Integer; + sym : TPasElement; + decList : TList; +begin + decList := AContainer.CurrentModule.InterfaceSection.Declarations; + for i := 0 to Pred(decList.Count) do begin + sym := TPasElement(decList[i]); + if sym.InheritsFrom(TPasType) and + ( sym.InheritsFrom(TPasClassType) or + sym.InheritsFrom(TPasNativeSimpleType) or + ( sym.InheritsFrom(TPasAliasType) and + Assigned(TPasAliasType(sym).DestType) and + ( TPasAliasType(sym).DestType.InheritsFrom(TPasClassType) or + TPasAliasType(sym).DestType.InheritsFrom(TPasNativeSimpleType) + ) + ) + ) + then begin + if ( ALs.IndexOfObject(sym) = -1 ) then begin + ALs.AddObject(AContainer.GetExternalName(sym),sym); + end; + end; + end; +end; + +procedure FillList( + ALs : TStrings; + AContainer : TwstPasTreeContainer +); +var + locLST : TStringList; +begin + locLST := TStringList.Create(); + try + locLST.Assign(ALs); + locLST.Duplicates := dupAccept; + InternalFillList(locLST,AContainer); + locLST.Sort(); + ALs.Assign(locLST); + finally + FreeAndNil(locLST); + end; +end; + +initialization + UpdaterRegistryInst := TUpdaterRegistry.Create(); + UpdaterRegistryInst.RegisterHandler(TEnumUpdater); + UpdaterRegistryInst.RegisterHandler(TClassUpdater); + UpdaterRegistryInst.RegisterHandler(TInterfaceUpdater); + +finalization + FreeAndNil(UpdaterRegistryInst); + +end. diff --git a/wst/trunk/type_lib_edtr/finterfaceedit.lfm b/wst/trunk/type_lib_edtr/finterfaceedit.lfm new file mode 100644 index 000000000..7f5062f02 --- /dev/null +++ b/wst/trunk/type_lib_edtr/finterfaceedit.lfm @@ -0,0 +1,10 @@ +object fInterfaceEdit: TfInterfaceEdit + Left = 275 + Height = 361 + Top = 286 + Width = 480 + HorzScrollBar.Page = 479 + VertScrollBar.Page = 360 + Caption = 'fInterfaceEdit' + Position = poDesktopCenter +end diff --git a/wst/trunk/type_lib_edtr/finterfaceedit.lrs b/wst/trunk/type_lib_edtr/finterfaceedit.lrs new file mode 100644 index 000000000..8b5e0df0c --- /dev/null +++ b/wst/trunk/type_lib_edtr/finterfaceedit.lrs @@ -0,0 +1,8 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TfInterfaceEdit','FORMDATA',[ + 'TPF0'#15'TfInterfaceEdit'#14'fInterfaceEdit'#4'Left'#3#19#1#6'Height'#3'i'#1 + +#3'Top'#3#30#1#5'Width'#3#224#1#18'HorzScrollBar.Page'#3#223#1#18'VertScroll' + +'Bar.Page'#3'h'#1#7'Caption'#6#14'fInterfaceEdit'#8'Position'#7#15'poDesktop' + +'Center'#0#0 +]); diff --git a/wst/trunk/type_lib_edtr/finterfaceedit.pas b/wst/trunk/type_lib_edtr/finterfaceedit.pas new file mode 100644 index 000000000..1c29bc8c1 --- /dev/null +++ b/wst/trunk/type_lib_edtr/finterfaceedit.pas @@ -0,0 +1,31 @@ +unit finterfaceedit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ActnList; + +type + + { TfInterfaceEdit } + + TfInterfaceEdit = class(TForm) + + private + { private declarations } + public + { public declarations } + end; + +var + fInterfaceEdit: TfInterfaceEdit; + +implementation + +initialization + {$I finterfaceedit.lrs} + +end. + diff --git a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi new file mode 100644 index 000000000..72d3062ca --- /dev/null +++ b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi @@ -0,0 +1,485 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpr b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpr new file mode 100644 index 000000000..ff5d6a87f --- /dev/null +++ b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpr @@ -0,0 +1,21 @@ +program typ_lib_edtr; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + , umain, view_helper, source_utils, uabout, ufEnumedit, + edit_helper, ufclassedit, wsdl_generator, ufpropedit, uinterfaceedit, udm, + pascal_parser_intf, PasTree, PParser; + +begin + Application.Initialize; + Application.CreateForm(TDM, DM); + Application.CreateForm(TfMain, fMain); + Application.Run; +end. + diff --git a/wst/trunk/type_lib_edtr/uabout.lfm b/wst/trunk/type_lib_edtr/uabout.lfm new file mode 100644 index 000000000..fd4ac615a --- /dev/null +++ b/wst/trunk/type_lib_edtr/uabout.lfm @@ -0,0 +1,54 @@ +object fAbout: TfAbout + Left = 481 + Height = 182 + Top = 291 + Width = 299 + HorzScrollBar.Page = 298 + VertScrollBar.Page = 181 + ActiveControl = Button1 + BorderIcons = [biSystemMenu] + BorderStyle = bsDialog + Caption = 'About' + ClientHeight = 182 + ClientWidth = 299 + Position = poDesktopCenter + object Label1: TLabel + Left = 44 + Height = 14 + Top = 24 + Width = 211 + Caption = 'Web Services Toolkit for FPC/Lazarus' + Color = clNone + Font.Style = [fsBold] + ParentColor = False + end + object Label2: TLabel + Left = 93 + Height = 14 + Top = 56 + Width = 113 + Caption = 'Type Librarry Editor' + Color = clNone + Font.Style = [fsBold, fsItalic] + ParentColor = False + end + object Label3: TLabel + Left = 49 + Height = 14 + Top = 112 + Width = 200 + Caption = 'Copyright (c) 2007 Inoussa OUEDRAOGO' + Color = clNone + ParentColor = False + end + object Button1: TButton + Left = 112 + Height = 25 + Top = 142 + Width = 75 + BorderSpacing.InnerBorder = 4 + Caption = 'OK' + ModalResult = 1 + TabOrder = 0 + end +end diff --git a/wst/trunk/type_lib_edtr/uabout.lrs b/wst/trunk/type_lib_edtr/uabout.lrs new file mode 100644 index 000000000..10e2219e3 --- /dev/null +++ b/wst/trunk/type_lib_edtr/uabout.lrs @@ -0,0 +1,19 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TfAbout','FORMDATA',[ + 'TPF0'#7'TfAbout'#6'fAbout'#4'Left'#3#225#1#6'Height'#3#182#0#3'Top'#3'#'#1#5 + +'Width'#3'+'#1#18'HorzScrollBar.Page'#3'*'#1#18'VertScrollBar.Page'#3#181#0 + +#13'ActiveControl'#7#7'Button1'#11'BorderIcons'#11#12'biSystemMenu'#0#11'Bor' + +'derStyle'#7#8'bsDialog'#7'Caption'#6#5'About'#12'ClientHeight'#3#182#0#11'C' + +'lientWidth'#3'+'#1#8'Position'#7#15'poDesktopCenter'#0#6'TLabel'#6'Label1'#4 + +'Left'#2','#6'Height'#2#14#3'Top'#2#24#5'Width'#3#211#0#7'Caption'#6'$Web Se' + +'rvices Toolkit for FPC/Lazarus'#5'Color'#7#6'clNone'#10'Font.Style'#11#6'fs' + +'Bold'#0#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2']'#6'Height'#2 + +#14#3'Top'#2'8'#5'Width'#2'q'#7'Caption'#6#20'Type Librarry Editor'#5'Color' + +#7#6'clNone'#10'Font.Style'#11#6'fsBold'#8'fsItalic'#0#11'ParentColor'#8#0#0 + +#6'TLabel'#6'Label3'#4'Left'#2'1'#6'Height'#2#14#3'Top'#2'p'#5'Width'#3#200#0 + +#7'Caption'#6'$Copyright (c) 2007 Inoussa OUEDRAOGO'#5'Color'#7#6'clNone'#11 + +'ParentColor'#8#0#0#7'TButton'#7'Button1'#4'Left'#2'p'#6'Height'#2#25#3'Top' + +#3#142#0#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#2'OK' + +#11'ModalResult'#2#1#8'TabOrder'#2#0#0#0#0 +]); diff --git a/wst/trunk/type_lib_edtr/uabout.pas b/wst/trunk/type_lib_edtr/uabout.pas new file mode 100644 index 000000000..bd25b0b1c --- /dev/null +++ b/wst/trunk/type_lib_edtr/uabout.pas @@ -0,0 +1,35 @@ +unit uabout; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + Buttons; + +type + + { TfAbout } + + TfAbout = class(TForm) + Button1: TButton; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + private + { private declarations } + public + { public declarations } + end; + +var + fAbout: TfAbout; + +implementation + +initialization + {$I uabout.lrs} + +end. + diff --git a/wst/trunk/type_lib_edtr/udm.lfm b/wst/trunk/type_lib_edtr/udm.lfm new file mode 100644 index 000000000..80ef57d3a --- /dev/null +++ b/wst/trunk/type_lib_edtr/udm.lfm @@ -0,0 +1,642 @@ +object DM: TDM + Height = 300 + HorizontalOffset = 381 + VerticalOffset = 236 + Width = 400 + object IM: TImageList + left = 208 + top = 200 + Bitmap = { + 6C690A0000001000000010000000DB0300002F2A2058504D202A2F0D0A737461 + 7469632063686172202A20706B675F70726F6A6563745F78706D5B5D203D207B + 0D0A2231382031382033322031222C0D0A22200963204E6F6E65222C0D0A222E + 09632023413041304130222C0D0A222B09632023383038303830222C0D0A2240 + 09632023343034303030222C0D0A222309632023464646464646222C0D0A2224 + 09632023444344434443222C0D0A222509632023433043304646222C0D0A2226 + 09632023433343334333222C0D0A222A09632023383038304646222C0D0A223D + 09632023353835383538222C0D0A222D09632023333033303330222C0D0A223B + 09632023303038303830222C0D0A223E09632023303034303430222C0D0A222C + 09632023464643304330222C0D0A222709632023303030304646222C0D0A2229 + 09632023464644434138222C0D0A222109632023433035383030222C0D0A227E + 09632023464638303030222C0D0A227B09632023464641383538222C0D0A225D + 09632023383038303030222C0D0A225E09632023464630304646222C0D0A222F + 09632023433030304330222C0D0A222809632023383030303830222C0D0A225F + 09632023303043304330222C0D0A223A09632023433046464330222C0D0A223C + 09632023303043303030222C0D0A225B09632023303038303030222C0D0A227D + 09632023383030303030222C0D0A227C09632023303034303030222C0D0A2231 + 09632023464630303030222C0D0A223209632023433030303030222C0D0A2233 + 09632023433043303030222C0D0A22202020202E2E2E2E2B2B2B402020202020 + 20222C0D0A22202020202E2323232323232E2B2020202020222C0D0A22202020 + 202E2323232323232E242B20202020222C0D0A22202020202E2325252E232326 + 24232B202020222C0D0A22202020202E2525252A2A23262E3D3D2D2020222C0D + 0A22202020202E2A3B2A3B3E2323232426402020222C0D0A2220202020242A3B + 3D3E3E23232424243D2020222C0D0A2220202C2C2C3D3D3E3E2723232329243D + 2020222C0D0A222020217E7B3D2D3D3E3D5D292324243D2020222C0D0A222020 + 215E2F28265F3A3C5B242929293D2020222C0D0A22202021217D7D3C3C5B3D7C + 232424243D2020222C0D0A2220202031322D3C5D5B3D7C24292C293D2020222C + 0D0A22202020202E233C5B5B7C7C242424263D2020222C0D0A22202020202B29 + 232940292429292C293D2020222C0D0A22202020202E242324242924262C332C + 3D2020222C0D0A2220202020402B2B2B2B3D5D3D2B3D2B402020222C0D0A2220 + 2020202020202020202020202020202020222C0D0A2220202020202020202020 + 2020202020202020227D3B0D0A5A0D00002F2A2058504D202A2F0D0A73746174 + 69632063686172202A20706B675F696E636C7564655F78706D5B5D203D207B0D + 0A223138203138203135342032222C0D0A2220200963204E6F6E65222C0D0A22 + 2E2009632023353835383538222C0D0A222B2009632023444544454445222C0D + 0A22402009632023424342374231222C0D0A2223200963202339393939393922 + 2C0D0A22242009632023333335343644222C0D0A222520096320233737393241 + 36222C0D0A22262009632023383439464234222C0D0A222A2009632023464646 + 464646222C0D0A223D2009632023454145414541222C0D0A222D200963202336 + 4436443644222C0D0A223B2009632023364538414130222C0D0A223E20096320 + 23434144324436222C0D0A222C2009632023433944354444222C0D0A22272009 + 632023393942344333222C0D0A22292009632023343036443843222C0D0A2221 + 2009632023424143374432222C0D0A227E2009632023464346434643222C0D0A + 227B2009632023373037303730222C0D0A225D2009632023434543454345222C + 0D0A225E2009632023333033303330222C0D0A222F2009632023394441454241 + 222C0D0A22282009632023434144434534222C0D0A225F200963202338394234 + 4341222C0D0A223A2009632023423644304445222C0D0A223C20096320233242 + 37434136222C0D0A225B2009632023333037394131222C0D0A227D2009632023 + 323736333839222C0D0A227C2009632023423142454338222C0D0A2231200963 + 2023383938393839222C0D0A22322009632023364236423642222C0D0A223320 + 09632023343234323432222C0D0A22342009632023353537383930222C0D0A22 + 352009632023433044334444222C0D0A22362009632023363541304244222C0D + 0A22372009632023353839384241222C0D0A2238200963202338364144433622 + 2C0D0A22392009632023304335433845222C0D0A223020096320233130354438 + 45222C0D0A22612009632023313234433735222C0D0A22622009632023444544 + 454446222C0D0A22632009632023463646354635222C0D0A2264200963202345 + 3245304445222C0D0A22652009632023384638393834222C0D0A226620096320 + 23334136333832222C0D0A22672009632023393842324245222C0D0A22682009 + 632023383842324338222C0D0A22692009632023323437384133222C0D0A226A + 2009632023313336383938222C0D0A226B2009632023304435453931222C0D0A + 226C2009632023304335433846222C0D0A226D2009632023304435433846222C + 0D0A226E2009632023304535453931222C0D0A226F2009632023304434443741 + 222C0D0A22702009632023364538363939222C0D0A2271200963202345434543 + 4541222C0D0A22722009632023463446304543222C0D0A227320096320234537 + 45304439222C0D0A22742009632023424542364146222C0D0A22752009632023 + 334136353835222C0D0A22762009632023384141424243222C0D0A2277200963 + 2023353038464230222C0D0A22782009632023313336413939222C0D0A227920 + 09632023394342444432222C0D0A227A2009632023384342324341222C0D0A22 + 412009632023304535453930222C0D0A22422009632023304334373734222C0D + 0A22432009632023354137323835222C0D0A2244200963202344334430434322 + 2C0D0A22452009632023463345444533222C0D0A224620096320234545453744 + 43222C0D0A22472009632023424341453937222C0D0A22482009632023333734 + 433543222C0D0A22492009632023363839314139222C0D0A224A200963202333 + 3837444132222C0D0A224B2009632023304436303932222C0D0A224C20096320 + 23304435453930222C0D0A224D2009632023304535443930222C0D0A224E2009 + 632023304535433845222C0D0A224F2009632023304133453638222C0D0A2250 + 2009632023354136423738222C0D0A22512009632023434343384330222C0D0A + 22522009632023463345424443222C0D0A22532009632023454345324434222C + 0D0A22542009632023324435323636222C0D0A22552009632023324536463936 + 222C0D0A22562009632023304435413843222C0D0A2257200963202331323544 + 3844222C0D0A22582009632023384241444335222C0D0A225920096320233044 + 35343836222C0D0A225A2009632023304534453742222C0D0A22602009632023 + 303732463530222C0D0A22202E09632023383438393841222C0D0A222E2E0963 + 2023434143344241222C0D0A222B2E09632023463145364434222C0D0A22402E + 09632023454344464341222C0D0A22232E09632023424341423930222C0D0A22 + 242E09632023313832373246222C0D0A22252E09632023313434433734222C0D + 0A22262E09632023304534453745222C0D0A222A2E0963202343304346444222 + 2C0D0A223D2E09632023444345344542222C0D0A222D2E096320234230433144 + 31222C0D0A223B2E09632023353437383937222C0D0A223E2E09632023303833 + 303535222C0D0A222C2E09632023334134423538222C0D0A22272E0963202341 + 3541303938222C0D0A22292E09632023443643444245222C0D0A22212E096320 + 23454545304341222C0D0A227E2E09632023454344424332222C0D0A227B2E09 + 632023424341383841222C0D0A225D2E09632023313331463242222C0D0A225E + 2E09632023303833353544222C0D0A222F2E09632023303633413636222C0D0A + 22282E09632023303933423636222C0D0A225F2E09632023303633333545222C + 0D0A223A2E09632023303632373443222C0D0A223C2E09632023324133313339 + 222C0D0A225B2E09632023413239433934222C0D0A227D2E0963202342454235 + 4138222C0D0A227C2E09632023453744424336222C0D0A22312E096320234543 + 44434331222C0D0A22322E09632023453944364241222C0D0A22332E09632023 + 424341363835222C0D0A22342E09632023323632363236222C0D0A22352E0963 + 2023303230413132222C0D0A22362E09632023303331343235222C0D0A22372E + 09632023303331343233222C0D0A22382E09632023344434443443222C0D0A22 + 392E09632023413039423933222C0D0A22302E09632023424342344136222C0D + 0A22612E09632023453344364332222C0D0A22622E0963202345434441433022 + 2C0D0A22632E09632023453944364239222C0D0A22642E096320234537443142 + 30222C0D0A22652E09632023424341333746222C0D0A22662E09632023413341 + 313946222C0D0A22672E09632023414541394132222C0D0A22682E0963202342 + 3041414130222C0D0A22692E09632023433842454146222C0D0A226A2E096320 + 23453444364332222C0D0A226B2E09632023454344414246222C0D0A226C2E09 + 632023453944364238222C0D0A226D2E09632023453543434137222C0D0A226E + 2E09632023424341313738222C0D0A226F2E09632023433643314236222C0D0A + 22702E09632023433442444143222C0D0A22712E09632023433342384133222C + 0D0A22722E09632023433242333941222C0D0A22732E09632023433041463931 + 222C0D0A22742E09632023424641413838222C0D0A22752E0963202342454135 + 3746222C0D0A22762E09632023424441303736222C0D0A22772E096320234243 + 39453733222C0D0A2220202020202020202E202E202E202E202E202E202E202E + 202E2020202020202020202020222C0D0A2220202020202020202E202B202B20 + 2B202B202B2040202E2023202E202020202020202020222C0D0A222020202020 + 2020202420252026202A202A202A203D202D202A2023202E2020202020202022 + 2C0D0A222020202020203B203E202C202720292021202A207E207B205D202A20 + 23205E2020202020222C0D0A22202020202F2028205F203A203C205B207D207C + 202A2031207B20322033205E2020202020222C0D0A2220203420352036203720 + 2A203820392030206120622063206420402065205E2020202020222C0D0A2266 + 206720682069206A206B206C206D206E206F20702071207220732074205E2020 + 202020222C0D0A22752076207720782079202A207A2041204120422043204420 + 4520462047205E2020202020222C0D0A22482049204A204B204C202A2038204D + 204E204F20502051205220532047205E2020202020222C0D0A22752054205520 + 562057202A20582059205A206020202E2E2E2B2E402E232E5E2020202020222C + 0D0A222020242E252E262E2A2E3D2E2D2E3B2E3E2E2C2E272E292E212E7E2E7B + 2E5E2020202020222C0D0A22202020205D2E5E2E2F2E282E5F2E3A2E3C2E5B2E + 7D2E7C2E312E322E332E5E2020202020222C0D0A22202020202020342E352E36 + 2E372E382E392E302E612E622E632E642E652E5E2020202020222C0D0A222020 + 2020202020202E20662E672E682E692E6A2E6B2E6C2E642E6D2E6E2E5E202020 + 2020222C0D0A2220202020202020202E206F2E6F2E702E712E722E732E742E75 + 2E762E772E5E2020202020222C0D0A2220202020202020202E205E205E205E20 + 5E205E205E205E205E205E205E205E2020202020222C0D0A2220202020202020 + 2020202020202020202020202020202020202020202020202020202020222C0D + 0A22202020202020202020202020202020202020202020202020202020202020 + 202020202020227D3B0D0AE40100002F2A2058504D202A2F0D0A737461746963 + 2063686172202A20706B675F696E686572697465645F78706D5B5D203D207B0D + 0A22313720313720332031222C0D0A22200963204E6F6E65222C0D0A222E0963 + 2023464646464646222C0D0A222B09632023303030303030222C0D0A22202020 + 2E202B2E20202020202020202020222C0D0A2220202E2B2E202B2E2020202020 + 20202020222C0D0A22202E2B202B2E202B2E2020202020202020222C0D0A222E + 2B2020202B2E202B2E20202020202020222C0D0A222E2B202E20202B2E202B2E + 202020202020222C0D0A222B2E202B2E20202B2E202B2E2020202020222C0D0A + 22202B2E202B2E20202B2E202B2E20202020222C0D0A2220202B2E202B2E2020 + 2B2E202B2E202020222C0D0A222020202B2E202B2E20202B2E202B2E2020222C + 0D0A22202020202B2E202B2E20202E20202B2E20222C0D0A2220202020202B2E + 202B2E2E2B20202E2B20222C0D0A222020202020202B2E202B2B2020202E2B20 + 222C0D0A22202020202020202B2E20202020202E2B20222C0D0A222020202020 + 2020202B2E202020202E2B20222C0D0A222020202020202020202B2E2E2E2E2E + 2B20222C0D0A22202020202020202020202B2B2B2B2B2B20222C0D0A22202020 + 2020202020202020202020202020227D3B0D0A380700002F2A2058504D202A2F + 0D0A7374617469632063686172202A20706B675F746578745F78706D5B5D203D + 207B0D0A2231382031382038362031222C0D0A22200963204E6F6E65222C0D0A + 222E09632023353835383538222C0D0A222B09632023444544454445222C0D0A + 224009632023424342374231222C0D0A222309632023393939393939222C0D0A + 222409632023464646464646222C0D0A222509632023454145414541222C0D0A + 222609632023364436443644222C0D0A222A09632023464346434643222C0D0A + 223D09632023373037303730222C0D0A222D09632023434543454345222C0D0A + 223B09632023333033303330222C0D0A223E09632023394239423942222C0D0A + 222C09632023383938393839222C0D0A222709632023364236423642222C0D0A + 222909632023343234323432222C0D0A222109632023463646354635222C0D0A + 227E09632023453245304445222C0D0A227B09632023384638393834222C0D0A + 225D09632023464246394636222C0D0A225E09632023463446304543222C0D0A + 222F09632023453745304439222C0D0A222809632023424542364146222C0D0A + 225F09632023444644464446222C0D0A223A09632023464546454645222C0D0A + 223C09632023464246384635222C0D0A225B09632023463846344544222C0D0A + 227D09632023463345444533222C0D0A227C09632023454545374443222C0D0A + 223109632023424341453937222C0D0A223209632023394139413941222C0D0A + 223309632023393839373934222C0D0A223409632023393739343846222C0D0A + 223509632023393539313842222C0D0A223609632023393438463836222C0D0A + 223709632023454345324434222C0D0A223809632023464446444643222C0D0A + 223909632023464146384634222C0D0A223009632023463846334542222C0D0A + 226109632023463545454534222C0D0A226209632023463345414443222C0D0A + 226309632023463145364434222C0D0A226409632023454344464341222C0D0A + 226509632023424341423930222C0D0A226609632023464346434642222C0D0A + 226709632023393539313841222C0D0A226809632023393438453835222C0D0A + 226909632023393238423830222C0D0A226A09632023393138383742222C0D0A + 226B09632023454344424332222C0D0A226C09632023424341383841222C0D0A + 226D09632023464146364632222C0D0A226E09632023463846324541222C0D0A + 226F09632023463545454532222C0D0A227009632023463245394441222C0D0A + 227109632023463045344432222C0D0A227209632023454545304339222C0D0A + 227309632023454344434331222C0D0A227409632023453944364241222C0D0A + 227509632023424341363835222C0D0A227609632023463746314539222C0D0A + 227709632023393439303839222C0D0A227809632023393338443834222C0D0A + 227909632023393238423746222C0D0A227A09632023393138383741222C0D0A + 224109632023384638353735222C0D0A224209632023384538323730222C0D0A + 224309632023453744314230222C0D0A224409632023424341333746222C0D0A + 224509632023463445444531222C0D0A224609632023463245384438222C0D0A + 224709632023463045344430222C0D0A224809632023454544454338222C0D0A + 224909632023454344414246222C0D0A224A09632023453944364238222C0D0A + 224B09632023453543434137222C0D0A224C09632023424341313738222C0D0A + 224D09632023433643314236222C0D0A224E09632023433442444143222C0D0A + 224F09632023433342384133222C0D0A225009632023433242333941222C0D0A + 225109632023433041463931222C0D0A225209632023424641413838222C0D0A + 225309632023424541353746222C0D0A225409632023424441303736222C0D0A + 225509632023424339453733222C0D0A22202020202E2E2E2E2E2E2E2E2E2020 + 202020222C0D0A22202020202E2B2B2B2B2B402E232E20202020222C0D0A2220 + 2020202E2B24242424252624232E202020222C0D0A22202020202E2B24242424 + 2A3D2D24233B2020222C0D0A22202020202E2B243E3E3E242C3D27293B202022 + 2C0D0A22202020202E2B2424242424217E407B3B2020222C0D0A22202020202E + 2B243E3E3E3E5D5E2F283B2020222C0D0A22202020202E5F2424243A3C5B7D7C + 313B2020222C0D0A22202020202E2B243E323334353637313B2020222C0D0A22 + 202020202E2B2438393061626364653B2020222C0D0A22202020202E2B663334 + 6768696A6B6C3B2020222C0D0A22202020202E2B6D6E6F7071727374753B2020 + 222C0D0A22202020202E2B767778797A414243443B2020222C0D0A2220202020 + 2E2B45464748494A434B4C3B2020222C0D0A22202020202E4D4D4E4F50515253 + 54553B2020222C0D0A22202020202E3B3B3B3B3B3B3B3B3B3B3B2020222C0D0A + 22202020202020202020202020202020202020222C0D0A222020202020202020 + 20202020202020202020227D3B0D0AB60900002F2A2058504D202A2F0D0A7374 + 617469632063686172202A2063655F747970655F78706D5B5D203D207B0D0A22 + 3136203136203130382032222C0D0A2220200963204E6F6E65222C0D0A222E20 + 09632023324431443146222C0D0A222B2009632023343932363241222C0D0A22 + 402009632023353632413243222C0D0A22232009632023364633303332222C0D + 0A22242009632023383032453333222C0D0A2225200963202338433238324422 + 2C0D0A22262009632023344130433043222C0D0A222A20096320233535343434 + 36222C0D0A223D2009632023433638373846222C0D0A222D2009632023423935 + 373543222C0D0A223B2009632023413733423434222C0D0A223E200963202339 + 4533343338222C0D0A222C2009632023393832423245222C0D0A222720096320 + 23393332313239222C0D0A22292009632023383531453235222C0D0A22212009 + 632023374531363143222C0D0A227E2009632023363830433130222C0D0A227B + 2009632023314230313032222C0D0A225D2009632023363333453432222C0D0A + 225E2009632023443138363841222C0D0A222F2009632023443638413933222C + 0D0A22282009632023424635413630222C0D0A225F2009632023413533433433 + 222C0D0A223A2009632023394533343344222C0D0A223C200963202339353244 + 3336222C0D0A225B2009632023384432343241222C0D0A227D20096320233838 + 31413231222C0D0A227C2009632023374631323136222C0D0A22312009632023 + 373430433043222C0D0A22322009632023333930333035222C0D0A2233200963 + 2023333932333235222C0D0A22342009632023434638343839222C0D0A223520 + 09632023443238363842222C0D0A22362009632023443339363938222C0D0A22 + 372009632023433136313641222C0D0A22382009632023413533433437222C0D + 0A22392009632023394333313334222C0D0A2230200963202339363238324322 + 2C0D0A22612009632023393031463236222C0D0A226220096320233832314332 + 31222C0D0A22632009632023374231343139222C0D0A22642009632023373530 + 423130222C0D0A22652009632023344630363037222C0D0A2266200963202330 + 4330303030222C0D0A22672009632023343732413244222C0D0A226820096320 + 23434638343837222C0D0A22692009632023443038343838222C0D0A226A2009 + 632023443139313930222C0D0A226B2009632023433037313646222C0D0A226C + 2009632023413533443435222C0D0A226D2009632023394233323342222C0D0A + 226E2009632023393232413332222C0D0A226F2009632023384132313238222C + 0D0A22702009632023383531363143222C0D0A22712009632023374631343135 + 222C0D0A22722009632023374332313232222C0D0A2273200963202336393234 + 3236222C0D0A22742009632023304530353035222C0D0A227520096320233436 + 32363238222C0D0A22762009632023434538343834222C0D0A22772009632023 + 434538363835222C0D0A22782009632023434638433845222C0D0A2279200963 + 2023433837363746222C0D0A227A2009632023413534323439222C0D0A224120 + 09632023394133303334222C0D0A22422009632023393533353339222C0D0A22 + 432009632023373332393243222C0D0A22442009632023364134313431222C0D + 0A22452009632023363835373541222C0D0A2246200963202336413638363822 + 2C0D0A22472009632023333632323232222C0D0A224820096320234341374538 + 37222C0D0A22492009632023443237433835222C0D0A224A2009632023434237 + 453745222C0D0A224B2009632023413536373641222C0D0A224C200963202334 + 4133313334222C0D0A224D2009632023334633393339222C0D0A224E20096320 + 23363736373637222C0D0A224F2009632023383238323832222C0D0A22502009 + 632023394639463946222C0D0A22512009632023413241324132222C0D0A2252 + 2009632023303830383038222C0D0A22532009632023333431453145222C0D0A + 22542009632023433837433833222C0D0A22552009632023434338303838222C + 0D0A22562009632023373835323534222C0D0A22572009632023344535313446 + 222C0D0A22582009632023363636393637222C0D0A2259200963202338443845 + 3844222C0D0A225A2009632023413641364136222C0D0A226020096320234132 + 39363936222C0D0A22202E09632023383635413541222C0D0A222E2E09632023 + 333030453045222C0D0A222B2E09632023324131393141222C0D0A22402E0963 + 2023433237373838222C0D0A22232E09632023383035333538222C0D0A22242E + 09632023373037303730222C0D0A22252E09632023374638303746222C0D0A22 + 262E09632023363436333543222C0D0A222A2E09632023343033313244222C0D + 0A223D2E09632023313030303030222C0D0A222D2E0963202330363030303022 + 2C0D0A223B2E09632023323931363138222C0D0A223E2E096320233638334634 + 30222C0D0A222C2E09632023324132413241222C0D0A22272E09632023303630 + 323031222C0D0A22292E09632023313430333031222C0D0A2220202020202020 + 20202020202020202020202020202020202020202020202020222C0D0A222020 + 202020202020202020202020202020202020202020202020202020202020222C + 0D0A222020202020202020202020202020202020202020202020202020202020 + 202020222C0D0A22202020202E202B2040202320242025202620202020202020 + 2020202020202020222C0D0A222A203D202D203B203E202C202720292021207E + 207B2020202020202020202020222C0D0A225D205E202F2028205F203A203C20 + 5B207D207C20312032202020202020202020222C0D0A22332034203520362037 + 2038203920302061206220632064206520662020202020222C0D0A2220206720 + 682069206A206B206C206D206E206F20702071207220732074202020222C0D0A + 2220202020752076207720782079207A20412042204320442045204620202020 + 20222C0D0A222020202020204720482049204A204B204C204D204E204F205020 + 512052202020222C0D0A22202020202020202053205420552056205720582059 + 205A206020202E2E2E2020222C0D0A22202020202020202020202B2E402E232E + 242E252E262E2A2E3D2E2D2E20202020222C0D0A222020202020202020202020 + 203B2E3E2E2C2E272E292E20202020202020202020222C0D0A22202020202020 + 2020202020202020202020202020202020202020202020202020222C0D0A2220 + 2020202020202020202020202020202020202020202020202020202020202022 + 2C0D0A2220202020202020202020202020202020202020202020202020202020 + 20202020227D3B0D0A760A00002F2A2058504D202A2F0D0A7374617469632063 + 686172202A2063655F696E746572666163655F78706D5B5D203D207B0D0A2231 + 36203136203131392032222C0D0A2220200963204E6F6E65222C0D0A222E2009 + 632023393939393939222C0D0A222B2009632023394139413941222C0D0A2240 + 2009632023394239423942222C0D0A22232009632023394339433943222C0D0A + 22242009632023394439443944222C0D0A22252009632023394539453945222C + 0D0A22262009632023394639463946222C0D0A222A2009632023413041304130 + 222C0D0A223D2009632023333533353335222C0D0A222D200963202345384538 + 4538222C0D0A223B2009632023453945394539222C0D0A223E20096320234541 + 45414541222C0D0A222C2009632023454245424542222C0D0A22272009632023 + 443444344434222C0D0A22292009632023444144414441222C0D0A2221200963 + 2023444344434443222C0D0A227E2009632023433243324246222C0D0A227B20 + 09632023463146314631222C0D0A225D2009632023463246324632222C0D0A22 + 5E2009632023353135313531222C0D0A222F2009632023433743374337222C0D + 0A22282009632023443544354435222C0D0A225F200963202341414132354122 + 2C0D0A223A2009632023414439463631222C0D0A223C20096320234139383932 + 32222C0D0A225B2009632023434542343331222C0D0A227D2009632023423442 + 313943222C0D0A227C2009632023463446344634222C0D0A2231200963202345 + 4445444544222C0D0A22322009632023433343334330222C0D0A223320096320 + 23433242423834222C0D0A22342009632023424441313444222C0D0A22352009 + 632023464346323745222C0D0A22362009632023463545413546222C0D0A2237 + 2009632023463745423646222C0D0A22382009632023463144433142222C0D0A + 22392009632023414341383742222C0D0A22302009632023463646364636222C + 0D0A22612009632023353235323532222C0D0A22622009632023454645464546 + 222C0D0A22632009632023414641464142222C0D0A2264200963202346314538 + 4131222C0D0A22652009632023463946323844222C0D0A226620096320234634 + 44423643222C0D0A22672009632023463043363431222C0D0A22682009632023 + 454542433146222C0D0A22692009632023463243453143222C0D0A226A200963 + 2023414641433845222C0D0A226B2009632023463846384638222C0D0A226C20 + 09632023353335333533222C0D0A226D2009632023423742364234222C0D0A22 + 6E2009632023453944303635222C0D0A226F2009632023463344343634222C0D + 0A22702009632023454242433242222C0D0A2271200963202345454342344122 + 2C0D0A22722009632023454543413332222C0D0A227320096320234543434230 + 38222C0D0A22742009632023413839373335222C0D0A22752009632023464146 + 414641222C0D0A22762009632023463346334633222C0D0A2277200963202341 + 3539363635222C0D0A22782009632023463845383745222C0D0A227920096320 + 23463244343444222C0D0A227A2009632023463544463733222C0D0A22412009 + 632023463945373641222C0D0A22422009632023463444343244222C0D0A2243 + 2009632023463244413345222C0D0A22442009632023413138363033222C0D0A + 22452009632023464346434643222C0D0A22462009632023353435343534222C + 0D0A22472009632023463546354635222C0D0A22482009632023413738463431 + 222C0D0A22492009632023463945463933222C0D0A224A200963202346314437 + 3435222C0D0A224B2009632023463945363545222C0D0A224C20096320234644 + 46343830222C0D0A224D2009632023454142383138222C0D0A224E2009632023 + 463444383530222C0D0A224F2009632023413037433038222C0D0A2250200963 + 2023464546454645222C0D0A22512009632023463746374637222C0D0A225220 + 09632023413739353446222C0D0A22532009632023463344393538222C0D0A22 + 542009632023463545333544222C0D0A22552009632023463444393435222C0D + 0A22562009632023463544393435222C0D0A2257200963202346314342334422 + 2C0D0A22582009632023454342383038222C0D0A225920096320234133383834 + 33222C0D0A225A2009632023463946394639222C0D0A22602009632023413639 + 443738222C0D0A22202E09632023463445333338222C0D0A222E2E0963202345 + 4342393034222C0D0A222B2E09632023454542453142222C0D0A22402E096320 + 23454442383043222C0D0A22232E09632023454442443038222C0D0A22242E09 + 632023433739383035222C0D0A22252E09632023434443414334222C0D0A2226 + 2E09632023464246424642222C0D0A222A2E09632023414139463335222C0D0A + 223D2E09632023454443443030222C0D0A222D2E09632023463043413137222C + 0D0A223B2E09632023463043393139222C0D0A223E2E09632023433439443144 + 222C0D0A222C2E09632023433843314230222C0D0A22272E0963202334373437 + 3437222C0D0A22292E09632023464446444644222C0D0A22212E096320234630 + 46304630222C0D0A227E2E09632023414441383844222C0D0A227B2E09632023 + 414539393436222C0D0A225D2E09632023413538353234222C0D0A225E2E0963 + 2023444344424437222C0D0A222F2E09632023434443444344222C0D0A22282E + 09632023433943394339222C0D0A225F2E09632023354335433543222C0D0A22 + 3A2E09632023424542454245222C0D0A223C2E09632023424442444244222C0D + 0A225B2E09632023343634433531222C0D0A2220202020202020202020202020 + 20202020202020202020202020202020202020222C0D0A222020202020202E20 + 2B2040204020232024202520262026202A203D2020202020222C0D0A22202020 + 2020202D203B203E202C202720292021207E207B205D205E2020202020222C0D + 0A222020202020203E202C202F2028205F203A203C205B207D207C205E202020 + 2020222C0D0A2220202020202031203220332034203520362037203820392030 + 20612020202020222C0D0A222020202020206220632064206520662067206820 + 69206A206B206C2020202020222C0D0A222020202020207B206D206E206F2070 + 20712072207320742075206C2020202020222C0D0A2220202020202076207720 + 782079207A2041204220432044204520462020202020222C0D0A222020202020 + 204720482049204A204B204C204D204E204F205020462020202020222C0D0A22 + 2020202020205120522053205420552056205720582059205020462020202020 + 222C0D0A222020202020205A206020202E2E2E2B2E402E232E242E252E502046 + 2020202020222C0D0A22202020202020262E31202A2E3D2E2D2E3B2E3E2E2C2E + 50205020272E20202020222C0D0A22202020202020292E5020212E7E2E7B2E5D + 2E5E2E502047202F2E202020202020222C0D0A22202020202020502050205020 + 50205020502050205020282E5F2E202020202020222C0D0A222020202020203A + 2E3A2E3A2E3A2E3A2E3A2E3C2E23205B2E2020202020202020222C0D0A222020 + 202020202020202020202020202020202020202020202020202020202020227D + 3B0D0AAD0600002F2A2058504D202A2F0D0A7374617469632063686172202A20 + 63655F70726F70657274795F78706D5B5D203D207B0D0A223136203136203832 + 2031222C0D0A22200963204E6F6E65222C0D0A222E0963202339393939393922 + 2C0D0A222B09632023394139413941222C0D0A22400963202339423942394222 + 2C0D0A222309632023394339433943222C0D0A22240963202339443944394422 + 2C0D0A222509632023394539453945222C0D0A22260963202339463946394622 + 2C0D0A222A09632023413041304130222C0D0A223D0963202333353335333522 + 2C0D0A222D09632023453845384538222C0D0A223B0963202345394539453922 + 2C0D0A223E09632023454145414541222C0D0A222C0963202345424542454222 + 2C0D0A222709632023454345434543222C0D0A22290963202345454545454522 + 2C0D0A222109632023454645464546222C0D0A227E0963202346304630463022 + 2C0D0A227B09632023463146314631222C0D0A225D0963202346324632463222 + 2C0D0A225E09632023353135313531222C0D0A222F0963202345444544454422 + 2C0D0A222809632023453345334533222C0D0A225F0963202343334333433322 + 2C0D0A223A09632023463346334633222C0D0A223C0963202346344634463422 + 2C0D0A225B09632023453645364536222C0D0A227D0963202338363836383622 + 2C0D0A227C09632023424142414241222C0D0A22310963202337383738373822 + 2C0D0A223209632023393339333933222C0D0A22330963202346364636463622 + 2C0D0A223409632023353235323532222C0D0A22350963202341324132413222 + 2C0D0A223609632023393839383938222C0D0A22370963202338453845384522 + 2C0D0A223809632023443044304430222C0D0A22390963202343314331433122 + 2C0D0A223009632023413941394139222C0D0A22610963202346384638463822 + 2C0D0A226209632023353335333533222C0D0A22630963202338393839383922 + 2C0D0A226409632023453145314531222C0D0A22650963202345304530453022 + 2C0D0A226609632023443844384438222C0D0A22670963202342444244424422 + 2C0D0A226809632023373837383737222C0D0A22690963202346414641464122 + 2C0D0A226A09632023443744374437222C0D0A226B0963202342434243424322 + 2C0D0A226C09632023413541354135222C0D0A226D0963202343464346434622 + 2C0D0A226E09632023383338333833222C0D0A226F0963202346434643464322 + 2C0D0A227009632023353435343534222C0D0A22710963202346354635463522 + 2C0D0A227209632023414341434143222C0D0A22730963202341334133413322 + 2C0D0A227409632023373237323732222C0D0A22750963202342354235423522 + 2C0D0A227609632023384638463846222C0D0A22770963202343374337433722 + 2C0D0A227809632023464546454645222C0D0A22790963202346374637463722 + 2C0D0A227A09632023373337333733222C0D0A22410963202344354435443522 + 2C0D0A224209632023433543354335222C0D0A22430963202342424242424222 + 2C0D0A224409632023463946394639222C0D0A22450963202339343934393422 + 2C0D0A224609632023423142314231222C0D0A22470963202337433743374322 + 2C0D0A224809632023413441344134222C0D0A22490963202346424642464222 + 2C0D0A224A09632023464446444644222C0D0A224B0963202342304230423022 + 2C0D0A224C09632023343734373437222C0D0A224D0963202343444344434422 + 2C0D0A224E09632023433943394339222C0D0A224F0963202335433543354322 + 2C0D0A225009632023424542454245222C0D0A22510963202333423342334222 + 2C0D0A2220202020202020202020202020202020222C0D0A222020202E2B4040 + 23242526262A3D2020222C0D0A222020202D3B3E2C2729217E7B5D5E2020222C + 0D0A222020203E2C2F29285F7B5D3A3C5E2020222C0D0A222020202F29215B7D + 7C31323A33342020222C0D0A22202020217E3536373C38393061622020222C0D + 0A222020207B5D636465663E676869622020222C0D0A222020203A392E6A6B7D + 6C6D6E6F702020222C0D0A2220202071726D2F737475767778702020222C0D0A + 22202020793B7A3941426B234378702020222C0D0A222020204469366C454647 + 487878702020222C0D0A22202020496F4A4B4832667878784C2020222C0D0A22 + 2020204A78787878787878714D202020222C0D0A222020207878787878787878 + 4E4F202020222C0D0A2220202050505050505067235120202020222C0D0A2220 + 202020202020202020202020202020227D3B0D0A200A00002F2A2058504D202A + 2F0D0A7374617469632063686172202A2063655F636F6E7374616E745F78706D + 5B5D203D207B0D0A223136203136203131342032222C0D0A2220200963204E6F + 6E65222C0D0A222E2009632023364337413630222C0D0A222B20096320233645 + 37433632222C0D0A22402009632023333232443232222C0D0A22232009632023 + 363036433536222C0D0A22242009632023373538343635222C0D0A2225200963 + 2023373638353635222C0D0A22262009632023363937363546222C0D0A222A20 + 09632023314131373131222C0D0A223D2009632023373538343634222C0D0A22 + 2D2009632023363537323543222C0D0A223B2009632023363635323438222C0D + 0A223E2009632023344432393236222C0D0A222C200963202341333543353222 + 2C0D0A22272009632023413235323445222C0D0A222920096320233846343634 + 31222C0D0A22212009632023373634423341222C0D0A227E2009632023354336 + 383533222C0D0A227B2009632023423735453632222C0D0A225D200963202343 + 4337433745222C0D0A225E2009632023433436393637222C0D0A222F20096320 + 23433636413636222C0D0A22282009632023433536453637222C0D0A225F2009 + 632023424135443539222C0D0A223A2009632023423034443444222C0D0A223C + 2009632023393134413431222C0D0A225B2009632023364133453246222C0D0A + 227D2009632023423836333633222C0D0A227C2009632023453742464246222C + 0D0A22312009632023444541354132222C0D0A22322009632023443438343830 + 222C0D0A22332009632023443137423736222C0D0A2234200963202343383737 + 3644222C0D0A22352009632023424236413544222C0D0A223620096320234232 + 35393532222C0D0A22372009632023394534413436222C0D0A22382009632023 + 373734353334222C0D0A22392009632023354533423238222C0D0A2230200963 + 2023363633353331222C0D0A22612009632023434538443838222C0D0A226220 + 09632023453242304145222C0D0A22632009632023443739333845222C0D0A22 + 642009632023443238413832222C0D0A22652009632023434537463736222C0D + 0A22662009632023433437353637222C0D0A2267200963202342373643354322 + 2C0D0A22682009632023414235443531222C0D0A226920096320233942344234 + 35222C0D0A226A2009632023374434393339222C0D0A226B2009632023354333 + 423235222C0D0A226C2009632023393435353439222C0D0A226D200963202343 + 4438453837222C0D0A226E2009632023443239333842222C0D0A226F20096320 + 23434638423832222C0D0A22702009632023434238333738222C0D0A22712009 + 632023433737433645222C0D0A22722009632023424337333631222C0D0A2273 + 2009632023423136423538222C0D0A22742009632023413335463445222C0D0A + 22752009632023393235303433222C0D0A22762009632023373834373334222C + 0D0A22772009632023353933423234222C0D0A22782009632023383335313432 + 222C0D0A22792009632023424437453731222C0D0A227A200963202343353836 + 3741222C0D0A22412009632023433437453731222C0D0A224220096320234331 + 37413642222C0D0A22432009632023424637363633222C0D0A22442009632023 + 423737323542222C0D0A22452009632023413836413533222C0D0A2246200963 + 2023394136303442222C0D0A22472009632023384135353431222C0D0A224820 + 09632023364134343245222C0D0A22492009632023353333383231222C0D0A22 + 4A2009632023413636413539222C0D0A224B2009632023423337333632222C0D + 0A224C2009632023423737343630222C0D0A224D200963202342413736363022 + 2C0D0A224E2009632023423637343542222C0D0A224F20096320234145364435 + 33222C0D0A22502009632023394636363443222C0D0A22512009632023384635 + 433433222C0D0A22522009632023373934443337222C0D0A2253200963202335 + 4233433235222C0D0A22542009632023343633353230222C0D0A225520096320 + 23384335433436222C0D0A22562009632023394536343444222C0D0A22572009 + 632023413736413531222C0D0A22582009632023414136433532222C0D0A2259 + 2009632023413736433446222C0D0A225A2009632023394336363439222C0D0A + 22602009632023384435433430222C0D0A22202E09632023374335333339222C + 0D0A222E2E09632023363934413332222C0D0A222B2E09632023353133393232 + 222C0D0A22402E09632023374134463339222C0D0A22232E0963202338413539 + 3430222C0D0A22242E09632023384235413346222C0D0A22252E096320233834 + 35353342222C0D0A22262E09632023374335313337222C0D0A222A2E09632023 + 373735303333222C0D0A223D2E09632023364534443334222C0D0A222D2E0963 + 2023354534353243222C0D0A223B2E09632023324432313134222C0D0A223E2E + 09632023303030303030222C0D0A222C2E09632023304330383035222C0D0A22 + 272E09632023353033363234222C0D0A22292E09632023364334383246222C0D + 0A22212E09632023353233363231222C0D0A227E2E0963202335303336323122 + 2C0D0A227B2E09632023363534343242222C0D0A225D2E096320233630343532 + 42222C0D0A225E2E09632023324432313135222C0D0A222F2E09632023303530 + 363034222C0D0A22202020202020202020202020202020202020202020202020 + 2020202020202020222C0D0A2220202020202020202020202020202020202020 + 20202020202020202020202020222C0D0A222020202020202E202B2020202020 + 402020202020202020202020202020202020222C0D0A22202020202320242025 + 20262020202A2020202020202020202020202020202020222C0D0A2220202020 + 3D202D20202020203B203E202C202720292021202020202020202020222C0D0A + 2220207E20202020207B205D205E202F2028205F203A203C205B202020202020 + 20222C0D0A222020202020207D207C2031203220332034203520362037203820 + 392020202020222C0D0A22202020203020612062206320642065206620672068 + 2069206A206B2020202020222C0D0A22202020206C206D206E206F2070207120 + 72207320742075207620772020202020222C0D0A2220202020782079207A2041 + 204220432044204520462047204820492020202020222C0D0A22202020202020 + 4A204B204C204D204E204F205020512052205320542020202020222C0D0A2220 + 2020202020552056205720582059205A206020202E2E2E2B2E20202020202022 + 2C0D0A222020202020202020402E232E242E252E262E2A2E3D2E2D2E3B2E3E2E + 3E2E2020222C0D0A2220202020202020202C2E272E292E212E7E2E7B2E5D2E5E + 2E3E2E3E2E20202020222C0D0A222020202020202020202020202F2E3E2E3E2E + 3E2E3E2E3E2E2020202020202020222C0D0A2220202020202020202020202020 + 20202020202020202020202020202020202020227D3B0D0AB60C00002F2A2058 + 504D202A2F0D0A7374617469632063686172202A2063655F70726F6772616D5F + 78706D5B5D203D207B0D0A223136203136203135332032222C0D0A2220200963 + 204E6F6E65222C0D0A222E2009632023364336373631222C0D0A222B20096320 + 23453445344534222C0D0A22402009632023453245324532222C0D0A22232009 + 632023433343334333222C0D0A22242009632023383438343834222C0D0A2225 + 2009632023364236363630222C0D0A22262009632023463946394639222C0D0A + 222A2009632023463846384638222C0D0A223D2009632023463446344634222C + 0D0A222D2009632023423942394239222C0D0A223B2009632023423442344234 + 222C0D0A223E2009632023413236423435222C0D0A222C200963202343333638 + 3431222C0D0A22272009632023423434373244222C0D0A222920096320234146 + 36443735222C0D0A22212009632023443143314339222C0D0A227E2009632023 + 463346334633222C0D0A227B2009632023423642364236222C0D0A225D200963 + 2023463146314631222C0D0A225E2009632023453341443646222C0D0A222F20 + 09632023463444384333222C0D0A22282009632023454542444135222C0D0A22 + 5F2009632023444338353734222C0D0A223A2009632023433335463737222C0D + 0A223C2009632023393834323836222C0D0A225B200963202342344132424222 + 2C0D0A227D2009632023454445444544222C0D0A227C20096320234331433143 + 31222C0D0A22312009632023383738363834222C0D0A22322009632023373837 + 363732222C0D0A22332009632023363136303545222C0D0A2234200963202344 + 3841463639222C0D0A22352009632023463745354343222C0D0A223620096320 + 23454242353746222C0D0A22372009632023443836303143222C0D0A22382009 + 632023433433363232222C0D0A22392009632023423334373833222C0D0A2230 + 2009632023393935334235222C0D0A22612009632023353834313930222C0D0A + 22622009632023424242444333222C0D0A22632009632023454445434543222C + 0D0A22642009632023444344414438222C0D0A22652009632023423942354144 + 222C0D0A22662009632023364336383632222C0D0A2267200963202345454442 + 4145222C0D0A22682009632023454144303945222C0D0A226920096320234532 + 39463343222C0D0A226A2009632023443936323035222C0D0A226B2009632023 + 424333353337222C0D0A226C2009632023393434374232222C0D0A226D200963 + 2023354135384245222C0D0A226E2009632023333335374130222C0D0A226F20 + 09632023364237433846222C0D0A22702009632023443844364432222C0D0A22 + 712009632023453845324442222C0D0A22722009632023443443444332222C0D + 0A22732009632023383137423730222C0D0A2274200963202337373645333922 + 2C0D0A22752009632023453944464137222C0D0A227620096320234530434638 + 31222C0D0A22772009632023444242463539222C0D0A22782009632023444341 + 373344222C0D0A22792009632023373035463839222C0D0A227A200963202332 + 3537354331222C0D0A22412009632023313038304334222C0D0A224220096320 + 23303737304135222C0D0A22432009632023333836373745222C0D0A22442009 + 632023433443304239222C0D0A22452009632023453744464433222C0D0A2246 + 2009632023444544354334222C0D0A22472009632023384338333735222C0D0A + 22482009632023353035373245222C0D0A22492009632023433444373933222C + 0D0A224A2009632023413243383646222C0D0A224B2009632023374242453546 + 222C0D0A224C2009632023333642343630222C0D0A224D200963202333354237 + 4339222C0D0A224E2009632023314541384442222C0D0A224F20096320233041 + 39384343222C0D0A22502009632023303337343945222C0D0A22512009632023 + 334636333645222C0D0A22522009632023423942334141222C0D0A2253200963 + 2023453344384339222C0D0A22542009632023453544384332222C0D0A225520 + 09632023393038353733222C0D0A22562009632023374242413643222C0D0A22 + 572009632023363442453643222C0D0A22582009632023323442313536222C0D + 0A22592009632023323442373831222C0D0A225A200963202333344243424422 + 2C0D0A22602009632023334241444430222C0D0A22202E096320233236384442 + 34222C0D0A222E2E09632023313135463743222C0D0A222B2E09632023373137 + 383736222C0D0A22402E09632023424342334136222C0D0A22232E0963202345 + 3344364331222C0D0A22242E09632023453944384245222C0D0A22252E096320 + 23393338363731222C0D0A22262E09632023323335453245222C0D0A222A2E09 + 632023334142303635222C0D0A223D2E09632023324642343734222C0D0A222D + 2E09632023323942343845222C0D0A223B2E09632023324541444139222C0D0A + 223E2E09632023324639364138222C0D0A222C2E09632023323636453836222C + 0D0A22272E09632023333935353545222C0D0A22292E09632023394539373843 + 222C0D0A22212E09632023433942454143222C0D0A227E2E0963202345354435 + 4244222C0D0A227B2E09632023453744354237222C0D0A225D2E096320233938 + 38373730222C0D0A225E2E09632023304134303233222C0D0A222F2E09632023 + 314637413536222C0D0A22282E09632023323438383731222C0D0A225F2E0963 + 2023323137423736222C0D0A223A2E09632023314135413630222C0D0A223C2E + 09632023343435413543222C0D0A225B2E09632023393738463835222C0D0A22 + 7D2E09632023423741443944222C0D0A227C2E09632023444143424234222C0D + 0A22312E09632023453644334236222C0D0A22322E0963202345354430414522 + 2C0D0A22332E09632023393938373644222C0D0A22342E096320233432343133 + 45222C0D0A22352E09632023374439323842222C0D0A22362E09632023373037 + 463741222C0D0A22372E09632023393739323841222C0D0A22382E0963202341 + 3639453933222C0D0A22392E09632023424242304130222C0D0A22302E096320 + 23443643374230222C0D0A22612E09632023453444314234222C0D0A22622E09 + 632023453543464145222C0D0A22632E09632023453243414135222C0D0A2264 + 2E09632023393838343638222C0D0A22652E09632023353235303443222C0D0A + 22662E09632023443944344344222C0D0A22672E09632023434343354242222C + 0D0A22682E09632023434143314233222C0D0A22692E09632023443343374234 + 222C0D0A226A2E09632023444443464237222C0D0A226B2E0963202345354432 + 4235222C0D0A226C2E09632023453143353944222C0D0A226D2E096320233937 + 38333635222C0D0A226E2E09632023343334303343222C0D0A226F2E09632023 + 394439363844222C0D0A22702E09632023393939313836222C0D0A22712E0963 + 2023393838463830222C0D0A22722E09632023393938453743222C0D0A22732E + 09632023394138433738222C0D0A22742E09632023394238423732222C0D0A22 + 752E09632023394138383644222C0D0A22762E09632023373036313442222C0D + 0A22202020202020202020202020202020202020202020202020202020202020 + 2020222C0D0A2220202020202020202E202B202B202B202B2040202320242020 + 20202020202020222C0D0A222020202020202020252026202A202A2026202620 + 3D202D203B20202020202020222C0D0A2220202020202020203E202C20272029 + 2021207E2026207B205D207B2020202020222C0D0A222020202020205E202F20 + 28205F203A203C205B207D207C203120322033202020222C0D0A222020202034 + 203520362037203820392030206120622063206420652066202020222C0D0A22 + 202020206720682069206A206B206C206D206E206F2070207120722073202020 + 222C0D0A2220207420752076207720782079207A204120422043204420452046 + 2047202020222C0D0A222020482049204A204B204C204D204E204F2050205120 + 52205320542055202020222C0D0A222020202056205720582059205A20602020 + 2E2E2E2B2E402E232E242E252E2020222C0D0A2220202020262E2A2E3D2E2D2E + 3B2E3E2E2C2E272E292E212E7E2E7B2E5D2E2020222C0D0A222020202020205E + 2E2F2E282E5F2E3A2E3C2E5B2E7D2E7C2E312E322E332E2020222C0D0A222020 + 202020202020342E352E362E372E382E392E302E612E622E632E642E2020222C + 0D0A222020202020202020652E662E672E682E692E6A2E6B2E622E632E6C2E6D + 2E2020222C0D0A2220202020202020206E2E6F2E702E712E722E732E742E752E + 642E6D2E762E2020222C0D0A2220202020202020202020202020202020202020 + 20202020202020202020202020227D3B0D0A7E0200002F2A2058504D202A2F0D + 0A7374617469632063686172202A2063655F70726F6365647572655F78706D5B + 5D203D207B0D0A2231362031362031352031222C0D0A22200963204E6F6E6522 + 2C0D0A222E09632023334133413341222C0D0A222B0963202339313931393122 + 2C0D0A224009632023384238423842222C0D0A22230963202343434343434322 + 2C0D0A222409632023443544354435222C0D0A22250963202341444144414422 + 2C0D0A222609632023433443344334222C0D0A222A0963202342344234423422 + 2C0D0A223D09632023413141314131222C0D0A222D0963202339383938393822 + 2C0D0A223B09632023413241324132222C0D0A223E0963202343364336433622 + 2C0D0A222C09632023443844384438222C0D0A22270963202334433443344322 + 2C0D0A222020202020202E2E2E2E202020202020222C0D0A222020202E2E202E + 2B2B2E202E2E202020222C0D0A2220202E402E2E232424232E2E402E2020222C + 0D0A22202E4025262A3D2D2D3D2A2625402E20222C0D0A22202E2E263B403E2C + 2C3E403B262E2E20222C0D0A2220202E2A3D3E2A27272A3E3D2A2E2020222C0D + 0A222E2E233D3E2A2E20202E2A3E3D232E2E222C0D0A222E2B242D2C27202020 + 20272C2D242B2E222C0D0A222E2B242D2C2720202020272C2D242B2E222C0D0A + 222E2E233D3E2A2E20202E2A3E3D232E2E222C0D0A2220202E2A3D3E2A27272A + 3E3D2A2E2020222C0D0A22202E2E263B403E2C2C3E403B262E2E20222C0D0A22 + 202E4025262A3D2D2D3D2A2625402E20222C0D0A2220202E402E2E232424232E + 2E402E2020222C0D0A222020202E2E202E2B2B2E202E2E202020222C0D0A2220 + 20202020202E2E2E2E202020202020227D3B0D0A + } + end +end diff --git a/wst/trunk/type_lib_edtr/udm.lrs b/wst/trunk/type_lib_edtr/udm.lrs new file mode 100644 index 000000000..34a7c2f87 --- /dev/null +++ b/wst/trunk/type_lib_edtr/udm.lrs @@ -0,0 +1,395 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TDM','FORMDATA',[ + 'TPF0'#3'TDM'#2'DM'#6'Height'#3','#1#16'HorizontalOffset'#3'}'#1#14'VerticalO' + +'ffset'#3#236#0#5'Width'#3#144#1#0#10'TImageList'#2'IM'#4'left'#3#208#0#3'to' + +'p'#3#200#0#6'Bitmap'#10#180'N'#0#0'li'#10#0#0#0#16#0#0#0#16#0#0#0#219#3#0#0 + +'/* XPM */'#13#10'static char * pkg_project_xpm[] = {'#13#10'"18 18 32 1",' + +#13#10'" '#9'c None",'#13#10'".'#9'c #A0A0A0",'#13#10'"+'#9'c #808080",'#13 + +#10'"@'#9'c #404000",'#13#10'"#'#9'c #FFFFFF",'#13#10'"$'#9'c #DCDCDC",'#13 + +#10'"%'#9'c #C0C0FF",'#13#10'"&'#9'c #C3C3C3",'#13#10'"*'#9'c #8080FF",'#13 + +#10'"='#9'c #585858",'#13#10'"-'#9'c #303030",'#13#10'";'#9'c #008080",'#13 + +#10'">'#9'c #004040",'#13#10'",'#9'c #FFC0C0",'#13#10'"'''#9'c #0000FF",'#13 + +#10'")'#9'c #FFDCA8",'#13#10'"!'#9'c #C05800",'#13#10'"~'#9'c #FF8000",'#13 + +#10'"{'#9'c #FFA858",'#13#10'"]'#9'c #808000",'#13#10'"^'#9'c #FF00FF",'#13 + +#10'"/'#9'c #C000C0",'#13#10'"('#9'c #800080",'#13#10'"_'#9'c #00C0C0",'#13 + +#10'":'#9'c #C0FFC0",'#13#10'"<'#9'c #00C000",'#13#10'"['#9'c #008000",'#13 + +#10'"}'#9'c #800000",'#13#10'"|'#9'c #004000",'#13#10'"1'#9'c #FF0000",'#13 + +#10'"2'#9'c #C00000",'#13#10'"3'#9'c #C0C000",'#13#10'" ....+++@ ",' + +#13#10'" .######.+ ",'#13#10'" .######.$+ ",'#13#10'" .#%%.#' + +'#&$#+ ",'#13#10'" .%%%**#&.==- ",'#13#10'" .*;*;>###$&@ ",'#13#10 + +'" $*;=>>##$$$= ",'#13#10'" ,,,==>>''###)$= ",'#13#10'" !~{=-=>=])#$$' + +'= ",'#13#10'" !^/(&_:<[$)))= ",'#13#10'" !!}}<<[=|#$$$= ",'#13#10'" ' + +'12-<][=|$),)= ",'#13#10'" .#<[[||$$$&= ",'#13#10'" +)#)@)$)),)= ",' + +#13#10'" .$#$$)$&,3,= ",'#13#10'" @++++=]=+=+@ ",'#13#10'" ' + +' ",'#13#10'" "};'#13#10'Z'#13#0#0'/* XPM */'#13#10 + +'static char * pkg_include_xpm[] = {'#13#10'"18 18 154 2",'#13#10'" '#9'c N' + +'one",'#13#10'". '#9'c #585858",'#13#10'"+ '#9'c #DEDEDE",'#13#10'"@ '#9'c #' + +'BCB7B1",'#13#10'"# '#9'c #999999",'#13#10'"$ '#9'c #33546D",'#13#10'"% '#9 + +'c #7792A6",'#13#10'"& '#9'c #849FB4",'#13#10'"* '#9'c #FFFFFF",'#13#10'"= ' + +#9'c #EAEAEA",'#13#10'"- '#9'c #6D6D6D",'#13#10'"; '#9'c #6E8AA0",'#13#10'">' + +' '#9'c #CAD2D6",'#13#10'", '#9'c #C9D5DD",'#13#10'"'' '#9'c #99B4C3",'#13#10 + +'") '#9'c #406D8C",'#13#10'"! '#9'c #BAC7D2",'#13#10'"~ '#9'c #FCFCFC",'#13 + +#10'"{ '#9'c #707070",'#13#10'"] '#9'c #CECECE",'#13#10'"^ '#9'c #303030",' + +#13#10'"/ '#9'c #9DAEBA",'#13#10'"( '#9'c #CADCE4",'#13#10'"_ '#9'c #89B4CA"' + +','#13#10'": '#9'c #B6D0DE",'#13#10'"< '#9'c #2B7CA6",'#13#10'"[ '#9'c #3079' + +'A1",'#13#10'"} '#9'c #276389",'#13#10'"| '#9'c #B1BEC8",'#13#10'"1 '#9'c #8' + +'98989",'#13#10'"2 '#9'c #6B6B6B",'#13#10'"3 '#9'c #424242",'#13#10'"4 '#9'c' + +' #557890",'#13#10'"5 '#9'c #C0D3DD",'#13#10'"6 '#9'c #65A0BD",'#13#10'"7 '#9 + +'c #5898BA",'#13#10'"8 '#9'c #86ADC6",'#13#10'"9 '#9'c #0C5C8E",'#13#10'"0 ' + +#9'c #105D8E",'#13#10'"a '#9'c #124C75",'#13#10'"b '#9'c #DEDEDF",'#13#10'"c' + +' '#9'c #F6F5F5",'#13#10'"d '#9'c #E2E0DE",'#13#10'"e '#9'c #8F8984",'#13#10 + +'"f '#9'c #3A6382",'#13#10'"g '#9'c #98B2BE",'#13#10'"h '#9'c #88B2C8",'#13 + +#10'"i '#9'c #2478A3",'#13#10'"j '#9'c #136898",'#13#10'"k '#9'c #0D5E91",' + +#13#10'"l '#9'c #0C5C8F",'#13#10'"m '#9'c #0D5C8F",'#13#10'"n '#9'c #0E5E91"' + +','#13#10'"o '#9'c #0D4D7A",'#13#10'"p '#9'c #6E8699",'#13#10'"q '#9'c #ECEC' + +'EA",'#13#10'"r '#9'c #F4F0EC",'#13#10'"s '#9'c #E7E0D9",'#13#10'"t '#9'c #B' + +'EB6AF",'#13#10'"u '#9'c #3A6585",'#13#10'"v '#9'c #8AABBC",'#13#10'"w '#9'c' + +' #508FB0",'#13#10'"x '#9'c #136A99",'#13#10'"y '#9'c #9CBDD2",'#13#10'"z '#9 + +'c #8CB2CA",'#13#10'"A '#9'c #0E5E90",'#13#10'"B '#9'c #0C4774",'#13#10'"C ' + +#9'c #5A7285",'#13#10'"D '#9'c #D3D0CC",'#13#10'"E '#9'c #F3EDE3",'#13#10'"F' + +' '#9'c #EEE7DC",'#13#10'"G '#9'c #BCAE97",'#13#10'"H '#9'c #374C5C",'#13#10 + +'"I '#9'c #6891A9",'#13#10'"J '#9'c #387DA2",'#13#10'"K '#9'c #0D6092",'#13 + +#10'"L '#9'c #0D5E90",'#13#10'"M '#9'c #0E5D90",'#13#10'"N '#9'c #0E5C8E",' + +#13#10'"O '#9'c #0A3E68",'#13#10'"P '#9'c #5A6B78",'#13#10'"Q '#9'c #CCC8C0"' + +','#13#10'"R '#9'c #F3EBDC",'#13#10'"S '#9'c #ECE2D4",'#13#10'"T '#9'c #2D52' + +'66",'#13#10'"U '#9'c #2E6F96",'#13#10'"V '#9'c #0D5A8C",'#13#10'"W '#9'c #1' + +'25D8D",'#13#10'"X '#9'c #8BADC5",'#13#10'"Y '#9'c #0D5486",'#13#10'"Z '#9'c' + +' #0E4E7B",'#13#10'"` '#9'c #072F50",'#13#10'" .'#9'c #84898A",'#13#10'"..'#9 + +'c #CAC4BA",'#13#10'"+.'#9'c #F1E6D4",'#13#10'"@.'#9'c #ECDFCA",'#13#10'"#.' + +#9'c #BCAB90",'#13#10'"$.'#9'c #18272F",'#13#10'"%.'#9'c #144C74",'#13#10'"&' + +'.'#9'c #0E4E7E",'#13#10'"*.'#9'c #C0CFDB",'#13#10'"=.'#9'c #DCE4EB",'#13#10 + +'"-.'#9'c #B0C1D1",'#13#10'";.'#9'c #547897",'#13#10'">.'#9'c #083055",'#13 + +#10'",.'#9'c #3A4B58",'#13#10'"''.'#9'c #A5A098",'#13#10'").'#9'c #D6CDBE",' + +#13#10'"!.'#9'c #EEE0CA",'#13#10'"~.'#9'c #ECDBC2",'#13#10'"{.'#9'c #BCA88A"' + +','#13#10'"].'#9'c #131F2B",'#13#10'"^.'#9'c #08355D",'#13#10'"/.'#9'c #063A' + +'66",'#13#10'"(.'#9'c #093B66",'#13#10'"_.'#9'c #06335E",'#13#10'":.'#9'c #0' + +'6274C",'#13#10'"<.'#9'c #2A3139",'#13#10'"[.'#9'c #A29C94",'#13#10'"}.'#9'c' + ,' #BEB5A8",'#13#10'"|.'#9'c #E7DBC6",'#13#10'"1.'#9'c #ECDCC1",'#13#10'"2.'#9 + +'c #E9D6BA",'#13#10'"3.'#9'c #BCA685",'#13#10'"4.'#9'c #262626",'#13#10'"5.' + +#9'c #020A12",'#13#10'"6.'#9'c #031425",'#13#10'"7.'#9'c #031423",'#13#10'"8' + +'.'#9'c #4D4D4C",'#13#10'"9.'#9'c #A09B93",'#13#10'"0.'#9'c #BCB4A6",'#13#10 + +'"a.'#9'c #E3D6C2",'#13#10'"b.'#9'c #ECDAC0",'#13#10'"c.'#9'c #E9D6B9",'#13 + +#10'"d.'#9'c #E7D1B0",'#13#10'"e.'#9'c #BCA37F",'#13#10'"f.'#9'c #A3A19F",' + +#13#10'"g.'#9'c #AEA9A2",'#13#10'"h.'#9'c #B0AAA0",'#13#10'"i.'#9'c #C8BEAF"' + +','#13#10'"j.'#9'c #E4D6C2",'#13#10'"k.'#9'c #ECDABF",'#13#10'"l.'#9'c #E9D6' + +'B8",'#13#10'"m.'#9'c #E5CCA7",'#13#10'"n.'#9'c #BCA178",'#13#10'"o.'#9'c #C' + +'6C1B6",'#13#10'"p.'#9'c #C4BDAC",'#13#10'"q.'#9'c #C3B8A3",'#13#10'"r.'#9'c' + +' #C2B39A",'#13#10'"s.'#9'c #C0AF91",'#13#10'"t.'#9'c #BFAA88",'#13#10'"u.'#9 + +'c #BEA57F",'#13#10'"v.'#9'c #BDA076",'#13#10'"w.'#9'c #BC9E73",'#13#10'" ' + +' . . . . . . . . . ",'#13#10'" . + + + + + @ . # . ' + +' ",'#13#10'" $ % & * * * = - * # . ",'#13#10'" ; > , ' + +''' ) ! * ~ { ] * # ^ ",'#13#10'" / ( _ : < [ } | * 1 { 2 3 ^ ",' + +#13#10'" 4 5 6 7 * 8 9 0 a b c d @ e ^ ",'#13#10'"f g h i j k l m n o p' + +' q r s t ^ ",'#13#10'"u v w x y * z A A B C D E F G ^ ",'#13#10'"H ' + +'I J K L * 8 M N O P Q R S G ^ ",'#13#10'"u T U V W * X Y Z ` ...+.@.#.' + +'^ ",'#13#10'" $.%.&.*.=.-.;.>.,.''.).!.~.{.^ ",'#13#10'" ].^./.' + +'(._.:.<.[.}.|.1.2.3.^ ",'#13#10'" 4.5.6.7.8.9.0.a.b.c.d.e.^ ",' + +#13#10'" . f.g.h.i.j.k.l.d.m.n.^ ",'#13#10'" . o.o.p.q.r.s' + +'.t.u.v.w.^ ",'#13#10'" . ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ",'#13#10'" ' + +' ",'#13#10'" ' + +' "};'#13#10#228#1#0#0'/* XPM */'#13#10'static char * pkg_inherited_xpm' + +'[] = {'#13#10'"17 17 3 1",'#13#10'" '#9'c None",'#13#10'".'#9'c #FFFFFF",' + +#13#10'"+'#9'c #000000",'#13#10'" . +. ",'#13#10'" .+. +. ' + +' ",'#13#10'" .+ +. +. ",'#13#10'".+ +. +. ",'#13#10'".+ . ' + +'+. +. ",'#13#10'"+. +. +. +. ",'#13#10'" +. +. +. +. ",'#13#10 + +'" +. +. +. +. ",'#13#10'" +. +. +. +. ",'#13#10'" +. +. . +. "' + +','#13#10'" +. +..+ .+ ",'#13#10'" +. ++ .+ ",'#13#10'" +.' + +' .+ ",'#13#10'" +. .+ ",'#13#10'" +.....+ ",'#13#10'"' + +' ++++++ ",'#13#10'" "};'#13#10'8'#7#0#0'/* XPM */' + +#13#10'static char * pkg_text_xpm[] = {'#13#10'"18 18 86 1",'#13#10'" '#9'c ' + +'None",'#13#10'".'#9'c #585858",'#13#10'"+'#9'c #DEDEDE",'#13#10'"@'#9'c #BC' + +'B7B1",'#13#10'"#'#9'c #999999",'#13#10'"$'#9'c #FFFFFF",'#13#10'"%'#9'c #EA' + +'EAEA",'#13#10'"&'#9'c #6D6D6D",'#13#10'"*'#9'c #FCFCFC",'#13#10'"='#9'c #70' + +'7070",'#13#10'"-'#9'c #CECECE",'#13#10'";'#9'c #303030",'#13#10'">'#9'c #9B' + +'9B9B",'#13#10'",'#9'c #898989",'#13#10'"'''#9'c #6B6B6B",'#13#10'")'#9'c #4' + +'24242",'#13#10'"!'#9'c #F6F5F5",'#13#10'"~'#9'c #E2E0DE",'#13#10'"{'#9'c #8' + +'F8984",'#13#10'"]'#9'c #FBF9F6",'#13#10'"^'#9'c #F4F0EC",'#13#10'"/'#9'c #E' + +'7E0D9",'#13#10'"('#9'c #BEB6AF",'#13#10'"_'#9'c #DFDFDF",'#13#10'":'#9'c #F' + +'EFEFE",'#13#10'"<'#9'c #FBF8F5",'#13#10'"['#9'c #F8F4ED",'#13#10'"}'#9'c #F' + +'3EDE3",'#13#10'"|'#9'c #EEE7DC",'#13#10'"1'#9'c #BCAE97",'#13#10'"2'#9'c #9' + +'A9A9A",'#13#10'"3'#9'c #989794",'#13#10'"4'#9'c #97948F",'#13#10'"5'#9'c #9' + +'5918B",'#13#10'"6'#9'c #948F86",'#13#10'"7'#9'c #ECE2D4",'#13#10'"8'#9'c #F' + +'DFDFC",'#13#10'"9'#9'c #FAF8F4",'#13#10'"0'#9'c #F8F3EB",'#13#10'"a'#9'c #F' + +'5EEE4",'#13#10'"b'#9'c #F3EADC",'#13#10'"c'#9'c #F1E6D4",'#13#10'"d'#9'c #E' + +'CDFCA",'#13#10'"e'#9'c #BCAB90",'#13#10'"f'#9'c #FCFCFB",'#13#10'"g'#9'c #9' + +'5918A",'#13#10'"h'#9'c #948E85",'#13#10'"i'#9'c #928B80",'#13#10'"j'#9'c #9' + +'1887B",'#13#10'"k'#9'c #ECDBC2",'#13#10'"l'#9'c #BCA88A",'#13#10'"m'#9'c #F' + +'AF6F2",'#13#10'"n'#9'c #F8F2EA",'#13#10'"o'#9'c #F5EEE2",'#13#10'"p'#9'c #F' + +'2E9DA",'#13#10'"q'#9'c #F0E4D2",'#13#10'"r'#9'c #EEE0C9",'#13#10'"s'#9'c #E' + +'CDCC1",'#13#10'"t'#9'c #E9D6BA",'#13#10'"u'#9'c #BCA685",'#13#10'"v'#9'c #F' + +'7F1E9",'#13#10'"w'#9'c #949089",'#13#10'"x'#9'c #938D84",'#13#10'"y'#9'c #9' + +'28B7F",'#13#10'"z'#9'c #91887A",'#13#10'"A'#9'c #8F8575",'#13#10'"B'#9'c #8' + +'E8270",'#13#10'"C'#9'c #E7D1B0",'#13#10'"D'#9'c #BCA37F",'#13#10'"E'#9'c #F' + +'4EDE1",'#13#10'"F'#9'c #F2E8D8",'#13#10'"G'#9'c #F0E4D0",'#13#10'"H'#9'c #E' + +'EDEC8",'#13#10'"I'#9'c #ECDABF",'#13#10'"J'#9'c #E9D6B8",'#13#10'"K'#9'c #E' + +'5CCA7",'#13#10'"L'#9'c #BCA178",'#13#10'"M'#9'c #C6C1B6",'#13#10'"N'#9'c #C' + +'4BDAC",'#13#10'"O'#9'c #C3B8A3",'#13#10'"P'#9'c #C2B39A",'#13#10'"Q'#9'c #C' + +'0AF91",'#13#10'"R'#9'c #BFAA88",'#13#10'"S'#9'c #BEA57F",'#13#10'"T'#9'c #B' + +'DA076",'#13#10'"U'#9'c #BC9E73",'#13#10'" ......... ",'#13#10'" .' + +'+++++@.#. ",'#13#10'" .+$$$$%&$#. ",'#13#10'" .+$$$$*=-$#; ",' + +#13#10'" .+$>>>$,=''); ",'#13#10'" .+$$$$$!~@{; ",'#13#10'" .+$>>' + ,'>>]^/(; ",'#13#10'" ._$$$:<[}|1; ",'#13#10'" .+$>2345671; ",'#13#10 + +'" .+$890abcde; ",'#13#10'" .+f34ghijkl; ",'#13#10'" .+mnopqrstu;' + +' ",'#13#10'" .+vwxyzABCD; ",'#13#10'" .+EFGHIJCKL; ",'#13#10'" ' + +'.MMNOPQRSTU; ",'#13#10'" .;;;;;;;;;;; ",'#13#10'" ",' + +#13#10'" "};'#13#10#182#9#0#0'/* XPM */'#13#10'static char ' + +'* ce_type_xpm[] = {'#13#10'"16 16 108 2",'#13#10'" '#9'c None",'#13#10'". ' + +#9'c #2D1D1F",'#13#10'"+ '#9'c #49262A",'#13#10'"@ '#9'c #562A2C",'#13#10'"#' + +' '#9'c #6F3032",'#13#10'"$ '#9'c #802E33",'#13#10'"% '#9'c #8C282D",'#13#10 + +'"& '#9'c #4A0C0C",'#13#10'"* '#9'c #554446",'#13#10'"= '#9'c #C6878F",'#13 + +#10'"- '#9'c #B9575C",'#13#10'"; '#9'c #A73B44",'#13#10'"> '#9'c #9E3438",' + +#13#10'", '#9'c #982B2E",'#13#10'"'' '#9'c #932129",'#13#10'") '#9'c #851E25' + +'",'#13#10'"! '#9'c #7E161C",'#13#10'"~ '#9'c #680C10",'#13#10'"{ '#9'c #1B0' + +'102",'#13#10'"] '#9'c #633E42",'#13#10'"^ '#9'c #D1868A",'#13#10'"/ '#9'c #' + +'D68A93",'#13#10'"( '#9'c #BF5A60",'#13#10'"_ '#9'c #A53C43",'#13#10'": '#9 + +'c #9E343D",'#13#10'"< '#9'c #952D36",'#13#10'"[ '#9'c #8D242A",'#13#10'"} ' + +#9'c #881A21",'#13#10'"| '#9'c #7F1216",'#13#10'"1 '#9'c #740C0C",'#13#10'"2' + +' '#9'c #390305",'#13#10'"3 '#9'c #392325",'#13#10'"4 '#9'c #CF8489",'#13#10 + +'"5 '#9'c #D2868B",'#13#10'"6 '#9'c #D39698",'#13#10'"7 '#9'c #C1616A",'#13 + +#10'"8 '#9'c #A53C47",'#13#10'"9 '#9'c #9C3134",'#13#10'"0 '#9'c #96282C",' + +#13#10'"a '#9'c #901F26",'#13#10'"b '#9'c #821C21",'#13#10'"c '#9'c #7B1419"' + +','#13#10'"d '#9'c #750B10",'#13#10'"e '#9'c #4F0607",'#13#10'"f '#9'c #0C00' + +'00",'#13#10'"g '#9'c #472A2D",'#13#10'"h '#9'c #CF8487",'#13#10'"i '#9'c #D' + +'08488",'#13#10'"j '#9'c #D19190",'#13#10'"k '#9'c #C0716F",'#13#10'"l '#9'c' + +' #A53D45",'#13#10'"m '#9'c #9B323B",'#13#10'"n '#9'c #922A32",'#13#10'"o '#9 + +'c #8A2128",'#13#10'"p '#9'c #85161C",'#13#10'"q '#9'c #7F1415",'#13#10'"r ' + +#9'c #7C2122",'#13#10'"s '#9'c #692426",'#13#10'"t '#9'c #0E0505",'#13#10'"u' + +' '#9'c #462628",'#13#10'"v '#9'c #CE8484",'#13#10'"w '#9'c #CE8685",'#13#10 + +'"x '#9'c #CF8C8E",'#13#10'"y '#9'c #C8767F",'#13#10'"z '#9'c #A54249",'#13 + +#10'"A '#9'c #9A3034",'#13#10'"B '#9'c #953539",'#13#10'"C '#9'c #73292C",' + +#13#10'"D '#9'c #6A4141",'#13#10'"E '#9'c #68575A",'#13#10'"F '#9'c #6A6868"' + +','#13#10'"G '#9'c #362222",'#13#10'"H '#9'c #CA7E87",'#13#10'"I '#9'c #D27C' + +'85",'#13#10'"J '#9'c #CB7E7E",'#13#10'"K '#9'c #A5676A",'#13#10'"L '#9'c #4' + +'A3134",'#13#10'"M '#9'c #3F3939",'#13#10'"N '#9'c #676767",'#13#10'"O '#9'c' + +' #828282",'#13#10'"P '#9'c #9F9F9F",'#13#10'"Q '#9'c #A2A2A2",'#13#10'"R '#9 + +'c #080808",'#13#10'"S '#9'c #341E1E",'#13#10'"T '#9'c #C87C83",'#13#10'"U ' + +#9'c #CC8088",'#13#10'"V '#9'c #785254",'#13#10'"W '#9'c #4E514F",'#13#10'"X' + +' '#9'c #666967",'#13#10'"Y '#9'c #8D8E8D",'#13#10'"Z '#9'c #A6A6A6",'#13#10 + +'"` '#9'c #A29696",'#13#10'" .'#9'c #865A5A",'#13#10'"..'#9'c #300E0E",'#13 + +#10'"+.'#9'c #2A191A",'#13#10'"@.'#9'c #C27788",'#13#10'"#.'#9'c #805358",' + +#13#10'"$.'#9'c #707070",'#13#10'"%.'#9'c #7F807F",'#13#10'"&.'#9'c #64635C"' + +','#13#10'"*.'#9'c #40312D",'#13#10'"=.'#9'c #100000",'#13#10'"-.'#9'c #0600' + +'00",'#13#10'";.'#9'c #291618",'#13#10'">.'#9'c #683F40",'#13#10'",.'#9'c #2' + +'A2A2A",'#13#10'"''.'#9'c #060201",'#13#10'").'#9'c #140301",'#13#10'" ' + +' ",'#13#10'" ",'#13 + +#10'" ",'#13#10'" . + @ # $ % & ' + +' ",'#13#10'"* = - ; > , '' ) ! ~ { ",'#13#10'"] ^ / ( _ : < [ ' + +'} | 1 2 ",'#13#10'"3 4 5 6 7 8 9 0 a b c d e f ",'#13#10'" g h' + +' i j k l m n o p q r s t ",'#13#10'" u v w x y z A B C D E F ",'#13 + +#10'" G H I J K L M N O P Q R ",'#13#10'" S T U V W X Y Z ` .' + +'.. ",'#13#10'" +.@.#.$.%.&.*.=.-. ",'#13#10'" ;.>.,' + +'.''.). ",'#13#10'" ",'#13#10'" ' + +' ",'#13#10'" "};' + +#13#10'v'#10#0#0'/* XPM */'#13#10'static char * ce_interface_xpm[] = {'#13#10 + +'"16 16 119 2",'#13#10'" '#9'c None",'#13#10'". '#9'c #999999",'#13#10'"+ ' + +#9'c #9A9A9A",'#13#10'"@ '#9'c #9B9B9B",'#13#10'"# '#9'c #9C9C9C",'#13#10'"$' + +' '#9'c #9D9D9D",'#13#10'"% '#9'c #9E9E9E",'#13#10'"& '#9'c #9F9F9F",'#13#10 + +'"* '#9'c #A0A0A0",'#13#10'"= '#9'c #353535",'#13#10'"- '#9'c #E8E8E8",'#13 + +#10'"; '#9'c #E9E9E9",'#13#10'"> '#9'c #EAEAEA",'#13#10'", '#9'c #EBEBEB",' + +#13#10'"'' '#9'c #D4D4D4",'#13#10'") '#9'c #DADADA",'#13#10'"! '#9'c #DCDCDC' + +'",'#13#10'"~ '#9'c #C2C2BF",'#13#10'"{ '#9'c #F1F1F1",'#13#10'"] '#9'c #F2F' + +'2F2",'#13#10'"^ '#9'c #515151",'#13#10'"/ '#9'c #C7C7C7",'#13#10'"( '#9'c #' + +'D5D5D5",'#13#10'"_ '#9'c #AAA25A",'#13#10'": '#9'c #AD9F61",'#13#10'"< '#9 + +'c #A98922",'#13#10'"[ '#9'c #CEB431",'#13#10'"} '#9'c #B4B19C",'#13#10'"| ' + +#9'c #F4F4F4",'#13#10'"1 '#9'c #EDEDED",'#13#10'"2 '#9'c #C3C3C0",'#13#10'"3' + ,' '#9'c #C2BB84",'#13#10'"4 '#9'c #BDA14D",'#13#10'"5 '#9'c #FCF27E",'#13#10 + +'"6 '#9'c #F5EA5F",'#13#10'"7 '#9'c #F7EB6F",'#13#10'"8 '#9'c #F1DC1B",'#13 + +#10'"9 '#9'c #ACA87B",'#13#10'"0 '#9'c #F6F6F6",'#13#10'"a '#9'c #525252",' + +#13#10'"b '#9'c #EFEFEF",'#13#10'"c '#9'c #AFAFAB",'#13#10'"d '#9'c #F1E8A1"' + +','#13#10'"e '#9'c #F9F28D",'#13#10'"f '#9'c #F4DB6C",'#13#10'"g '#9'c #F0C6' + +'41",'#13#10'"h '#9'c #EEBC1F",'#13#10'"i '#9'c #F2CE1C",'#13#10'"j '#9'c #A' + +'FAC8E",'#13#10'"k '#9'c #F8F8F8",'#13#10'"l '#9'c #535353",'#13#10'"m '#9'c' + +' #B7B6B4",'#13#10'"n '#9'c #E9D065",'#13#10'"o '#9'c #F3D464",'#13#10'"p '#9 + +'c #EBBC2B",'#13#10'"q '#9'c #EECB4A",'#13#10'"r '#9'c #EECA32",'#13#10'"s ' + +#9'c #ECCB08",'#13#10'"t '#9'c #A89735",'#13#10'"u '#9'c #FAFAFA",'#13#10'"v' + +' '#9'c #F3F3F3",'#13#10'"w '#9'c #A59665",'#13#10'"x '#9'c #F8E87E",'#13#10 + +'"y '#9'c #F2D44D",'#13#10'"z '#9'c #F5DF73",'#13#10'"A '#9'c #F9E76A",'#13 + +#10'"B '#9'c #F4D42D",'#13#10'"C '#9'c #F2DA3E",'#13#10'"D '#9'c #A18603",' + +#13#10'"E '#9'c #FCFCFC",'#13#10'"F '#9'c #545454",'#13#10'"G '#9'c #F5F5F5"' + +','#13#10'"H '#9'c #A78F41",'#13#10'"I '#9'c #F9EF93",'#13#10'"J '#9'c #F1D7' + +'45",'#13#10'"K '#9'c #F9E65E",'#13#10'"L '#9'c #FDF480",'#13#10'"M '#9'c #E' + +'AB818",'#13#10'"N '#9'c #F4D850",'#13#10'"O '#9'c #A07C08",'#13#10'"P '#9'c' + +' #FEFEFE",'#13#10'"Q '#9'c #F7F7F7",'#13#10'"R '#9'c #A7954F",'#13#10'"S '#9 + +'c #F3D958",'#13#10'"T '#9'c #F5E35D",'#13#10'"U '#9'c #F4D945",'#13#10'"V ' + +#9'c #F5D945",'#13#10'"W '#9'c #F1CB3D",'#13#10'"X '#9'c #ECB808",'#13#10'"Y' + +' '#9'c #A38843",'#13#10'"Z '#9'c #F9F9F9",'#13#10'"` '#9'c #A69D78",'#13#10 + +'" .'#9'c #F4E338",'#13#10'"..'#9'c #ECB904",'#13#10'"+.'#9'c #EEBE1B",'#13 + +#10'"@.'#9'c #EDB80C",'#13#10'"#.'#9'c #EDBD08",'#13#10'"$.'#9'c #C79805",' + +#13#10'"%.'#9'c #CDCAC4",'#13#10'"&.'#9'c #FBFBFB",'#13#10'"*.'#9'c #AA9F35"' + +','#13#10'"=.'#9'c #EDCD00",'#13#10'"-.'#9'c #F0CA17",'#13#10'";.'#9'c #F0C9' + +'19",'#13#10'">.'#9'c #C49D1D",'#13#10'",.'#9'c #C8C1B0",'#13#10'"''.'#9'c #' + +'474747",'#13#10'").'#9'c #FDFDFD",'#13#10'"!.'#9'c #F0F0F0",'#13#10'"~.'#9 + +'c #ADA88D",'#13#10'"{.'#9'c #AE9946",'#13#10'"].'#9'c #A58524",'#13#10'"^.' + +#9'c #DCDBD7",'#13#10'"/.'#9'c #CDCDCD",'#13#10'"(.'#9'c #C9C9C9",'#13#10'"_' + +'.'#9'c #5C5C5C",'#13#10'":.'#9'c #BEBEBE",'#13#10'"<.'#9'c #BDBDBD",'#13#10 + +'"[.'#9'c #464C51",'#13#10'" ",'#13#10'" ' + +' . + @ @ # $ % & & * = ",'#13#10'" - ; > , '' ) ! ~ { ] ^ ",' + +#13#10'" > , / ( _ : < [ } | ^ ",'#13#10'" 1 2 3 4 5 6 7 8 9 0' + +' a ",'#13#10'" b c d e f g h i j k l ",'#13#10'" { m n o ' + +'p q r s t u l ",'#13#10'" v w x y z A B C D E F ",'#13#10'" ' + +' G H I J K L M N O P F ",'#13#10'" Q R S T U V W X Y P F ",' + +#13#10'" Z ` ...+.@.#.$.%.P F ",'#13#10'" &.1 *.=.-.;.>.,.P P' + +' ''. ",'#13#10'" ).P !.~.{.].^.P G /. ",'#13#10'" P P P P' + +' P P P P (._. ",'#13#10'" :.:.:.:.:.:.<.# [. ",'#13#10'" ' + +' "};'#13#10#173#6#0#0'/* XPM */'#13#10'static ' + +'char * ce_property_xpm[] = {'#13#10'"16 16 82 1",'#13#10'" '#9'c None",'#13 + +#10'".'#9'c #999999",'#13#10'"+'#9'c #9A9A9A",'#13#10'"@'#9'c #9B9B9B",'#13 + +#10'"#'#9'c #9C9C9C",'#13#10'"$'#9'c #9D9D9D",'#13#10'"%'#9'c #9E9E9E",'#13 + +#10'"&'#9'c #9F9F9F",'#13#10'"*'#9'c #A0A0A0",'#13#10'"='#9'c #353535",'#13 + +#10'"-'#9'c #E8E8E8",'#13#10'";'#9'c #E9E9E9",'#13#10'">'#9'c #EAEAEA",'#13 + +#10'",'#9'c #EBEBEB",'#13#10'"'''#9'c #ECECEC",'#13#10'")'#9'c #EEEEEE",'#13 + +#10'"!'#9'c #EFEFEF",'#13#10'"~'#9'c #F0F0F0",'#13#10'"{'#9'c #F1F1F1",'#13 + +#10'"]'#9'c #F2F2F2",'#13#10'"^'#9'c #515151",'#13#10'"/'#9'c #EDEDED",'#13 + +#10'"('#9'c #E3E3E3",'#13#10'"_'#9'c #C3C3C3",'#13#10'":'#9'c #F3F3F3",'#13 + +#10'"<'#9'c #F4F4F4",'#13#10'"['#9'c #E6E6E6",'#13#10'"}'#9'c #868686",'#13 + +#10'"|'#9'c #BABABA",'#13#10'"1'#9'c #787878",'#13#10'"2'#9'c #939393",'#13 + +#10'"3'#9'c #F6F6F6",'#13#10'"4'#9'c #525252",'#13#10'"5'#9'c #A2A2A2",'#13 + +#10'"6'#9'c #989898",'#13#10'"7'#9'c #8E8E8E",'#13#10'"8'#9'c #D0D0D0",'#13 + +#10'"9'#9'c #C1C1C1",'#13#10'"0'#9'c #A9A9A9",'#13#10'"a'#9'c #F8F8F8",'#13 + +#10'"b'#9'c #535353",'#13#10'"c'#9'c #898989",'#13#10'"d'#9'c #E1E1E1",'#13 + +#10'"e'#9'c #E0E0E0",'#13#10'"f'#9'c #D8D8D8",'#13#10'"g'#9'c #BDBDBD",'#13 + +#10'"h'#9'c #787877",'#13#10'"i'#9'c #FAFAFA",'#13#10'"j'#9'c #D7D7D7",'#13 + +#10'"k'#9'c #BCBCBC",'#13#10'"l'#9'c #A5A5A5",'#13#10'"m'#9'c #CFCFCF",'#13 + +#10'"n'#9'c #838383",'#13#10'"o'#9'c #FCFCFC",'#13#10'"p'#9'c #545454",'#13 + +#10'"q'#9'c #F5F5F5",'#13#10'"r'#9'c #ACACAC",'#13#10'"s'#9'c #A3A3A3",'#13 + +#10'"t'#9'c #727272",'#13#10'"u'#9'c #B5B5B5",'#13#10'"v'#9'c #8F8F8F",'#13 + +#10'"w'#9'c #C7C7C7",'#13#10'"x'#9'c #FEFEFE",'#13#10'"y'#9'c #F7F7F7",'#13 + +#10'"z'#9'c #737373",'#13#10'"A'#9'c #D5D5D5",'#13#10'"B'#9'c #C5C5C5",'#13 + +#10'"C'#9'c #BBBBBB",'#13#10'"D'#9'c #F9F9F9",'#13#10'"E'#9'c #949494",'#13 + ,#10'"F'#9'c #B1B1B1",'#13#10'"G'#9'c #7C7C7C",'#13#10'"H'#9'c #A4A4A4",'#13 + +#10'"I'#9'c #FBFBFB",'#13#10'"J'#9'c #FDFDFD",'#13#10'"K'#9'c #B0B0B0",'#13 + +#10'"L'#9'c #474747",'#13#10'"M'#9'c #CDCDCD",'#13#10'"N'#9'c #C9C9C9",'#13 + +#10'"O'#9'c #5C5C5C",'#13#10'"P'#9'c #BEBEBE",'#13#10'"Q'#9'c #3B3B3B",'#13 + +#10'" ",'#13#10'" .+@@#$%&&*= ",'#13#10'" -;>,'')!~{]^ ' + +'",'#13#10'" >,/)(_{]:<^ ",'#13#10'" /)![}|12:34 ",'#13#10'" !~567<8' + +'90ab ",'#13#10'" {]cdef>ghib ",'#13#10'" :9.jk}lmnop ",'#13#10'" q' + +'rm/stuvwxp ",'#13#10'" y;z9ABk#Cxp ",'#13#10'" Di6lEFGHxxp ",'#13#10 + +'" IoJKH2fxxxL ",'#13#10'" JxxxxxxxqM ",'#13#10'" xxxxxxxxNO ",' + +#13#10'" PPPPPPg#Q ",'#13#10'" "};'#13#10' '#10#0#0'/* X' + +'PM */'#13#10'static char * ce_constant_xpm[] = {'#13#10'"16 16 114 2",'#13 + +#10'" '#9'c None",'#13#10'". '#9'c #6C7A60",'#13#10'"+ '#9'c #6E7C62",'#13 + +#10'"@ '#9'c #322D22",'#13#10'"# '#9'c #606C56",'#13#10'"$ '#9'c #758465",' + +#13#10'"% '#9'c #768565",'#13#10'"& '#9'c #69765F",'#13#10'"* '#9'c #1A1711"' + +','#13#10'"= '#9'c #758464",'#13#10'"- '#9'c #65725C",'#13#10'"; '#9'c #6652' + +'48",'#13#10'"> '#9'c #4D2926",'#13#10'", '#9'c #A35C52",'#13#10'"'' '#9'c #' + +'A2524E",'#13#10'") '#9'c #8F4641",'#13#10'"! '#9'c #764B3A",'#13#10'"~ '#9 + +'c #5C6853",'#13#10'"{ '#9'c #B75E62",'#13#10'"] '#9'c #CC7C7E",'#13#10'"^ ' + +#9'c #C46967",'#13#10'"/ '#9'c #C66A66",'#13#10'"( '#9'c #C56E67",'#13#10'"_' + +' '#9'c #BA5D59",'#13#10'": '#9'c #B04D4D",'#13#10'"< '#9'c #914A41",'#13#10 + +'"[ '#9'c #6A3E2F",'#13#10'"} '#9'c #B86363",'#13#10'"| '#9'c #E7BFBF",'#13 + +#10'"1 '#9'c #DEA5A2",'#13#10'"2 '#9'c #D48480",'#13#10'"3 '#9'c #D17B76",' + +#13#10'"4 '#9'c #C8776D",'#13#10'"5 '#9'c #BB6A5D",'#13#10'"6 '#9'c #B25952"' + +','#13#10'"7 '#9'c #9E4A46",'#13#10'"8 '#9'c #774534",'#13#10'"9 '#9'c #5E3B' + +'28",'#13#10'"0 '#9'c #663531",'#13#10'"a '#9'c #CE8D88",'#13#10'"b '#9'c #E' + +'2B0AE",'#13#10'"c '#9'c #D7938E",'#13#10'"d '#9'c #D28A82",'#13#10'"e '#9'c' + +' #CE7F76",'#13#10'"f '#9'c #C47567",'#13#10'"g '#9'c #B76C5C",'#13#10'"h '#9 + +'c #AB5D51",'#13#10'"i '#9'c #9B4B45",'#13#10'"j '#9'c #7D4939",'#13#10'"k ' + +#9'c #5C3B25",'#13#10'"l '#9'c #945549",'#13#10'"m '#9'c #CD8E87",'#13#10'"n' + +' '#9'c #D2938B",'#13#10'"o '#9'c #CF8B82",'#13#10'"p '#9'c #CB8378",'#13#10 + +'"q '#9'c #C77C6E",'#13#10'"r '#9'c #BC7361",'#13#10'"s '#9'c #B16B58",'#13 + +#10'"t '#9'c #A35F4E",'#13#10'"u '#9'c #925043",'#13#10'"v '#9'c #784734",' + +#13#10'"w '#9'c #593B24",'#13#10'"x '#9'c #835142",'#13#10'"y '#9'c #BD7E71"' + +','#13#10'"z '#9'c #C5867A",'#13#10'"A '#9'c #C47E71",'#13#10'"B '#9'c #C17A' + +'6B",'#13#10'"C '#9'c #BF7663",'#13#10'"D '#9'c #B7725B",'#13#10'"E '#9'c #A' + +'86A53",'#13#10'"F '#9'c #9A604B",'#13#10'"G '#9'c #8A5541",'#13#10'"H '#9'c' + +' #6A442E",'#13#10'"I '#9'c #533821",'#13#10'"J '#9'c #A66A59",'#13#10'"K '#9 + +'c #B37362",'#13#10'"L '#9'c #B77460",'#13#10'"M '#9'c #BA7660",'#13#10'"N ' + +#9'c #B6745B",'#13#10'"O '#9'c #AE6D53",'#13#10'"P '#9'c #9F664C",'#13#10'"Q' + +' '#9'c #8F5C43",'#13#10'"R '#9'c #794D37",'#13#10'"S '#9'c #5B3C25",'#13#10 + +'"T '#9'c #463520",'#13#10'"U '#9'c #8C5C46",'#13#10'"V '#9'c #9E644D",'#13 + +#10'"W '#9'c #A76A51",'#13#10'"X '#9'c #AA6C52",'#13#10'"Y '#9'c #A76C4F",' + +#13#10'"Z '#9'c #9C6649",'#13#10'"` '#9'c #8D5C40",'#13#10'" .'#9'c #7C5339"' + +','#13#10'"..'#9'c #694A32",'#13#10'"+.'#9'c #513922",'#13#10'"@.'#9'c #7A4F' + +'39",'#13#10'"#.'#9'c #8A5940",'#13#10'"$.'#9'c #8B5A3F",'#13#10'"%.'#9'c #8' + +'4553B",'#13#10'"&.'#9'c #7C5137",'#13#10'"*.'#9'c #775033",'#13#10'"=.'#9'c' + +' #6E4D34",'#13#10'"-.'#9'c #5E452C",'#13#10'";.'#9'c #2D2114",'#13#10'">.'#9 + +'c #000000",'#13#10'",.'#9'c #0C0805",'#13#10'"''.'#9'c #503624",'#13#10'").' + +#9'c #6C482F",'#13#10'"!.'#9'c #523621",'#13#10'"~.'#9'c #503621",'#13#10'"{' + +'.'#9'c #65442B",'#13#10'"].'#9'c #60452B",'#13#10'"^.'#9'c #2D2115",'#13#10 + +'"/.'#9'c #050604",'#13#10'" ",'#13#10'" ' + +' ",'#13#10'" . + @ ",'#13 + +#10'" # $ % & * ",'#13#10'" = - ; > , '' ) ! ' + +' ",'#13#10'" ~ { ] ^ / ( _ : < [ ",'#13#10'" } | 1 2 3 ' + +'4 5 6 7 8 9 ",'#13#10'" 0 a b c d e f g h i j k ",'#13#10'" l' + +' m n o p q r s t u v w ",'#13#10'" x y z A B C D E F G H I ",'#13 + +#10'" J K L M N O P Q R S T ",'#13#10'" U V W X Y Z ` ...+. ' + +' ",'#13#10'" @.#.$.%.&.*.=.-.;.>.>. ",'#13#10'" ,.''.).!.' + +'~.{.].^.>.>. ",'#13#10'" /.>.>.>.>.>. ",'#13#10'" ' + +' "};'#13#10#182#12#0#0'/* XPM */'#13#10'static ch' + +'ar * ce_program_xpm[] = {'#13#10'"16 16 153 2",'#13#10'" '#9'c None",'#13 + +#10'". '#9'c #6C6761",'#13#10'"+ '#9'c #E4E4E4",'#13#10'"@ '#9'c #E2E2E2",' + +#13#10'"# '#9'c #C3C3C3",'#13#10'"$ '#9'c #848484",'#13#10'"% '#9'c #6B6660"' + +','#13#10'"& '#9'c #F9F9F9",'#13#10'"* '#9'c #F8F8F8",'#13#10'"= '#9'c #F4F4' + ,'F4",'#13#10'"- '#9'c #B9B9B9",'#13#10'"; '#9'c #B4B4B4",'#13#10'"> '#9'c #A' + +'26B45",'#13#10'", '#9'c #C36841",'#13#10'"'' '#9'c #B4472D",'#13#10'") '#9 + +'c #AF6D75",'#13#10'"! '#9'c #D1C1C9",'#13#10'"~ '#9'c #F3F3F3",'#13#10'"{ ' + +#9'c #B6B6B6",'#13#10'"] '#9'c #F1F1F1",'#13#10'"^ '#9'c #E3AD6F",'#13#10'"/' + +' '#9'c #F4D8C3",'#13#10'"( '#9'c #EEBDA5",'#13#10'"_ '#9'c #DC8574",'#13#10 + +'": '#9'c #C35F77",'#13#10'"< '#9'c #984286",'#13#10'"[ '#9'c #B4A2BB",'#13 + +#10'"} '#9'c #EDEDED",'#13#10'"| '#9'c #C1C1C1",'#13#10'"1 '#9'c #878684",' + +#13#10'"2 '#9'c #787672",'#13#10'"3 '#9'c #61605E",'#13#10'"4 '#9'c #D8AF69"' + +','#13#10'"5 '#9'c #F7E5CC",'#13#10'"6 '#9'c #EBB57F",'#13#10'"7 '#9'c #D860' + +'1C",'#13#10'"8 '#9'c #C43622",'#13#10'"9 '#9'c #B34783",'#13#10'"0 '#9'c #9' + +'953B5",'#13#10'"a '#9'c #584190",'#13#10'"b '#9'c #BBBDC3",'#13#10'"c '#9'c' + +' #EDECEC",'#13#10'"d '#9'c #DCDAD8",'#13#10'"e '#9'c #B9B5AD",'#13#10'"f '#9 + +'c #6C6862",'#13#10'"g '#9'c #EEDBAE",'#13#10'"h '#9'c #EAD09E",'#13#10'"i ' + +#9'c #E29F3C",'#13#10'"j '#9'c #D96205",'#13#10'"k '#9'c #BC3537",'#13#10'"l' + +' '#9'c #9447B2",'#13#10'"m '#9'c #5A58BE",'#13#10'"n '#9'c #3357A0",'#13#10 + +'"o '#9'c #6B7C8F",'#13#10'"p '#9'c #D8D6D2",'#13#10'"q '#9'c #E8E2DB",'#13 + +#10'"r '#9'c #D4CDC2",'#13#10'"s '#9'c #817B70",'#13#10'"t '#9'c #776E39",' + +#13#10'"u '#9'c #E9DFA7",'#13#10'"v '#9'c #E0CF81",'#13#10'"w '#9'c #DBBF59"' + +','#13#10'"x '#9'c #DCA73D",'#13#10'"y '#9'c #705F89",'#13#10'"z '#9'c #2575' + +'C1",'#13#10'"A '#9'c #1080C4",'#13#10'"B '#9'c #0770A5",'#13#10'"C '#9'c #3' + +'8677E",'#13#10'"D '#9'c #C4C0B9",'#13#10'"E '#9'c #E7DFD3",'#13#10'"F '#9'c' + +' #DED5C4",'#13#10'"G '#9'c #8C8375",'#13#10'"H '#9'c #50572E",'#13#10'"I '#9 + +'c #C4D793",'#13#10'"J '#9'c #A2C86F",'#13#10'"K '#9'c #7BBE5F",'#13#10'"L ' + +#9'c #36B460",'#13#10'"M '#9'c #35B7C9",'#13#10'"N '#9'c #1EA8DB",'#13#10'"O' + +' '#9'c #0A98CC",'#13#10'"P '#9'c #03749E",'#13#10'"Q '#9'c #3F636E",'#13#10 + +'"R '#9'c #B9B3AA",'#13#10'"S '#9'c #E3D8C9",'#13#10'"T '#9'c #E5D8C2",'#13 + +#10'"U '#9'c #908573",'#13#10'"V '#9'c #7BBA6C",'#13#10'"W '#9'c #64BE6C",' + +#13#10'"X '#9'c #24B156",'#13#10'"Y '#9'c #24B781",'#13#10'"Z '#9'c #34BCBD"' + +','#13#10'"` '#9'c #3BADD0",'#13#10'" .'#9'c #268DB4",'#13#10'"..'#9'c #115F' + +'7C",'#13#10'"+.'#9'c #717876",'#13#10'"@.'#9'c #BCB3A6",'#13#10'"#.'#9'c #E' + +'3D6C1",'#13#10'"$.'#9'c #E9D8BE",'#13#10'"%.'#9'c #938671",'#13#10'"&.'#9'c' + +' #235E2E",'#13#10'"*.'#9'c #3AB065",'#13#10'"=.'#9'c #2FB474",'#13#10'"-.'#9 + +'c #29B48E",'#13#10'";.'#9'c #2EADA9",'#13#10'">.'#9'c #2F96A8",'#13#10'",.' + +#9'c #266E86",'#13#10'"''.'#9'c #39555E",'#13#10'").'#9'c #9E978C",'#13#10'"' + +'!.'#9'c #C9BEAC",'#13#10'"~.'#9'c #E5D5BD",'#13#10'"{.'#9'c #E7D5B7",'#13#10 + +'"].'#9'c #988770",'#13#10'"^.'#9'c #0A4023",'#13#10'"/.'#9'c #1F7A56",'#13 + +#10'"(.'#9'c #248871",'#13#10'"_.'#9'c #217B76",'#13#10'":.'#9'c #1A5A60",' + +#13#10'"<.'#9'c #445A5C",'#13#10'"[.'#9'c #978F85",'#13#10'"}.'#9'c #B7AD9D"' + +','#13#10'"|.'#9'c #DACBB4",'#13#10'"1.'#9'c #E6D3B6",'#13#10'"2.'#9'c #E5D0' + +'AE",'#13#10'"3.'#9'c #99876D",'#13#10'"4.'#9'c #42413E",'#13#10'"5.'#9'c #7' + +'D928B",'#13#10'"6.'#9'c #707F7A",'#13#10'"7.'#9'c #97928A",'#13#10'"8.'#9'c' + +' #A69E93",'#13#10'"9.'#9'c #BBB0A0",'#13#10'"0.'#9'c #D6C7B0",'#13#10'"a.'#9 + +'c #E4D1B4",'#13#10'"b.'#9'c #E5CFAE",'#13#10'"c.'#9'c #E2CAA5",'#13#10'"d.' + +#9'c #988468",'#13#10'"e.'#9'c #52504C",'#13#10'"f.'#9'c #D9D4CD",'#13#10'"g' + +'.'#9'c #CCC5BB",'#13#10'"h.'#9'c #CAC1B3",'#13#10'"i.'#9'c #D3C7B4",'#13#10 + +'"j.'#9'c #DDCFB7",'#13#10'"k.'#9'c #E5D2B5",'#13#10'"l.'#9'c #E1C59D",'#13 + +#10'"m.'#9'c #978365",'#13#10'"n.'#9'c #43403C",'#13#10'"o.'#9'c #9D968D",' + +#13#10'"p.'#9'c #999186",'#13#10'"q.'#9'c #988F80",'#13#10'"r.'#9'c #998E7C"' + +','#13#10'"s.'#9'c #9A8C78",'#13#10'"t.'#9'c #9B8B72",'#13#10'"u.'#9'c #9A88' + +'6D",'#13#10'"v.'#9'c #70614B",'#13#10'" ",' + +#13#10'" . + + + + @ # $ ",'#13#10'" % & * * & & = - ;' + +' ",'#13#10'" > , '' ) ! ~ & { ] { ",'#13#10'" ^ / ( _' + +' : < [ } | 1 2 3 ",'#13#10'" 4 5 6 7 8 9 0 a b c d e f ",'#13#10'" ' + +' g h i j k l m n o p q r s ",'#13#10'" t u v w x y z A B C D E F G ",' + +#13#10'" H I J K L M N O P Q R S T U ",'#13#10'" V W X Y Z ` ...+.@.#' + +'.$.%. ",'#13#10'" &.*.=.-.;.>.,.''.).!.~.{.]. ",'#13#10'" ^./.(._' + +'.:.<.[.}.|.1.2.3. ",'#13#10'" 4.5.6.7.8.9.0.a.b.c.d. ",'#13#10'" ' + +' e.f.g.h.i.j.k.b.c.l.m. ",'#13#10'" n.o.p.q.r.s.t.u.d.m.v. ",' + +#13#10'" "};'#13#10'~'#2#0#0'/* XPM */'#13#10 + +'static char * ce_procedure_xpm[] = {'#13#10'"16 16 15 1",'#13#10'" '#9'c No' + +'ne",'#13#10'".'#9'c #3A3A3A",'#13#10'"+'#9'c #919191",'#13#10'"@'#9'c #8B8B' + +'8B",'#13#10'"#'#9'c #CCCCCC",'#13#10'"$'#9'c #D5D5D5",'#13#10'"%'#9'c #ADAD' + +'AD",'#13#10'"&'#9'c #C4C4C4",'#13#10'"*'#9'c #B4B4B4",'#13#10'"='#9'c #A1A1' + +'A1",'#13#10'"-'#9'c #989898",'#13#10'";'#9'c #A2A2A2",'#13#10'">'#9'c #C6C6' + ,'C6",'#13#10'",'#9'c #D8D8D8",'#13#10'"'''#9'c #4C4C4C",'#13#10'" .... ' + +' ",'#13#10'" .. .++. .. ",'#13#10'" .@..#$$#..@. ",'#13#10'" .@%&' + +'*=--=*&%@. ",'#13#10'" ..&;@>,,>@;&.. ",'#13#10'" .*=>*''''*>=*. ",'#13#10 + +'"..#=>*. .*>=#..",'#13#10'".+$-,'' '',-$+.",'#13#10'".+$-,'' '',-$+.' + +'",'#13#10'"..#=>*. .*>=#..",'#13#10'" .*=>*''''*>=*. ",'#13#10'" ..&;@>,' + +',>@;&.. ",'#13#10'" .@%&*=--=*&%@. ",'#13#10'" .@..#$$#..@. ",'#13#10'" ' + +' .. .++. .. ",'#13#10'" .... "};'#13#10#0#0#0 +]); diff --git a/wst/trunk/type_lib_edtr/udm.pas b/wst/trunk/type_lib_edtr/udm.pas new file mode 100644 index 000000000..0cfa0f740 --- /dev/null +++ b/wst/trunk/type_lib_edtr/udm.pas @@ -0,0 +1,31 @@ +unit udm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Dialogs; + +type + + { TDM } + + TDM = class(TDataModule) + IM: TImageList; + private + { private declarations } + public + { public declarations } + end; + +var + DM: TDM; + +implementation + +initialization + {$I udm.lrs} + +end. + diff --git a/wst/trunk/type_lib_edtr/ufclassedit.lfm b/wst/trunk/type_lib_edtr/ufclassedit.lfm new file mode 100644 index 000000000..d287821b6 --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufclassedit.lfm @@ -0,0 +1,200 @@ +object fClassEdit: TfClassEdit + Left = 754 + Height = 547 + Top = 162 + Width = 518 + HorzScrollBar.Page = 517 + VertScrollBar.Page = 546 + ActiveControl = Button1 + BorderStyle = bsSizeToolWin + Caption = 'fClassEdit' + ClientHeight = 547 + ClientWidth = 518 + Position = poDesktopCenter + object Panel1: TPanel + Height = 50 + Top = 497 + Width = 518 + Align = alBottom + ClientHeight = 50 + ClientWidth = 518 + TabOrder = 0 + object Button1: TButton + Left = 430 + Height = 25 + Top = 10 + Width = 75 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object Button2: TButton + Left = 340 + Height = 25 + Top = 10 + Width = 75 + Action = actOK + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Default = True + TabOrder = 1 + end + end + object PC: TPageControl + Height = 497 + Width = 518 + ActivePage = TabSheet1 + Align = alClient + TabIndex = 0 + TabOrder = 1 + object TabSheet1: TTabSheet + Caption = 'Compound Object' + ClientHeight = 471 + ClientWidth = 510 + object Label1: TLabel + Left = 4 + Height = 14 + Top = 18 + Width = 28 + Caption = 'Name' + Color = clNone + ParentColor = False + end + object Label2: TLabel + Left = 4 + Height = 14 + Top = 59 + Width = 67 + Caption = 'Inheritts from' + Color = clNone + ParentColor = False + end + object edtName: TEdit + Left = 92 + Height = 23 + Top = 18 + Width = 406 + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + end + object GroupBox1: TGroupBox + Left = 4 + Height = 312 + Top = 98 + Width = 495 + Anchors = [akTop, akLeft, akRight, akBottom] + Caption = ' Properties ' + ClientHeight = 294 + ClientWidth = 491 + TabOrder = 1 + object edtProp: TListView + Height = 294 + Width = 491 + Align = alClient + BorderWidth = 2 + Columns = < + item + AutoSize = True + Caption = 'Name' + Width = 210 + end + item + Caption = 'Type' + Width = 200 + end + item + Caption = 'Attrbute' + end> + PopupMenu = PopupMenu1 + RowSelect = True + TabOrder = 0 + ViewStyle = vsReport + OnDblClick = edtPropDblClick + end + end + object Button3: TButton + Left = 4 + Height = 25 + Top = 421 + Width = 91 + Action = actPropAdd + BorderSpacing.InnerBorder = 4 + TabOrder = 2 + end + object Button4: TButton + Left = 100 + Height = 25 + Top = 421 + Width = 91 + Action = actPropEdit + BorderSpacing.InnerBorder = 4 + TabOrder = 3 + end + object Button5: TButton + Left = 196 + Height = 25 + Top = 421 + Width = 91 + Action = actPropDelete + BorderSpacing.InnerBorder = 4 + TabOrder = 4 + end + object edtParent: TComboBox + Left = 92 + Height = 21 + Top = 59 + Width = 406 + AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] + MaxLength = 0 + Style = csDropDownList + TabOrder = 5 + end + end + end + object ActionList1: TActionList + left = 275 + top = 147 + object actOK: TAction + Caption = 'OK' + DisableIfNoHandler = True + OnExecute = actOKExecute + OnUpdate = actOKUpdate + end + object actPropAdd: TAction + Caption = 'New Property' + DisableIfNoHandler = True + OnExecute = actPropAddExecute + end + object actPropEdit: TAction + Caption = 'Edit Property' + DisableIfNoHandler = True + OnExecute = actPropEditExecute + OnUpdate = actPropEditUpdate + end + object actPropDelete: TAction + Caption = 'Delete Property' + DisableIfNoHandler = True + OnExecute = actPropDeleteExecute + OnUpdate = actPropEditUpdate + end + end + object PopupMenu1: TPopupMenu + left = 105 + top = 186 + object MenuItem1: TMenuItem + Action = actPropAdd + OnClick = actPropAddExecute + end + object MenuItem2: TMenuItem + Action = actPropEdit + OnClick = actPropEditExecute + end + object MenuItem3: TMenuItem + Action = actPropDelete + OnClick = actPropDeleteExecute + end + end +end diff --git a/wst/trunk/type_lib_edtr/ufclassedit.lrs b/wst/trunk/type_lib_edtr/ufclassedit.lrs new file mode 100644 index 000000000..5c9cdc8ad --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufclassedit.lrs @@ -0,0 +1,56 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TfClassEdit','FORMDATA',[ + 'TPF0'#11'TfClassEdit'#10'fClassEdit'#4'Left'#3#242#2#6'Height'#3'#'#2#3'Top' + +#3#162#0#5'Width'#3#6#2#18'HorzScrollBar.Page'#3#5#2#18'VertScrollBar.Page'#3 + +'"'#2#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeToolWin'#7'C' + +'aption'#6#10'fClassEdit'#12'ClientHeight'#3'#'#2#11'ClientWidth'#3#6#2#8'Po' + +'sition'#7#15'poDesktopCenter'#0#6'TPanel'#6'Panel1'#6'Height'#2'2'#3'Top'#3 + +#241#1#5'Width'#3#6#2#5'Align'#7#8'alBottom'#12'ClientHeight'#2'2'#11'Client' + +'Width'#3#6#2#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4'Left'#3#174#1#6'Heig' + +'ht'#2#25#3'Top'#2#10#5'Width'#2'K'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'B' + +'orderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalRe' + +'sult'#2#2#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3'T'#1#6'Height' + +#2#25#3'Top'#2#10#5'Width'#2'K'#6'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7 + +'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Default'#9#8'TabOrder'#2#1#0 + +#0#0#12'TPageControl'#2'PC'#6'Height'#3#241#1#5'Width'#3#6#2#10'ActivePage'#7 + +#9'TabSheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTa' + +'bSheet'#9'TabSheet1'#7'Caption'#6#15'Compound Object'#12'ClientHeight'#3#215 + +#1#11'ClientWidth'#3#254#1#0#6'TLabel'#6'Label1'#4'Left'#2#4#6'Height'#2#14#3 + +'Top'#2#18#5'Width'#2#28#7'Caption'#6#4'Name'#5'Color'#7#6'clNone'#11'Parent' + +'Color'#8#0#0#6'TLabel'#6'Label2'#4'Left'#2#4#6'Height'#2#14#3'Top'#2';'#5'W' + +'idth'#2'C'#7'Caption'#6#14'Inheritts from'#5'Color'#7#6'clNone'#11'ParentCo' + +'lor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2'\'#6'Height'#2#23#3'Top'#2#18#5'Wi' + +'dth'#3#150#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#0#0 + +#0#9'TGroupBox'#9'GroupBox1'#4'Left'#2#4#6'Height'#3'8'#1#3'Top'#2'b'#5'Widt' + +'h'#3#239#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Capt' + +'ion'#6#14' Properties '#12'ClientHeight'#3'&'#1#11'ClientWidth'#3#235#1#8 + +'TabOrder'#2#1#0#9'TListView'#7'edtProp'#6'Height'#3'&'#1#5'Width'#3#235#1#5 + +'Align'#7#8'alClient'#11'BorderWidth'#2#2#7'Columns'#14#1#8'AutoSize'#9#7'Ca' + +'ption'#6#4'Name'#5'Width'#3#210#0#0#1#7'Caption'#6#4'Type'#5'Width'#3#200#0 + +#0#1#7'Caption'#6#8'Attrbute'#0#0#9'PopupMenu'#7#10'PopupMenu1'#9'RowSelect' + +#9#8'TabOrder'#2#0#9'ViewStyle'#7#8'vsReport'#10'OnDblClick'#7#15'edtPropDbl' + +'Click'#0#0#0#7'TButton'#7'Button3'#4'Left'#2#4#6'Height'#2#25#3'Top'#3#165#1 + +#5'Width'#2'['#6'Action'#7#10'actPropAdd'#25'BorderSpacing.InnerBorder'#2#4#8 + +'TabOrder'#2#2#0#0#7'TButton'#7'Button4'#4'Left'#2'd'#6'Height'#2#25#3'Top'#3 + +#165#1#5'Width'#2'['#6'Action'#7#11'actPropEdit'#25'BorderSpacing.InnerBorde' + +'r'#2#4#8'TabOrder'#2#3#0#0#7'TButton'#7'Button5'#4'Left'#3#196#0#6'Height'#2 + +#25#3'Top'#3#165#1#5'Width'#2'['#6'Action'#7#13'actPropDelete'#25'BorderSpac' + +'ing.InnerBorder'#2#4#8'TabOrder'#2#4#0#0#9'TComboBox'#9'edtParent'#4'Left'#2 + +'\'#6'Height'#2#21#3'Top'#2';'#5'Width'#3#150#1#16'AutoCompleteText'#11#22'c' + +'bactEndOfLineComplete'#20'cbactSearchAscending'#0#9'MaxLength'#2#0#5'Style' + +#7#14'csDropDownList'#8'TabOrder'#2#5#0#0#0#0#11'TActionList'#11'ActionList1' + +#4'left'#3#19#1#3'top'#3#147#0#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18'D' + +'isableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actOK' + +'Update'#0#0#7'TAction'#10'actPropAdd'#7'Caption'#6#12'New Property'#18'Disa' + +'bleIfNoHandler'#9#9'OnExecute'#7#17'actPropAddExecute'#0#0#7'TAction'#11'ac' + +'tPropEdit'#7'Caption'#6#13'Edit Property'#18'DisableIfNoHandler'#9#9'OnExec' + +'ute'#7#18'actPropEditExecute'#8'OnUpdate'#7#17'actPropEditUpdate'#0#0#7'TAc' + +'tion'#13'actPropDelete'#7'Caption'#6#15'Delete Property'#18'DisableIfNoHand' + +'ler'#9#9'OnExecute'#7#20'actPropDeleteExecute'#8'OnUpdate'#7#17'actPropEdit' + +'Update'#0#0#0#10'TPopupMenu'#10'PopupMenu1'#4'left'#2'i'#3'top'#3#186#0#0#9 + +'TMenuItem'#9'MenuItem1'#6'Action'#7#10'actPropAdd'#7'OnClick'#7#17'actPropA' + +'ddExecute'#0#0#9'TMenuItem'#9'MenuItem2'#6'Action'#7#11'actPropEdit'#7'OnCl' + +'ick'#7#18'actPropEditExecute'#0#0#9'TMenuItem'#9'MenuItem3'#6'Action'#7#13 + +'actPropDelete'#7'OnClick'#7#20'actPropDeleteExecute'#0#0#0#0 +]); diff --git a/wst/trunk/type_lib_edtr/ufclassedit.pas b/wst/trunk/type_lib_edtr/ufclassedit.pas new file mode 100644 index 000000000..8232b2178 --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufclassedit.pas @@ -0,0 +1,339 @@ +unit ufclassedit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ActnList, + ExtCtrls, ComCtrls, Buttons, StdCtrls, + pastree, pascal_parser_intf, //parserdefs, + edit_helper, Menus; + +type + + { TfClassEdit } + + TfClassEdit = class(TForm) + actPropDelete: TAction; + actPropEdit: TAction; + actPropAdd: TAction; + ActionList1: TActionList; + actOK: TAction; + actOK1: TAction; + Button1: TButton; + Button2: TButton; + Button3: TButton; + Button4: TButton; + Button5: TButton; + edtParent: TComboBox; + edtName: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + edtProp: TListView; + Label2: TLabel; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + Panel1: TPanel; + PC: TPageControl; + PopupMenu1: TPopupMenu; + TabSheet1: TTabSheet; + procedure actOKExecute(Sender: TObject); + procedure actOKUpdate(Sender: TObject); + procedure actPropAddExecute(Sender: TObject); + procedure actPropDeleteExecute(Sender: TObject); + procedure actPropEditExecute(Sender: TObject); + procedure actPropEditUpdate(Sender: TObject); + procedure edtPropDblClick(Sender: TObject); + private + FUpdateType : TEditType; + FObject : TPasClassType; + FSymbolTable : TwstPasTreeContainer; + FOldAncestor : TPasType; + private + property UpdateType : TEditType read FUpdateType; + private + procedure PrepareParentCombo(); + procedure LoadProperty(APropDef : TPasProperty); + procedure LoadFromObject(); + procedure SaveToObject(); + public + function UpdateObject( + var AObject : TPasClassType; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer + ):Boolean; + end; + +var + fClassEdit: TfClassEdit; + +implementation +uses parserutils, ufpropedit; + +function FindItem(const ACaption : string; AList : TListItems) : TListItem ; +var + i : Integer; +begin + for i := 0 to Pred(AList.Count) do begin + if AnsiSameText(ACaption,AList[i].Caption) then begin + Result := AList[i]; + Exit; + end; + end; + Result := nil; +end; + +{ TfClassEdit } + +procedure TfClassEdit.actPropAddExecute(Sender: TObject); +var + prp : TPasProperty; +begin + prp := CreateProperty(FObject,FSymbolTable); + if Assigned(prp) then begin + LoadProperty(prp); + end; +end; + +procedure TfClassEdit.actOKUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := not IsStrEmpty(ExtractIdentifier(edtName.Text)); +end; + +procedure TfClassEdit.actOKExecute(Sender: TObject); +begin + ModalResult := mrOk; +end; + +procedure TfClassEdit.actPropDeleteExecute(Sender: TObject); +var + prop : TPasProperty; +begin + prop := TPasProperty(edtProp.ItemFocused.Data); + FObject.Members.Extract(prop); + prop.Release(); + edtProp.ItemFocused.Free(); +end; + +procedure TfClassEdit.actPropEditExecute(Sender: TObject); +var + prp : TPasProperty; + itm : TListItem; +begin + itm := edtProp.ItemFocused; + if Assigned(itm) then begin + prp := TPasProperty(itm.Data); + if UpdateProperty(prp,FSymbolTable) then begin + itm.Free(); + LoadProperty(prp); + end; + end; +end; + +procedure TfClassEdit.actPropEditUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(edtProp.ItemFocused); +end; + +procedure TfClassEdit.edtPropDblClick(Sender: TObject); +begin + if actPropEdit.Enabled then begin + actPropEdit.Execute(); + end else if actPropAdd.Enabled then begin + actPropAdd.Execute(); + end; +end; + +procedure InternalFillList( + ALs : TStrings; + AContainer : TwstPasTreeContainer +); +var + i, j : Integer; + sym : TPasElement; + modulList, decList : TList; + mdl : TPasModule; +begin + modulList := AContainer.Package.Modules; + for i := 0 to Pred(modulList.Count) do begin + mdl := TPasModule(modulList[i]); + decList := mdl.InterfaceSection.Declarations; + for j := 0 to Pred(decList.Count) do begin + sym := TPasElement(decList[j]); + if sym.InheritsFrom(TPasType) and + ( sym.InheritsFrom(TPasClassType) or + sym.InheritsFrom(TPasNativeSimpleType) or + ( sym.InheritsFrom(TPasAliasType) and + Assigned(TPasAliasType(sym).DestType) and + ( TPasAliasType(sym).DestType.InheritsFrom(TPasClassType) or + TPasAliasType(sym).DestType.InheritsFrom(TPasNativeSimpleType) + ) + ) + ) + then begin + if ( ALs.IndexOfObject(sym) = -1 ) then begin + ALs.AddObject(AContainer.GetExternalName(sym),sym); + end; + end; + end; + end; +end; + +procedure FillList( + ALs : TStrings; + ASymbol : TwstPasTreeContainer +); +var + locLST : TStringList; +begin + locLST := TStringList.Create(); + try + locLST.Assign(ALs); + locLST.Duplicates := dupAccept; + InternalFillList(locLST,ASymbol); + locLST.Sort(); + ALs.Assign(locLST); + finally + FreeAndNil(locLST); + end; +end; + +procedure TfClassEdit.PrepareParentCombo(); +begin + edtParent.Items.BeginUpdate(); + try + FillList(edtParent.Items,FSymbolTable); + finally + edtParent.Items.EndUpdate(); + end; +end; + +procedure TfClassEdit.LoadProperty(APropDef: TPasProperty); +var + itm : TListItem; + s, extName : string; +begin + extName := FSymbolTable.GetExternalName(APropDef); + itm := FindItem(extName,edtProp.Items); + if ( itm = nil ) then begin + itm := edtProp.Items.Add(); + end; + itm.Caption := extName; + itm.SubItems.Add(FSymbolTable.GetExternalName(APropDef.VarType)); + if FSymbolTable.IsAttributeProperty(APropDef) then begin + s := 'Y'; + end else begin + s := 'N'; + end; + itm.SubItems.Add(s); + itm.Data := APropDef; +end; + +procedure TfClassEdit.LoadFromObject(); +var + i : Integer; + prp : TPasProperty; + extName : string; +begin + edtName.Text := ''; + edtProp.Clear(); + if Assigned(FObject) then begin + extName := FSymbolTable.GetExternalName(FObject); + Self.Caption := extName; + edtName.Text := extName; + for i := 0 to Pred(FObject.Members.Count) do begin + if TPasElement(FObject.Members[i]).InheritsFrom(TPasProperty) then begin + prp := TPasProperty(FObject.Members[i]); + LoadProperty(prp); + end; + end; + if Assigned(FObject.AncestorType) then begin + edtParent.ItemIndex := edtParent.Items.IndexOfObject(FObject.AncestorType); + end; + end else begin + Self.Caption := 'New'; + end; +end; + +procedure TfClassEdit.SaveToObject(); +var + typExtName, typIntName : string; + locObj : TPasClassType; + trueParent : TPasType; +begin + locObj := nil; + typExtName := ExtractIdentifier(edtName.Text); + typIntName := MakeInternalSymbolNameFrom(typExtName); + locObj := FObject; + locObj.Name := typIntName; + FSymbolTable.RegisterExternalAlias(locObj,typExtName); + if ( edtParent.ItemIndex >= 0 ) then begin + trueParent := edtParent.Items.Objects[edtParent.ItemIndex] as TPasType; + if trueParent.InheritsFrom(TPasAliasType) then begin + trueParent := GetUltimeType(trueParent); + end; + if trueParent.InheritsFrom(TPasNativeSimpleType) and + Assigned(TPasNativeSimpleType(trueParent).BoxedType) + then begin + trueParent := TPasNativeSimpleType(trueParent).BoxedType; + end; + end else begin + trueParent := nil; + end; + if ( trueParent <> FOldAncestor ) then begin + if ( FOldAncestor <> nil ) then + FOldAncestor.Release(); + locObj.AncestorType := trueParent; + end; +end; + +function TfClassEdit.UpdateObject( + var AObject : TPasClassType; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer +): Boolean; +begin + Assert(Assigned(ASymbolTable)); + FSymbolTable := ASymbolTable; + FUpdateType := AUpdateType; + FObject := AObject; + if ( UpdateType = etCreate ) and ( FObject = nil ) then begin + FObject := TPasClassType(FSymbolTable.CreateElement(TPasClassType,'new_class',FSymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + FSymbolTable.CurrentModule.InterfaceSection.Declarations.Add(FObject); + FSymbolTable.CurrentModule.InterfaceSection.Types.Add(FObject); + FSymbolTable.CurrentModule.InterfaceSection.Classes.Add(FObject); + end; + FOldAncestor := FObject.AncestorType; + try + PrepareParentCombo(); + LoadFromObject(); + Result := ( ShowModal() = mrOK ); + if Result then begin + try + SaveToObject(); + if ( AUpdateType = etCreate ) then begin + AObject := FObject; + end; + except + Result := False; + raise; + end; + end; + finally + if ( not Result ) and ( UpdateType = etCreate ) and ( AObject = nil ) then begin + FSymbolTable.CurrentModule.InterfaceSection.Declarations.Extract(FObject); + FSymbolTable.CurrentModule.InterfaceSection.Types.Extract(FObject); + FSymbolTable.CurrentModule.InterfaceSection.Classes.Extract(FObject); + FObject.Release(); + FObject := nil; + end; + end; +end; + +initialization + {$I ufclassedit.lrs} + +end. + diff --git a/wst/trunk/type_lib_edtr/ufenumedit.lfm b/wst/trunk/type_lib_edtr/ufenumedit.lfm new file mode 100644 index 000000000..d1d674394 --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufenumedit.lfm @@ -0,0 +1,103 @@ +object fEnumEdit: TfEnumEdit + Left = 373 + Height = 368 + Top = 215 + Width = 400 + HorzScrollBar.Page = 399 + VertScrollBar.Page = 367 + ActiveControl = edtName + BorderStyle = bsSizeToolWin + Caption = 'fEnumEdit' + ClientHeight = 368 + ClientWidth = 400 + object PC: TPageControl + Height = 318 + Width = 400 + ActivePage = TabSheet1 + Align = alClient + TabIndex = 0 + TabOrder = 0 + object TabSheet1: TTabSheet + Caption = 'Enumeration' + ClientHeight = 292 + ClientWidth = 392 + object Label1: TLabel + Left = 4 + Height = 14 + Top = 18 + Width = 28 + Caption = 'Name' + Color = clNone + ParentColor = False + end + object edtName: TEdit + Left = 68 + Height = 23 + Top = 18 + Width = 312 + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + end + object GroupBox1: TGroupBox + Left = 4 + Height = 231 + Top = 51 + Width = 377 + Anchors = [akTop, akLeft, akRight, akBottom] + Caption = ' Items ' + ClientHeight = 213 + ClientWidth = 373 + TabOrder = 1 + object edtItems: TMemo + Height = 213 + Width = 373 + Align = alClient + ScrollBars = ssBoth + TabOrder = 0 + end + end + end + end + object Panel1: TPanel + Height = 50 + Top = 318 + Width = 400 + Align = alBottom + ClientHeight = 50 + ClientWidth = 400 + TabOrder = 1 + object Button1: TButton + Left = 312 + Height = 25 + Top = 10 + Width = 75 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object Button2: TButton + Left = 222 + Height = 25 + Top = 10 + Width = 75 + Action = actOK + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Default = True + TabOrder = 1 + end + end + object ActionList1: TActionList + left = 248 + top = 120 + object actOK: TAction + Caption = 'OK' + DisableIfNoHandler = True + OnExecute = actOKExecute + OnUpdate = actOKUpdate + end + end +end diff --git a/wst/trunk/type_lib_edtr/ufenumedit.lrs b/wst/trunk/type_lib_edtr/ufenumedit.lrs new file mode 100644 index 000000000..074d73b1d --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufenumedit.lrs @@ -0,0 +1,29 @@ +LazarusResources.Add('TfEnumEdit','FORMDATA',[ + 'TPF0'#10'TfEnumEdit'#9'fEnumEdit'#4'Left'#3'u'#1#6'Height'#3'p'#1#3'Top'#3 + +#215#0#5'Width'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page' + +#3'o'#1#13'ActiveControl'#7#7'edtName'#11'BorderStyle'#7#13'bsSizeToolWin'#7 + +'Caption'#6#9'fEnumEdit'#12'ClientHeight'#3'p'#1#11'ClientWidth'#3#144#1#0#12 + +'TPageControl'#2'PC'#6'Height'#3'>'#1#5'Width'#3#144#1#10'ActivePage'#7#9'Ta' + +'bSheet1'#5'Align'#7#8'alClient'#8'TabIndex'#2#0#8'TabOrder'#2#0#0#9'TTabShe' + +'et'#9'TabSheet1'#7'Caption'#6#11'Enumeration'#12'ClientHeight'#3'$'#1#11'Cl' + +'ientWidth'#3#136#1#0#6'TLabel'#6'Label1'#4'Left'#2#4#6'Height'#2#14#3'Top'#2 + +#18#5'Width'#2#28#7'Caption'#6#4'Name'#5'Color'#7#6'clNone'#11'ParentColor'#8 + +#0#0#5'TEdit'#7'edtName'#4'Left'#2'D'#6'Height'#2#23#3'Top'#2#18#5'Width'#3 + +'8'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#0#0#0#9'TG' + +'roupBox'#9'GroupBox1'#4'Left'#2#4#6'Height'#3#231#0#3'Top'#2'3'#5'Width'#3 + +'y'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6 + +#9' Items '#12'ClientHeight'#3#213#0#11'ClientWidth'#3'u'#1#8'TabOrder'#2#1 + +#0#5'TMemo'#8'edtItems'#6'Height'#3#213#0#5'Width'#3'u'#1#5'Align'#7#8'alCli' + +'ent'#10'ScrollBars'#7#6'ssBoth'#8'TabOrder'#2#0#0#0#0#0#0#6'TPanel'#6'Panel' + +'1'#6'Height'#2'2'#3'Top'#3'>'#1#5'Width'#3#144#1#5'Align'#7#8'alBottom'#12 + +'ClientHeight'#2'2'#11'ClientWidth'#3#144#1#8'TabOrder'#2#1#0#7'TButton'#7'B' + +'utton1'#4'Left'#3'8'#1#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#7'Anchors' + +#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Ca' + +'ption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TButton'#7'But' + +'ton2'#4'Left'#3#222#0#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#6'Action'#7#5 + +'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4 + +#7'Default'#9#8'TabOrder'#2#1#0#0#0#11'TActionList'#11'ActionList1'#4'left'#3 + +#248#0#3'top'#2'x'#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18'DisableIfNoHa' + +'ndler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#0 + +#0 +]); diff --git a/wst/trunk/type_lib_edtr/ufenumedit.pas b/wst/trunk/type_lib_edtr/ufenumedit.pas new file mode 100644 index 000000000..9d917b5a3 --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufenumedit.pas @@ -0,0 +1,168 @@ +unit ufEnumedit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + ComCtrls, ExtCtrls, ActnList, Buttons, + pastree, pascal_parser_intf, edit_helper; + +type + + { TfEnumEdit } + + TfEnumEdit = class(TForm) + actOK: TAction; + ActionList1: TActionList; + Button1: TButton; + Button2: TButton; + edtName: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + edtItems: TMemo; + PC: TPageControl; + Panel1: TPanel; + TabSheet1: TTabSheet; + procedure actOKExecute(Sender: TObject); + procedure actOKUpdate(Sender: TObject); + private + FUpdateType : TEditType; + FObject : TPasEnumType; + FSymbolTable : TwstPasTreeContainer; + private + property UpdateType : TEditType read FUpdateType; + private + procedure LoadFromObject(); + procedure SaveToObject(); + public + function UpdateObject( + var AObject : TPasEnumType; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer + ):Boolean; + end; + +var + fEnumEdit: TfEnumEdit; + +implementation +uses parserutils; + +function ParseEnum( + const AName : string; + AItems : TStrings; + AObject : TPasEnumType; + ASymbolTable : TwstPasTreeContainer +) : TPasEnumType ; +var + buffer : string; + i : Integer; + typExtName, typIntName, itmExtName : string; + itm : TPasEnumValue; +begin + typExtName := ExtractIdentifier(AName); + typIntName := MakeInternalSymbolNameFrom(typExtName); + if IsStrEmpty(typExtName) then begin + raise ESymbolException.CreateFmt('Invalid enumeration name : "%s"',[AName]); + end; + Result := AObject; + if ( Result = nil ) then begin + Result := TPasEnumType(ASymbolTable.CreateElement(TPasEnumType,typIntName,ASymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + ASymbolTable.CurrentModule.InterfaceSection.Declarations.Add(Result); + ASymbolTable.CurrentModule.InterfaceSection.Types.Add(Result); + end; + ASymbolTable.RegisterExternalAlias(Result,typExtName); + try + while ( Result.Values.Count > 0 ) do begin + itm := TPasEnumValue(Result.Values[0]); + Result.Values.Extract(itm); + itm.Release(); + end; + for i := 0 to Pred(AItems.Count) do begin + buffer := AItems[i]; + itm := TPasEnumValue(ASymbolTable.CreateElement(TPasEnumValue,MakeInternalSymbolNameFrom(buffer),Result,visDefault,'',0)); + Result.Values.Add(itm); + itmExtName := ExtractIdentifier(buffer); + if not AnsiSameText(itm.Name,itmExtName) then + ASymbolTable.RegisterExternalAlias(itm,itmExtName); + end; + except + if ( AObject = nil ) then begin + Result.Release(); + end; + raise; + end; +end; + +{ TfEnumEdit } + +procedure TfEnumEdit.actOKUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := + ( not IsStrEmpty(ExtractIdentifier(edtName.Text)) ) and + ( not IsStrEmpty(edtItems.Lines.Text) ); +end; + +procedure TfEnumEdit.actOKExecute(Sender: TObject); +begin + ModalResult := mrOK; +end; + +procedure TfEnumEdit.LoadFromObject(); +var + i : Integer; +begin + if ( FObject = nil ) then begin + edtName.Text := ''; + edtItems.Lines.Clear(); + Self.Caption := 'New enumeration'; + end else begin + edtName.Text := FSymbolTable.GetExternalName(FObject); + Self.Caption := edtName.Text; + edtItems.Lines.Clear(); + for i := 0 to Pred(FObject.Values.Count) do begin + edtItems.Lines.Add(FSymbolTable.GetExternalName(TPasElement(FObject.Values[i]))); + end; + end; +end; + +procedure TfEnumEdit.SaveToObject(); +var + locObj : TPasEnumType; +begin + locObj := nil; + if ( UpdateType = etCreate ) then begin + locObj := ParseEnum(edtName.Text,edtItems.Lines,nil,FSymbolTable); + //FreeAndNil(FObject); + FObject := locObj; + end else begin + ParseEnum(edtName.Text,edtItems.Lines,FObject,FSymbolTable); + end; +end; + +function TfEnumEdit.UpdateObject( + var AObject : TPasEnumType; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer +) : Boolean; +begin + FSymbolTable := ASymbolTable; + FUpdateType := AUpdateType; + FObject := AObject; + LoadFromObject(); + Result := ( ShowModal() = mrOK ); + if Result then begin + SaveToObject(); + if ( AUpdateType = etCreate ) then begin + AObject := FObject; + end; + end; +end; + +initialization + {$I ufenumedit.lrs} + +end. + diff --git a/wst/trunk/type_lib_edtr/ufpropedit.lfm b/wst/trunk/type_lib_edtr/ufpropedit.lfm new file mode 100644 index 000000000..b5b69fd01 --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufpropedit.lfm @@ -0,0 +1,113 @@ +object fPropEdit: TfPropEdit + Left = 474 + Height = 272 + Top = 186 + Width = 324 + HorzScrollBar.Page = 323 + VertScrollBar.Page = 271 + ActiveControl = Button1 + BorderIcons = [biSystemMenu] + BorderStyle = bsDialog + Caption = 'fPropEdit' + ClientHeight = 272 + ClientWidth = 324 + Position = poDesktopCenter + object Panel1: TPanel + Height = 50 + Top = 222 + Width = 324 + Align = alBottom + ClientHeight = 50 + ClientWidth = 324 + TabOrder = 0 + object Button1: TButton + Left = 236 + Height = 25 + Top = 10 + Width = 75 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object Button2: TButton + Left = 146 + Height = 25 + Top = 10 + Width = 75 + Action = actOK + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Default = True + TabOrder = 1 + end + end + object PageControl1: TPageControl + Height = 222 + Width = 324 + ActivePage = TabSheet1 + Align = alClient + TabIndex = 0 + TabOrder = 1 + object TabSheet1: TTabSheet + Caption = 'Property' + ClientHeight = 196 + ClientWidth = 316 + object Label1: TLabel + Left = 20 + Height = 14 + Top = 24 + Width = 28 + Caption = 'Name' + Color = clNone + ParentColor = False + end + object Label2: TLabel + Left = 20 + Height = 14 + Top = 98 + Width = 25 + Caption = 'Type' + Color = clNone + ParentColor = False + end + object edtName: TEdit + Left = 20 + Height = 23 + Top = 42 + Width = 272 + TabOrder = 0 + end + object edtType: TComboBox + Left = 20 + Height = 21 + Top = 116 + Width = 272 + AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] + MaxLength = 0 + Style = csDropDownList + TabOrder = 1 + end + object edtAttribute: TCheckBox + Left = 20 + Height = 13 + Top = 170 + Width = 101 + Caption = 'Attribute Property' + TabOrder = 2 + end + end + end + object ActionList1: TActionList + left = 104 + top = 104 + object actOK: TAction + Caption = 'OK' + DisableIfNoHandler = True + OnExecute = actOKExecute + OnUpdate = actOKUpdate + end + end +end diff --git a/wst/trunk/type_lib_edtr/ufpropedit.lrs b/wst/trunk/type_lib_edtr/ufpropedit.lrs new file mode 100644 index 000000000..bd64b8aaf --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufpropedit.lrs @@ -0,0 +1,33 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TfPropEdit','FORMDATA',[ + 'TPF0'#10'TfPropEdit'#9'fPropEdit'#4'Left'#3#218#1#6'Height'#3#16#1#3'Top'#3 + +#186#0#5'Width'#3'D'#1#18'HorzScrollBar.Page'#3'C'#1#18'VertScrollBar.Page'#3 + +#15#1#13'ActiveControl'#7#7'Button1'#11'BorderIcons'#11#12'biSystemMenu'#0#11 + +'BorderStyle'#7#8'bsDialog'#7'Caption'#6#9'fPropEdit'#12'ClientHeight'#3#16#1 + +#11'ClientWidth'#3'D'#1#8'Position'#7#15'poDesktopCenter'#0#6'TPanel'#6'Pane' + +'l1'#6'Height'#2'2'#3'Top'#3#222#0#5'Width'#3'D'#1#5'Align'#7#8'alBottom'#12 + +'ClientHeight'#2'2'#11'ClientWidth'#3'D'#1#8'TabOrder'#2#0#0#7'TButton'#7'Bu' + +'tton1'#4'Left'#3#236#0#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#7'Anchors' + +#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Ca' + +'ption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TButton'#7'But' + +'ton2'#4'Left'#3#146#0#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#6'Action'#7#5 + +'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4 + +#7'Default'#9#8'TabOrder'#2#1#0#0#0#12'TPageControl'#12'PageControl1'#6'Heig' + +'ht'#3#222#0#5'Width'#3'D'#1#10'ActivePage'#7#9'TabSheet1'#5'Align'#7#8'alCl' + +'ient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabSheet'#9'TabSheet1'#7'Caption' + +#6#8'Property'#12'ClientHeight'#3#196#0#11'ClientWidth'#3'<'#1#0#6'TLabel'#6 + +'Label1'#4'Left'#2#20#6'Height'#2#14#3'Top'#2#24#5'Width'#2#28#7'Caption'#6#4 + +'Name'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left' + +#2#20#6'Height'#2#14#3'Top'#2'b'#5'Width'#2#25#7'Caption'#6#4'Type'#5'Color' + +#7#6'clNone'#11'ParentColor'#8#0#0#5'TEdit'#7'edtName'#4'Left'#2#20#6'Height' + +#2#23#3'Top'#2'*'#5'Width'#3#16#1#8'TabOrder'#2#0#0#0#9'TComboBox'#7'edtType' + +#4'Left'#2#20#6'Height'#2#21#3'Top'#2't'#5'Width'#3#16#1#16'AutoCompleteText' + +#11#22'cbactEndOfLineComplete'#20'cbactSearchAscending'#0#9'MaxLength'#2#0#5 + +'Style'#7#14'csDropDownList'#8'TabOrder'#2#1#0#0#9'TCheckBox'#12'edtAttribut' + +'e'#4'Left'#2#20#6'Height'#2#13#3'Top'#3#170#0#5'Width'#2'e'#7'Caption'#6#18 + +'Attribute Property'#8'TabOrder'#2#2#0#0#0#0#11'TActionList'#11'ActionList1' + +#4'left'#2'h'#3'top'#2'h'#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18'Disabl' + +'eIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actOKUpdat' + +'e'#0#0#0#0 +]); diff --git a/wst/trunk/type_lib_edtr/ufpropedit.pas b/wst/trunk/type_lib_edtr/ufpropedit.pas new file mode 100644 index 000000000..6155b6474 --- /dev/null +++ b/wst/trunk/type_lib_edtr/ufpropedit.pas @@ -0,0 +1,221 @@ +unit ufpropedit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ActnList, + ExtCtrls, Buttons, ComCtrls, StdCtrls, + pastree, pascal_parser_intf, + edit_helper; + +type + + { TfPropEdit } + + TfPropEdit = class(TForm) + ActionList1: TActionList; + actOK: TAction; + Button1: TButton; + Button2: TButton; + Button4: TButton; + edtAttribute: TCheckBox; + edtType: TComboBox; + edtName: TEdit; + Label1: TLabel; + Label2: TLabel; + PageControl1: TPageControl; + Panel1: TPanel; + TabSheet1: TTabSheet; + procedure actOKExecute(Sender: TObject); + procedure actOKUpdate(Sender: TObject); + private + FClassObject: TPasClassType; + FUpdateType : TEditType; + FObject : TPasProperty; + FSymbolTable : TwstPasTreeContainer; + private + property UpdateType : TEditType read FUpdateType; + property ClassObject : TPasClassType read FClassObject; + private + procedure LoadFromObject(); + procedure SaveToObject(); + public + function UpdateObject( + var AObject : TPasProperty; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer + ) : Boolean; + end; + +var + fPropEdit: TfPropEdit; + + function CreateProperty(AClass : TPasClassType; ASymboltable : TwstPasTreeContainer):TPasProperty ; + function UpdateProperty(AProp : TPasProperty; ASymboltable : TwstPasTreeContainer):Boolean; + +implementation +uses parserutils; + +function CreateProperty(AClass : TPasClassType; ASymboltable : TwstPasTreeContainer):TPasProperty ; +var + f : TfPropEdit; +begin + Result := nil; + f := TfPropEdit.Create(Application); + try + f.FClassObject := AClass; + f.UpdateObject(Result,etCreate,ASymboltable); + finally + f.Release(); + end; +end; + +function UpdateProperty(AProp : TPasProperty; ASymboltable : TwstPasTreeContainer):Boolean; +var + f : TfPropEdit; +begin + f := TfPropEdit.Create(Application); + try + Result := f.UpdateObject(AProp,etUpdate,ASymboltable); + finally + f.Release(); + end; +end; + +procedure InternalFillList(ALs : TStrings; AContainer : TwstPasTreeContainer); +var + i, j : Integer; + sym : TPasElement; + moduleList, decList : TList; + mdl : TPasModule; +begin + moduleList := AContainer.Package.Modules; + for i := 0 to Pred(moduleList.Count) do begin + mdl := TPasModule(moduleList[i]); + decList := mdl.InterfaceSection.Declarations; + for j := 0 to Pred(decList.Count) do begin + sym := TPasElement(decList[i]); + if sym.InheritsFrom(TPasType) then begin + if ( ALs.IndexOfObject(sym) = -1 ) then begin + ALs.AddObject(AContainer.GetExternalName(sym),sym); + end; + end; + end; + end; +end; + +procedure FillList( + ALs : TStrings; + ASymbol : TwstPasTreeContainer +); +var + locLST : TStringList; +begin + locLST := TStringList.Create(); + try + locLST.Assign(ALs); + locLST.Duplicates := dupAccept; + InternalFillList(locLST,ASymbol); + locLST.Sort(); + ALs.Assign(locLST); + finally + FreeAndNil(locLST); + end; +end; + +{ TfPropEdit } + +procedure TfPropEdit.actOKUpdate(Sender: TObject); +var + internalName : string; +begin + internalName := ExtractIdentifier(edtName.Text); + TAction(Sender).Enabled := + ( not IsStrEmpty(internalName) ) and + ( edtType.ItemIndex >= 0 ) and + ( FindMember(ClassObject,internalName) = nil ); +end; + +procedure TfPropEdit.actOKExecute(Sender: TObject); +begin + ModalResult := mrOK; +end; + +procedure TfPropEdit.LoadFromObject(); +begin + edtName.Text := ''; + edtType.Clear(); + edtType.Items.BeginUpdate(); + try + edtType.Items.Clear(); + FillList(edtType.Items,FSymbolTable); + finally + edtType.Items.EndUpdate(); + end; + if Assigned(FObject) then begin + Self.Caption := FSymbolTable.GetExternalName(FObject); + edtName.Text := FSymbolTable.GetExternalName(FObject); + edtType.ItemIndex := edtType.Items.IndexOfObject(FObject.VarType); + edtAttribute.Checked := FSymbolTable.IsAttributeProperty(FObject); + end else begin + Self.Caption := 'New'; + end; +end; + +procedure TfPropEdit.SaveToObject(); +var + locObj : TPasProperty; + typExtName, typIntName : string; + propType : TPasType; +begin + locObj := nil; + typExtName := ExtractIdentifier(edtName.Text); + typIntName := MakeInternalSymbolNameFrom(typExtName); + propType := edtType.Items.Objects[edtType.ItemIndex] as TPasType; + if ( UpdateType = etCreate ) then begin + locObj := TPasProperty(FSymbolTable.CreateElement(TPasProperty,typIntName,ClassObject,visPublished,'',0)); + FreeAndNil(FObject); + FObject := locObj; + locObj.VarType := propType; + locObj.VarType.AddRef(); + end else begin + locObj := FObject; + if ( propType <> locObj.VarType ) then begin + if ( locObj.VarType <> nil ) then + locObj.VarType.Release(); + locObj.VarType := propType; + locObj.VarType.AddRef(); + end; + locObj.Name := typIntName; + end; + FSymbolTable.RegisterExternalAlias(locObj,typExtName); + //if ( edtAttribute.Checked <> FSymbolTable.IsAttributeProperty(locObj) ) then + FSymbolTable.SetPropertyAsAttribute(locObj,edtAttribute.Checked); +end; + +function TfPropEdit.UpdateObject( + var AObject : TPasProperty; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer +): Boolean; +begin + FSymbolTable := ASymbolTable; + FUpdateType := AUpdateType; + FObject := AObject; + LoadFromObject(); + Result := ( ShowModal() = mrOK ); + if Result then begin + SaveToObject(); + if ( AUpdateType = etCreate ) then begin + AObject := FObject; + end; + end; +end; + +initialization + {$I ufpropedit.lrs} + +end. + diff --git a/wst/trunk/type_lib_edtr/uinterfaceedit.lfm b/wst/trunk/type_lib_edtr/uinterfaceedit.lfm new file mode 100644 index 000000000..89375800b --- /dev/null +++ b/wst/trunk/type_lib_edtr/uinterfaceedit.lfm @@ -0,0 +1,105 @@ +object fInterfaceEdit: TfInterfaceEdit + Left = 627 + Height = 564 + Top = 101 + Width = 531 + HorzScrollBar.Page = 530 + VertScrollBar.Page = 563 + ActiveControl = Button1 + BorderStyle = bsSizeToolWin + Caption = 'fInterfaceEdit' + ClientHeight = 564 + ClientWidth = 531 + OnCreate = FormCreate + Position = poDesktopCenter + object Panel1: TPanel + Height = 50 + Top = 514 + Width = 531 + Align = alBottom + ClientHeight = 50 + ClientWidth = 531 + TabOrder = 0 + object Button1: TButton + Left = 436 + Height = 25 + Top = 10 + Width = 75 + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Cancel = True + Caption = 'Cancel' + ModalResult = 2 + TabOrder = 0 + end + object Button2: TButton + Left = 346 + Height = 25 + Top = 10 + Width = 75 + Action = actOK + Anchors = [akTop, akRight] + BorderSpacing.InnerBorder = 4 + Default = True + TabOrder = 1 + end + end + object PC: TPageControl + Height = 514 + Width = 531 + ActivePage = TabSheet1 + Align = alClient + TabIndex = 0 + TabOrder = 1 + object TabSheet1: TTabSheet + Caption = 'Interface definition' + ClientHeight = 488 + ClientWidth = 523 + object Label1: TLabel + Left = 20 + Height = 14 + Top = 26 + Width = 28 + Caption = 'Name' + Color = clNone + ParentColor = False + end + object edtName: TEdit + Left = 60 + Height = 23 + Top = 26 + Width = 443 + Anchors = [akTop, akLeft, akRight] + TabOrder = 0 + end + object GroupBox1: TGroupBox + Left = 20 + Height = 384 + Top = 74 + Width = 484 + Anchors = [akTop, akLeft, akRight, akBottom] + Caption = ' Methods ' + ClientHeight = 366 + ClientWidth = 480 + TabOrder = 1 + object trvMethods: TTreeView + Height = 366 + Width = 480 + Align = alClient + DefaultItemHeight = 15 + TabOrder = 0 + end + end + end + end + object AL: TActionList + left = 130 + top = 201 + object actOK: TAction + Caption = 'OK' + DisableIfNoHandler = True + OnExecute = actOKExecute + OnUpdate = actOKUpdate + end + end +end diff --git a/wst/trunk/type_lib_edtr/uinterfaceedit.lrs b/wst/trunk/type_lib_edtr/uinterfaceedit.lrs new file mode 100644 index 000000000..7c70a10fa --- /dev/null +++ b/wst/trunk/type_lib_edtr/uinterfaceedit.lrs @@ -0,0 +1,30 @@ +LazarusResources.Add('TfInterfaceEdit','FORMDATA',[ + 'TPF0'#15'TfInterfaceEdit'#14'fInterfaceEdit'#4'Left'#3's'#2#6'Height'#3'4'#2 + +#3'Top'#2'e'#5'Width'#3#19#2#18'HorzScrollBar.Page'#3#18#2#18'VertScrollBar.' + +'Page'#3'3'#2#13'ActiveControl'#7#7'Button1'#11'BorderStyle'#7#13'bsSizeTool' + +'Win'#7'Caption'#6#14'fInterfaceEdit'#12'ClientHeight'#3'4'#2#11'ClientWidth' + +#3#19#2#8'OnCreate'#7#10'FormCreate'#8'Position'#7#15'poDesktopCenter'#0#6'T' + +'Panel'#6'Panel1'#6'Height'#2'2'#3'Top'#3#2#2#5'Width'#3#19#2#5'Align'#7#8'a' + +'lBottom'#12'ClientHeight'#2'2'#11'ClientWidth'#3#19#2#8'TabOrder'#2#0#0#7'T' + +'Button'#7'Button1'#4'Left'#3#180#1#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K' + +#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Can' + +'cel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TBu' + +'tton'#7'Button2'#4'Left'#3'Z'#1#6'Height'#2#25#3'Top'#2#10#5'Width'#2'K'#6 + +'Action'#7#5'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.Inn' + +'erBorder'#2#4#7'Default'#9#8'TabOrder'#2#1#0#0#0#12'TPageControl'#2'PC'#6'H' + +'eight'#3#2#2#5'Width'#3#19#2#10'ActivePage'#7#9'TabSheet1'#5'Align'#7#8'alC' + +'lient'#8'TabIndex'#2#0#8'TabOrder'#2#1#0#9'TTabSheet'#9'TabSheet1'#7'Captio' + +'n'#6#20'Interface definition'#12'ClientHeight'#3#232#1#11'ClientWidth'#3#11 + +#2#0#6'TLabel'#6'Label1'#4'Left'#2#20#6'Height'#2#14#3'Top'#2#26#5'Width'#2 + +#28#7'Caption'#6#4'Name'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#5'TEdit' + +#7'edtName'#4'Left'#2'<'#6'Height'#2#23#3'Top'#2#26#5'Width'#3#187#1#7'Ancho' + +'rs'#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#0#0#0#9'TGroupBox'#9'G' + +'roupBox1'#4'Left'#2#20#6'Height'#3#128#1#3'Top'#2'J'#5'Width'#3#228#1#7'Anc' + +'hors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6#11' Meth' + +'ods '#12'ClientHeight'#3'n'#1#11'ClientWidth'#3#224#1#8'TabOrder'#2#1#0#9 + +'TTreeView'#10'trvMethods'#6'Height'#3'n'#1#5'Width'#3#224#1#5'Align'#7#8'al' + +'Client'#17'DefaultItemHeight'#2#15#8'TabOrder'#2#0#0#0#0#0#0#11'TActionList' + +#2'AL'#4'left'#3#130#0#3'top'#3#201#0#0#7'TAction'#5'actOK'#7'Caption'#6#2'O' + +'K'#18'DisableIfNoHandler'#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11 + +'actOKUpdate'#0#0#0#0 +]); diff --git a/wst/trunk/type_lib_edtr/uinterfaceedit.pas b/wst/trunk/type_lib_edtr/uinterfaceedit.pas new file mode 100644 index 000000000..bfdb01788 --- /dev/null +++ b/wst/trunk/type_lib_edtr/uinterfaceedit.pas @@ -0,0 +1,170 @@ +unit uinterfaceedit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ActnList, + ExtCtrls, ComCtrls, StdCtrls, Buttons, + pastree, pascal_parser_intf, + edit_helper; + +type + + { TfInterfaceEdit } + + TfInterfaceEdit = class(TForm) + actOK: TAction; + AL: TActionList; + Button1: TButton; + Button2: TButton; + edtName: TEdit; + GroupBox1: TGroupBox; + Label1: TLabel; + PC: TPageControl; + Panel1: TPanel; + TabSheet1: TTabSheet; + trvMethods: TTreeView; + procedure actOKExecute(Sender: TObject); + procedure actOKUpdate(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + FUpdateType : TEditType; + FObject : TPasClassType; + FSymbolTable : TwstPasTreeContainer; + private + property UpdateType : TEditType read FUpdateType; + private + procedure LoadMethod(AMthDef : TPasProcedure); + procedure LoadFromObject(); + procedure SaveToObject(); + public + function UpdateObject( + var AObject : TPasClassType; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer + ):Boolean; + end; + +var + fInterfaceEdit: TfInterfaceEdit; + +implementation +uses view_helper, parserutils, udm; + +{ TfInterfaceEdit } + +procedure TfInterfaceEdit.actOKUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := not IsStrEmpty(ExtractIdentifier(edtName.Text)); +end; + +procedure TfInterfaceEdit.FormCreate(Sender: TObject); +begin + trvMethods.Images := DM.IM; +end; + +procedure TfInterfaceEdit.actOKExecute(Sender: TObject); +begin + ModalResult := mrOK; +end; + +procedure TfInterfaceEdit.LoadMethod(AMthDef: TPasProcedure); +var + topNode : TTreeNode; +begin + topNode := trvMethods.Items[0]; + FindPainter(AMthDef).Paint(FSymbolTable,AMthDef,topNode); +end; + +procedure TfInterfaceEdit.LoadFromObject(); +var + i : Integer; + mthd : TPasProcedure; + extName : string; +begin + edtName.Text := ''; + trvMethods.BeginUpdate(); + try + trvMethods.Items.Clear(); + trvMethods.Items.AddFirst(nil,'Methods'); + if Assigned(FObject) then begin + extName := FSymbolTable.GetExternalName(FObject); + Self.Caption := extName; + edtName.Text := extName; + for i := 0 to Pred(FObject.Members.Count) do begin + if TPasElement(FObject.Members[i]).InheritsFrom(TPasProcedure) then begin + mthd := TPasProcedure(FObject.Members[i]); + LoadMethod(mthd); + end; + end; + end else begin + Self.Caption := 'New'; + end; + trvMethods.Items[0].Expand(False); + finally + trvMethods.EndUpdate(); + end; +end; + +procedure TfInterfaceEdit.SaveToObject(); +var + typExtName, typIntName : string; +begin + typExtName := ExtractIdentifier(edtName.Text); + typIntName := MakeInternalSymbolNameFrom(typExtName); + FObject.Name := typIntName; + FSymbolTable.RegisterExternalAlias(FObject,typExtName); +end; + +function TfInterfaceEdit.UpdateObject( + var AObject : TPasClassType; + const AUpdateType : TEditType; + ASymbolTable : TwstPasTreeContainer +): Boolean; +var + intName : string; + i : Integer; +begin + Assert(Assigned(ASymbolTable)); + FSymbolTable := ASymbolTable; + FUpdateType := AUpdateType; + FObject := AObject; + if ( FUpdateType = etCreate ) then begin + i := 1; + intName := 'ISampleService'; + while ( FSymbolTable.FindElementInModule(intName,FSymbolTable.CurrentModule) <> nil ) do begin + intName := 'ISampleService' + IntToStr(i); + Inc(i); + end; + FObject := TPasClassType(FSymbolTable.CreateElement(TPasClassType,intName,FSymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + FObject.ObjKind := okInterface; + FSymbolTable.CurrentModule.InterfaceSection.Declarations.Add(FObject); + FSymbolTable.CurrentModule.InterfaceSection.Types.Add(FObject); + end; + try + LoadFromObject(); + Result := ( ShowModal() = mrOK ); + if Result then begin + SaveToObject(); + if ( AUpdateType = etCreate ) then begin + AObject := FObject; + end; + end; + except + if ( FUpdateType = etCreate ) then begin + FSymbolTable.CurrentModule.InterfaceSection.Declarations.Extract(FObject); + FSymbolTable.CurrentModule.InterfaceSection.Types.Extract(FObject); + FObject.Release(); + AObject := nil; + end; + raise; + end; +end; + +initialization + {$I uinterfaceedit.lrs} + +end. + diff --git a/wst/trunk/type_lib_edtr/umain.lfm b/wst/trunk/type_lib_edtr/umain.lfm new file mode 100644 index 000000000..a8a331303 --- /dev/null +++ b/wst/trunk/type_lib_edtr/umain.lfm @@ -0,0 +1,1719 @@ +object fMain: TfMain + Left = 114 + Height = 644 + Top = 209 + Width = 833 + HorzScrollBar.Page = 832 + VertScrollBar.Page = 623 + ActiveControl = trvSchema + Caption = '[Web Services Toolkit ] Type Library Editor' + ClientHeight = 624 + ClientWidth = 833 + Menu = MainMenu1 + OnShow = FormShow + Position = poDesktopCenter + object SB: TStatusBar + Height = 23 + Top = 601 + Width = 833 + Panels = < + item + Width = 200 + end + item + Width = 50 + end> + SimplePanel = False + end + object Panel1: TPanel + Height = 601 + Width = 314 + Align = alLeft + ClientHeight = 601 + ClientWidth = 314 + TabOrder = 0 + object trvSchema: TTreeView + Left = 1 + Height = 599 + Top = 1 + Width = 312 + Align = alClient + DefaultItemHeight = 15 + PopupMenu = PopupMenu1 + TabOrder = 0 + end + end + object Panel2: TPanel + Left = 322 + Height = 601 + Width = 511 + Align = alClient + ClientHeight = 601 + ClientWidth = 511 + TabOrder = 1 + object PC: TPageControl + Left = 1 + Height = 599 + Top = 1 + Width = 509 + ActivePage = tsInterface + Align = alClient + TabIndex = 0 + TabOrder = 0 + object tsInterface: TTabSheet + Caption = '&Interface' + ClientHeight = 573 + ClientWidth = 501 + object srcInterface: TSynEdit + Height = 573 + Width = 501 + Align = alClient + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -20 + Font.Name = 'Courier' + Font.Pitch = fpFixed + ParentColor = False + PopupMenu = PopupMenu2 + TabOrder = 0 + BookMarkOptions.Xoffset = 81 + Gutter.DigitCount = 5 + Gutter.ShowLineNumbers = True + Gutter.ShowCodeFolding = True + Gutter.CodeFoldingWidth = 14 + Highlighter = SynPasSyn1 + Keystrokes = < + item + Command = 3 + ShortCut = 38 + end + item + Command = 103 + ShortCut = 8230 + end + item + Command = 211 + ShortCut = 16422 + end + item + Command = 4 + ShortCut = 40 + end + item + Command = 104 + ShortCut = 8232 + end + item + Command = 212 + ShortCut = 16424 + end + item + Command = 1 + ShortCut = 37 + end + item + Command = 101 + ShortCut = 8229 + end + item + Command = 5 + ShortCut = 16421 + end + item + Command = 105 + ShortCut = 24613 + end + item + Command = 2 + ShortCut = 39 + end + item + Command = 102 + ShortCut = 8231 + end + item + Command = 6 + ShortCut = 16423 + end + item + Command = 106 + ShortCut = 24615 + end + item + Command = 10 + ShortCut = 34 + end + item + Command = 110 + ShortCut = 8226 + end + item + Command = 14 + ShortCut = 16418 + end + item + Command = 114 + ShortCut = 24610 + end + item + Command = 9 + ShortCut = 33 + end + item + Command = 109 + ShortCut = 8225 + end + item + Command = 13 + ShortCut = 16417 + end + item + Command = 113 + ShortCut = 24609 + end + item + Command = 7 + ShortCut = 36 + end + item + Command = 107 + ShortCut = 8228 + end + item + Command = 15 + ShortCut = 16420 + end + item + Command = 115 + ShortCut = 24612 + end + item + Command = 8 + ShortCut = 35 + end + item + Command = 108 + ShortCut = 8227 + end + item + Command = 16 + ShortCut = 16419 + end + item + Command = 116 + ShortCut = 24611 + end + item + Command = 223 + ShortCut = 45 + end + item + Command = 201 + ShortCut = 16429 + end + item + Command = 604 + ShortCut = 8237 + end + item + Command = 502 + ShortCut = 46 + end + item + Command = 603 + ShortCut = 8238 + end + item + Command = 501 + ShortCut = 8 + end + item + Command = 501 + ShortCut = 8200 + end + item + Command = 504 + ShortCut = 16392 + end + item + Command = 601 + ShortCut = 32776 + end + item + Command = 602 + ShortCut = 40968 + end + item + Command = 509 + ShortCut = 13 + end + item + Command = 199 + ShortCut = 16449 + end + item + Command = 201 + ShortCut = 16451 + end + item + Command = 610 + ShortCut = 24649 + end + item + Command = 509 + ShortCut = 16461 + end + item + Command = 510 + ShortCut = 16462 + end + item + Command = 503 + ShortCut = 16468 + end + item + Command = 611 + ShortCut = 24661 + end + item + Command = 604 + ShortCut = 16470 + end + item + Command = 603 + ShortCut = 16472 + end + item + Command = 507 + ShortCut = 16473 + end + item + Command = 506 + ShortCut = 24665 + end + item + Command = 601 + ShortCut = 16474 + end + item + Command = 602 + ShortCut = 24666 + end + item + Command = 301 + ShortCut = 16432 + end + item + Command = 302 + ShortCut = 16433 + end + item + Command = 303 + ShortCut = 16434 + end + item + Command = 304 + ShortCut = 16435 + end + item + Command = 305 + ShortCut = 16436 + end + item + Command = 306 + ShortCut = 16437 + end + item + Command = 307 + ShortCut = 16438 + end + item + Command = 308 + ShortCut = 16439 + end + item + Command = 309 + ShortCut = 16440 + end + item + Command = 310 + ShortCut = 16441 + end + item + Command = 351 + ShortCut = 24624 + end + item + Command = 352 + ShortCut = 24625 + end + item + Command = 353 + ShortCut = 24626 + end + item + Command = 354 + ShortCut = 24627 + end + item + Command = 355 + ShortCut = 24628 + end + item + Command = 356 + ShortCut = 24629 + end + item + Command = 357 + ShortCut = 24630 + end + item + Command = 358 + ShortCut = 24631 + end + item + Command = 359 + ShortCut = 24632 + end + item + Command = 360 + ShortCut = 24633 + end + item + Command = 231 + ShortCut = 24654 + end + item + Command = 232 + ShortCut = 24643 + end + item + Command = 233 + ShortCut = 24652 + end + item + Command = 612 + ShortCut = 9 + end + item + Command = 613 + ShortCut = 8201 + end + item + Command = 250 + ShortCut = 24642 + end> + ReadOnly = True + end + end + object tsProxy: TTabSheet + Caption = '&Proxy' + ClientHeight = 573 + ClientWidth = 501 + object srcProxy: TSynEdit + Height = 573 + Width = 501 + Align = alClient + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -20 + Font.Name = 'Courier' + Font.Pitch = fpFixed + ParentColor = False + PopupMenu = PopupMenu2 + TabOrder = 0 + BookMarkOptions.Xoffset = 81 + BookMarkOptions.OnChange = nil + Gutter.DigitCount = 5 + Gutter.ShowLineNumbers = True + Gutter.ShowCodeFolding = True + Gutter.OnChange = nil + Gutter.CodeFoldingWidth = 14 + Highlighter = SynPasSyn1 + Keystrokes = < + item + Command = 3 + ShortCut = 38 + end + item + Command = 103 + ShortCut = 8230 + end + item + Command = 211 + ShortCut = 16422 + end + item + Command = 4 + ShortCut = 40 + end + item + Command = 104 + ShortCut = 8232 + end + item + Command = 212 + ShortCut = 16424 + end + item + Command = 1 + ShortCut = 37 + end + item + Command = 101 + ShortCut = 8229 + end + item + Command = 5 + ShortCut = 16421 + end + item + Command = 105 + ShortCut = 24613 + end + item + Command = 2 + ShortCut = 39 + end + item + Command = 102 + ShortCut = 8231 + end + item + Command = 6 + ShortCut = 16423 + end + item + Command = 106 + ShortCut = 24615 + end + item + Command = 10 + ShortCut = 34 + end + item + Command = 110 + ShortCut = 8226 + end + item + Command = 14 + ShortCut = 16418 + end + item + Command = 114 + ShortCut = 24610 + end + item + Command = 9 + ShortCut = 33 + end + item + Command = 109 + ShortCut = 8225 + end + item + Command = 13 + ShortCut = 16417 + end + item + Command = 113 + ShortCut = 24609 + end + item + Command = 7 + ShortCut = 36 + end + item + Command = 107 + ShortCut = 8228 + end + item + Command = 15 + ShortCut = 16420 + end + item + Command = 115 + ShortCut = 24612 + end + item + Command = 8 + ShortCut = 35 + end + item + Command = 108 + ShortCut = 8227 + end + item + Command = 16 + ShortCut = 16419 + end + item + Command = 116 + ShortCut = 24611 + end + item + Command = 223 + ShortCut = 45 + end + item + Command = 201 + ShortCut = 16429 + end + item + Command = 604 + ShortCut = 8237 + end + item + Command = 502 + ShortCut = 46 + end + item + Command = 603 + ShortCut = 8238 + end + item + Command = 501 + ShortCut = 8 + end + item + Command = 501 + ShortCut = 8200 + end + item + Command = 504 + ShortCut = 16392 + end + item + Command = 601 + ShortCut = 32776 + end + item + Command = 602 + ShortCut = 40968 + end + item + Command = 509 + ShortCut = 13 + end + item + Command = 199 + ShortCut = 16449 + end + item + Command = 201 + ShortCut = 16451 + end + item + Command = 610 + ShortCut = 24649 + end + item + Command = 509 + ShortCut = 16461 + end + item + Command = 510 + ShortCut = 16462 + end + item + Command = 503 + ShortCut = 16468 + end + item + Command = 611 + ShortCut = 24661 + end + item + Command = 604 + ShortCut = 16470 + end + item + Command = 603 + ShortCut = 16472 + end + item + Command = 507 + ShortCut = 16473 + end + item + Command = 506 + ShortCut = 24665 + end + item + Command = 601 + ShortCut = 16474 + end + item + Command = 602 + ShortCut = 24666 + end + item + Command = 301 + ShortCut = 16432 + end + item + Command = 302 + ShortCut = 16433 + end + item + Command = 303 + ShortCut = 16434 + end + item + Command = 304 + ShortCut = 16435 + end + item + Command = 305 + ShortCut = 16436 + end + item + Command = 306 + ShortCut = 16437 + end + item + Command = 307 + ShortCut = 16438 + end + item + Command = 308 + ShortCut = 16439 + end + item + Command = 309 + ShortCut = 16440 + end + item + Command = 310 + ShortCut = 16441 + end + item + Command = 351 + ShortCut = 24624 + end + item + Command = 352 + ShortCut = 24625 + end + item + Command = 353 + ShortCut = 24626 + end + item + Command = 354 + ShortCut = 24627 + end + item + Command = 355 + ShortCut = 24628 + end + item + Command = 356 + ShortCut = 24629 + end + item + Command = 357 + ShortCut = 24630 + end + item + Command = 358 + ShortCut = 24631 + end + item + Command = 359 + ShortCut = 24632 + end + item + Command = 360 + ShortCut = 24633 + end + item + Command = 231 + ShortCut = 24654 + end + item + Command = 232 + ShortCut = 24643 + end + item + Command = 233 + ShortCut = 24652 + end + item + Command = 612 + ShortCut = 9 + end + item + Command = 613 + ShortCut = 8201 + end + item + Command = 250 + ShortCut = 24642 + end> + ReadOnly = True + SelectedColor.OnChange = nil + end + end + object tsImp: TTabSheet + Caption = 'Im&plementation Skeleton' + ClientHeight = 573 + ClientWidth = 501 + object srcImp: TSynEdit + Height = 573 + Width = 501 + Align = alClient + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -20 + Font.Name = 'Courier' + Font.Pitch = fpFixed + ParentColor = False + PopupMenu = PopupMenu2 + TabOrder = 0 + BookMarkOptions.Xoffset = 81 + BookMarkOptions.OnChange = nil + Gutter.DigitCount = 5 + Gutter.ShowLineNumbers = True + Gutter.ShowCodeFolding = True + Gutter.OnChange = nil + Gutter.CodeFoldingWidth = 14 + Highlighter = SynPasSyn1 + Keystrokes = < + item + Command = 3 + ShortCut = 38 + end + item + Command = 103 + ShortCut = 8230 + end + item + Command = 211 + ShortCut = 16422 + end + item + Command = 4 + ShortCut = 40 + end + item + Command = 104 + ShortCut = 8232 + end + item + Command = 212 + ShortCut = 16424 + end + item + Command = 1 + ShortCut = 37 + end + item + Command = 101 + ShortCut = 8229 + end + item + Command = 5 + ShortCut = 16421 + end + item + Command = 105 + ShortCut = 24613 + end + item + Command = 2 + ShortCut = 39 + end + item + Command = 102 + ShortCut = 8231 + end + item + Command = 6 + ShortCut = 16423 + end + item + Command = 106 + ShortCut = 24615 + end + item + Command = 10 + ShortCut = 34 + end + item + Command = 110 + ShortCut = 8226 + end + item + Command = 14 + ShortCut = 16418 + end + item + Command = 114 + ShortCut = 24610 + end + item + Command = 9 + ShortCut = 33 + end + item + Command = 109 + ShortCut = 8225 + end + item + Command = 13 + ShortCut = 16417 + end + item + Command = 113 + ShortCut = 24609 + end + item + Command = 7 + ShortCut = 36 + end + item + Command = 107 + ShortCut = 8228 + end + item + Command = 15 + ShortCut = 16420 + end + item + Command = 115 + ShortCut = 24612 + end + item + Command = 8 + ShortCut = 35 + end + item + Command = 108 + ShortCut = 8227 + end + item + Command = 16 + ShortCut = 16419 + end + item + Command = 116 + ShortCut = 24611 + end + item + Command = 223 + ShortCut = 45 + end + item + Command = 201 + ShortCut = 16429 + end + item + Command = 604 + ShortCut = 8237 + end + item + Command = 502 + ShortCut = 46 + end + item + Command = 603 + ShortCut = 8238 + end + item + Command = 501 + ShortCut = 8 + end + item + Command = 501 + ShortCut = 8200 + end + item + Command = 504 + ShortCut = 16392 + end + item + Command = 601 + ShortCut = 32776 + end + item + Command = 602 + ShortCut = 40968 + end + item + Command = 509 + ShortCut = 13 + end + item + Command = 199 + ShortCut = 16449 + end + item + Command = 201 + ShortCut = 16451 + end + item + Command = 610 + ShortCut = 24649 + end + item + Command = 509 + ShortCut = 16461 + end + item + Command = 510 + ShortCut = 16462 + end + item + Command = 503 + ShortCut = 16468 + end + item + Command = 611 + ShortCut = 24661 + end + item + Command = 604 + ShortCut = 16470 + end + item + Command = 603 + ShortCut = 16472 + end + item + Command = 507 + ShortCut = 16473 + end + item + Command = 506 + ShortCut = 24665 + end + item + Command = 601 + ShortCut = 16474 + end + item + Command = 602 + ShortCut = 24666 + end + item + Command = 301 + ShortCut = 16432 + end + item + Command = 302 + ShortCut = 16433 + end + item + Command = 303 + ShortCut = 16434 + end + item + Command = 304 + ShortCut = 16435 + end + item + Command = 305 + ShortCut = 16436 + end + item + Command = 306 + ShortCut = 16437 + end + item + Command = 307 + ShortCut = 16438 + end + item + Command = 308 + ShortCut = 16439 + end + item + Command = 309 + ShortCut = 16440 + end + item + Command = 310 + ShortCut = 16441 + end + item + Command = 351 + ShortCut = 24624 + end + item + Command = 352 + ShortCut = 24625 + end + item + Command = 353 + ShortCut = 24626 + end + item + Command = 354 + ShortCut = 24627 + end + item + Command = 355 + ShortCut = 24628 + end + item + Command = 356 + ShortCut = 24629 + end + item + Command = 357 + ShortCut = 24630 + end + item + Command = 358 + ShortCut = 24631 + end + item + Command = 359 + ShortCut = 24632 + end + item + Command = 360 + ShortCut = 24633 + end + item + Command = 231 + ShortCut = 24654 + end + item + Command = 232 + ShortCut = 24643 + end + item + Command = 233 + ShortCut = 24652 + end + item + Command = 612 + ShortCut = 9 + end + item + Command = 613 + ShortCut = 8201 + end + item + Command = 250 + ShortCut = 24642 + end> + ReadOnly = True + SelectedColor.OnChange = nil + end + end + object tsBinder: TTabSheet + Caption = '&Binder' + ClientHeight = 573 + ClientWidth = 501 + object srcBinder: TSynEdit + Height = 573 + Width = 501 + Align = alClient + Font.CharSet = ANSI_CHARSET + Font.Color = clBlack + Font.Height = -20 + Font.Name = 'Courier' + Font.Pitch = fpFixed + ParentColor = False + PopupMenu = PopupMenu2 + TabOrder = 0 + BookMarkOptions.Xoffset = 81 + BookMarkOptions.OnChange = nil + Gutter.AutoSize = True + Gutter.DigitCount = 5 + Gutter.ShowLineNumbers = True + Gutter.ShowCodeFolding = True + Gutter.OnChange = nil + Gutter.CodeFoldingWidth = 14 + Highlighter = SynPasSyn1 + Keystrokes = < + item + Command = 3 + ShortCut = 38 + end + item + Command = 103 + ShortCut = 8230 + end + item + Command = 211 + ShortCut = 16422 + end + item + Command = 4 + ShortCut = 40 + end + item + Command = 104 + ShortCut = 8232 + end + item + Command = 212 + ShortCut = 16424 + end + item + Command = 1 + ShortCut = 37 + end + item + Command = 101 + ShortCut = 8229 + end + item + Command = 5 + ShortCut = 16421 + end + item + Command = 105 + ShortCut = 24613 + end + item + Command = 2 + ShortCut = 39 + end + item + Command = 102 + ShortCut = 8231 + end + item + Command = 6 + ShortCut = 16423 + end + item + Command = 106 + ShortCut = 24615 + end + item + Command = 10 + ShortCut = 34 + end + item + Command = 110 + ShortCut = 8226 + end + item + Command = 14 + ShortCut = 16418 + end + item + Command = 114 + ShortCut = 24610 + end + item + Command = 9 + ShortCut = 33 + end + item + Command = 109 + ShortCut = 8225 + end + item + Command = 13 + ShortCut = 16417 + end + item + Command = 113 + ShortCut = 24609 + end + item + Command = 7 + ShortCut = 36 + end + item + Command = 107 + ShortCut = 8228 + end + item + Command = 15 + ShortCut = 16420 + end + item + Command = 115 + ShortCut = 24612 + end + item + Command = 8 + ShortCut = 35 + end + item + Command = 108 + ShortCut = 8227 + end + item + Command = 16 + ShortCut = 16419 + end + item + Command = 116 + ShortCut = 24611 + end + item + Command = 223 + ShortCut = 45 + end + item + Command = 201 + ShortCut = 16429 + end + item + Command = 604 + ShortCut = 8237 + end + item + Command = 502 + ShortCut = 46 + end + item + Command = 603 + ShortCut = 8238 + end + item + Command = 501 + ShortCut = 8 + end + item + Command = 501 + ShortCut = 8200 + end + item + Command = 504 + ShortCut = 16392 + end + item + Command = 601 + ShortCut = 32776 + end + item + Command = 602 + ShortCut = 40968 + end + item + Command = 509 + ShortCut = 13 + end + item + Command = 199 + ShortCut = 16449 + end + item + Command = 201 + ShortCut = 16451 + end + item + Command = 610 + ShortCut = 24649 + end + item + Command = 509 + ShortCut = 16461 + end + item + Command = 510 + ShortCut = 16462 + end + item + Command = 503 + ShortCut = 16468 + end + item + Command = 611 + ShortCut = 24661 + end + item + Command = 604 + ShortCut = 16470 + end + item + Command = 603 + ShortCut = 16472 + end + item + Command = 507 + ShortCut = 16473 + end + item + Command = 506 + ShortCut = 24665 + end + item + Command = 601 + ShortCut = 16474 + end + item + Command = 602 + ShortCut = 24666 + end + item + Command = 301 + ShortCut = 16432 + end + item + Command = 302 + ShortCut = 16433 + end + item + Command = 303 + ShortCut = 16434 + end + item + Command = 304 + ShortCut = 16435 + end + item + Command = 305 + ShortCut = 16436 + end + item + Command = 306 + ShortCut = 16437 + end + item + Command = 307 + ShortCut = 16438 + end + item + Command = 308 + ShortCut = 16439 + end + item + Command = 309 + ShortCut = 16440 + end + item + Command = 310 + ShortCut = 16441 + end + item + Command = 351 + ShortCut = 24624 + end + item + Command = 352 + ShortCut = 24625 + end + item + Command = 353 + ShortCut = 24626 + end + item + Command = 354 + ShortCut = 24627 + end + item + Command = 355 + ShortCut = 24628 + end + item + Command = 356 + ShortCut = 24629 + end + item + Command = 357 + ShortCut = 24630 + end + item + Command = 358 + ShortCut = 24631 + end + item + Command = 359 + ShortCut = 24632 + end + item + Command = 360 + ShortCut = 24633 + end + item + Command = 231 + ShortCut = 24654 + end + item + Command = 232 + ShortCut = 24643 + end + item + Command = 233 + ShortCut = 24652 + end + item + Command = 612 + ShortCut = 9 + end + item + Command = 613 + ShortCut = 8201 + end + item + Command = 250 + ShortCut = 24642 + end> + ReadOnly = True + SelectedColor.OnChange = nil + end + end + object tsLog: TTabSheet + Caption = '&Log' + ClientHeight = 573 + ClientWidth = 501 + object mmoLog: TMemo + Height = 573 + Width = 501 + Align = alClient + Lines.Strings = ( + '' + ) + ScrollBars = ssBoth + TabOrder = 0 + end + end + end + end + object Splitter1: TSplitter + Left = 314 + Height = 601 + Width = 8 + Color = clBlack + ParentColor = False + end + object MainMenu1: TMainMenu + left = 352 + top = 112 + object MenuItem1: TMenuItem + Caption = '&Files' + object MenuItem16: TMenuItem + Action = actNewFile + OnClick = actNewFileExecute + end + object MenuItem2: TMenuItem + Caption = '-' + OnClick = actOpenFileExecute + end + object MenuItem5: TMenuItem + Action = actOpenFile + OnClick = actOpenFileExecute + end + object MenuItem3: TMenuItem + Action = actExport + OnClick = actExportExecute + end + object MenuItem7: TMenuItem + Action = actSaveAs + OnClick = actSaveAsExecute + end + object MenuItem17: TMenuItem + Caption = '-' + end + object MenuItem4: TMenuItem + Action = actExit + OnClick = actExitExecute + end + end + object MenuItem14: TMenuItem + Caption = '&View' + object MenuItem15: TMenuItem + Action = actRefreshView + OnClick = actRefreshViewExecute + end + object MenuItem29: TMenuItem + Caption = '-' + end + object MenuItem30: TMenuItem + Action = actFullExpand + OnClick = actFullExpandExecute + end + object MenuItem31: TMenuItem + Action = actFullCollapse + OnClick = actFullCollapseExecute + end + end + object MenuItem10: TMenuItem + Caption = '&Edition' + object MenuItem11: TMenuItem + Action = actEnumCreate + OnClick = actEnumCreateExecute + end + object MenuItem23: TMenuItem + Action = actCompoundCreate + OnClick = actCompoundCreateExecute + end + object MenuItem25: TMenuItem + Action = actIntfCreate + OnClick = actIntfCreateExecute + end + object MenuItem12: TMenuItem + Caption = '-' + end + object MenuItem13: TMenuItem + Action = actUpdateObject + Caption = 'Update Object' + OnClick = actUpdateObjectExecute + end + end + object MenuItem6: TMenuItem + Action = actAbout + Caption = '&About' + OnClick = actAboutExecute + end + end + object AL: TActionList + left = 344 + top = 56 + object actOpenFile: TAction + Caption = 'Open File' + DisableIfNoHandler = True + OnExecute = actOpenFileExecute + end + object actExit: TAction + Caption = 'Exit' + DisableIfNoHandler = True + OnExecute = actExitExecute + end + object actExport: TAction + Caption = 'Save generated files ...' + DisableIfNoHandler = True + OnExecute = actExportExecute + OnUpdate = actExportUpdate + end + object actAbout: TAction + Caption = 'About' + DisableIfNoHandler = True + OnExecute = actAboutExecute + end + object actSaveAs: TAction + Caption = 'Save As ...' + DisableIfNoHandler = True + OnExecute = actSaveAsExecute + OnUpdate = actExportUpdate + end + object actEnumCreate: TAction + Caption = 'Create Enumeration' + DisableIfNoHandler = True + OnExecute = actEnumCreateExecute + end + object actUpdateObject: TAction + Caption = 'Update' + DisableIfNoHandler = True + OnExecute = actUpdateObjectExecute + OnUpdate = actUpdateObjectUpdate + end + object actRefreshView: TAction + Caption = '&Refresh Views' + DisableIfNoHandler = True + OnExecute = actRefreshViewExecute + end + object actNewFile: TAction + Caption = 'New File' + DisableIfNoHandler = True + OnExecute = actNewFileExecute + end + object actCompoundCreate: TAction + Caption = 'Create Compound Type' + DisableIfNoHandler = True + OnExecute = actCompoundCreateExecute + end + object actIntfCreate: TAction + Caption = 'Create Interface' + DisableIfNoHandler = True + OnExecute = actIntfCreateExecute + end + object actFullExpand: TAction + Caption = 'Full expand' + DisableIfNoHandler = True + OnExecute = actFullExpandExecute + end + object actFullCollapse: TAction + Caption = 'Full Collapse' + DisableIfNoHandler = True + OnExecute = actFullCollapseExecute + end + end + object OD: TOpenDialog + Title = 'Ouvrir un fichier existant' + Filter = 'WDSL files(*.WSDL)|*.WSDL' + FilterIndex = 0 + InitialDir = '.\' + Options = [ofPathMustExist, ofFileMustExist, ofEnableSizing, ofViewDetail] + left = 409 + top = 88 + end + object SynPasSyn1: TSynPasSyn + Enabled = False + CommentAttri.Foreground = clBlue + CommentAttri.Style = [fsBold] + StringAttri.Foreground = clMaroon + SymbolAttri.Style = [fsBold] + DirectiveAttri.Foreground = clGreen + DirectiveAttri.Style = [fsBold] + NestedComments = True + left = 439 + top = 104 + end + object SDD: TSelectDirectoryDialog + Title = 'Select Directory' + FilterIndex = 0 + Options = [ofPathMustExist, ofEnableSizing, ofViewDetail] + left = 432 + top = 152 + end + object SD: TSaveDialog + Title = 'Enregistrer le fichier sous' + DefaultExt = '.WSDL' + Filter = 'WDSL files(*.WSDL)|*.WSDL' + FilterIndex = 0 + Options = [ofPathMustExist, ofEnableSizing, ofViewDetail] + left = 498 + top = 174 + end + object PopupMenu1: TPopupMenu + left = 384 + top = 264 + object MenuItem28: TMenuItem + Action = actFullExpand + OnClick = actFullExpandExecute + end + object MenuItem27: TMenuItem + Action = actFullCollapse + OnClick = actFullCollapseExecute + end + object MenuItem26: TMenuItem + Caption = '-' + end + object MenuItem8: TMenuItem + Action = actEnumCreate + OnClick = actEnumCreateExecute + end + object MenuItem21: TMenuItem + Action = actCompoundCreate + OnClick = actCompoundCreateExecute + end + object MenuItem24: TMenuItem + Action = actIntfCreate + OnClick = actIntfCreateExecute + end + object MenuItem22: TMenuItem + Caption = '-' + end + object MenuItem9: TMenuItem + Action = actUpdateObject + OnClick = actUpdateObjectExecute + end + end + object PopupMenu2: TPopupMenu + left = 528 + top = 235 + object MenuItem18: TMenuItem + Action = actRefreshView + OnClick = actRefreshViewExecute + end + object MenuItem19: TMenuItem + Caption = '-' + end + object MenuItem20: TMenuItem + Action = actExport + OnClick = actExportExecute + end + end +end diff --git a/wst/trunk/type_lib_edtr/umain.lrs b/wst/trunk/type_lib_edtr/umain.lrs new file mode 100644 index 000000000..f15f1b903 --- /dev/null +++ b/wst/trunk/type_lib_edtr/umain.lrs @@ -0,0 +1,303 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + +LazarusResources.Add('TfMain','FORMDATA',[ + 'TPF0'#6'TfMain'#5'fMain'#4'Left'#2'r'#6'Height'#3#132#2#3'Top'#3#209#0#5'Wid' + +'th'#3'A'#3#18'HorzScrollBar.Page'#3'@'#3#18'VertScrollBar.Page'#3'o'#2#13'A' + +'ctiveControl'#7#9'trvSchema'#7'Caption'#6'+[Web Services Toolkit ] Type Lib' + +'rary Editor'#12'ClientHeight'#3'p'#2#11'ClientWidth'#3'A'#3#4'Menu'#7#9'Mai' + +'nMenu1'#6'OnShow'#7#8'FormShow'#8'Position'#7#15'poDesktopCenter'#0#10'TSta' + +'tusBar'#2'SB'#6'Height'#2#23#3'Top'#3'Y'#2#5'Width'#3'A'#3#6'Panels'#14#1#5 + +'Width'#3#200#0#0#1#5'Width'#2'2'#0#0#11'SimplePanel'#8#0#0#6'TPanel'#6'Pane' + +'l1'#6'Height'#3'Y'#2#5'Width'#3':'#1#5'Align'#7#6'alLeft'#12'ClientHeight'#3 + +'Y'#2#11'ClientWidth'#3':'#1#8'TabOrder'#2#0#0#9'TTreeView'#9'trvSchema'#4'L' + +'eft'#2#1#6'Height'#3'W'#2#3'Top'#2#1#5'Width'#3'8'#1#5'Align'#7#8'alClient' + +#17'DefaultItemHeight'#2#15#9'PopupMenu'#7#10'PopupMenu1'#8'TabOrder'#2#0#0#0 + +#0#6'TPanel'#6'Panel2'#4'Left'#3'B'#1#6'Height'#3'Y'#2#5'Width'#3#255#1#5'Al' + +'ign'#7#8'alClient'#12'ClientHeight'#3'Y'#2#11'ClientWidth'#3#255#1#8'TabOrd' + +'er'#2#1#0#12'TPageControl'#2'PC'#4'Left'#2#1#6'Height'#3'W'#2#3'Top'#2#1#5 + +'Width'#3#253#1#10'ActivePage'#7#11'tsInterface'#5'Align'#7#8'alClient'#8'Ta' + +'bIndex'#2#0#8'TabOrder'#2#0#0#9'TTabSheet'#11'tsInterface'#7'Caption'#6#10 + +'&Interface'#12'ClientHeight'#3'='#2#11'ClientWidth'#3#245#1#0#8'TSynEdit'#12 + +'srcInterface'#6'Height'#3'='#2#5'Width'#3#245#1#5'Align'#7#8'alClient'#12'F' + +'ont.CharSet'#7#12'ANSI_CHARSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height' + +#2#236#9'Font.Name'#6#7'Courier'#10'Font.Pitch'#7#7'fpFixed'#11'ParentColor' + +#8#9'PopupMenu'#7#10'PopupMenu2'#8'TabOrder'#2#0#23'BookMarkOptions.Xoffset' + +#2'Q'#17'Gutter.DigitCount'#2#5#22'Gutter.ShowLineNumbers'#9#22'Gutter.ShowC' + +'odeFolding'#9#23'Gutter.CodeFoldingWidth'#2#14#11'Highlighter'#7#10'SynPasS' + +'yn1'#10'Keystrokes'#14#1#7'Command'#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g' + +#8'ShortCut'#3'& '#0#1#7'Command'#3#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2 + +#4#8'ShortCut'#2'('#0#1#7'Command'#2'h'#8'ShortCut'#3'( '#0#1#7'Command'#3 + +#212#0#8'ShortCut'#3'(@'#0#1#7'Command'#2#1#8'ShortCut'#2'%'#0#1#7'Command'#2 + +'e'#8'ShortCut'#3'% '#0#1#7'Command'#2#5#8'ShortCut'#3'%@'#0#1#7'Command'#2 + +'i'#8'ShortCut'#3'%`'#0#1#7'Command'#2#2#8'ShortCut'#2''''#0#1#7'Command'#2 + +'f'#8'ShortCut'#3''' '#0#1#7'Command'#2#6#8'ShortCut'#3'''@'#0#1#7'Command'#2 + +'j'#8'ShortCut'#3'''`'#0#1#7'Command'#2#10#8'ShortCut'#2'"'#0#1#7'Command'#2 + +'n'#8'ShortCut'#3'" '#0#1#7'Command'#2#14#8'ShortCut'#3'"@'#0#1#7'Command'#2 + +'r'#8'ShortCut'#3'"`'#0#1#7'Command'#2#9#8'ShortCut'#2'!'#0#1#7'Command'#2'm' + +#8'ShortCut'#3'! '#0#1#7'Command'#2#13#8'ShortCut'#3'!@'#0#1#7'Command'#2'q' + +#8'ShortCut'#3'!`'#0#1#7'Command'#2#7#8'ShortCut'#2'$'#0#1#7'Command'#2'k'#8 + +'ShortCut'#3'$ '#0#1#7'Command'#2#15#8'ShortCut'#3'$@'#0#1#7'Command'#2's'#8 + +'ShortCut'#3'$`'#0#1#7'Command'#2#8#8'ShortCut'#2'#'#0#1#7'Command'#2'l'#8'S' + +'hortCut'#3'# '#0#1#7'Command'#2#16#8'ShortCut'#3'#@'#0#1#7'Command'#2't'#8 + +'ShortCut'#3'#`'#0#1#7'Command'#3#223#0#8'ShortCut'#2'-'#0#1#7'Command'#3#201 + +#0#8'ShortCut'#3'-@'#0#1#7'Command'#3'\'#2#8'ShortCut'#3'- '#0#1#7'Command'#3 + +#246#1#8'ShortCut'#2'.'#0#1#7'Command'#3'['#2#8'ShortCut'#3'. '#0#1#7'Comman' + +'d'#3#245#1#8'ShortCut'#2#8#0#1#7'Command'#3#245#1#8'ShortCut'#3#8' '#0#1#7 + +'Command'#3#248#1#8'ShortCut'#3#8'@'#0#1#7'Command'#3'Y'#2#8'ShortCut'#4#8 + +#128#0#0#0#1#7'Command'#3'Z'#2#8'ShortCut'#4#8#160#0#0#0#1#7'Command'#3#253#1 + +#8'ShortCut'#2#13#0#1#7'Command'#3#199#0#8'ShortCut'#3'A@'#0#1#7'Command'#3 + +#201#0#8'ShortCut'#3'C@'#0#1#7'Command'#3'b'#2#8'ShortCut'#3'I`'#0#1#7'Comma' + +'nd'#3#253#1#8'ShortCut'#3'M@'#0#1#7'Command'#3#254#1#8'ShortCut'#3'N@'#0#1#7 + +'Command'#3#247#1#8'ShortCut'#3'T@'#0#1#7'Command'#3'c'#2#8'ShortCut'#3'U`'#0 + +#1#7'Command'#3'\'#2#8'ShortCut'#3'V@'#0#1#7'Command'#3'['#2#8'ShortCut'#3'X' + +'@'#0#1#7'Command'#3#251#1#8'ShortCut'#3'Y@'#0#1#7'Command'#3#250#1#8'ShortC' + +'ut'#3'Y`'#0#1#7'Command'#3'Y'#2#8'ShortCut'#3'Z@'#0#1#7'Command'#3'Z'#2#8'S' + +'hortCut'#3'Z`'#0#1#7'Command'#3'-'#1#8'ShortCut'#3'0@'#0#1#7'Command'#3'.'#1 + +#8'ShortCut'#3'1@'#0#1#7'Command'#3'/'#1#8'ShortCut'#3'2@'#0#1#7'Command'#3 + +'0'#1#8'ShortCut'#3'3@'#0#1#7'Command'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Comman' + +'d'#3'2'#1#8'ShortCut'#3'5@'#0#1#7'Command'#3'3'#1#8'ShortCut'#3'6@'#0#1#7'C' + +'ommand'#3'4'#1#8'ShortCut'#3'7@'#0#1#7'Command'#3'5'#1#8'ShortCut'#3'8@'#0#1 + +#7'Command'#3'6'#1#8'ShortCut'#3'9@'#0#1#7'Command'#3'_'#1#8'ShortCut'#3'0`' + +#0#1#7'Command'#3'`'#1#8'ShortCut'#3'1`'#0#1#7'Command'#3'a'#1#8'ShortCut'#3 + +'2`'#0#1#7'Command'#3'b'#1#8'ShortCut'#3'3`'#0#1#7'Command'#3'c'#1#8'ShortCu' + +'t'#3'4`'#0#1#7'Command'#3'd'#1#8'ShortCut'#3'5`'#0#1#7'Command'#3'e'#1#8'Sh' + +'ortCut'#3'6`'#0#1#7'Command'#3'f'#1#8'ShortCut'#3'7`'#0#1#7'Command'#3'g'#1 + +#8'ShortCut'#3'8`'#0#1#7'Command'#3'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3 + +#231#0#8'ShortCut'#3'N`'#0#1#7'Command'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Comm' + +'and'#3#233#0#8'ShortCut'#3'L`'#0#1#7'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7 + ,'Command'#3'e'#2#8'ShortCut'#3#9' '#0#1#7'Command'#3#250#0#8'ShortCut'#3'B`' + +#0#0#8'ReadOnly'#9#0#0#0#9'TTabSheet'#7'tsProxy'#7'Caption'#6#6'&Proxy'#12'C' + +'lientHeight'#3'='#2#11'ClientWidth'#3#245#1#0#8'TSynEdit'#8'srcProxy'#6'Hei' + +'ght'#3'='#2#5'Width'#3#245#1#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12'A' + +'NSI_CHARSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#236#9'Font.Name' + +#6#7'Courier'#10'Font.Pitch'#7#7'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10 + +'PopupMenu2'#8'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'Q'#24'BookMarkOpt' + +'ions.OnChange'#13#17'Gutter.DigitCount'#2#5#22'Gutter.ShowLineNumbers'#9#22 + +'Gutter.ShowCodeFolding'#9#15'Gutter.OnChange'#13#23'Gutter.CodeFoldingWidth' + +#2#14#11'Highlighter'#7#10'SynPasSyn1'#10'Keystrokes'#14#1#7'Command'#2#3#8 + +'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7'Command'#3#211#0 + +#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7'Command'#2'h'#8 + +'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1#7'Command'#2#1 + +#8'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1#7'Command'#2#5#8 + +'ShortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7'Command'#2#2#8 + +'ShortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7'Command'#2#6#8 + +'ShortCut'#3'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7'Command'#2#10 + +#8'ShortCut'#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7'Command'#2#14#8 + +'ShortCut'#3'"@'#0#1#7'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7'Command'#2#9#8 + +'ShortCut'#2'!'#0#1#7'Command'#2'm'#8'ShortCut'#3'! '#0#1#7'Command'#2#13#8 + +'ShortCut'#3'!@'#0#1#7'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7'Command'#2#7#8 + +'ShortCut'#2'$'#0#1#7'Command'#2'k'#8'ShortCut'#3'$ '#0#1#7'Command'#2#15#8 + +'ShortCut'#3'$@'#0#1#7'Command'#2's'#8'ShortCut'#3'$`'#0#1#7'Command'#2#8#8 + +'ShortCut'#2'#'#0#1#7'Command'#2'l'#8'ShortCut'#3'# '#0#1#7'Command'#2#16#8 + +'ShortCut'#3'#@'#0#1#7'Command'#2't'#8'ShortCut'#3'#`'#0#1#7'Command'#3#223#0 + +#8'ShortCut'#2'-'#0#1#7'Command'#3#201#0#8'ShortCut'#3'-@'#0#1#7'Command'#3 + +'\'#2#8'ShortCut'#3'- '#0#1#7'Command'#3#246#1#8'ShortCut'#2'.'#0#1#7'Comman' + +'d'#3'['#2#8'ShortCut'#3'. '#0#1#7'Command'#3#245#1#8'ShortCut'#2#8#0#1#7'Co' + +'mmand'#3#245#1#8'ShortCut'#3#8' '#0#1#7'Command'#3#248#1#8'ShortCut'#3#8'@' + +#0#1#7'Command'#3'Y'#2#8'ShortCut'#4#8#128#0#0#0#1#7'Command'#3'Z'#2#8'Short' + +'Cut'#4#8#160#0#0#0#1#7'Command'#3#253#1#8'ShortCut'#2#13#0#1#7'Command'#3 + +#199#0#8'ShortCut'#3'A@'#0#1#7'Command'#3#201#0#8'ShortCut'#3'C@'#0#1#7'Comm' + +'and'#3'b'#2#8'ShortCut'#3'I`'#0#1#7'Command'#3#253#1#8'ShortCut'#3'M@'#0#1#7 + +'Command'#3#254#1#8'ShortCut'#3'N@'#0#1#7'Command'#3#247#1#8'ShortCut'#3'T@' + +#0#1#7'Command'#3'c'#2#8'ShortCut'#3'U`'#0#1#7'Command'#3'\'#2#8'ShortCut'#3 + +'V@'#0#1#7'Command'#3'['#2#8'ShortCut'#3'X@'#0#1#7'Command'#3#251#1#8'ShortC' + +'ut'#3'Y@'#0#1#7'Command'#3#250#1#8'ShortCut'#3'Y`'#0#1#7'Command'#3'Y'#2#8 + +'ShortCut'#3'Z@'#0#1#7'Command'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Command'#3'-' + +#1#8'ShortCut'#3'0@'#0#1#7'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7'Command'#3 + +'/'#1#8'ShortCut'#3'2@'#0#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0#1#7'Comman' + +'d'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5@'#0#1#7'C' + +'ommand'#3'3'#1#8'ShortCut'#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut'#3'7@'#0#1 + +#7'Command'#3'5'#1#8'ShortCut'#3'8@'#0#1#7'Command'#3'6'#1#8'ShortCut'#3'9@' + +#0#1#7'Command'#3'_'#1#8'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8'ShortCut'#3 + +'1`'#0#1#7'Command'#3'a'#1#8'ShortCut'#3'2`'#0#1#7'Command'#3'b'#1#8'ShortCu' + +'t'#3'3`'#0#1#7'Command'#3'c'#1#8'ShortCut'#3'4`'#0#1#7'Command'#3'd'#1#8'Sh' + +'ortCut'#3'5`'#0#1#7'Command'#3'e'#1#8'ShortCut'#3'6`'#0#1#7'Command'#3'f'#1 + +#8'ShortCut'#3'7`'#0#1#7'Command'#3'g'#1#8'ShortCut'#3'8`'#0#1#7'Command'#3 + +'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0#1#7'Comma' + +'nd'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3'L`'#0#1#7 + +'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut'#3#9' '#0#1 + +#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#22'SelectedColor.OnC' + +'hange'#13#0#0#0#9'TTabSheet'#5'tsImp'#7'Caption'#6#24'Im&plementation Skele' + +'ton'#12'ClientHeight'#3'='#2#11'ClientWidth'#3#245#1#0#8'TSynEdit'#6'srcImp' + +#6'Height'#3'='#2#5'Width'#3#245#1#5'Align'#7#8'alClient'#12'Font.CharSet'#7 + +#12'ANSI_CHARSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#236#9'Font.N' + +'ame'#6#7'Courier'#10'Font.Pitch'#7#7'fpFixed'#11'ParentColor'#8#9'PopupMenu' + +#7#10'PopupMenu2'#8'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'Q'#24'BookMa' + +'rkOptions.OnChange'#13#17'Gutter.DigitCount'#2#5#22'Gutter.ShowLineNumbers' + +#9#22'Gutter.ShowCodeFolding'#9#15'Gutter.OnChange'#13#23'Gutter.CodeFolding' + +'Width'#2#14#11'Highlighter'#7#10'SynPasSyn1'#10'Keystrokes'#14#1#7'Command' + +#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1#7'Command'#3 + +#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1#7'Command'#2 + +'h'#8'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0#1#7'Command' + ,#2#1#8'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1#7'Command'#2 + +#5#8'ShortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7'Command'#2#2 + +#8'ShortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7'Command'#2#6 + +#8'ShortCut'#3'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7'Command'#2 + +#10#8'ShortCut'#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7'Command'#2 + +#14#8'ShortCut'#3'"@'#0#1#7'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7'Command'#2 + +#9#8'ShortCut'#2'!'#0#1#7'Command'#2'm'#8'ShortCut'#3'! '#0#1#7'Command'#2#13 + +#8'ShortCut'#3'!@'#0#1#7'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7'Command'#2#7#8 + +'ShortCut'#2'$'#0#1#7'Command'#2'k'#8'ShortCut'#3'$ '#0#1#7'Command'#2#15#8 + +'ShortCut'#3'$@'#0#1#7'Command'#2's'#8'ShortCut'#3'$`'#0#1#7'Command'#2#8#8 + +'ShortCut'#2'#'#0#1#7'Command'#2'l'#8'ShortCut'#3'# '#0#1#7'Command'#2#16#8 + +'ShortCut'#3'#@'#0#1#7'Command'#2't'#8'ShortCut'#3'#`'#0#1#7'Command'#3#223#0 + +#8'ShortCut'#2'-'#0#1#7'Command'#3#201#0#8'ShortCut'#3'-@'#0#1#7'Command'#3 + +'\'#2#8'ShortCut'#3'- '#0#1#7'Command'#3#246#1#8'ShortCut'#2'.'#0#1#7'Comman' + +'d'#3'['#2#8'ShortCut'#3'. '#0#1#7'Command'#3#245#1#8'ShortCut'#2#8#0#1#7'Co' + +'mmand'#3#245#1#8'ShortCut'#3#8' '#0#1#7'Command'#3#248#1#8'ShortCut'#3#8'@' + +#0#1#7'Command'#3'Y'#2#8'ShortCut'#4#8#128#0#0#0#1#7'Command'#3'Z'#2#8'Short' + +'Cut'#4#8#160#0#0#0#1#7'Command'#3#253#1#8'ShortCut'#2#13#0#1#7'Command'#3 + +#199#0#8'ShortCut'#3'A@'#0#1#7'Command'#3#201#0#8'ShortCut'#3'C@'#0#1#7'Comm' + +'and'#3'b'#2#8'ShortCut'#3'I`'#0#1#7'Command'#3#253#1#8'ShortCut'#3'M@'#0#1#7 + +'Command'#3#254#1#8'ShortCut'#3'N@'#0#1#7'Command'#3#247#1#8'ShortCut'#3'T@' + +#0#1#7'Command'#3'c'#2#8'ShortCut'#3'U`'#0#1#7'Command'#3'\'#2#8'ShortCut'#3 + +'V@'#0#1#7'Command'#3'['#2#8'ShortCut'#3'X@'#0#1#7'Command'#3#251#1#8'ShortC' + +'ut'#3'Y@'#0#1#7'Command'#3#250#1#8'ShortCut'#3'Y`'#0#1#7'Command'#3'Y'#2#8 + +'ShortCut'#3'Z@'#0#1#7'Command'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Command'#3'-' + +#1#8'ShortCut'#3'0@'#0#1#7'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7'Command'#3 + +'/'#1#8'ShortCut'#3'2@'#0#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0#1#7'Comman' + +'d'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5@'#0#1#7'C' + +'ommand'#3'3'#1#8'ShortCut'#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut'#3'7@'#0#1 + +#7'Command'#3'5'#1#8'ShortCut'#3'8@'#0#1#7'Command'#3'6'#1#8'ShortCut'#3'9@' + +#0#1#7'Command'#3'_'#1#8'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8'ShortCut'#3 + +'1`'#0#1#7'Command'#3'a'#1#8'ShortCut'#3'2`'#0#1#7'Command'#3'b'#1#8'ShortCu' + +'t'#3'3`'#0#1#7'Command'#3'c'#1#8'ShortCut'#3'4`'#0#1#7'Command'#3'd'#1#8'Sh' + +'ortCut'#3'5`'#0#1#7'Command'#3'e'#1#8'ShortCut'#3'6`'#0#1#7'Command'#3'f'#1 + +#8'ShortCut'#3'7`'#0#1#7'Command'#3'g'#1#8'ShortCut'#3'8`'#0#1#7'Command'#3 + +'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0#1#7'Comma' + +'nd'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3'L`'#0#1#7 + +'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut'#3#9' '#0#1 + +#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#22'SelectedColor.OnC' + +'hange'#13#0#0#0#9'TTabSheet'#8'tsBinder'#7'Caption'#6#7'&Binder'#12'ClientH' + +'eight'#3'='#2#11'ClientWidth'#3#245#1#0#8'TSynEdit'#9'srcBinder'#6'Height'#3 + +'='#2#5'Width'#3#245#1#5'Align'#7#8'alClient'#12'Font.CharSet'#7#12'ANSI_CHA' + +'RSET'#10'Font.Color'#7#7'clBlack'#11'Font.Height'#2#236#9'Font.Name'#6#7'Co' + +'urier'#10'Font.Pitch'#7#7'fpFixed'#11'ParentColor'#8#9'PopupMenu'#7#10'Popu' + +'pMenu2'#8'TabOrder'#2#0#23'BookMarkOptions.Xoffset'#2'Q'#24'BookMarkOptions' + +'.OnChange'#13#15'Gutter.AutoSize'#9#17'Gutter.DigitCount'#2#5#22'Gutter.Sho' + +'wLineNumbers'#9#22'Gutter.ShowCodeFolding'#9#15'Gutter.OnChange'#13#23'Gutt' + +'er.CodeFoldingWidth'#2#14#11'Highlighter'#7#10'SynPasSyn1'#10'Keystrokes'#14 + +#1#7'Command'#2#3#8'ShortCut'#2'&'#0#1#7'Command'#2'g'#8'ShortCut'#3'& '#0#1 + +#7'Command'#3#211#0#8'ShortCut'#3'&@'#0#1#7'Command'#2#4#8'ShortCut'#2'('#0#1 + +#7'Command'#2'h'#8'ShortCut'#3'( '#0#1#7'Command'#3#212#0#8'ShortCut'#3'(@'#0 + +#1#7'Command'#2#1#8'ShortCut'#2'%'#0#1#7'Command'#2'e'#8'ShortCut'#3'% '#0#1 + +#7'Command'#2#5#8'ShortCut'#3'%@'#0#1#7'Command'#2'i'#8'ShortCut'#3'%`'#0#1#7 + +'Command'#2#2#8'ShortCut'#2''''#0#1#7'Command'#2'f'#8'ShortCut'#3''' '#0#1#7 + +'Command'#2#6#8'ShortCut'#3'''@'#0#1#7'Command'#2'j'#8'ShortCut'#3'''`'#0#1#7 + +'Command'#2#10#8'ShortCut'#2'"'#0#1#7'Command'#2'n'#8'ShortCut'#3'" '#0#1#7 + +'Command'#2#14#8'ShortCut'#3'"@'#0#1#7'Command'#2'r'#8'ShortCut'#3'"`'#0#1#7 + +'Command'#2#9#8'ShortCut'#2'!'#0#1#7'Command'#2'm'#8'ShortCut'#3'! '#0#1#7'C' + +'ommand'#2#13#8'ShortCut'#3'!@'#0#1#7'Command'#2'q'#8'ShortCut'#3'!`'#0#1#7 + +'Command'#2#7#8'ShortCut'#2'$'#0#1#7'Command'#2'k'#8'ShortCut'#3'$ '#0#1#7'C' + +'ommand'#2#15#8'ShortCut'#3'$@'#0#1#7'Command'#2's'#8'ShortCut'#3'$`'#0#1#7 + +'Command'#2#8#8'ShortCut'#2'#'#0#1#7'Command'#2'l'#8'ShortCut'#3'# '#0#1#7'C' + +'ommand'#2#16#8'ShortCut'#3'#@'#0#1#7'Command'#2't'#8'ShortCut'#3'#`'#0#1#7 + +'Command'#3#223#0#8'ShortCut'#2'-'#0#1#7'Command'#3#201#0#8'ShortCut'#3'-@'#0 + ,#1#7'Command'#3'\'#2#8'ShortCut'#3'- '#0#1#7'Command'#3#246#1#8'ShortCut'#2 + +'.'#0#1#7'Command'#3'['#2#8'ShortCut'#3'. '#0#1#7'Command'#3#245#1#8'ShortCu' + +'t'#2#8#0#1#7'Command'#3#245#1#8'ShortCut'#3#8' '#0#1#7'Command'#3#248#1#8'S' + +'hortCut'#3#8'@'#0#1#7'Command'#3'Y'#2#8'ShortCut'#4#8#128#0#0#0#1#7'Command' + +#3'Z'#2#8'ShortCut'#4#8#160#0#0#0#1#7'Command'#3#253#1#8'ShortCut'#2#13#0#1#7 + +'Command'#3#199#0#8'ShortCut'#3'A@'#0#1#7'Command'#3#201#0#8'ShortCut'#3'C@' + +#0#1#7'Command'#3'b'#2#8'ShortCut'#3'I`'#0#1#7'Command'#3#253#1#8'ShortCut'#3 + +'M@'#0#1#7'Command'#3#254#1#8'ShortCut'#3'N@'#0#1#7'Command'#3#247#1#8'Short' + +'Cut'#3'T@'#0#1#7'Command'#3'c'#2#8'ShortCut'#3'U`'#0#1#7'Command'#3'\'#2#8 + +'ShortCut'#3'V@'#0#1#7'Command'#3'['#2#8'ShortCut'#3'X@'#0#1#7'Command'#3#251 + +#1#8'ShortCut'#3'Y@'#0#1#7'Command'#3#250#1#8'ShortCut'#3'Y`'#0#1#7'Command' + +#3'Y'#2#8'ShortCut'#3'Z@'#0#1#7'Command'#3'Z'#2#8'ShortCut'#3'Z`'#0#1#7'Comm' + +'and'#3'-'#1#8'ShortCut'#3'0@'#0#1#7'Command'#3'.'#1#8'ShortCut'#3'1@'#0#1#7 + +'Command'#3'/'#1#8'ShortCut'#3'2@'#0#1#7'Command'#3'0'#1#8'ShortCut'#3'3@'#0 + +#1#7'Command'#3'1'#1#8'ShortCut'#3'4@'#0#1#7'Command'#3'2'#1#8'ShortCut'#3'5' + +'@'#0#1#7'Command'#3'3'#1#8'ShortCut'#3'6@'#0#1#7'Command'#3'4'#1#8'ShortCut' + +#3'7@'#0#1#7'Command'#3'5'#1#8'ShortCut'#3'8@'#0#1#7'Command'#3'6'#1#8'Short' + +'Cut'#3'9@'#0#1#7'Command'#3'_'#1#8'ShortCut'#3'0`'#0#1#7'Command'#3'`'#1#8 + +'ShortCut'#3'1`'#0#1#7'Command'#3'a'#1#8'ShortCut'#3'2`'#0#1#7'Command'#3'b' + +#1#8'ShortCut'#3'3`'#0#1#7'Command'#3'c'#1#8'ShortCut'#3'4`'#0#1#7'Command'#3 + +'d'#1#8'ShortCut'#3'5`'#0#1#7'Command'#3'e'#1#8'ShortCut'#3'6`'#0#1#7'Comman' + +'d'#3'f'#1#8'ShortCut'#3'7`'#0#1#7'Command'#3'g'#1#8'ShortCut'#3'8`'#0#1#7'C' + +'ommand'#3'h'#1#8'ShortCut'#3'9`'#0#1#7'Command'#3#231#0#8'ShortCut'#3'N`'#0 + +#1#7'Command'#3#232#0#8'ShortCut'#3'C`'#0#1#7'Command'#3#233#0#8'ShortCut'#3 + +'L`'#0#1#7'Command'#3'd'#2#8'ShortCut'#2#9#0#1#7'Command'#3'e'#2#8'ShortCut' + +#3#9' '#0#1#7'Command'#3#250#0#8'ShortCut'#3'B`'#0#0#8'ReadOnly'#9#22'Select' + +'edColor.OnChange'#13#0#0#0#9'TTabSheet'#5'tsLog'#7'Caption'#6#4'&Log'#12'Cl' + +'ientHeight'#3'='#2#11'ClientWidth'#3#245#1#0#5'TMemo'#6'mmoLog'#6'Height'#3 + +'='#2#5'Width'#3#245#1#5'Align'#7#8'alClient'#13'Lines.Strings'#1#6#0#0#10'S' + +'crollBars'#7#6'ssBoth'#8'TabOrder'#2#0#0#0#0#0#0#9'TSplitter'#9'Splitter1'#4 + +'Left'#3':'#1#6'Height'#3'Y'#2#5'Width'#2#8#5'Color'#7#7'clBlack'#11'ParentC' + +'olor'#8#0#0#9'TMainMenu'#9'MainMenu1'#4'left'#3'`'#1#3'top'#2'p'#0#9'TMenuI' + +'tem'#9'MenuItem1'#7'Caption'#6#6'&Files'#0#9'TMenuItem'#10'MenuItem16'#6'Ac' + +'tion'#7#10'actNewFile'#7'OnClick'#7#17'actNewFileExecute'#0#0#9'TMenuItem'#9 + +'MenuItem2'#7'Caption'#6#1'-'#7'OnClick'#7#18'actOpenFileExecute'#0#0#9'TMen' + +'uItem'#9'MenuItem5'#6'Action'#7#11'actOpenFile'#7'OnClick'#7#18'actOpenFile' + +'Execute'#0#0#9'TMenuItem'#9'MenuItem3'#6'Action'#7#9'actExport'#7'OnClick'#7 + +#16'actExportExecute'#0#0#9'TMenuItem'#9'MenuItem7'#6'Action'#7#9'actSaveAs' + +#7'OnClick'#7#16'actSaveAsExecute'#0#0#9'TMenuItem'#10'MenuItem17'#7'Caption' + +#6#1'-'#0#0#9'TMenuItem'#9'MenuItem4'#6'Action'#7#7'actExit'#7'OnClick'#7#14 + +'actExitExecute'#0#0#0#9'TMenuItem'#10'MenuItem14'#7'Caption'#6#5'&View'#0#9 + +'TMenuItem'#10'MenuItem15'#6'Action'#7#14'actRefreshView'#7'OnClick'#7#21'ac' + +'tRefreshViewExecute'#0#0#9'TMenuItem'#10'MenuItem29'#7'Caption'#6#1'-'#0#0#9 + +'TMenuItem'#10'MenuItem30'#6'Action'#7#13'actFullExpand'#7'OnClick'#7#20'act' + +'FullExpandExecute'#0#0#9'TMenuItem'#10'MenuItem31'#6'Action'#7#15'actFullCo' + +'llapse'#7'OnClick'#7#22'actFullCollapseExecute'#0#0#0#9'TMenuItem'#10'MenuI' + +'tem10'#7'Caption'#6#8'&Edition'#0#9'TMenuItem'#10'MenuItem11'#6'Action'#7#13 + +'actEnumCreate'#7'OnClick'#7#20'actEnumCreateExecute'#0#0#9'TMenuItem'#10'Me' + +'nuItem23'#6'Action'#7#17'actCompoundCreate'#7'OnClick'#7#24'actCompoundCrea' + +'teExecute'#0#0#9'TMenuItem'#10'MenuItem25'#6'Action'#7#13'actIntfCreate'#7 + +'OnClick'#7#20'actIntfCreateExecute'#0#0#9'TMenuItem'#10'MenuItem12'#7'Capti' + +'on'#6#1'-'#0#0#9'TMenuItem'#10'MenuItem13'#6'Action'#7#15'actUpdateObject'#7 + +'Caption'#6#13'Update Object'#7'OnClick'#7#22'actUpdateObjectExecute'#0#0#0#9 + +'TMenuItem'#9'MenuItem6'#6'Action'#7#8'actAbout'#7'Caption'#6#6'&About'#7'On' + +'Click'#7#15'actAboutExecute'#0#0#0#11'TActionList'#2'AL'#4'left'#3'X'#1#3't' + +'op'#2'8'#0#7'TAction'#11'actOpenFile'#7'Caption'#6#9'Open File'#18'DisableI' + +'fNoHandler'#9#9'OnExecute'#7#18'actOpenFileExecute'#0#0#7'TAction'#7'actExi' + +'t'#7'Caption'#6#4'Exit'#18'DisableIfNoHandler'#9#9'OnExecute'#7#14'actExitE' + +'xecute'#0#0#7'TAction'#9'actExport'#7'Caption'#6#24'Save generated files ..' + +'.'#18'DisableIfNoHandler'#9#9'OnExecute'#7#16'actExportExecute'#8'OnUpdate' + +#7#15'actExportUpdate'#0#0#7'TAction'#8'actAbout'#7'Caption'#6#5'About'#18'D' + +'isableIfNoHandler'#9#9'OnExecute'#7#15'actAboutExecute'#0#0#7'TAction'#9'ac' + +'tSaveAs'#7'Caption'#6#11'Save As ...'#18'DisableIfNoHandler'#9#9'OnExecute' + +#7#16'actSaveAsExecute'#8'OnUpdate'#7#15'actExportUpdate'#0#0#7'TAction'#13 + ,'actEnumCreate'#7'Caption'#6#18'Create Enumeration'#18'DisableIfNoHandler'#9 + +#9'OnExecute'#7#20'actEnumCreateExecute'#0#0#7'TAction'#15'actUpdateObject'#7 + +'Caption'#6#6'Update'#18'DisableIfNoHandler'#9#9'OnExecute'#7#22'actUpdateOb' + +'jectExecute'#8'OnUpdate'#7#21'actUpdateObjectUpdate'#0#0#7'TAction'#14'actR' + +'efreshView'#7'Caption'#6#14'&Refresh Views'#18'DisableIfNoHandler'#9#9'OnEx' + +'ecute'#7#21'actRefreshViewExecute'#0#0#7'TAction'#10'actNewFile'#7'Caption' + +#6#8'New File'#18'DisableIfNoHandler'#9#9'OnExecute'#7#17'actNewFileExecute' + +#0#0#7'TAction'#17'actCompoundCreate'#7'Caption'#6#20'Create Compound Type' + +#18'DisableIfNoHandler'#9#9'OnExecute'#7#24'actCompoundCreateExecute'#0#0#7 + +'TAction'#13'actIntfCreate'#7'Caption'#6#16'Create Interface'#18'DisableIfNo' + +'Handler'#9#9'OnExecute'#7#20'actIntfCreateExecute'#0#0#7'TAction'#13'actFul' + +'lExpand'#7'Caption'#6#11'Full expand'#18'DisableIfNoHandler'#9#9'OnExecute' + +#7#20'actFullExpandExecute'#0#0#7'TAction'#15'actFullCollapse'#7'Caption'#6 + +#13'Full Collapse'#18'DisableIfNoHandler'#9#9'OnExecute'#7#22'actFullCollaps' + +'eExecute'#0#0#0#11'TOpenDialog'#2'OD'#5'Title'#6#26'Ouvrir un fichier exist' + +'ant'#6'Filter'#6#25'WDSL files(*.WSDL)|*.WSDL'#11'FilterIndex'#2#0#10'Initi' + +'alDir'#6#2'.\'#7'Options'#11#15'ofPathMustExist'#15'ofFileMustExist'#14'ofE' + +'nableSizing'#12'ofViewDetail'#0#4'left'#3#153#1#3'top'#2'X'#0#0#10'TSynPasS' + +'yn'#10'SynPasSyn1'#7'Enabled'#8#23'CommentAttri.Foreground'#7#6'clBlue'#18 + +'CommentAttri.Style'#11#6'fsBold'#0#22'StringAttri.Foreground'#7#8'clMaroon' + +#17'SymbolAttri.Style'#11#6'fsBold'#0#25'DirectiveAttri.Foreground'#7#7'clGr' + +'een'#20'DirectiveAttri.Style'#11#6'fsBold'#0#14'NestedComments'#9#4'left'#3 + +#183#1#3'top'#2'h'#0#0#22'TSelectDirectoryDialog'#3'SDD'#5'Title'#6#16'Selec' + +'t Directory'#11'FilterIndex'#2#0#7'Options'#11#15'ofPathMustExist'#14'ofEna' + +'bleSizing'#12'ofViewDetail'#0#4'left'#3#176#1#3'top'#3#152#0#0#0#11'TSaveDi' + +'alog'#2'SD'#5'Title'#6#27'Enregistrer le fichier sous'#10'DefaultExt'#6#5'.' + +'WSDL'#6'Filter'#6#25'WDSL files(*.WSDL)|*.WSDL'#11'FilterIndex'#2#0#7'Optio' + +'ns'#11#15'ofPathMustExist'#14'ofEnableSizing'#12'ofViewDetail'#0#4'left'#3 + +#242#1#3'top'#3#174#0#0#0#10'TPopupMenu'#10'PopupMenu1'#4'left'#3#128#1#3'to' + +'p'#3#8#1#0#9'TMenuItem'#10'MenuItem28'#6'Action'#7#13'actFullExpand'#7'OnCl' + +'ick'#7#20'actFullExpandExecute'#0#0#9'TMenuItem'#10'MenuItem27'#6'Action'#7 + +#15'actFullCollapse'#7'OnClick'#7#22'actFullCollapseExecute'#0#0#9'TMenuItem' + +#10'MenuItem26'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#9'MenuItem8'#6'Action'#7 + +#13'actEnumCreate'#7'OnClick'#7#20'actEnumCreateExecute'#0#0#9'TMenuItem'#10 + +'MenuItem21'#6'Action'#7#17'actCompoundCreate'#7'OnClick'#7#24'actCompoundCr' + +'eateExecute'#0#0#9'TMenuItem'#10'MenuItem24'#6'Action'#7#13'actIntfCreate'#7 + +'OnClick'#7#20'actIntfCreateExecute'#0#0#9'TMenuItem'#10'MenuItem22'#7'Capti' + +'on'#6#1'-'#0#0#9'TMenuItem'#9'MenuItem9'#6'Action'#7#15'actUpdateObject'#7 + +'OnClick'#7#22'actUpdateObjectExecute'#0#0#0#10'TPopupMenu'#10'PopupMenu2'#4 + +'left'#3#16#2#3'top'#3#235#0#0#9'TMenuItem'#10'MenuItem18'#6'Action'#7#14'ac' + +'tRefreshView'#7'OnClick'#7#21'actRefreshViewExecute'#0#0#9'TMenuItem'#10'Me' + +'nuItem19'#7'Caption'#6#1'-'#0#0#9'TMenuItem'#10'MenuItem20'#6'Action'#7#9'a' + +'ctExport'#7'OnClick'#7#16'actExportExecute'#0#0#0#0 +]); diff --git a/wst/trunk/type_lib_edtr/umain.pas b/wst/trunk/type_lib_edtr/umain.pas new file mode 100644 index 000000000..6454ea768 --- /dev/null +++ b/wst/trunk/type_lib_edtr/umain.pas @@ -0,0 +1,552 @@ +unit umain; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls, + ExtCtrls, Menus, ActnList, + pastree, pascal_parser_intf, logger_intf, + SynHighlighterPas, SynEdit, StdCtrls; + +type + + { TfMain } + + TfMain = class(TForm) + actExit: TAction; + actExport: TAction; + actAbout: TAction; + actEnumCreate: TAction; + actCompoundCreate: TAction; + actIntfCreate: TAction; + actFullExpand: TAction; + actFullCollapse: TAction; + actNewFile: TAction; + actRefreshView: TAction; + actUpdateObject: TAction; + actSaveAs: TAction; + actOpenFile: TAction; + AL: TActionList; + MainMenu1: TMainMenu; + MenuItem10: TMenuItem; + MenuItem11: TMenuItem; + MenuItem12: TMenuItem; + MenuItem13: TMenuItem; + MenuItem14: TMenuItem; + MenuItem15: TMenuItem; + MenuItem16: TMenuItem; + MenuItem17: TMenuItem; + MenuItem18: TMenuItem; + MenuItem19: TMenuItem; + MenuItem20: TMenuItem; + MenuItem21: TMenuItem; + MenuItem22: TMenuItem; + MenuItem23: TMenuItem; + MenuItem24: TMenuItem; + MenuItem25: TMenuItem; + MenuItem26: TMenuItem; + MenuItem27: TMenuItem; + MenuItem28: TMenuItem; + MenuItem29: TMenuItem; + MenuItem30: TMenuItem; + MenuItem31: TMenuItem; + MenuItem5: TMenuItem; + MenuItem6: TMenuItem; + MenuItem7: TMenuItem; + MenuItem8: TMenuItem; + MenuItem9: TMenuItem; + mmoLog: TMemo; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + MenuItem4: TMenuItem; + OD: TOpenDialog; + PC: TPageControl; + Panel1: TPanel; + Panel2: TPanel; + PopupMenu1: TPopupMenu; + PopupMenu2: TPopupMenu; + SD: TSaveDialog; + SDD: TSelectDirectoryDialog; + Splitter1: TSplitter; + srcInterface: TSynEdit; + SB: TStatusBar; + srcImp: TSynEdit; + srcBinder: TSynEdit; + srcProxy: TSynEdit; + SynPasSyn1: TSynPasSyn; + tsLog: TTabSheet; + tsImp: TTabSheet; + tsBinder: TTabSheet; + tsInterface: TTabSheet; + tsProxy: TTabSheet; + trvSchema: TTreeView; + procedure actAboutExecute(Sender: TObject); + procedure actCompoundCreateExecute(Sender: TObject); + procedure actEnumCreateExecute(Sender: TObject); + procedure actExitExecute(Sender: TObject); + procedure actExportExecute(Sender: TObject); + procedure actExportUpdate(Sender: TObject); + procedure actFullCollapseExecute(Sender: TObject); + procedure actFullExpandExecute(Sender: TObject); + procedure actIntfCreateExecute(Sender: TObject); + procedure actNewFileExecute(Sender: TObject); + procedure actOpenFileExecute(Sender: TObject); + procedure actRefreshViewExecute(Sender: TObject); + procedure actSaveAsExecute(Sender: TObject); + procedure actUpdateObjectExecute(Sender: TObject); + procedure actUpdateObjectUpdate(Sender: TObject); + procedure FormShow(Sender: TObject); + private + FSymbolTable : TwstPasTreeContainer; + FStatusMessageTag : PtrInt; + private + function GetTypeNode() : TTreeNode; + function GetInterfaceNode() : TTreeNode; + private + procedure ShowStatusMessage(const AMsgType : TMessageType;const AMsg : string); + procedure RenderSymbols(); + procedure RenderSources(); + public + constructor Create(AOwner : TComponent);override; + destructor Destroy();override; + end; + +var + fMain: TfMain; + +implementation +uses view_helper, DOM, XMLRead, XMLWrite, HeapTrc, + wsdl2pas_imp, source_utils, command_line_parser, generator, metadata_generator, + binary_streamer, wst_resources_utils, wsdl_generator, + uabout, edit_helper, udm; + + +const + DEF_FILE_NAME = 'library1'; + sWST_META = 'wst_meta'; + +type + TSourceType = cloInterface .. cloBinder; + TSourceTypes = set of TSourceType; + +function ParseWsdlFile( + const AFileName : string; + const ANotifier : TOnParserMessage +):TwstPasTreeContainer; +var + locDoc : TXMLDocument; + prsr : TWsdlParser; + symName : string; +begin + Result := nil; + if FileExists(AFileName) then begin + symName := ChangeFileExt(ExtractFileName(AFileName),''); + if ( symName[Length(symName)] = '.' ) then begin + Delete(symName,Length(symName),1); + end; + prsr := nil; + ReadXMLFile(locDoc,AFileName); + try + Result := TwstPasTreeContainer.Create(); + try + prsr := TWsdlParser.Create(locDoc,Result); + prsr.OnMessage := ANotifier; + prsr.Parse(pmAllTypes,symName); + except + FreeAndNil(Result); + raise; + end; + finally + FreeAndNil(prsr); + FreeAndNil(locDoc); + end; + end; +end; + +type TOutputType = ( otMemory, otFileSystem ); +function GenerateSource( + ASymbolTable : TwstPasTreeContainer; + AOptions : TSourceTypes; + const AOutputType : TOutputType; + const AOutPath : string; + const ANotifier : TOnParserMessage +) : ISourceManager; + + procedure Notify(const AMsg : string); + begin + if Assigned(ANotifier) then begin + ANotifier(mtInfo, AMsg); + end; + end; + +var + mtdaFS: TMemoryStream; + g : TBaseGenerator; + mg : TMetadataGenerator; + rsrcStrm : TMemoryStream; +begin + Result := CreateSourceManager(); + rsrcStrm := nil; + mtdaFS := nil; + mg := nil; + g := Nil; + try + + if ( cloInterface in AOptions ) then begin + Notify('Interface file generation...'); + g := TInftGenerator.Create(ASymbolTable,Result); + g.Execute(); + FreeAndNil(g); + end; + + if ( cloProxy in AOptions ) then begin + Notify('Proxy file generation...'); + g := TProxyGenerator.Create(ASymbolTable,Result); + g.Execute(); + FreeAndNil(g); + end; + + if ( cloBinder in AOptions ) then begin + Notify('Binder file generation...'); + g := TBinderGenerator.Create(ASymbolTable,Result); + g.Execute(); + FreeAndNil(g); + end; + + if ( cloImp in AOptions ) then begin + Notify('Implementation file generation...'); + g := TImplementationGenerator.Create(ASymbolTable,Result); + g.Execute(); + FreeAndNil(g); + end; + + if ( AOutputType = otFileSystem ) and ( [cloBinder,cloProxy]*AOptions <> [] ) then begin + Notify('Metadata file generation...'); + mtdaFS := TMemoryStream.Create(); + mg := TMetadataGenerator.Create(ASymbolTable,CreateBinaryWriter(mtdaFS)); + mg.Execute(); + mtdaFS.SaveToFile(AOutPath + Format('%s.%s',[ASymbolTable.CurrentModule.Name,sWST_META])); + rsrcStrm := TMemoryStream.Create(); + mtdaFS.Position := 0; + BinToWstRessource(UpperCase(ASymbolTable.CurrentModule.Name),mtdaFS,rsrcStrm); + rsrcStrm.SaveToFile(AOutPath + Format('%s.%s',[ASymbolTable.CurrentModule.Name,sWST_EXTENSION])); + end; + + if ( AOutputType = otFileSystem ) then begin + Result.SaveToFile(AOutPath); + end; + finally + rsrcStrm.Free(); + mg.Free();; + mtdaFS.Free();; + g.Free(); + end; +end; + +procedure GenerateWSDL_ToStream(ASymbol : TwstPasTreeContainer; ADest : TStream); +var + doc : TXMLDocument; +begin + doc := TXMLDocument.Create(); + try + GenerateWSDL(ASymbol,doc); + WriteXML(doc,ADest); + finally + FreeAndNil(doc); + end; +end; + +function CreateSymbolTable(const AName : string):TwstPasTreeContainer ; +begin + Result := TwstPasTreeContainer.Create(); + try + CreateWstInterfaceSymbolTable(Result); + Result.CreateElement(TPasModule,AName,Result.Package,visDefault,'',0); + Result.CurrentModule.InterfaceSection := TPasSection(Result.CreateElement(TPasSection,'',Result.CurrentModule,visDefault,'',0)); + except + FreeAndNil(Result); + raise; + end; +end; + +{ TfMain } + +procedure TfMain.actOpenFileExecute(Sender: TObject); +var + tmpTable : TwstPasTreeContainer; + curLok : IInterface; +begin + if OD.Execute() then begin + mmoLog.Clear(); + PC.ActivePage := tsLog; + curLok := SetCursorHourGlass(); + tmpTable := ParseWsdlFile(OD.FileName,@ShowStatusMessage); + if Assigned(tmpTable) then begin + trvSchema.Items.Clear(); + FreeAndNil(FSymbolTable); + FSymbolTable := tmpTable; + RenderSymbols(); + PC.ActivePage := tsInterface; + end; + end; + curLok := nil; +end; + +procedure TfMain.actRefreshViewExecute(Sender: TObject); +begin + RenderSymbols(); +end; + +procedure TfMain.actSaveAsExecute(Sender: TObject); +var + mstrm : TMemoryStream; +begin + if SD.Execute() then begin + mstrm := TMemoryStream.Create(); + try + GenerateWSDL_ToStream(FSymbolTable,mstrm); + mstrm.SaveToFile(SD.FileName); + finally + FreeAndNil(mstrm); + end; + end; +end; + +procedure TfMain.actUpdateObjectExecute(Sender: TObject); +var + o : TPasElement; + nd, nd_1 : TTreeNode; +begin + nd := trvSchema.Selected; + if Assigned(nd) and Assigned(nd.Data) then begin + o := TPasElement(nd.Data); + if HasEditor(o) then begin + UpdateObject(o,FSymbolTable); + nd_1 := nd; + trvSchema.BeginUpdate(); + try + nd := FindPainter(o).Paint(FSymbolTable,o,GetTypeNode()); + nd.MoveTo(nd_1,naInsertBehind); + FreeAndNil(nd_1); + finally + trvSchema.EndUpdate(); + end; + end; + end; +end; + +procedure TfMain.actUpdateObjectUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := + Assigned(trvSchema.Selected) and + Assigned(trvSchema.Selected.Data) and + HasEditor(TPasElement(trvSchema.Selected.Data)); +end; + +procedure TfMain.FormShow(Sender: TObject); +begin + RenderSymbols(); +end; + +function TfMain.GetTypeNode(): TTreeNode; +begin + Result := trvSchema.TopItem.GetFirstChild().Items[1]; +end; + +function TfMain.GetInterfaceNode(): TTreeNode; +begin + Result := trvSchema.TopItem.GetFirstChild().Items[2]; +end; + +procedure TfMain.ShowStatusMessage(const AMsgType : TMessageType;const AMsg: string); +begin + mmoLog.Lines.Add(Format('%s : %s',[MessageTypeNames[AMsgType],AMsg])); + SB.Panels[1].Text := AMsg; + Inc(FStatusMessageTag); + if ( (FStatusMessageTag) > 23 ) then begin + FStatusMessageTag := 0; + Application.ProcessMessages(); + end; +end; + +procedure TfMain.actExitExecute(Sender: TObject); +begin + Close(); +end; + +procedure TfMain.actAboutExecute(Sender: TObject); +var + fa : TfAbout; +begin + fa := TfAbout.Create(Self); + try + fa.ShowModal(); + finally + fa.Release(); + end; +end; + +procedure TfMain.actCompoundCreateExecute(Sender: TObject); +var + e : TPasClassType; +begin + e := CreateCompoundObject(FSymbolTable); + if Assigned(e) then begin + FindPainter(e).Paint(FSymbolTable,e,GetTypeNode()); + end; +end; + +procedure TfMain.actEnumCreateExecute(Sender: TObject); +var + e : TPasEnumType; +begin + e := CreateEnum(FSymbolTable); + if Assigned(e) then begin + FindPainter(e).Paint(FSymbolTable,e,GetTypeNode()); + end; +end; + +procedure TfMain.actExportExecute(Sender: TObject); +var + curLok : IInterface; +begin + if SDD.Execute() then begin + curLok := SetCursorHourGlass(); + GenerateSource( + FSymbolTable, + [cloInterface,cloProxy,cloImp,cloBinder], + otFileSystem, + IncludeTrailingBackslash(SDD.FileName), + nil + ); + curLok := nil; + end; +end; + +procedure TfMain.actExportUpdate(Sender: TObject); +begin + TAction(Sender).Enabled := Assigned(FSymbolTable) and ( FSymbolTable.CurrentModule.InterfaceSection.Declarations.Count > 0 ); +end; + +procedure TfMain.actFullCollapseExecute(Sender: TObject); +begin + trvSchema.FullCollapse(); +end; + +procedure TfMain.actFullExpandExecute(Sender: TObject); +begin + trvSchema.FullExpand(); +end; + +procedure TfMain.actIntfCreateExecute(Sender: TObject); +var + e : TPasClassType; +begin + e := CreateInterface(FSymbolTable); + if Assigned(e) then begin + FindPainter(e).Paint(FSymbolTable,e,GetInterfaceNode()); + end; +end; + +procedure TfMain.actNewFileExecute(Sender: TObject); +var + res : Integer; +begin + res := MessageDlg(Application.Title,'Save the current file before ?',mtConfirmation,mbYesNoCancel,0,mbYes); + if ( res = mrCancel ) then begin + Exit; + end; + if ( res = mrYes ) then begin + actSaveAs.Execute(); + end; + FreeAndNil(FSymbolTable); + FSymbolTable := CreateSymbolTable(ExtractFileName(DEF_FILE_NAME)); + RenderSymbols(); +end; + +procedure TfMain.RenderSymbols(); +var + objPtr : ISymbolPainter; + nd : TTreeNode; +begin + trvSchema.BeginUpdate(); + try + trvSchema.Items.Clear(); + srcInterface.ClearAll(); + nd := trvSchema.Items.AddFirst(nil,'Type Library Editor'); + nd.ImageIndex := -1; + nd.StateIndex := -1; + nd.SelectedIndex := -1; + if Assigned(FSymbolTable) then begin + objPtr := FindPainter(FSymbolTable.Package); + if Assigned(objPtr) then begin + objPtr.Paint(FSymbolTable,FSymbolTable.Package,trvSchema.TopItem); + end; + RenderSources(); + end; + trvSchema.Items[0].Expand(False); + trvSchema.Items[0].Items[0].Expand(False); + finally + trvSchema.EndUpdate(); + end; + ShowStatusMessage(mtInfo,''); +end; + +procedure TfMain.RenderSources(); + + procedure LoadText(const AList : TStrings; ASrc : ISourceStream); + var + srcItemSV : ISavableSourceStream; + begin + if Supports(ASrc,ISavableSourceStream,srcItemSV) then begin + srcItemSV.GetStream().Position := 0; + AList.LoadFromStream(srcItemSV.GetStream()); + end; + end; + +var + srcMngr : ISourceManager; +begin + if Assigned(FSymbolTable) then begin + if ( FSymbolTable.CurrentModule.InterfaceSection.Declarations.Count > 0 ) then begin + srcMngr := GenerateSource(FSymbolTable,[cloInterface,cloProxy,cloBinder,cloImp],otMemory,'',@ShowStatusMessage); + if Assigned(srcMngr) and ( srcMngr.GetCount() > 0 ) then begin + LoadText(srcInterface.Lines,srcMngr.GetItem(0)); + LoadText(srcProxy.Lines,srcMngr.GetItem(1)); + LoadText(srcBinder.Lines,srcMngr.GetItem(2)); + LoadText(srcImp.Lines,srcMngr.GetItem(3)); + end; + end else begin + srcInterface.ClearAll(); + srcProxy.ClearAll(); + srcBinder.ClearAll(); + srcImp.ClearAll(); + end; + end; + ShowStatusMessage(mtInfo,''); +end; + +constructor TfMain.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FSymbolTable := CreateSymbolTable(ExtractFileName(DEF_FILE_NAME)); + trvSchema.Images := DM.IM; +end; + +destructor TfMain.Destroy(); +begin + trvSchema.Items.Clear(); + FreeAndNil(FSymbolTable); + inherited Destroy(); +end; + +initialization + SetHeapTraceOutput('heap_trace.txt'); + + {$I umain.lrs} + +end. + diff --git a/wst/trunk/type_lib_edtr/view_helper.pas b/wst/trunk/type_lib_edtr/view_helper.pas new file mode 100644 index 000000000..ff3f3ac22 --- /dev/null +++ b/wst/trunk/type_lib_edtr/view_helper.pas @@ -0,0 +1,680 @@ +unit view_helper; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, ComCtrls, + pastree, pascal_parser_intf; + +type + + ISymbolPainter = interface + ['{C13B3547-F338-43D7-8A44-2F81CC34A188}'] + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode; + end; + + function FindPainter(AObj : TPasElement) : ISymbolPainter ; + + function SetCursorHourGlass():IInterface; + +implementation +uses Contnrs, Controls, Forms; + +const + IMG_TABLE = 0; + IMG_TYPES = 1; + IMG_CONST = 2; + IMG_TYPE_DEF = 4; + IMG_INTF_DEF = 5; + IMG_PROP_DEF = 6; + IMG_ENUM = 6; + IMG_CONST_ITEM = 7; + IMG_ENUM_ITEM = 8; + IMG_PROC_ITEM = 9; + +type + + { TCursorHolder } + + TCursorHolder = class(TInterfacedObject,IInterface) + private + FCursor : TCursor; + FOldCursor : TCursor; + public + constructor Create(const ACursor : TCursor); + destructor Destroy();override; + end; + +function SetCursorHourGlass():IInterface; +begin + Result := TCursorHolder.Create(crHourGlass); + Application.ProcessMessages(); +end; + +function AddChildNode(AParent: TTreeNode; const AText : string):TTreeNode ; +begin + Result := AParent.TreeNodes.AddChild(AParent,AText); + Result.ImageIndex := -1; + Result.StateIndex := -1; + Result.SelectedIndex := -1; +end; + +{ TCursorHolder } + +constructor TCursorHolder.Create(const ACursor: TCursor); +begin + FCursor := ACursor; + FOldCursor := Screen.Cursor; + Screen.Cursor := FCursor; +end; + +destructor TCursorHolder.Destroy(); +begin + Screen.Cursor := FOldCursor; + inherited Destroy(); +end; + +type + + { TSymbolPainter } + + TSymbolPainter = class(TInterfacedObject,ISymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;virtual;abstract; + public + constructor Create();virtual; + //class function CanHandle(AObjClass : TClass):Boolean;overload;virtual;abstract; + class function CanHandle(AObj : TObject):Boolean;overload;virtual;abstract; + end; + + TSymbolPainterClass = class of TSymbolPainter; + + { TPainterRegistry } + + TPainterRegistry = class + private + FList : TClassList; + private + function FindHanlderIndex(AObj : TObject):Integer; + public + constructor Create(); + destructor Destroy();override; + procedure RegisterHandler(APainterClass : TSymbolPainterClass); + function FindHandler(AObj : TObject; out AHandler : ISymbolPainter) : Boolean; + end; + +var + FPainterRegistryInst : TPainterRegistry; + +type + + { TAbstractSymbolPainter } + + TAbstractSymbolPainter = class(TSymbolPainter,ISymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + public + //class function CanHandle(AObjClass : TClass):Boolean;overload;override; + class function CanHandle(AObj : TObject):Boolean;overload;override; + end; + + { TPackagePainter } + + TPackagePainter = class(TAbstractSymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + + { TModulePainter } + + TModulePainter = class(TAbstractSymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + + { TAbstractConstantDefinitionPainter } + + TAbstractConstantDefinitionPainter = class(TAbstractSymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + + { TTypeSymbolPainter } + + TTypeSymbolPainter = class(TAbstractSymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + end; + + { TAnyTypeDefinitionPainter } + + TAnyTypeDefinitionPainter = class(TTypeSymbolPainter) + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + + { TTypeAliasDefinitionPainter } + + TTypeAliasDefinitionPainter = class(TTypeSymbolPainter) + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + + { TEnumTypeDefinitionPainter } + + TEnumTypeDefinitionPainter = class(TTypeSymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + + { TClassTypeDefinitionPainter } + + TClassTypeDefinitionPainter = class(TTypeSymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + + { TMethodDefinitionPainter } + + TMethodDefinitionPainter = class(TTypeSymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + + { TInterfaceDefinitionPainter } + + TInterfaceDefinitionPainter = class(TTypeSymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + + { TPasNativeSimpleTypePainter } + + TPasNativeSimpleTypePainter = class(TTypeSymbolPainter) + protected + function Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode + ):TTreeNode;override; + public + class function CanHandle(AObj : TObject):Boolean;override; + end; + +{ TPasNativeSimpleTypePainter } + +function TPasNativeSimpleTypePainter.Paint( + AContainer: TwstPasTreeContainer; + AObj: TPasElement; + AParent: TTreeNode +): TTreeNode; +var + locObj : TPasNativeSimpleType; + boxeNode : TTreeNode; +begin + locObj := TPasNativeSimpleType(AObj); + Result := inherited Paint(AContainer, locObj, AParent); + {if ( locObj.BoxedType <> nil ) then begin + boxeNode := AddChildNode(Result,locObj.BoxedType.Name); + boxeNode.Data := locObj.BoxedType; + boxeNode.ImageIndex := -1; + boxeNode.StateIndex := -1; + boxeNode.SelectedIndex := -1; + end;} +end; + +class function TPasNativeSimpleTypePainter.CanHandle(AObj: TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and AObj.InheritsFrom(TPasNativeSimpleType); +end; + +{ TModulePainter } + +function TModulePainter.Paint( + AContainer: TwstPasTreeContainer; + AObj: TPasElement; + AParent: TTreeNode +): TTreeNode; +var + i , c: Integer; + locObj : TPasModule; + objPtr : ISymbolPainter; + constNode, typNode, intfNode : TTreeNode; + objItm : TPasElement; + decList : TList; +begin + locObj := AObj as TPasModule; + Result := inherited Paint(AContainer, locObj, AParent); + Result.ImageIndex := IMG_TABLE; + Result.StateIndex := IMG_TABLE; + Result.SelectedIndex := IMG_TABLE; + constNode := AddChildNode(Result,'Const'); + constNode.ImageIndex := IMG_CONST; + constNode.StateIndex := IMG_CONST; + constNode.SelectedIndex := IMG_CONST; + typNode := AddChildNode(Result,'Type'); + typNode.ImageIndex := IMG_TYPES; + typNode.StateIndex := IMG_TYPES; + typNode.SelectedIndex := IMG_TYPES; + intfNode := AddChildNode(Result,'Interface'); + decList := locObj.InterfaceSection.Declarations; + c := decList.Count; + for i := 0 to Pred(c) do begin + objItm := TPasElement(decList[i]); + objPtr := FindPainter(objItm) ; + if Assigned(objPtr) then begin + if objItm.InheritsFrom(TPasClassType) and ( TPasClassType(objItm).ObjKind = okInterface ) then + objPtr.Paint(AContainer,objItm,intfNode) + else + objPtr.Paint(AContainer,objItm,typNode); + {if objItm.InheritsFrom(TpasTypeDefinition) then begin + objPtr.Paint(objItm,typNode); + end else if objItm.InheritsFrom(TInterfaceDefinition) then begin + objPtr.Paint(objItm,intfNode); + end else if objItm.InheritsFrom(TAbstractConstantDefinition) then begin + objPtr.Paint(objItm,constNode); + end;} + end; + end; +end; + +class function TModulePainter.CanHandle(AObj: TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and AObj.InheritsFrom(TPasModule); +end; + +{ TMethodDefinitionPainter } + +function TMethodDefinitionPainter.Paint( + AContainer : TwstPasTreeContainer; + AObj: TPasElement; + AParent: TTreeNode +): TTreeNode; +var + j : Integer; + ss : string; + pmr : TPasArgument; + locMthd : TPasProcedure; + memberList : TList; +begin + locMthd := AObj as TPasProcedure; + Result := AddChildNode(AParent,AContainer.GetExternalName(locMthd)); + Result.Data := locMthd; + Result.ImageIndex := IMG_PROC_ITEM; + Result.StateIndex := IMG_PROC_ITEM; + Result.SelectedIndex := IMG_PROC_ITEM; + memberList := locMthd.ProcType.Args; + for j := 0 to Pred(memberList.Count) do begin + pmr := TPasArgument(memberList[j]); + ss := AccessNames[pmr.Access]; + if ( Length(ss) > 0 ) then begin + ss := ss + ' ' + AContainer.GetExternalName(pmr); + end; + AddChildNode(Result,ss); + end; + if locMthd.InheritsFrom(TPasFunction) then begin + AddChildNode(Result,'>> ' + AContainer.GetExternalName(TPasFunctionType(locMthd.ProcType).ResultEl)); + end; +end; + +class function TMethodDefinitionPainter.CanHandle(AObj : TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and AObj.InheritsFrom(TPasProcedure); +end; + +{ TInterfaceDefinitionPainter } + +function TInterfaceDefinitionPainter.Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent: TTreeNode +): TTreeNode; + +{ function PaintMethod(AIntfNode : TTreeNode; AMthd : TMethodDefinition):TTreeNode ; + var + j : Integer; + ss : string; + pmr : TParameterDefinition; + begin + Result := AddChildNode(AIntfNode,AMthd.ExternalName); + Result.Data := AMthd; + Result.ImageIndex := IMG_PROC_ITEM; + Result.StateIndex := IMG_PROC_ITEM; + Result.SelectedIndex := IMG_PROC_ITEM; + for j := 0 to Pred(AMthd.ParameterCount) do begin + pmr := AMthd.Parameter[j]; + ss := ParameterModifierMAP[pmr.Modifier]; + if ( Length(ss) > 0 ) then begin + ss := ss + ' ' + pmr.ExternalName; + end; + AddChildNode(Result,ss); + end; + end; } + +var + locObj : TPasClassType; + locMthd : TPasProcedure; + i : Integer; + memberList : TList; +begin + locObj := AObj as TPasClassType; + Result := inherited Paint(AContainer, locObj, AParent); + Result.ImageIndex := IMG_INTF_DEF; + Result.StateIndex := IMG_INTF_DEF; + Result.SelectedIndex := IMG_INTF_DEF; + memberList := locObj.Members; + for i := 0 to Pred(memberList.Count) do begin + if TPasElement(memberList[i]).InheritsFrom(TPasProcedure) then begin + locMthd := TPasProcedure(memberList[i]); + FindPainter(locMthd).Paint(AContainer,locMthd,Result); + end; + end; +end; + +class function TInterfaceDefinitionPainter.CanHandle(AObj : TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and + AObj.InheritsFrom(TPasClassType) and + ( TPasClassType(AObj).ObjKind = okInterface ); +end; + +{ TAbstractConstantDefinitionPainter } + +function TAbstractConstantDefinitionPainter.Paint( + AContainer : TwstPasTreeContainer; + AObj: TPasElement; + AParent: TTreeNode +): TTreeNode; +begin + Result := inherited Paint(AContainer,AObj, AParent); + Result.ImageIndex := IMG_CONST_ITEM; + Result.StateIndex := IMG_CONST_ITEM; + Result.SelectedIndex := IMG_CONST_ITEM; +end; + +class function TAbstractConstantDefinitionPainter.CanHandle(AObj : TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and AObj.InheritsFrom(TPasConst); +end; + +{ TTypeSymbolPainter } + +function TTypeSymbolPainter.Paint( + AContainer : TwstPasTreeContainer; + AObj: TPasElement; + AParent: TTreeNode +): TTreeNode; +begin + Result := inherited Paint(AContainer, AObj, AParent); + Result.ImageIndex := IMG_TYPE_DEF; + Result.StateIndex := IMG_TYPE_DEF; + Result.SelectedIndex := IMG_TYPE_DEF; +end; + +{ TClassTypeDefinitionPainter } + +function TClassTypeDefinitionPainter.Paint( + AContainer : TwstPasTreeContainer; + AObj: TPasElement; + AParent: TTreeNode +): TTreeNode; +var + locObj : TPasClassType; + locProp : TPasProperty; + i : Integer; + s : string; +begin + locObj := AObj as TPasClassType; + Result := inherited Paint(AContainer,locObj, AParent); + if Assigned(locObj.AncestorType) then begin + Result.Text := Format('%s (%s)',[AContainer.GetExternalName(locObj),AContainer.GetExternalName(locObj.AncestorType)]); + end; + for i := 0 to Pred(locObj.Members.Count) do begin + if TPasElement(locObj.Members[i]).InheritsFrom(TPasProperty) then begin + locProp := TPasProperty(locObj.Members[i]); + s := Format('%s : %s',[AContainer.GetExternalName(locProp),AContainer.GetExternalName(locProp.VarType)]); + if AContainer.IsAttributeProperty(locProp) then begin + s := s + ' ( Attribute )'; + end; + AddChildNode(Result,s); + end; + end; +end; + +class function TClassTypeDefinitionPainter.CanHandle(AObj : TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and + ( AObj.InheritsFrom(TPasClassType) and ( TPasClassType(AObj).ObjKind = okClass ) )and + ( not AObj.InheritsFrom(TPasNativeClassType) ); + +end; + +{ TEnumTypeDefinitionPainter } + +function TEnumTypeDefinitionPainter.Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode +): TTreeNode; +var + locObj : TPasEnumType; + locItem : TPasEnumValue; + i : Integer; + locNode : TTreeNode; +begin + locObj := AObj as TPasEnumType; + Result := inherited Paint(AContainer, locObj, AParent); + Result.ImageIndex := IMG_ENUM; + Result.StateIndex := IMG_ENUM; + Result.SelectedIndex := IMG_ENUM; + for i := 0 to Pred(locObj.Values.Count) do begin + locItem := TPasEnumValue(locObj.Values[i]); + locNode := AddChildNode(Result,AContainer.GetExternalName(locItem)); + locNode.ImageIndex := IMG_ENUM_ITEM; + locNode.StateIndex := IMG_ENUM_ITEM; + locNode.SelectedIndex := IMG_ENUM_ITEM; + end; +end; + +class function TEnumTypeDefinitionPainter.CanHandle(AObj : TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and AObj.InheritsFrom(TPasEnumType); +end; + + +{ TTypeAliasDefinitionPainter } + +class function TTypeAliasDefinitionPainter.CanHandle(AObj : TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and AObj.InheritsFrom(TPasAliasType); +end; + +{ TAnyTypeDefinitionPainter } + +class function TAnyTypeDefinitionPainter.CanHandle(AObj : TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and AObj.InheritsFrom(TPasUnresolvedTypeRef); +end; + +{ TPackagePainter } + +function TPackagePainter.Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode +):TTreeNode; +var + objPtr : ISymbolPainter; +begin + Result := AParent; + objPtr := FindPainter(AContainer.CurrentModule) ; + if Assigned(objPtr) then begin + objPtr.Paint(AContainer,AContainer.CurrentModule,Result); + end; +end; + +class function TPackagePainter.CanHandle(AObj : TObject): Boolean; +begin + Result := ( inherited CanHandle(AObj) ) and AObj.InheritsFrom(TPasPackage); +end; + +function FindPainter(AObj: TPasElement): ISymbolPainter; +begin + Result := nil; + if Assigned(AObj) then begin + FPainterRegistryInst.FindHandler(AObj,Result); + end; +end; + +{ TPainterRegistry } + +function TPainterRegistry.FindHanlderIndex(AObj: TObject): Integer; +var + i : Integer; +begin + for i := 0 to Pred(FList.Count) do begin + if TSymbolPainterClass(FList[i]).CanHandle(AObj) then begin + Result := i; + Exit; + end; + end; + Result := -1; +end; + +constructor TPainterRegistry.Create(); +begin + FList := TClassList.Create(); +end; + +destructor TPainterRegistry.Destroy(); +begin + FreeAndNil(FList); + inherited Destroy(); +end; + +procedure TPainterRegistry.RegisterHandler(APainterClass: TSymbolPainterClass); +begin + if ( FList.IndexOf(APainterClass) = -1 ) then begin + FList.Add(APainterClass); + end; +end; + +function TPainterRegistry.FindHandler(AObj: TObject; out AHandler: ISymbolPainter): Boolean; +var + i : Integer; +begin + AHandler := nil; + i := FindHanlderIndex(AObj); + Result := ( i >= 0 ); + if Result then begin + AHandler := TSymbolPainterClass(FList[i]).Create(); + end; +end; + +function TAbstractSymbolPainter.Paint( + AContainer : TwstPasTreeContainer; + AObj : TPasElement; + AParent : TTreeNode +):TTreeNode; +begin + Assert(Assigned(AParent)); + if Assigned(AObj) then begin + Result := AddChildNode(AParent,AContainer.GetExternalName(AObj)); + Result.Data := AObj; + Result.ImageIndex := -1; + Result.StateIndex := -1; + Result.SelectedIndex := -1; + end; +end; + +class function TAbstractSymbolPainter.CanHandle(AObj : TObject): Boolean; +begin + Result := Assigned(AObj) and AObj.InheritsFrom(TPasElement); +end; + +{ TSymbolPainter } + +constructor TSymbolPainter.Create(); +begin + +end; + + + +initialization + FPainterRegistryInst := TPainterRegistry.Create(); + FPainterRegistryInst.RegisterHandler(TPackagePainter); + FPainterRegistryInst.RegisterHandler(TModulePainter); + FPainterRegistryInst.RegisterHandler(TAnyTypeDefinitionPainter); + FPainterRegistryInst.RegisterHandler(TTypeAliasDefinitionPainter); + FPainterRegistryInst.RegisterHandler(TEnumTypeDefinitionPainter); + FPainterRegistryInst.RegisterHandler(TClassTypeDefinitionPainter); + FPainterRegistryInst.RegisterHandler(TAbstractConstantDefinitionPainter); + FPainterRegistryInst.RegisterHandler(TInterfaceDefinitionPainter); + FPainterRegistryInst.RegisterHandler(TMethodDefinitionPainter); + FPainterRegistryInst.RegisterHandler(TPasNativeSimpleTypePainter) + +finalization + FreeAndNil(FPainterRegistryInst); + +end. diff --git a/wst/trunk/type_lib_edtr/wsdl_generator.pas b/wst/trunk/type_lib_edtr/wsdl_generator.pas new file mode 100644 index 000000000..835a7c077 --- /dev/null +++ b/wst/trunk/type_lib_edtr/wsdl_generator.pas @@ -0,0 +1,922 @@ +{ + This file is part of the Web Service Toolkit + Copyright (c) 2006 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} + +unit wsdl_generator; + +{$INCLUDE wst.inc} + +interface + +uses + Classes, SysUtils, TypInfo, + DOM, + pastree, pascal_parser_intf; //parserdefs; + +type + + EWsdlGeneratorException = class(Exception) end; + TBaseTypeHandler = class; + TBaseTypeHandlerClass = class of TBaseTypeHandler; + + IWsdlTypeHandler = interface + ['{541EA377-4F70-49B1-AFB4-FC62B24F567B}'] + procedure Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument + ); + end; + + IWsdlTypeHandlerRegistry = Interface + ['{C5666646-3426-4696-93EE-AFA8EE7CAE53}'] + function Find( + ASymbol : TPTreeElement; + out AHandler : IWsdlTypeHandler + ) : Boolean; + procedure Register(AFactory : TBaseTypeHandlerClass); + End; + + TBaseTypeHandler = class(TInterfacedObject,IWsdlTypeHandler) + protected + procedure Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument + );virtual;abstract; + class function CanHandle(ASymbol : TClass) : Boolean;virtual;abstract; + end; + + { TTypeDefinition_TypeHandler } + + TTypeDefinition_TypeHandler = class(TBaseTypeHandler) + protected + procedure Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument + );override; + class function CanHandle(ASymbol : TClass) : Boolean;override; + end; + + { TTypeAliasDefinition_TypeHandler } + + TTypeAliasDefinition_TypeHandler = class(TBaseTypeHandler) + protected + procedure Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument + );override; + class function CanHandle(ASymbol : TClass) : Boolean;override; + end; + + { TEnumTypeHandler } + + TEnumTypeHandler = class(TTypeDefinition_TypeHandler) + protected + procedure Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument + );override; + class function CanHandle(ASymbol : TClass) : Boolean;override; + end; + + { TClassTypeDefinition_TypeHandler } + + TClassTypeDefinition_TypeHandler = class(TTypeDefinition_TypeHandler) + protected + procedure Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument + );override; + class function CanHandle(ASymbol : TClass) : Boolean;override; + end; + + { TBaseArrayRemotable_TypeHandler } + + TBaseArrayRemotable_TypeHandler = class(TTypeDefinition_TypeHandler) + protected + procedure Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument + );override; + class function CanHandle(ASymbol : TClass) : Boolean;override; + end; + + procedure GenerateWSDL(ASymbolTable : TwstPasTreeContainer; ADoc : TDOMDocument); + + function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry; + +implementation +uses Contnrs; + +const + sWSDL_NS = 'http://schemas.xmlsoap.org/wsdl/'; + sSOAP_NS = 'http://schemas.xmlsoap.org/wsdl/soap/'; + sSOAP = 'soap'; + sSOAP_ENC_NS = 'http://schemas.xmlsoap.org/soap/encoding/'; + sXMLNS = 'xmlns'; + sXSD_NS = 'http://www.w3.org/2001/XMLSchema'; + sXSD = 'xsd'; + sTNS = 'tns'; + + sSOAP_ACTION = 'soapAction'; + sSOAP_ENCODED = 'encoded'; + sSOAP_ENCODING_STYLE = 'encodingStyle'; + sSOAP_RPC = 'rpc'; + sSOAP_TRANSPORT = 'http://schemas.xmlsoap.org/soap/http'; + sSOAP_USE = 'use'; + + sADDRESS = 'address'; + sATTRIBUTE = 'attribute'; + sBASE = 'base'; + sBINDING = 'binding'; + sBODY = 'body'; + sCOMPLEX_TYPE = 'complexType'; + sELEMENT = 'element'; + sENUMERATION = 'enumeration'; + sEXTENSION = 'extension'; + sITEM = 'item'; + sLOCATION = 'location'; + sMIN_OCCURS = 'minOccurs'; + sMAX_OCCURS = 'maxOccurs'; + sNAME = 'name'; + sNAME_SPACE = 'namespace'; + sPORT_TYPE = 'portType'; + sRESTRICTION = 'restriction'; + sSEQUENCE = 'sequence'; + sSERVICE = 'service'; + sSIMPLE_TYPE = 'simpleType'; + sSTYLE = 'style'; + sTRANSPORT = 'transport'; + sTYPE = 'type'; + sUNBOUNDED = 'unbounded'; + sUSE = 'use'; + sVALUE = 'value'; + + sWSDL_DEFINITIONS = 'definitions'; + sWSDL_INPUT = 'input'; + sWSDL_MESSAGE = 'message'; + sWSDL_NAME = 'name'; + sWSDL_OPERATION = 'operation'; + sWSDL_OUTPUT = 'output'; + sWSDL_PART = 'part'; + sWSDL_PORT = 'port'; + sWSDL_PORT_TYPE = sPORT_TYPE; + sWSDL_SCHEMA = 'schema'; + sWSDL_TARGET_NS = 'targetNamespace'; + sWSDL_TYPE = sTYPE; + sWSDL_TYPES = 'types'; + +var + WsdlTypeHandlerRegistryInst : IWsdlTypeHandlerRegistry; + +type + + { TWsdlTypeHandlerRegistry } + + TWsdlTypeHandlerRegistry = class(TInterfacedObject,IInterface,IWsdlTypeHandlerRegistry) + private + FList : TClassList; + private + function FindIndexOfHandler(ASymbol : TPTreeElement) : Integer; + protected + function Find( + ASymbol : TPTreeElement; + out AHandler : IWsdlTypeHandler + ) : Boolean; + procedure Register(AFactory : TBaseTypeHandlerClass); + public + constructor Create(); + destructor Destroy();override; + end; + +{ TWsdlTypeHandlerRegistry } + +function TWsdlTypeHandlerRegistry.FindIndexOfHandler(ASymbol: TPTreeElement): Integer; +Var + i, c : Integer; +begin + Result := -1; + c := FList.Count; + for i := 0 to Pred(c) do begin + if TBaseTypeHandlerClass(FList[i]).CanHandle(ASymbol) then begin + Result := i; + Break; + end; + end; +end; + +function TWsdlTypeHandlerRegistry.Find( + ASymbol : TPTreeElement; + out AHandler : IWsdlTypeHandler +) : Boolean; +var + fct : TBaseTypeHandlerClass; + i : Integer; +begin + i := FindIndexOfHandler(ASymbol); + Result := ( i >= 0 ); + if Result then begin + fct := TBaseTypeHandlerClass(FList[i]); + AHandler := fct.Create() as IWsdlTypeHandler; + end; +end; + +procedure TWsdlTypeHandlerRegistry.Register(AFactory: TBaseTypeHandlerClass); +begin + if ( FList.IndexOf(AFactory) = -1 ) then begin + FList.Add(AFactory); + end; +end; + +constructor TWsdlTypeHandlerRegistry.Create(); +begin + FList := TClassList.Create(); +end; + +destructor TWsdlTypeHandlerRegistry.Destroy(); +begin + FreeAndNil(FList); + inherited Destroy(); +end; + +function CreateElement(const ANodeName : DOMString; AParent : TDOMNode; ADoc : TDOMDocument):TDOMElement;//inline; +begin + Result := ADoc.CreateElement(ANodeName); + AParent.AppendChild(Result); +end; + +function FindAttributeByValueInNode( + const AAttValue : string; + const ANode : TDOMNode; + out AResAtt : string; + const AStartIndex : Integer = 0; + const AStartingWith : string = '' +):boolean; +var + i,c : Integer; + b : Boolean; +begin + AResAtt := ''; + if Assigned(ANode) and Assigned(ANode.Attributes) then begin + b := ( Length(AStartingWith) = 0); + c := Pred(ANode.Attributes.Length); + if ( AStartIndex >= 0 ) then + i := AStartIndex; + for i := 0 to c do begin + if AnsiSameText(AAttValue,ANode.Attributes.Item[i].NodeValue) and + ( b or ( Pos(AStartingWith,ANode.Attributes.Item[i].NodeName) = 1 )) + then begin + AResAtt := ANode.Attributes.Item[i].NodeName; + Result := True; + Exit; + end; + end; + end; + Result := False; +end; + +function GetNameSpaceShortName( + const ANameSpace : string; + AWsdlDocument : TDOMDocument +):string;//inline; +begin + if FindAttributeByValueInNode(ANameSpace,AWsdlDocument.DocumentElement,Result,0,sXMLNS) then begin + Result := Copy(Result,Length(sXMLNS+':')+1,MaxInt); + end else begin + Result := Format('ns%d',[AWsdlDocument.DocumentElement.Attributes.{$IFNDEF FPC_211}Count{$ELSE}Length{$ENDIF}]) ; + AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,Result]),ANameSpace); + end; +end; + +type TServiceElementType = ( setPortType, setBinding, setPort, setService,setAddress ); +function GetServicePartName(AContainer : TwstPasTreeContainer; AService : TPasClassType; const AServicePart : TServiceElementType):string; +const PART_NAME_MAP : array[TServiceElementType] of shortstring = ('', 'Binding', 'Port', '',''); +begin + Result := AContainer.GetExternalName(AService) + PART_NAME_MAP[AServicePart]; +end; + +procedure GenerateWSDL(ASymbolTable : TwstPasTreeContainer; ADoc : TDOMDocument); + + procedure GenerateServiceMessages( + AContract : TPasClassType; + ARootNode : TDOMElement + ); + + procedure GenerateOperationMessage(AOperation : TPasProcedure); + + procedure GenerateParam(APrm : TPasArgument; AMsgNode : TDOMElement); + var + tmpNode : TDOMElement; + ns_shortName, s : string; + typItm : TPasType; + begin + tmpNode := CreateElement(sWSDL_PART,AMsgNode,ADoc); + tmpNode.SetAttribute(sWSDL_NAME,ASymbolTable.GetExternalName(APrm)); + typItm := APrm.ArgType; + if Assigned(typItm.Parent) and Assigned(typItm.Parent.Parent) then + s := ASymbolTable.GetExternalName(typItm.Parent.Parent) + else + s := ASymbolTable.GetExternalName(ASymbolTable.CurrentModule); + ns_shortName := GetNameSpaceShortName(s,ADoc); + s := Format('%s:%s',[ns_shortName,ASymbolTable.GetExternalName(typItm)]); + tmpNode.SetAttribute(sWSDL_TYPE,s); + end; + + procedure GenerateResultParam(APrm : TPasResultElement; AMsgNode : TDOMElement); + var + tmpNode : TDOMElement; + ns_shortName, s : string; + typItm : TPasType; + begin + tmpNode := CreateElement(sWSDL_PART,AMsgNode,ADoc); + tmpNode.SetAttribute(sWSDL_NAME,ASymbolTable.GetExternalName(APrm)); + typItm := APrm.ResultType; + if Assigned(typItm.Parent) and Assigned(typItm.Parent.Parent) then + s := ASymbolTable.GetExternalName(typItm.Parent.Parent) + else + s := ASymbolTable.GetExternalName(ASymbolTable.CurrentModule); + ns_shortName := GetNameSpaceShortName(s,ADoc); + s := Format('%s:%s',[ns_shortName,ASymbolTable.GetExternalName(typItm)]); + tmpNode.SetAttribute(sWSDL_TYPE,s); + end; + + var + qryNode, rspNode : TDOMElement; + ii, cc : Integer; + pp : TPasArgument; + begin + qryNode := CreateElement(sWSDL_MESSAGE,ARootNode,ADoc); + qryNode.SetAttribute(sWSDL_NAME,Format('%s',[ASymbolTable.GetExternalName(AOperation)])); + rspNode := CreateElement(sWSDL_MESSAGE,ARootNode,ADoc); + rspNode.SetAttribute(sWSDL_NAME,Format('%sResponse',[ASymbolTable.GetExternalName(AOperation)])); + cc := AOperation.ProcType.Args.Count; + for ii := 0 to Pred(cc) do begin + pp := TPasArgument(AOperation.ProcType.Args[ii]); + if ( pp.Access in [argDefault, argConst] ) then + GenerateParam(pp,qryNode) + else if ( pp.Access in [argVar, argOut] ) then + GenerateParam(pp,rspNode); + end; + if AOperation.InheritsFrom(TPasFunction) then begin + GenerateResultParam(TPasFunctionType(AOperation.ProcType).ResultEl,rspNode); + end; + end; + + Var + j, k : Integer; + po : TPasProcedure; + begin + k := AContract.Members.Count; + if ( k > 0 ) then begin + for j := 0 to pred(k) do begin + if TPasElement(AContract.Members[j]).InheritsFrom(TPasProcedure) then begin + po := TPasProcedure(AContract.Members[j]); + GenerateOperationMessage(po); + end; + end; + end; + end; + + procedure GenerateServicePortType(AContract : TPasClassType; ARootNode : TDOMElement); + + procedure GenerateOperation(AOperation : TPasProcedure; APrtTypeNode : TDOMElement); + var + opNode, inNode, outNode : TDOMElement; + begin + opNode := CreateElement(sWSDL_OPERATION,APrtTypeNode,ADoc); + opNode.SetAttribute(sWSDL_NAME,ASymbolTable.GetExternalName(AOperation)); + inNode := CreateElement(sWSDL_INPUT,opNode,ADoc); + inNode.SetAttribute(sWSDL_MESSAGE,Format('%s:%s',[sTNS,ASymbolTable.GetExternalName(AOperation)])); + outNode := CreateElement(sWSDL_OUTPUT,opNode,ADoc); + outNode.SetAttribute(sWSDL_MESSAGE,Format('%s:%sResponse',[sTNS,ASymbolTable.GetExternalName(AOperation)])); + end; + + var + prtTypeNode : TDOMElement; + j, k : Integer; + po : TPasProcedure; + begin + prtTypeNode := CreateElement(sWSDL_PORT_TYPE,ARootNode,ADoc); + prtTypeNode.SetAttribute(sWSDL_NAME,ASymbolTable.GetExternalName(AContract)); + k := AContract.Members.Count; + if ( k > 0 ) then begin + for j := 0 to pred(k) do begin + if TPasElement(AContract.Members[j]).InheritsFrom(TPasProcedure) then begin + po := TPasProcedure(AContract.Members[j]); + GenerateOperation(po,prtTypeNode); + end; + end; + end; + end; + + procedure GenerateServiceBinding(ABinding : TwstBinding; ARootNode : TDOMElement); + + procedure GenerateOperation(AOperation : TPasProcedure; ABndngNode : TDOMElement); + var + opNode, inNode, outNode, bdyNode : TDOMElement; + strBuff : string; + encdStyl{,encdStylURI} : string; + begin + strBuff := Format('%s:%s',[sSOAP,sWSDL_OPERATION]); + opNode := CreateElement(sWSDL_OPERATION,ABndngNode,ADoc); + opNode.SetAttribute(sWSDL_NAME,ASymbolTable.GetExternalName(AOperation)); + CreateElement(strBuff,opNode,ADoc).SetAttribute(sSOAP_ACTION,Format('%s/%s%s',[ASymbolTable.GetExternalName(ASymbolTable.CurrentModule),ASymbolTable.GetExternalName(ABinding.Intf),ASymbolTable.GetExternalName(AOperation)])); + inNode := CreateElement(sWSDL_INPUT,opNode,ADoc); + strBuff := Format('%s:%s',[sSOAP,sBODY]); + bdyNode := CreateElement(strBuff,inNode,ADoc); + encdStyl := 'literal'; + {encdStylURI := ''; + propData := Find(AOperation^.Properties,sFORMAT_Input_EncodingStyle); + if Assigned(propData) and ( Length(Trim(propData^.Data)) > 0 ) then begin + encdStyl := Trim(propData^.Data); + end;} + bdyNode.SetAttribute(sSOAP_USE,encdStyl); + bdyNode.SetAttribute(sNAME_SPACE,Format('%s',[ASymbolTable.GetExternalName(ASymbolTable.CurrentModule)])); + {propData := Find(AOperation^.Properties,sFORMAT_Input_EncodingStyleURI); + if Assigned(propData) and ( Length(Trim(propData^.Data)) > 0 ) then begin + encdStylURI := Trim(propData^.Data); + end; + if ( Length(encdStylURI) > 0 ) then + bdyNode.SetAttribute(sSOAP_ENCODING_STYLE,encdStylURI); } + + outNode := CreateElement(sWSDL_OUTPUT,opNode,ADoc); + strBuff := Format('%s:%s',[sSOAP,sBODY]); + bdyNode := CreateElement(strBuff,outNode,ADoc); + bdyNode.SetAttribute(sSOAP_USE,encdStyl); + bdyNode.SetAttribute(sNAME_SPACE,Format('%s',[ASymbolTable.GetExternalName(ASymbolTable.CurrentModule)])); + {if ( Length(encdStylURI) > 0 ) then + bdyNode.SetAttribute(sSOAP_ENCODING_STYLE,encdStylURI);} + end; + + var + bndgNode, soapbndgNode : TDOMElement; + j, k : Integer; + po : TPasProcedure; + strBuf : string; + begin + bndgNode := CreateElement(sBINDING,ARootNode,ADoc); + bndgNode.SetAttribute(sWSDL_NAME,ABinding.Name); + bndgNode.SetAttribute(sWSDL_TYPE,Format('%s:%s',[sTNS,ASymbolTable.GetExternalName(ABinding.Intf)])); + + strBuf := Format('%s:%s',[sSOAP,sBINDING]); + soapbndgNode := CreateElement(strBuf,bndgNode,ADoc); + soapbndgNode.SetAttribute(sSTYLE,sSOAP_RPC); + soapbndgNode.SetAttribute(sTRANSPORT,sSOAP_TRANSPORT); + + k := ABinding.Intf.Members.Count; + if ( k > 0 ) then begin + for j := 0 to pred(k) do begin + if TPasElement(ABinding.Intf.Members[j]).InheritsFrom(TPasProcedure) then begin + po := TPasProcedure(ABinding.Intf.Members[j]); + GenerateOperation(po,bndgNode); + end; + end; + end; + end; + + procedure GenerateServicePublication(ABinding : TwstBinding; ARootNode : TDOMElement); + var + srvcNode, portNode, soapAdrNode : TDOMElement; + strBuf : string; + begin + srvcNode := CreateElement(sSERVICE,ARootNode,ADoc); + srvcNode.SetAttribute(sWSDL_NAME,ASymbolTable.GetExternalName(ABinding.Intf)); + + strBuf := Format('%s',[sWSDL_PORT]); + portNode := CreateElement(strBuf,srvcNode,ADoc); + portNode.SetAttribute(sWSDL_NAME,ASymbolTable.GetExternalName(ABinding.Intf) + 'Port'); + portNode.SetAttribute(sBINDING,Format('%s:%s',[sTNS,ABinding.Name])); + + strBuf := Format('%s:%s',[sSOAP,sADDRESS]); + soapAdrNode := CreateElement(strBuf,portNode,ADoc); + soapAdrNode.SetAttribute(sLOCATION,ABinding.Address); + end; + + procedure GenerateServiceTypes(); + var + j, k : Integer; + tri : TPasElement; + g : IWsdlTypeHandler; + gr : IWsdlTypeHandlerRegistry; + typeList : TList; + begin + gr := GetWsdlTypeHandlerRegistry(); + typeList := ASymbolTable.CurrentModule.InterfaceSection.Declarations; + k := typeList.Count; + for j := 0 to Pred(k) do begin + tri := TPasElement(typeList[j]); + if tri.InheritsFrom(TPasType) and + ( not tri.InheritsFrom(TPasNativeClassType) ) and + ( not tri.InheritsFrom(TPasNativeSimpleType) ) + then begin + if gr.Find(TPTreeElement(tri.ClassType),g) then + g.Generate(ASymbolTable, tri,ADoc); + end; + end; + end; + + function CreateRootNode():TDOMElement; + begin + Result := CreateElement(sWSDL_DEFINITIONS,ADoc,ADoc); + Result.SetAttribute(sWSDL_NAME,ASymbolTable.GetExternalName(ASymbolTable.CurrentModule)); + + Result.SetAttribute(sWSDL_TARGET_NS,ASymbolTable.GetExternalName(ASymbolTable.CurrentModule)); + Result.SetAttribute(Format('%s:%s',[sXMLNS,sSOAP]),sSOAP_NS); + Result.SetAttribute(Format('%s:%s',[sXMLNS,sXSD]),sXSD_NS); + Result.SetAttribute(Format('%s:%s',[sXMLNS,sTNS]),ASymbolTable.GetExternalName(ASymbolTable.CurrentModule)); + Result.SetAttribute(sXMLNS,sWSDL_NS); + end; + + function CreateTypesRootNode(ARootNode : TDOMNode):TDOMElement; + begin + Result := CreateElement(sWSDL_TYPES,ARootNode,ADoc); + end; + +var + defNode, typesNode, schNode : TDOMElement; + j, c : Integer; + sym : TPasElement; + ps : TPasClassType; + decList : TList; + bndg : TwstBinding; +begin + if not ( Assigned(ASymbolTable) and Assigned(ADoc)) then + Exit; + + defNode := CreateRootNode(); + typesNode := CreateTypesRootNode(defNode); + schNode := CreateElement(sXSD + ':' + sWSDL_SCHEMA,typesNode,ADoc); + schNode.SetAttribute(sXMLNS,sXSD_NS); + schNode.SetAttribute(sWSDL_TARGET_NS,ASymbolTable.GetExternalName(ASymbolTable.CurrentModule)); + + GenerateServiceTypes(); + + decList := ASymbolTable.CurrentModule.InterfaceSection.Declarations; + c := decList.Count; + for j := 0 to Pred(c) do begin + sym := TPasElement(decList[j]); + if sym.InheritsFrom(TPasClassType) and ( TPasClassType(sym).ObjKind = okInterface ) then begin + ps := TPasClassType(sym); + GenerateServiceMessages(ps,defNode); + GenerateServicePortType(ps,defNode); + end; + end; + + for j := 0 to Pred(ASymbolTable.BindingCount) do begin + bndg := ASymbolTable.Binding[j]; + GenerateServiceBinding(bndg,defNode); + GenerateServicePublication(bndg,defNode); + end; +end; + +function GetWsdlTypeHandlerRegistry():IWsdlTypeHandlerRegistry; +begin + Result := WsdlTypeHandlerRegistryInst; +end; + +type + + { TFakeTypeHandler } + + TFakeTypeHandler = class(TBaseTypeHandler) + protected + procedure Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument + );override; + end; + +{ TClassTypeDefinition_TypeHandler } +type TTypeCategory = ( tcComplexContent, tcSimpleContent ); +procedure TClassTypeDefinition_TypeHandler.Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument +); +var + typItm : TPasClassType; + propTypItm : TPasType; + s, prop_ns_shortName : string; + defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, derivationNode : TDOMElement; + i : Integer; + p : TPasProperty; + typeCategory : TTypeCategory; + hasSequence : Boolean; + trueParent : TPasType; +begin + inherited; + typItm := ASymbol as TPasClassType; + if Assigned(typItm) then begin + GetNameSpaceShortName(AContainer.GetExternalName(AContainer.CurrentModule) ,AWsdlDocument); + defTypesNode := AWsdlDocument.DocumentElement.FindNode(sWSDL_TYPES) as TDOMElement; + Assert(Assigned(defTypesNode)); + defSchemaNode := defTypesNode.FirstChild as TDOMElement; + + s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]); + cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument); + cplxNode.SetAttribute(sNAME, AContainer.GetExternalName(typItm)) ; + + typeCategory := tcComplexContent; + derivationNode := nil; + hasSequence := True; + if Assigned(typItm.AncestorType) then begin + trueParent := typItm.AncestorType; + if trueParent.InheritsFrom(TPasAliasType) then begin + trueParent := GetUltimeType(trueParent); + end; + if trueParent.InheritsFrom(TPasNativeSimpleContentClassType) or + trueParent.InheritsFrom(TPasNativeSimpleType) + then begin + typeCategory := tcSimpleContent; + derivationNode := CreateElement(Format('%s:%s',[sXSD,sEXTENSION]),cplxNode,AWsdlDocument); + s := Trim(GetNameSpaceShortName(AContainer.GetExternalName(trueParent.Parent.Parent),AWsdlDocument)); + if ( Length(s) > 0 ) then begin + s := s + ':'; + end; + s := s + AContainer.GetExternalName(trueParent); + derivationNode.SetAttribute(sBASE,s); + hasSequence := False; + end; + end; + for i := 0 to Pred(typItm.Members.Count) do begin + if TPasElement(typItm.Members[i]).InheritsFrom(TPasProperty) then begin + p := TPasProperty(typItm.Members[i]); + if not AContainer.IsAttributeProperty(p) then begin + if ( typeCategory = tcSimpleContent ) then begin + raise EWsdlGeneratorException.CreateFmt('Invalid type definition, a simple type cannot have "not attribute" properties : "%s"',[AContainer.GetExternalName(ASymbol)]); + hasSequence := True; + end; + end; + end; + end; + if hasSequence then begin + s := Format('%s:%s',[sXSD,sSEQUENCE]); + if Assigned(derivationNode) then begin + sqcNode := CreateElement(s,derivationNode,AWsdlDocument); + end else begin + sqcNode := CreateElement(s,cplxNode,AWsdlDocument); + end; + end else begin + sqcNode := nil; + end; + + + for i := 0 to Pred(typItm.Members.Count) do begin + if TPasElement(typItm.Members[i]).InheritsFrom(TPasProperty) then begin + p := TPasProperty(typItm.Members[i]); + if AnsiSameText('Has',Copy(p.StoredAccessorName,1,3)) or AnsiSameText('True',p.StoredAccessorName) then begin + if AContainer.IsAttributeProperty(p) then begin + s := Format('%s:%s',[sXSD,sATTRIBUTE]); + if Assigned(derivationNode) then + propNode := CreateElement(s,derivationNode,AWsdlDocument) + else + propNode := CreateElement(s,cplxNode,AWsdlDocument); + end else begin + s := Format('%s:%s',[sXSD,sELEMENT]); + propNode := CreateElement(s,sqcNode,AWsdlDocument); + end; + propNode.SetAttribute(sNAME,AContainer.GetExternalName(p)); + propTypItm := p.VarType; + if Assigned(propTypItm) then begin + prop_ns_shortName := GetNameSpaceShortName(AContainer.GetExternalName(propTypItm.Parent.Parent),AWsdlDocument); + propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,AContainer.GetExternalName(propTypItm)])); + if AContainer.IsAttributeProperty(p) then begin + if AnsiSameText('Has',Copy(p.StoredAccessorName,1,3)) then + propNode.SetAttribute(sATTRIBUTE,'optional') + else + propNode.SetAttribute(sATTRIBUTE,'required'); + end else begin + if AnsiSameText('Has',Copy(p.StoredAccessorName,1,3)) then + propNode.SetAttribute(sMIN_OCCURS,'0') + else + propNode.SetAttribute(sMIN_OCCURS,'1'); + propNode.SetAttribute(sMAX_OCCURS,'1'); + end; + end; + end; + end; + end; + end; +end; + +class function TClassTypeDefinition_TypeHandler.CanHandle(ASymbol: TClass): Boolean; +begin + Result := inherited CanHandle(ASymbol) and ASymbol.InheritsFrom(TPasClassType); +end; + +{ TEnumTypeHandler } + +procedure TEnumTypeHandler.Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument +); +var + typItm : TPasEnumType; + ns_shortName, s : string; + defTypesNode, defSchemaNode, resNode, restrictNode : TDOMElement; + i, c : Integer; + unitExternalName : string; +begin + typItm := ASymbol as TPasEnumType; + if Assigned(typItm) then begin + unitExternalName := AContainer.GetExternalName(ASymbol.Parent.Parent); + if FindAttributeByValueInNode(unitExternalName,AWsdlDocument.DocumentElement,ns_shortName) then begin + ns_shortName := Copy(ns_shortName,Length(sXMLNS+':')+1,MaxInt); + end else begin + ns_shortName := Format('ns%d',[AWsdlDocument.DocumentElement.Attributes.{$IFNDEF FPC_211}Count{$ELSE}Length{$ENDIF}]) ; + AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,ns_shortName]),unitExternalName); + end; + defTypesNode := AWsdlDocument.DocumentElement.FindNode(sWSDL_TYPES) as TDOMElement; + Assert(Assigned(defTypesNode)); + defSchemaNode := defTypesNode.FirstChild as TDOMElement; + + //s := Format('%s:%s',[sXSD,sELEMENT]); + //eltNode := CreateElement(s,defSchemaNode,AWsdlDocument); + //eltNode.SetAttribute(sNAME, typItm.DeclaredName) ; + s := Format('%s:%s',[sXSD,sSIMPLE_TYPE]); + resNode := CreateElement(s,defSchemaNode,AWsdlDocument); + resNode.SetAttribute(sNAME, AContainer.GetExternalName(typItm)) ; + s := Format('%s:%s',[sXSD,sRESTRICTION]); + restrictNode := CreateElement(s,resNode,AWsdlDocument); + restrictNode.SetAttribute(sBASE,Format('%s:%s',[sXSD,'string'])) ; + c := typItm.Values.Count; + for i := 0 to pred(c) do begin + s := Format('%s:%s',[sXSD,sENUMERATION]); + CreateElement(s,restrictNode,AWsdlDocument).SetAttribute( + sVALUE, + AContainer.GetExternalName(TPasEnumValue(typItm.Values[i])) + ); + end; + end; +end; + +class function TEnumTypeHandler.CanHandle(ASymbol: TClass): Boolean; +begin + Result := inherited CanHandle(ASymbol) and ASymbol.InheritsFrom(TPasEnumType); +end; + + +{ TFakeTypeHandler } + +procedure TFakeTypeHandler.Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument +); +begin +end; + +{ TBaseArrayRemotable_TypeHandler } + +procedure TBaseArrayRemotable_TypeHandler.Generate( + AContainer : TwstPasTreeContainer; + const ASymbol : TPasElement; + AWsdlDocument : TDOMDocument +); + + function GetNameSpaceShortName(const ANameSpace : string):string;//inline; + begin + if FindAttributeByValueInNode(ANameSpace,AWsdlDocument.DocumentElement,Result,0,sXMLNS) then begin + Result := Copy(Result,Length(sXMLNS+':')+1,MaxInt); + end else begin + Result := Format('ns%d',[AWsdlDocument.DocumentElement.Attributes.{$IFNDEF FPC_211}Count{$ELSE}Length{$ENDIF}]) ; + AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,Result]),ANameSpace); + end; + end; + +var + typItm : TPasArrayType; + propTypItm : TPasType; + s, prop_ns_shortName : string; + defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement; + unitExternalName : string; +begin + inherited; + typItm := ASymbol as TPasArrayType; + if not Assigned(typItm) then + Exit; + if Assigned(typItm) then begin + unitExternalName := AContainer.GetExternalName(typItm.Parent.Parent); + GetNameSpaceShortName(unitExternalName); + defTypesNode := AWsdlDocument.DocumentElement.FindNode(sWSDL_TYPES) as TDOMElement; + Assert(Assigned(defTypesNode)); + defSchemaNode := defTypesNode.FirstChild as TDOMElement; + + s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]); + cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument); + cplxNode.SetAttribute(sNAME, AContainer.GetExternalName(typItm)) ; + + s := Format('%s:%s',[sXSD,sSEQUENCE]); + sqcNode := CreateElement(s,cplxNode,AWsdlDocument); + propTypItm := typItm.ElType; + s := Format('%s:%s',[sXSD,sELEMENT]); + propNode := CreateElement(s,sqcNode,AWsdlDocument); + propNode.SetAttribute(sNAME,sITEM); + if Assigned(propTypItm) then begin + prop_ns_shortName := GetNameSpaceShortName(AContainer.GetExternalName(propTypItm.Parent.Parent)); + propNode.SetAttribute(sTYPE,Format('%s:%s',[prop_ns_shortName,AContainer.GetExternalName(propTypItm)])); + propNode.SetAttribute(sMIN_OCCURS,'0'); + propNode.SetAttribute(sMAX_OCCURS,sUNBOUNDED); + end; + end; +end; + +class function TBaseArrayRemotable_TypeHandler.CanHandle(ASymbol: TClass): Boolean; +begin + Result := inherited CanHandle(ASymbol) and ASymbol.InheritsFrom(TPasArrayType); +end; + +{ TTypeDefinition_TypeHandler } + +procedure TTypeDefinition_TypeHandler.Generate( + AContainer : TwstPasTreeContainer; + const ASymbol: TPasElement; + AWsdlDocument: TDOMDocument +); +begin + Assert(ASymbol.InheritsFrom(TPasType)); +end; + +class function TTypeDefinition_TypeHandler.CanHandle(ASymbol: TClass): Boolean; +begin + Result := Assigned(ASymbol) and ASymbol.InheritsFrom(TPasType); +end; + +procedure RegisterFondamentalTypes(); +var + r : IWsdlTypeHandlerRegistry; +begin + r := GetWsdlTypeHandlerRegistry(); + r.Register(TEnumTypeHandler); + r.Register(TClassTypeDefinition_TypeHandler); + r.Register(TBaseArrayRemotable_TypeHandler); + r.Register(TTypeAliasDefinition_TypeHandler); +end; + +{ TTypeAliasDefinition_TypeHandler } + +procedure TTypeAliasDefinition_TypeHandler.Generate( + AContainer : TwstPasTreeContainer; + const ASymbol: TPasElement; + AWsdlDocument: TDOMDocument +); +var + typItm : TPasAliasType; + ns_shortName, s : string; + defTypesNode, defSchemaNode, resNode : TDOMElement; + unitExternalName, baseUnitExternalName : string; +begin + typItm := ASymbol as TPasAliasType; + if Assigned(typItm) then begin + unitExternalName := AContainer.GetExternalName(ASymbol.Parent.Parent); + if FindAttributeByValueInNode(unitExternalName,AWsdlDocument.DocumentElement,ns_shortName) then begin + ns_shortName := Copy(ns_shortName,Length(sXMLNS+':')+1,MaxInt); + end else begin + ns_shortName := Format('ns%d',[AWsdlDocument.DocumentElement.Attributes.{$IFNDEF FPC_211}Count{$ELSE}Length{$ENDIF}]) ; + AWsdlDocument.DocumentElement.SetAttribute(Format('%s:%s',[sXMLNS,ns_shortName]),unitExternalName); + end; + defTypesNode := AWsdlDocument.DocumentElement.FindNode(sWSDL_TYPES) as TDOMElement; + Assert(Assigned(defTypesNode)); + defSchemaNode := defTypesNode.FirstChild as TDOMElement; + + s := Format('%s:%s',[sXSD,sELEMENT]); + resNode := CreateElement(s,defSchemaNode,AWsdlDocument); + resNode.SetAttribute(sNAME, AContainer.GetExternalName(typItm)) ; + + baseUnitExternalName := AContainer.GetExternalName(typItm.DestType.Parent.Parent); + s := GetNameSpaceShortName(baseUnitExternalName,AWsdlDocument); + s := Format('%s:%s',[s,AContainer.GetExternalName(typItm.DestType)]); + resNode.SetAttribute(sTYPE,s) ; + end; +end; + +class function TTypeAliasDefinition_TypeHandler.CanHandle(ASymbol: TClass): Boolean; +begin + Result := Assigned(ASymbol) and ASymbol.InheritsFrom(TPasAliasType); +end; + +initialization + WsdlTypeHandlerRegistryInst := TWsdlTypeHandlerRegistry.Create() as IWsdlTypeHandlerRegistry; + RegisterFondamentalTypes(); + +finalization + WsdlTypeHandlerRegistryInst := nil; + +end. diff --git a/wst/trunk/ws_helper/generator.pas b/wst/trunk/ws_helper/generator.pas index de21b6269..e59b3b086 100644 --- a/wst/trunk/ws_helper/generator.pas +++ b/wst/trunk/ws_helper/generator.pas @@ -26,7 +26,8 @@ interface uses Classes, SysUtils, - parserdefs, source_utils; + PasTree, + pascal_parser_intf, source_utils; const sWST_EXTENSION = 'wst'; @@ -39,7 +40,7 @@ type Private FSrcMngr : ISourceManager; FCurrentStream : ISourceStream; - FSymbolTable: TSymbolTable; + FSymbolTable: TwstPasTreeContainer; Protected procedure SetCurrentStream(AStream : ISourceStream); procedure Indent(); @@ -53,14 +54,14 @@ type procedure WriteLn(AText : String; Const AArgs : array of const);overload; procedure NewLine(); - function ExtractserviceName(AIntf : TInterfaceDefinition):String; + function ExtractserviceName(AIntf : TPasElement):String; Public constructor Create( - ASymTable : TSymbolTable; + ASymTable : TwstPasTreeContainer; ASrcMngr : ISourceManager ); procedure Execute();virtual;abstract; - property SymbolTable : TSymbolTable Read FSymbolTable; + property SymbolTable : TwstPasTreeContainer Read FSymbolTable; property SrcMngr : ISourceManager Read FSrcMngr; End; @@ -72,19 +73,19 @@ type FDecProcStream : ISourceStream; FImpStream : ISourceStream; - function GenerateClassName(AIntf : TInterfaceDefinition):String; + function GenerateClassName(AIntf : TPasElement):String; procedure GenerateUnitHeader(); procedure GenerateUnitImplementationHeader(); procedure GenerateUnitImplementationFooter(); - procedure GenerateProxyIntf(AIntf : TInterfaceDefinition); - procedure GenerateProxyImp(AIntf : TInterfaceDefinition); + procedure GenerateProxyIntf(AIntf : TPasClassType); + procedure GenerateProxyImp(AIntf : TPasClassType); function GetDestUnitName():string; Public constructor Create( - ASymTable : TSymbolTable; + ASymTable : TwstPasTreeContainer; ASrcMngr : ISourceManager ); procedure Execute();override; @@ -97,19 +98,19 @@ type FDecStream : ISourceStream; FImpStream : ISourceStream; - function GenerateClassName(AIntf : TInterfaceDefinition):String; + function GenerateClassName(AIntf : TPasElement):String; procedure GenerateUnitHeader(); procedure GenerateUnitImplementationHeader(); procedure GenerateUnitImplementationFooter(); - procedure GenerateIntf(AIntf : TInterfaceDefinition); - procedure GenerateImp(AIntf : TInterfaceDefinition); + procedure GenerateIntf(AIntf : TPasClassType); + procedure GenerateImp(AIntf : TPasClassType); function GetDestUnitName():string; Public constructor Create( - ASymTable : TSymbolTable; + ASymTable : TwstPasTreeContainer; ASrcMngr : ISourceManager ); procedure Execute();override; @@ -122,19 +123,19 @@ type FDecStream : ISourceStream; FImpStream : ISourceStream; - function GenerateClassName(AIntf : TInterfaceDefinition):String; + function GenerateClassName(AIntf : TPasElement):String; procedure GenerateUnitHeader(); procedure GenerateUnitImplementationHeader(); procedure GenerateUnitImplementationFooter(); - procedure GenerateIntf(AIntf : TInterfaceDefinition); - procedure GenerateImp(AIntf : TInterfaceDefinition); + procedure GenerateIntf(AIntf : TPasClassType); + procedure GenerateImp(AIntf : TPasClassType); function GetDestUnitName():string; Public constructor Create( - ASymTable : TSymbolTable; + ASymTable : TwstPasTreeContainer; ASrcMngr : ISourceManager ); procedure Execute();override; @@ -149,23 +150,23 @@ type FImpTempStream : ISourceStream; FImpLastStream : ISourceStream; private - function GenerateIntfName(AIntf : TInterfaceDefinition):string; + function GenerateIntfName(AIntf : TPasElement):string; procedure GenerateUnitHeader(); procedure GenerateUnitImplementationHeader(); procedure GenerateUnitImplementationFooter(); - procedure GenerateIntf(AIntf : TInterfaceDefinition); - procedure GenerateTypeAlias(ASymbol : TTypeAliasDefinition); - procedure GenerateClass(ASymbol : TClassTypeDefinition); - procedure GenerateEnum(ASymbol : TEnumTypeDefinition); - procedure GenerateArray(ASymbol : TArrayDefinition); + procedure GenerateIntf(AIntf : TPasClassType); + procedure GenerateTypeAlias(ASymbol : TPasAliasType); + procedure GenerateClass(ASymbol : TPasClassType); + procedure GenerateEnum(ASymbol : TPasEnumType); + procedure GenerateArray(ASymbol : TPasArrayType); procedure GenerateCustomMetadatas(); function GetDestUnitName():string; public constructor Create( - ASymTable : TSymbolTable; + ASymTable : TwstPasTreeContainer; ASrcMngr : ISourceManager ); procedure Execute();override; @@ -174,7 +175,7 @@ type implementation -uses parserutils, Contnrs; +uses parserutils, Contnrs, logger_intf; Const sPROXY_BASE_CLASS = 'TBaseProxy'; sBINDER_BASE_CLASS = 'TBaseServiceBinder'; @@ -190,7 +191,7 @@ Const sPROXY_BASE_CLASS = 'TBaseProxy'; { TProxyGenerator } -function TProxyGenerator.GenerateClassName(AIntf: TInterfaceDefinition): String; +function TProxyGenerator.GenerateClassName(AIntf: TPasElement): String; begin Result := ExtractserviceName(AIntf); Result := Format('T%s_Proxy',[Result]); @@ -201,7 +202,7 @@ begin SetCurrentStream(FDecStream); WriteLn('{'); WriteLn('This unit has been produced by ws_helper.'); - WriteLn(' Input unit name : "%s".',[SymbolTable.Name]); + WriteLn(' Input unit name : "%s".',[SymbolTable.CurrentModule.Name]); WriteLn(' This unit name : "%s".',[GetDestUnitName()]); WriteLn(' Date : "%s".',[DateTimeToStr(Now())]); WriteLn('}'); @@ -210,7 +211,7 @@ begin WriteLn('{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}'); WriteLn('Interface'); WriteLn(''); - WriteLn('Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, %s;',[SymbolTable.Name]); + WriteLn('Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, %s;',[SymbolTable.CurrentModule.Name]); WriteLn(''); WriteLn('Type'); WriteLn(''); @@ -231,9 +232,9 @@ begin SetCurrentStream(FImpStream); NewLine(); WriteLn('initialization'); - WriteLn(' {$i %s.%s}',[SymbolTable.Name,sWST_EXTENSION]); + WriteLn(' {$i %s.%s}',[SymbolTable.CurrentModule.Name,sWST_EXTENSION]); NewLine(); - s := Format('Register_%s_ServiceMetadata',[SymbolTable.Name]); + s := Format('Register_%s_ServiceMetadata',[SymbolTable.CurrentModule.Name]); WriteLn(' {$IF DECLARED(%s)}',[s]); WriteLn(' %s();',[s]); WriteLn(' {$IFEND}'); @@ -241,7 +242,7 @@ begin end; constructor TProxyGenerator.Create( - ASymTable : TSymbolTable; + ASymTable : TwstPasTreeContainer; ASrcMngr : ISourceManager ); begin @@ -254,30 +255,34 @@ end; procedure TProxyGenerator.Execute(); Var i,c : Integer; - intf : TInterfaceDefinition; + intf : TPasClassType; + elt : TPasElement; + ls : TList; begin GenerateUnitHeader(); GenerateUnitImplementationHeader(); - c := Pred(SymbolTable.Count); - For i := 0 To c Do Begin - If SymbolTable.Item[i] Is TInterfaceDefinition Then Begin - intf := SymbolTable.Item[i] As TInterfaceDefinition; + ls := SymbolTable.CurrentModule.InterfaceSection.Declarations; + c := Pred(ls.Count); + for i := 0 to c do begin + elt := TPasElement(ls[i]); + if ( elt is TPasClassType ) and ( TPasClassType(elt).ObjKind = okInterface ) then begin + intf := elt as TPasClassType; GenerateProxyIntf(intf); GenerateProxyImp(intf); - End; - End; + end; + end; GenerateUnitImplementationFooter(); FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FDecProcStream,FImpStream]); - FDecStream := Nil; - FImpStream := Nil; + FDecStream := nil; + FImpStream := nil; end; function TProxyGenerator.GetDestUnitName(): string; begin - Result := Format('%s_proxy',[SymbolTable.Name]); + Result := Format('%s_proxy',[SymbolTable.CurrentModule.Name]); end; -procedure TProxyGenerator.GenerateProxyIntf(AIntf: TInterfaceDefinition); +procedure TProxyGenerator.GenerateProxyIntf(AIntf: TPasClassType); procedure WriteDec(); begin @@ -293,30 +298,31 @@ procedure TProxyGenerator.GenerateProxyIntf(AIntf: TInterfaceDefinition); end; end; - procedure WriteMethod(AMthd : TMethodDefinition); + procedure WriteMethod(AMthd : TPasProcedure); Var prmCnt,k : Integer; - prm : TParameterDefinition; + prm : TPasArgument; + prms : TList; Begin Indent(); - prmCnt := AMthd.ParameterCount; - If ( AMthd.MethodType = mtProcedure ) Then + prms := AMthd.ProcType.Args; + prmCnt := prms.Count; + if AMthd.InheritsFrom(TPasFunction) then begin + Write('function ') + end else begin Write('procedure ') - Else Begin - Write('function '); - Dec(prmCnt); - End; + end; Write('%s(',[AMthd.Name]); If ( prmCnt > 0 ) Then Begin IncIndent(); For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; + prm := TPasArgument(prms[k]); If (k > 0 ) Then Write('; '); NewLine(); Indent(); - Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]); + Write('%s %s : %s',[AccessNames[prm.Access],prm.Name,prm.ArgType.Name]); End; DecIndent(); NewLine(); @@ -324,25 +330,32 @@ procedure TProxyGenerator.GenerateProxyIntf(AIntf: TInterfaceDefinition); End; Write(')'); - If ( AMthd.MethodType = mtFunction ) Then Begin - Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]); - End; + if AMthd.InheritsFrom(TPasFunction) then begin + Write(':%s',[TPasFunctionType(AMthd.ProcType).ResultEl.ResultType.Name]); + end; WriteLn(';'); End; procedure WriteMethods(); - Var + var k : Integer; + mthds : TList; + elt : TPasElement; begin - If ( AIntf.MethodCount = 0 ) Then + if ( GetElementCount(AIntf.Members,TPasProcedure) = 0 ) then Exit; //IncIndent(); Indent(); WriteLn('Protected'); IncIndent(); Indent();WriteLn('class function GetServiceType() : PTypeInfo;override;'); - For k := 0 To Pred(AIntf.MethodCount) Do - WriteMethod(AIntf.Method[k]); + mthds := AIntf.Members; + for k := 0 to Pred(mthds.Count) do begin + elt := TPasElement(mthds[k]); + if elt.InheritsFrom(TPasProcedure) then begin + WriteMethod(TPasProcedure(elt)); + end; + end; DecIndent(); //DecIndent(); end; @@ -357,7 +370,7 @@ begin DecIndent(); end; -procedure TProxyGenerator.GenerateProxyImp(AIntf: TInterfaceDefinition); +procedure TProxyGenerator.GenerateProxyImp(AIntf: TPasClassType); Var strClassName : String; @@ -381,33 +394,34 @@ Var end; WriteLn('End;'); NewLine(); - If ( AIntf.MethodCount > 0 ) Then + if ( GetElementCount(AIntf.Members,TPasProcedure) > 0 ) then WriteLn('{ %s implementation }',[strClassName]); end; - procedure WriteMethodDec(AMthd : TMethodDefinition); + procedure WriteMethodDec(AMthd : TPasProcedure); Var prmCnt,k : Integer; - prm : TParameterDefinition; + prm : TPasArgument; + prms : TList; Begin - prmCnt := AMthd.ParameterCount; - If ( AMthd.MethodType = mtProcedure ) Then - Write('procedure ') - Else Begin - Write('function '); - Dec(prmCnt); - End; + prms := AMthd.ProcType.Args; + prmCnt := prms.Count; + if AMthd.InheritsFrom(TPasFunction) then begin + Write('function ') + end else begin + Write('procedure '); + end; Write('%s.%s(',[strClassName,AMthd.Name]); If ( prmCnt > 0 ) Then Begin IncIndent(); For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; + prm := TPasArgument(prms[k]); If (k > 0 ) Then Write('; '); NewLine(); Indent(); - Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]); + Write('%s %s : %s',[AccessNames[prm.Access],prm.Name,prm.ArgType.Name]); End; DecIndent(); NewLine(); @@ -415,16 +429,18 @@ Var End; Write(')'); - If ( AMthd.MethodType = mtFunction ) Then Begin - Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]); - End; + if AMthd.InheritsFrom(TPasFunction) then begin + Write(':%s',[TPasFunctionType(AMthd.ProcType).ResultEl.ResultType.Name]); + end; WriteLn(';'); End; - procedure WriteMethodImp(AMthd : TMethodDefinition); + procedure WriteMethodImp(AMthd : TPasProcedure); Var prmCnt,k : Integer; - prm : TParameterDefinition; + prm : TPasArgument; + resPrm : TPasResultElement; + prms : TList; Begin IncIndent(); WriteLn('Var'); @@ -437,15 +453,14 @@ Var Indent();WriteLn('%s := GetSerializer();',[sLOC_SERIALIZER]); Indent();WriteLn('Try');IncIndent(); - Indent();WriteLn('%s.BeginCall(''%s'', GetTarget(),(Self as ICallContext));',[sLOC_SERIALIZER,AMthd.ExternalName]); + Indent();WriteLn('%s.BeginCall(''%s'', GetTarget(),(Self as ICallContext));',[sLOC_SERIALIZER,SymbolTable.GetExternalName(AMthd)]); IncIndent(); - prmCnt := AMthd.ParameterCount; - If ( AMthd.MethodType = mtFunction ) Then - Dec(prmCnt); - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - If ( prm.Modifier <> pmOut ) Then Begin - Indent();WriteLn('%s.Put(%s, TypeInfo(%s), %s);',[sLOC_SERIALIZER,QuotedStr(prm.ExternalName),prm.DataType.Name,prm.Name]); + prms := AMthd.ProcType.Args; + prmCnt := prms.Count; + for k := 0 To Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + If ( prm.Access <> argOut ) Then Begin + Indent();WriteLn('%s.Put(%s, TypeInfo(%s), %s);',[sLOC_SERIALIZER,QuotedStr(SymbolTable.GetExternalName(prm)),prm.ArgType.Name,prm.Name]); End; End; DecIndent(); @@ -457,36 +472,34 @@ Var Indent();WriteLn('%s.BeginCallRead((Self as ICallContext));',[sLOC_SERIALIZER]); IncIndent(); - k:= Pred(AMthd.ParameterCount); - If ( AMthd.MethodType = mtFunction ) Then Begin - prm := AMthd.Parameter[k]; - //Indent();WriteLn('%s := TypeInfo(%s);',[sRES_TYPE_INFO,prm.DataType.Name]); - if prm.DataType.NeedFinalization() then begin - if prm.DataType.InheritsFrom(TClassTypeDefinition) or - prm.DataType.InheritsFrom(TArrayDefinition) + if AMthd.InheritsFrom(TPasFunction) then begin + resPrm := TPasFunctionType(AMthd.ProcType).ResultEl; + if SymbolTable.IsInitNeed(resPrm.ResultType) then begin + if SymbolTable.IsOfType(resPrm.ResultType,TPasClassType) or + SymbolTable.IsOfType(resPrm.ResultType,TPasArrayType) then begin Indent();WriteLn('TObject(Result) := Nil;'); end else begin - Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]); + Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[resPrm.ResultType.Name]); IncIndent(); Indent();WriteLn('Pointer(Result) := Nil;'); DecIndent(); end; end; - Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(prm.ExternalName)]);//Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(RETURN_PARAM_NAME)]); - Indent();WriteLn('%s.Get(TypeInfo(%s), %s, %s);',[sLOC_SERIALIZER,prm.DataType.Name,sPRM_NAME,'Result']); - End; + Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(FSymbolTable.GetExternalName(resPrm))]); + Indent();WriteLn('%s.Get(TypeInfo(%s), %s, %s);',[sLOC_SERIALIZER,resPrm.ResultType.Name,sPRM_NAME,'Result']); + end; //-------------------------------- for k := 0 to Pred(prmCnt) do begin - prm := AMthd.Parameter[k]; - if ( prm.Modifier = pmOut ) then begin - if prm.DataType.NeedFinalization() then begin - if prm.DataType.InheritsFrom(TClassTypeDefinition) or - prm.DataType.InheritsFrom(TArrayDefinition) + prm := TPasArgument(prms[k]); + if ( prm.Access = argOut ) then begin + if SymbolTable.IsInitNeed(prm.ArgType) then begin + if SymbolTable.IsOfType(prm.ArgType,TPasClassType) or + SymbolTable.IsOfType(prm.ArgType,TPasArrayType) then begin Indent();WriteLn('TObject(%s) := Nil;',[prm.Name]); end else begin - Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]); + Indent();WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.ArgType.Name]); IncIndent(); Indent();WriteLn('Pointer(%s) := Nil;',[prm.Name]); DecIndent(); @@ -496,13 +509,13 @@ Var end; //-------------------------------- - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - If ( prm.Modifier In [pmVar, pmOut] ) Then Begin - Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(prm.ExternalName)]); - Indent();WriteLn('%s.Get(TypeInfo(%s), %s, %s);',[sLOC_SERIALIZER,prm.DataType.Name,sPRM_NAME,prm.Name]); - End; - End; + for k := 0 to Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + if ( prm.Access in [argVar, argOut] ) then begin + Indent();WriteLn('%s := %s;',[sPRM_NAME,QuotedStr(SymbolTable.GetExternalName(prm))]); + Indent();WriteLn('%s.Get(TypeInfo(%s), %s, %s);',[sLOC_SERIALIZER,prm.ArgType.Name,sPRM_NAME,prm.Name]); + end; + end; DecIndent(); @@ -515,7 +528,7 @@ Var Indent();WriteLn('End;');DecIndent(); WriteLn('End;'); - End; + end; procedure WriteTypeInfoMethod(); begin @@ -530,15 +543,21 @@ Var end; procedure WriteMethods(); - Var + var k : Integer; + mthds : TList; + elt : TPasElement; begin WriteTypeInfoMethod(); - For k := 0 To Pred(AIntf.MethodCount) Do Begin - WriteMethodDec(AIntf.Method[k]); - WriteMethodImp(AIntf.Method[k]); - WriteLn(''); - End; + mthds := AIntf.Members; + for k := 0 to Pred(mthds.Count) do begin + elt := TPasElement(mthds[k]); + if elt.InheritsFrom(TPasProcedure) then begin + WriteMethodDec(TPasProcedure(elt)); + WriteMethodImp(TPasProcedure(elt)); + WriteLn(''); + end; + end; end; begin @@ -610,14 +629,14 @@ begin WriteLn(''); end; -function TBaseGenerator.ExtractserviceName(AIntf: TInterfaceDefinition): String; +function TBaseGenerator.ExtractserviceName(AIntf: TPasElement): String; begin Result := AIntf.Name; If upCase(Result[1]) = 'I' Then Delete(Result,1,1); end; -constructor TBaseGenerator.Create(ASymTable: TSymbolTable; ASrcMngr: ISourceManager); +constructor TBaseGenerator.Create(ASymTable: TwstPasTreeContainer; ASrcMngr: ISourceManager); begin Assert(Assigned(ASymTable)); Assert(Assigned(ASrcMngr)); @@ -628,7 +647,7 @@ end; { TBinderGenerator } -function TBinderGenerator.GenerateClassName(AIntf: TInterfaceDefinition): String; +function TBinderGenerator.GenerateClassName(AIntf: TPasElement): String; begin Result := ExtractserviceName(AIntf); Result := Format('T%s_ServiceBinder',[Result]); @@ -639,7 +658,7 @@ begin SetCurrentStream(FDecStream); WriteLn('{'); WriteLn('This unit has been produced by ws_helper.'); - WriteLn(' Input unit name : "%s".',[SymbolTable.Name]); + WriteLn(' Input unit name : "%s".',[SymbolTable.CurrentModule.Name]); WriteLn(' This unit name : "%s".',[GetDestUnitName()]); WriteLn(' Date : "%s".',[DateTimeToStr(Now())]); WriteLn('}'); @@ -648,7 +667,7 @@ begin WriteLn('{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}'); WriteLn('interface'); WriteLn(''); - WriteLn('uses SysUtils, Classes, base_service_intf, server_service_intf, %s;',[SymbolTable.Name]); + WriteLn('uses SysUtils, Classes, base_service_intf, server_service_intf, %s;',[SymbolTable.CurrentModule.Name]); WriteLn(''); WriteLn('type'); WriteLn(''); @@ -669,21 +688,21 @@ begin NewLine(); WriteLn('initialization'); NewLine(); - s := Format('Register_%s_NameSpace',[SymbolTable.Name]); + s := Format('Register_%s_NameSpace',[SymbolTable.CurrentModule.Name]); WriteLn(' {$IF DECLARED(%s)}',[s]); WriteLn(' %s();',[s]); WriteLn(' {$ENDIF}'); NewLine(); - WriteLn(' {$i %s.%s}',[SymbolTable.Name,sWST_EXTENSION]); + WriteLn(' {$i %s.%s}',[SymbolTable.CurrentModule.Name,sWST_EXTENSION]); NewLine(); WriteLn('End.'); end; -procedure TBinderGenerator.GenerateIntf(AIntf: TInterfaceDefinition); +procedure TBinderGenerator.GenerateIntf(AIntf: TPasClassType); procedure WriteDec(); begin Indent(); - WriteLn('%s=class(%s)',[GenerateClassName(AIntf),sBINDER_BASE_CLASS]); + WriteLn('%s = class(%s)',[GenerateClassName(AIntf),sBINDER_BASE_CLASS]); end; procedure WriteConstructor(); @@ -692,26 +711,33 @@ procedure TBinderGenerator.GenerateIntf(AIntf: TInterfaceDefinition); WriteLn('constructor Create();') End; - procedure WriteMethod(AMthd : TMethodDefinition); + procedure WriteMethod(AMthd : TPasProcedure); Begin Indent(); - WriteLn('procedure %sHandler(AFormatter:IFormatterResponse);',[AMthd.Name]) + WriteLn('procedure %sHandler(AFormatter : IFormatterResponse; AContext : ICallContext);',[AMthd.Name]) End; procedure WriteMethods(); - Var + var k : Integer; + mbrs : TList; + elt : TPasElement; begin - If ( AIntf.MethodCount = 0 ) Then - Exit; - Indent();WriteLn('Protected'); + if ( GetElementCount(AIntf.Members,TPasProcedure) > 0 ) then begin + Indent();WriteLn('protected'); IncIndent(); - For k := 0 To Pred(AIntf.MethodCount) Do - WriteMethod(AIntf.Method[k]); + mbrs := AIntf.Members; + for k := 0 to Pred(mbrs.Count) do begin + elt := TPasElement(mbrs[k]); + if elt.InheritsFrom(TPasProcedure) then begin + WriteMethod(TPasProcedure(elt)); + end; + end; DecIndent(); - - Indent();WriteLn('Public'); + + Indent();WriteLn('public'); Indent();WriteConstructor(); + end; end; procedure GenerateFactoryClass(); @@ -719,15 +745,25 @@ procedure TBinderGenerator.GenerateIntf(AIntf: TInterfaceDefinition); NewLine(); IncIndent();BeginAutoIndent(); WriteLn('T%s_ServiceBinderFactory = class(TInterfacedObject,IItemFactory)',[ExtractserviceName(AIntf)]); + WriteLn('private'); + IncIndent(); + WriteLn('FInstance : IInterface;'); + DecIndent(); + WriteLn('protected'); - IncIndent(); WriteLn('function CreateInstance():IInterface;'); DecIndent(); - WriteLn('End;'); + + WriteLn('public'); + IncIndent(); + WriteLn('constructor Create();'); + WriteLn('destructor Destroy();override;'); + DecIndent(); + WriteLn('end;'); DecIndent();EndAutoIndent(); End; - + procedure GenerateRegistrationProc(); Begin NewLine(); @@ -744,201 +780,227 @@ begin IncIndent(); WriteDec(); WriteMethods(); - Indent();WriteLn('End;'); + Indent();WriteLn('end;'); DecIndent(); GenerateFactoryClass(); GenerateRegistrationProc(); end; -procedure TBinderGenerator.GenerateImp(AIntf: TInterfaceDefinition); +procedure TBinderGenerator.GenerateImp(AIntf: TPasClassType); Var strClassName : String; procedure WriteDec(); begin - If ( AIntf.MethodCount > 0 ) Then + if ( GetElementCount(AIntf.Members,TPasProcedure) > 0 ) then WriteLn('{ %s implementation }',[strClassName]); end; - procedure WriteMethodDec(AMthd : TMethodDefinition); + procedure WriteMethodDec(AMthd : TPasProcedure); Begin - WriteLn('procedure %s.%sHandler(AFormatter:IFormatterResponse);',[strClassName,AMthd.Name]); + WriteLn('procedure %s.%sHandler(AFormatter : IFormatterResponse; AContext : ICallContext);',[strClassName,AMthd.Name]); End; - procedure WriteMethodImp(AMthd : TMethodDefinition); + procedure WriteMethodImp(AMthd : TPasProcedure); Var prmCnt,k : Integer; - prm : TParameterDefinition; + prm : TPasArgument; + prms : TList; + resElt : TPasResultElement; strBuff : string; Begin - prmCnt := AMthd.ParameterCount; - If ( AMthd.MethodType = mtFunction ) Then - Dec(prmCnt); - - WriteLn('Var'); + prms := AMthd.ProcType.Args; + prmCnt := prms.Count; + WriteLn('var'); IncIndent();BeginAutoIndent(); WriteLn('cllCntrl : ICallControl;'); + WriteLn('objCntrl : IObjectControl;'); + WriteLn('hasObjCntrl : Boolean;'); WriteLn('tmpObj : %s;',[AIntf.Name]); WriteLn('callCtx : ICallContext;'); - If ( prmCnt > 0 ) Or ( AMthd.MethodType = mtFunction ) Then Begin + if ( prmCnt > 0 ) or AMthd.InheritsFrom(TPasFunction) then begin WriteLn('%s : string;',[sPRM_NAME]); WriteLn('procName,trgName : string;'); - End; - If ( prmCnt > 0 ) Then Begin - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - WriteLn('%s : %s;',[prm.Name,prm.DataType.Name]); - End; - End; - If ( AMthd.MethodType = mtFunction ) Then Begin - WriteLn('%s : %s;',[RETURN_VAL_NAME,AMthd.Parameter[prmCnt].DataType.Name]); - //WriteLn('%s : %s;',[sLOC_TYPE_INFO,'PTypeInfo']); - End; + end; + if ( prmCnt > 0 ) then begin + for k := 0 to Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + WriteLn('%s : %s;',[prm.Name,prm.ArgType.Name]); + end; + end; + if AMthd.InheritsFrom(TPasFunction) then begin + WriteLn('%s : %s;',[RETURN_VAL_NAME,TPasFunctionType(AMthd.ProcType).ResultEl.ResultType.Name]); + end; DecIndent();EndAutoIndent(); - WriteLn('Begin'); + WriteLn('begin'); IncIndent();BeginAutoIndent(); - WriteLn('callCtx := GetCallContext();'); - If ( AMthd.MethodType = mtFunction ) Then Begin - prm := AMthd.Parameter[prmCnt]; - If prm.DataType.NeedFinalization() Then Begin - if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin - WriteLn('TObject(%s) := Nil;',[RETURN_VAL_NAME]); + WriteLn('callCtx := AContext;'); + if AMthd.InheritsFrom(TPasFunction) then begin + resElt := TPasFunctionType(AMthd.ProcType).ResultEl; + if SymbolTable.IsInitNeed(resElt.ResultType) then begin + if ( SymbolTable.IsOfType(resElt.ResultType,TPasClassType) and + ( TPasClassType(GetUltimeType(resElt.ResultType)).ObjKind = okClass ) + ) or + SymbolTable.IsOfType(resElt.ResultType,TPasArrayType) + then begin + WriteLn('TObject(%s) := nil;',[RETURN_VAL_NAME]); end else begin - WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) Then',[prm.DataType.Name]); + WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkInterface] ) then',[resElt.ResultType.Name]); IncIndent(); - WriteLn('Pointer(%s) := Nil;',[RETURN_VAL_NAME]); + WriteLn('Pointer(%s) := nil;',[RETURN_VAL_NAME]); DecIndent(); end; - End; - End; + end; + end; - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - If prm.DataType.NeedFinalization() Then Begin - if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin - WriteLn('TObject(%s) := Nil;',[prm.Name]); + for k := 0 to Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + if SymbolTable.IsInitNeed(prm.ArgType) then begin + if SymbolTable.IsOfType(prm.ArgType,TPasClassType) or + SymbolTable.IsOfType(prm.ArgType,TPasArrayType) + then begin + WriteLn('TObject(%s) := nil;',[prm.Name]); end else begin - WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkObject,tkInterface] ) Then',[prm.DataType.Name]); + WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind in [tkClass,tkObject,tkInterface] ) then',[prm.ArgType.Name]); IncIndent(); - WriteLn('Pointer(%s) := Nil;',[prm.Name]); + WriteLn('Pointer(%s) := nil;',[prm.Name]); DecIndent(); end; - End; - End; + end; + end; NewLine(); - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - Write('%s := %s;',[sPRM_NAME,QuotedStr(prm.ExternalName)]); - WriteLn('AFormatter.Get(TypeInfo(%s),%s,%s);',[prm.DataType.Name,sPRM_NAME,prm.Name]); - If prm.DataType.NeedFinalization() Then Begin - if prm.DataType.InheritsFrom(TClassTypeDefinition) then begin - WriteLn('If Assigned(Pointer(%s)) Then',[prm.Name]); + for k := 0 to Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + Write('%s := %s;',[sPRM_NAME,QuotedStr(SymbolTable.GetExternalName(prm))]); + WriteLn('AFormatter.Get(TypeInfo(%s),%s,%s);',[prm.ArgType.Name,sPRM_NAME,prm.Name]); + if SymbolTable.IsInitNeed(prm.ArgType) then begin + if SymbolTable.IsOfType(prm.ArgType,TPasClassType) or SymbolTable.IsOfType(prm.ArgType,TPasArrayType) then begin + WriteLn('if Assigned(Pointer(%s)) then',[prm.Name]); IncIndent(); WriteLn('callCtx.AddObjectToFree(TObject(%s));',[prm.Name]); DecIndent(); end else begin - WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) And Assigned(Pointer(%s)) Then',[prm.DataType.Name,prm.Name]); + WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) and Assigned(Pointer(%s)) then',[prm.ArgType.Name,prm.Name]); IncIndent(); WriteLn('callCtx.AddObjectToFree(TObject(%s));',[prm.Name]); DecIndent(); end; - End; - End; + end; + end; NewLine(); WriteLn('tmpObj := Self.GetFactory().CreateInstance() as %s;',[AIntf.Name]); WriteLn('if Supports(tmpObj,ICallControl,cllCntrl) then'); - Indent();WriteLn('cllCntrl.SetCallContext(GetCallContext());'); - NewLine(); + Indent();WriteLn('cllCntrl.SetCallContext(callCtx);'); + WriteLn('hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);'); + WriteLn('if hasObjCntrl then'); + Indent();WriteLn('objCntrl.Activate();'); - If ( AMthd.MethodType = mtFunction ) Then - Write('%s := tmpObj.%s(',[RETURN_VAL_NAME,AMthd.Name]) - Else - Write('tmpObj.%s(',[AMthd.Name]); - strBuff := ''; - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - strBuff := strBuff + Format('%s,',[prm.Name]); - End; - If ( prmCnt > 0 ) Then - Delete(strBuff,Length(strBuff),1); - strBuff := strBuff + ');'; - EndAutoIndent(); - WriteLn(strBuff); - BeginAutoIndent(); + WriteLn('try');IncIndent(); - If ( AMthd.MethodType = mtFunction ) Then Begin - prm := AMthd.Parameter[prmCnt]; - If prm.DataType.NeedFinalization() Then Begin - if prm.DataType.InheritsFrom(TClassTypeDefinition) then - WriteLn('If Assigned(TObject(%s)) Then',[RETURN_VAL_NAME]) - else - WriteLn('If ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) And Assigned(Pointer(%s)) Then',[prm.DataType.Name,RETURN_VAL_NAME]); - IncIndent(); - WriteLn('callCtx.AddObjectToFree(TObject(%s));',[RETURN_VAL_NAME]); - DecIndent(); - End; - End; - NewLine(); - - WriteLn('procName := AFormatter.GetCallProcedureName();'); - WriteLn('trgName := AFormatter.GetCallTarget();'); - WriteLn('AFormatter.Clear();'); - - WriteLn('AFormatter.BeginCallResponse(procName,trgName);'); - IncIndent(); - if ( AMthd.MethodType = mtFunction ) then begin - //WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(RETURN_PARAM_NAME),AMthd.Parameter[prmCnt].DataType.Name,RETURN_VAL_NAME]); - WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(prm.ExternalName),AMthd.Parameter[prmCnt].DataType.Name,RETURN_VAL_NAME]); + if AMthd.InheritsFrom(TPasFunction) then + Write('%s := tmpObj.%s(',[RETURN_VAL_NAME,AMthd.Name]) + else + Write('tmpObj.%s(',[AMthd.Name]); + strBuff := ''; + for k := 0 to Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + strBuff := strBuff + Format('%s,',[prm.Name]); end; - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - If ( prm.Modifier In [pmOut,pmVar] ) Then - WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(prm.ExternalName),prm.DataType.Name,prm.Name]); - End; - DecIndent(); - WriteLn('AFormatter.EndCallResponse();'); - NewLine(); - WriteLn('callCtx := Nil;'); + if ( prmCnt > 0 ) then + Delete(strBuff,Length(strBuff),1); + strBuff := strBuff + ');'; + EndAutoIndent(); + WriteLn(strBuff); + BeginAutoIndent(); + + if AMthd.InheritsFrom(TPasFunction) then begin + if SymbolTable.IsInitNeed(resElt.ResultType) then begin + if SymbolTable.IsOfType(resElt.ResultType,TPasClassType) or SymbolTable.IsOfType(resElt.ResultType,TPasArrayType) then + WriteLn('if Assigned(TObject(%s)) then',[RETURN_VAL_NAME]) + else + WriteLn('if ( PTypeInfo(TypeInfo(%s))^.Kind = tkClass ) and Assigned(Pointer(%s)) then',[resElt.ResultType.Name,RETURN_VAL_NAME]); + IncIndent(); + WriteLn('callCtx.AddObjectToFree(TObject(%s));',[RETURN_VAL_NAME]); + DecIndent(); + end; + end; + NewLine(); + + WriteLn('procName := AFormatter.GetCallProcedureName();'); + WriteLn('trgName := AFormatter.GetCallTarget();'); + WriteLn('AFormatter.Clear();'); + + WriteLn('AFormatter.BeginCallResponse(procName,trgName);'); + IncIndent(); + if AMthd.InheritsFrom(TPasFunction) then begin + WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(SymbolTable.GetExternalName(resElt)),resElt.ResultType.Name,RETURN_VAL_NAME]); + end; + for k := 0 to Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + if ( prm.Access in [argOut,argVar] ) then + WriteLn('AFormatter.Put(%s,TypeInfo(%s),%s);',[QuotedStr(SymbolTable.GetExternalName(prm)),prm.ArgType.Name,prm.Name]); + end; + DecIndent(); + WriteLn('AFormatter.EndCallResponse();'); + NewLine(); + WriteLn('callCtx := nil;'); + + DecIndent(); + WriteLn('finally'); + WriteLn(' if hasObjCntrl then'); + WriteLn(' objCntrl.Deactivate();'); + WriteLn(' Self.GetFactory().ReleaseInstance(tmpObj);'); + WriteLn('end;'); DecIndent();EndAutoIndent(); - WriteLn('End;'); + WriteLn('end;'); End; procedure WriteConstructor(); Var k : Integer; - mtd : TMethodDefinition; + mtd : TPasProcedure; + mtds : TList; Begin NewLine(); WriteLn('constructor %s.Create();',[strClassName]); - WriteLn('Begin'); + WriteLn('begin'); IncIndent(); BeginAutoIndent(); - WriteLn('Inherited Create(GetServiceImplementationRegistry().FindFactory(%s));',[QuotedStr(AIntf.Name)]); - For k := 0 To Pred(AIntf.MethodCount) Do Begin - mtd := AIntf.Method[k]; - WriteLn('RegisterVerbHandler(%s,@%sHandler);',[QuotedStr(mtd.Name),mtd.Name]); - End; + WriteLn('inherited Create(GetServiceImplementationRegistry().FindFactory(%s));',[QuotedStr(AIntf.Name)]); + mtds := AIntf.Members; + for k := 0 to Pred(mtds.Count) do begin + if TPasElement(mtds[k]).InheritsFrom(TPasProcedure) then begin + mtd := TPasProcedure(mtds[k]); + WriteLn('RegisterVerbHandler(%s,@%sHandler);',[QuotedStr(mtd.Name),mtd.Name]); + end; + end; EndAutoIndent(); DecIndent(); - WriteLn('End;'); + WriteLn('end;'); NewLine(); End; procedure WriteMethods(); - Var + var k : Integer; + mtds : TList; + mtd : TPasProcedure; begin - For k := 0 To Pred(AIntf.MethodCount) Do Begin - WriteMethodDec(AIntf.Method[k]); - WriteMethodImp(AIntf.Method[k]); - WriteLn(''); - End; + mtds := AIntf.Members; + for k := 0 to Pred(mtds.Count) do begin + if TPasElement(mtds[k]).InheritsFrom(TPasProcedure) then begin + mtd := TPasProcedure(mtds[k]); + WriteMethodDec(mtd); + WriteMethodImp(mtd); + WriteLn(''); + end; + end; WriteConstructor(); end; @@ -950,15 +1012,34 @@ Var BeginAutoIndent(); strBuff := Format('T%s_ServiceBinderFactory',[ExtractserviceName(AIntf)]); WriteLn('{ %s }',[strBuff]); + NewLine(); WriteLn('function %s.CreateInstance():IInterface;',[strBuff]); - WriteLn('Begin'); + WriteLn('begin'); IncIndent(); - WriteLn('Result := %s.Create() as IInterface;',[strClassName]); + WriteLn('Result := FInstance;',[strClassName]); DecIndent(); - WriteLn('End;'); + WriteLn('end;'); + + NewLine(); + WriteLn('constructor %s.Create();',[strBuff]); + WriteLn('begin'); + IncIndent(); + WriteLn('FInstance := %s.Create() as IInterface;',[strClassName]); + DecIndent(); + WriteLn('end;'); + + NewLine(); + WriteLn('destructor %s.Destroy();',[strBuff]); + WriteLn('begin'); + IncIndent(); + WriteLn('FInstance := nil;'); + WriteLn('inherited Destroy();'); + DecIndent(); + WriteLn('end;'); + EndAutoIndent(); End; - + procedure GenerateRegistrationProc(); Var strBuff : string; @@ -985,17 +1066,17 @@ begin NewLine(); WriteDec(); WriteMethods(); - + GenerateFactoryClass(); GenerateRegistrationProc(); end; function TBinderGenerator.GetDestUnitName(): string; begin - Result := Format('%s_binder',[SymbolTable.Name]); + Result := Format('%s_binder',[SymbolTable.CurrentModule.Name]); end; -constructor TBinderGenerator.Create(ASymTable: TSymbolTable;ASrcMngr: ISourceManager); +constructor TBinderGenerator.Create(ASymTable: TwstPasTreeContainer;ASrcMngr: ISourceManager); begin Inherited Create(ASymTable,ASrcMngr); FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec'); @@ -1005,27 +1086,31 @@ end; procedure TBinderGenerator.Execute(); Var i,c : Integer; - intf : TInterfaceDefinition; + intf : TPasClassType; + typeList : TList; + elt : TPasElement; begin GenerateUnitHeader(); GenerateUnitImplementationHeader(); - c := Pred(SymbolTable.Count); - For i := 0 To c Do Begin - If SymbolTable.Item[i] Is TInterfaceDefinition Then Begin - intf := SymbolTable.Item[i] As TInterfaceDefinition; + typeList := SymbolTable.CurrentModule.InterfaceSection.Types; + c := Pred(typeList.Count); + for i := 0 to c do begin + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okInterface ) then begin + intf := TPasClassType(elt); GenerateIntf(intf); GenerateImp(intf); - End; - End; + end; + end; GenerateUnitImplementationFooter(); FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream]); - FDecStream := Nil; - FImpStream := Nil; + FDecStream := nil; + FImpStream := nil; end; { TImplementationGenerator } -function TImplementationGenerator.GenerateClassName(AIntf: TInterfaceDefinition): String; +function TImplementationGenerator.GenerateClassName(AIntf: TPasElement): String; begin Result := ExtractserviceName(AIntf); Result := Format('T%s_ServiceImp',[Result]); @@ -1036,7 +1121,7 @@ begin SetCurrentStream(FDecStream); WriteLn('{'); WriteLn('This unit has been produced by ws_helper.'); - WriteLn(' Input unit name : "%s".',[SymbolTable.Name]); + WriteLn(' Input unit name : "%s".',[SymbolTable.CurrentModule.Name]); WriteLn(' This unit name : "%s".',[GetDestUnitName()]); WriteLn(' Date : "%s".',[DateTimeToStr(Now())]); WriteLn('}'); @@ -1046,7 +1131,7 @@ begin WriteLn('Interface'); WriteLn(''); WriteLn('Uses SysUtils, Classes, '); - WriteLn(' base_service_intf, server_service_intf, server_service_imputils, %s;',[SymbolTable.Name]); + WriteLn(' base_service_intf, server_service_intf, server_service_imputils, %s;',[SymbolTable.CurrentModule.Name]); WriteLn(''); WriteLn('Type'); WriteLn(''); @@ -1065,61 +1150,69 @@ begin WriteLn('End.'); end; -procedure TImplementationGenerator.GenerateIntf(AIntf: TInterfaceDefinition); +procedure TImplementationGenerator.GenerateIntf(AIntf: TPasClassType); procedure WriteDec(); begin Indent(); WriteLn('%s=class(%s,%s)',[GenerateClassName(AIntf),sIMP_BASE_CLASS,AIntf.Name]); end; - procedure WriteMethod(AMthd : TMethodDefinition); - Var + procedure WriteMethod(AMthd : TPasProcedure); + var prmCnt,k : Integer; - prm : TParameterDefinition; - Begin + prm : TPasArgument; + prms : TList; + begin Indent(); - prmCnt := AMthd.ParameterCount; - If ( AMthd.MethodType = mtProcedure ) Then - Write('procedure ') - Else Begin - Write('function '); - Dec(prmCnt); - End; + prms := AMthd.ProcType.Args; + prmCnt := prms.Count; + if AMthd.InheritsFrom(TPasFunction) then begin + Write('function ') + end else begin + Write('procedure '); + end; Write('%s(',[AMthd.Name]); - If ( prmCnt > 0 ) Then Begin + if ( prmCnt > 0 ) then begin IncIndent(); - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - If (k > 0 ) Then + for k := 0 to Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + if (k > 0 ) then Write('; '); NewLine(); Indent(); - Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]); - End; + Write('%s %s : %s',[AccessNames[prm.Access],prm.Name,prm.ArgType.Name]); + end; DecIndent(); NewLine(); Indent(); - End; + end; Write(')'); - If ( AMthd.MethodType = mtFunction ) Then Begin - Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]); - End; + if AMthd.InheritsFrom(TPasFunction) then begin + Write(':%s',[TPasFunctionType(AMthd.ProcType).ResultEl.ResultType.Name]); + end; WriteLn(';'); - End; + end; procedure WriteMethods(); - Var + var k : Integer; + mtds : TList; + elt : TPasElement; begin - If ( AIntf.MethodCount = 0 ) Then - Exit; - Indent();WriteLn('Protected'); - IncIndent(); - For k := 0 To Pred(AIntf.MethodCount) Do - WriteMethod(AIntf.Method[k]); - DecIndent(); + if ( GetElementCount(AIntf.Members,TPasProcedure) > 0 ) then begin + Indent();WriteLn('Protected'); + IncIndent(); + mtds := AIntf.Members; + for k := 0 to Pred(mtds.Count) do begin + elt := TPasElement(mtds[k]); + if elt.InheritsFrom(TPasProcedure) then begin + WriteMethod(TPasProcedure(elt)); + end; + end; + DecIndent(); + end; end; procedure GenerateRegistrationProc(); @@ -1145,68 +1238,78 @@ begin GenerateRegistrationProc(); end; -procedure TImplementationGenerator.GenerateImp(AIntf: TInterfaceDefinition); -Var +procedure TImplementationGenerator.GenerateImp(AIntf: TPasClassType); +var strClassName : String; procedure WriteDec(); begin - If ( AIntf.MethodCount > 0 ) Then + if ( GetElementCount(AIntf.Members,TPasProcedure) > 0 ) then begin WriteLn('{ %s implementation }',[strClassName]); + end; end; - procedure WriteMethodDec(AMthd : TMethodDefinition); - Var + procedure WriteMethodDec(AMthd : TPasProcedure); + var prmCnt,k : Integer; - prm : TParameterDefinition; - Begin - prmCnt := AMthd.ParameterCount; - If ( AMthd.MethodType = mtProcedure ) Then - Write('procedure ') - Else Begin + prms : TList; + prm : TPasArgument; + begin + prms := AMthd.ProcType.Args; + prmCnt := prms.Count; + if AMthd.InheritsFrom(TPasFunction) then begin Write('function '); - Dec(prmCnt); - End; + end else begin + Write('procedure '); + end; Write('%s.%s(',[strClassName,AMthd.Name]); - If ( prmCnt > 0 ) Then Begin + if ( prmCnt > 0 ) then begin IncIndent(); - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - If (k > 0 ) Then + for k := 0 to Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + if (k > 0 ) then Write('; '); NewLine(); Indent(); - Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]); - End; + Write('%s %s : %s',[AccessNames[prm.Access],prm.Name,prm.ArgType.Name]); + end; DecIndent(); NewLine(); Indent(); - End; + end; Write(')'); - If ( AMthd.MethodType = mtFunction ) Then Begin - Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]); - End; + if AMthd.InheritsFrom(TPasFunction) then begin + Write(':%s',[TPasFunctionType(AMthd.ProcType).ResultEl.ResultType.Name]); + end; WriteLn(';'); - End; + end; - procedure WriteMethodImp(AMthd : TMethodDefinition); - Begin + procedure WriteMethodImp(AMthd : TPasProcedure); + begin WriteLn('Begin'); WriteLn('// your code here'); WriteLn('End;'); - End; + end; procedure WriteMethods(); - Var + var k : Integer; + mbrs : TList; + elt : TPasElement; + mtd : TPasProcedure; begin - For k := 0 To Pred(AIntf.MethodCount) Do Begin - WriteMethodDec(AIntf.Method[k]); - WriteMethodImp(AIntf.Method[k]); - WriteLn(''); - End; + mbrs := AIntf.Members; + for k := 0 to Pred(mbrs.Count) do begin + elt := TPasElement(mbrs[k]); + if elt.InheritsFrom(TPasProcedure) then begin + mtd := TPasProcedure(elt); + WriteMethodDec(mtd); + WriteMethodImp(mtd); + WriteLn(''); + end; + end; end; procedure GenerateRegistrationProc(); @@ -1241,10 +1344,10 @@ end; function TImplementationGenerator.GetDestUnitName(): string; begin - Result := Format('%s_imp',[SymbolTable.Name]); + Result := Format('%s_imp',[SymbolTable.CurrentModule.Name]); end; -constructor TImplementationGenerator.Create(ASymTable: TSymbolTable;ASrcMngr: ISourceManager); +constructor TImplementationGenerator.Create(ASymTable: TwstPasTreeContainer;ASrcMngr: ISourceManager); begin Inherited Create(ASymTable,ASrcMngr); FDecStream := SrcMngr.CreateItem(GetDestUnitName() + '.dec'); @@ -1254,27 +1357,31 @@ end; procedure TImplementationGenerator.Execute(); Var i,c : Integer; - intf : TInterfaceDefinition; + intf : TPasClassType; + elt : TPasElement; + typeList : TList; begin GenerateUnitHeader(); GenerateUnitImplementationHeader(); - c := Pred(SymbolTable.Count); - For i := 0 To c Do Begin - If SymbolTable.Item[i] Is TInterfaceDefinition Then Begin - intf := SymbolTable.Item[i] As TInterfaceDefinition; + typeList := SymbolTable.CurrentModule.InterfaceSection.Types; + c := Pred(typeList.Count); + for i := 0 to c do begin + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okInterface ) then begin + intf := TPasClassType(elt); GenerateIntf(intf); GenerateImp(intf); - End; - End; + end; + end; GenerateUnitImplementationFooter(); FSrcMngr.Merge(GetDestUnitName() + '.pas',[FDecStream,FImpStream]); - FDecStream := Nil; - FImpStream := Nil; + FDecStream := nil; + FImpStream := nil; end; { TInftGenerator } -function TInftGenerator.GenerateIntfName(AIntf: TInterfaceDefinition): string; +function TInftGenerator.GenerateIntfName(AIntf: TPasElement): string; begin Result := ExtractserviceName(AIntf); end; @@ -1284,7 +1391,7 @@ begin SetCurrentStream(FDecStream); WriteLn('{'); WriteLn('This unit has been produced by ws_helper.'); - WriteLn(' Input unit name : "%s".',[SymbolTable.Name]); + WriteLn(' Input unit name : "%s".',[SymbolTable.CurrentModule.Name]); WriteLn(' This unit name : "%s".',[GetDestUnitName()]); WriteLn(' Date : "%s".',[DateTimeToStr(Now())]); WriteLn('}'); @@ -1298,8 +1405,8 @@ begin WriteLn('const'); IncIndent(); - Indent();WriteLn('sNAME_SPACE = %s;',[QuotedStr(FSymbolTable.ExternalName)]); - Indent();WriteLn('sUNIT_NAME = %s;',[QuotedStr(FSymbolTable.Name)]); + Indent();WriteLn('sNAME_SPACE = %s;',[QuotedStr(SymbolTable.GetExternalName(FSymbolTable.CurrentModule))]); + Indent();WriteLn('sUNIT_NAME = %s;',[QuotedStr(FSymbolTable.CurrentModule.Name)]); DecIndent(); WriteLn(''); @@ -1326,7 +1433,7 @@ begin FImpLastStream.WriteLn('End.'); end; -procedure TInftGenerator.GenerateIntf(AIntf: TInterfaceDefinition); +procedure TInftGenerator.GenerateIntf(AIntf: TPasClassType); procedure WriteDec(); begin @@ -1337,53 +1444,59 @@ procedure TInftGenerator.GenerateIntf(AIntf: TInterfaceDefinition); end; end; - procedure WriteMethod(AMthd : TMethodDefinition); - Var + procedure WriteMethod(AMthd : TPasProcedure); + var prmCnt,k : Integer; - prm : TParameterDefinition; - Begin + prm : TPasArgument; + prms : TList; + begin Indent(); - prmCnt := AMthd.ParameterCount; - If ( AMthd.MethodType = mtProcedure ) Then - Write('procedure ') - Else Begin + prms := AMthd.ProcType.Args; + prmCnt := prms.Count; + if AMthd.InheritsFrom(TPasFunction) then begin Write('function '); - Dec(prmCnt); - End; + end else begin + Write('procedure '); + end; Write('%s(',[AMthd.Name]); - If ( prmCnt > 0 ) Then Begin + if ( prmCnt > 0 ) then begin IncIndent(); - For k := 0 To Pred(prmCnt) Do Begin - prm := AMthd.Parameter[k]; - If (k > 0 ) Then + for k := 0 to Pred(prmCnt) do begin + prm := TPasArgument(prms[k]); + if (k > 0 ) then Write('; '); NewLine(); Indent(); - Write('%s %s : %s',[ParameterModifierMAP[prm.Modifier],prm.Name,prm.DataType.Name]); - End; + Write('%s %s : %s',[AccessNames[prm.Access],prm.Name,prm.ArgType.Name]); + end; DecIndent(); NewLine(); Indent(); - End; + end; Write(')'); - If ( AMthd.MethodType = mtFunction ) Then Begin - Write(':%s',[AMthd.Parameter[prmCnt].DataType.Name]); - End; + if AMthd.InheritsFrom(TPasFunction) then begin + Write(':%s',[TPasFunctionType(AMthd.ProcType).ResultEl.ResultType.Name]); + end; WriteLn(';'); - End; + end; procedure WriteMethods(); - Var + var k : Integer; + mbrs : TList; + elt : TPasElement; begin - If ( AIntf.MethodCount = 0 ) Then - Exit; - IncIndent(); - For k := 0 To Pred(AIntf.MethodCount) Do - WriteMethod(AIntf.Method[k]); - DecIndent(); + IncIndent(); + mbrs := AIntf.Members; + for k := 0 to Pred(mbrs.Count) do begin + elt := TPasElement(mbrs[k]); + if elt.InheritsFrom(TPasProcedure) then begin + WriteMethod(TPasProcedure(elt)); + end; + end; + DecIndent(); end; begin @@ -1396,118 +1509,157 @@ begin DecIndent(); end; -procedure TInftGenerator.GenerateTypeAlias(ASymbol: TTypeAliasDefinition); +procedure TInftGenerator.GenerateTypeAlias(ASymbol: TPasAliasType); +var + typeModifier : string; begin try SetCurrentStream(FDecStream); + if ASymbol.InheritsFrom(TPasTypeAliasType) then begin + typeModifier := 'type '; + end else begin + typeModifier := ''; + end; NewLine(); IncIndent(); Indent(); - WriteLn('%s = type %s;',[ASymbol.Name,ASymbol.BaseType.Name]); + WriteLn('%s = %s%s;',[ASymbol.Name,typeModifier,ASymbol.DestType.Name]); DecIndent(); except on e : Exception do - System.WriteLn('TInftGenerator.GenerateTypeAlias()=', ASymbol.Name, ' ;; ', e.Message); + GetLogger.Log(mtError,'TInftGenerator.GenerateTypeAlias()=',[ASymbol.Name, ' ;; ', e.Message]); end; end; -procedure TInftGenerator.GenerateClass(ASymbol: TClassTypeDefinition); +procedure TInftGenerator.GenerateClass(ASymbol: TPasClassType); var - locClassPropNbr, locStoredPropsNbr, locArrayPropsNbr : Integer; - loc_BaseComplexSimpleContentRemotable : TClassTypeDefinition; + locClassPropNbr, locOptionalPropsNbr, locArrayPropsNbr, locPropCount : Integer; + locPropList : TObjectList; procedure Prepare(); var k : Integer; - p : TPropertyDefinition; + elt : TPasElement; + p : TPasProperty; begin + locPropCount := 0; locClassPropNbr := 0; - locStoredPropsNbr := 0; locArrayPropsNbr := 0; - for k := 0 to Pred(ASymbol.PropertyCount) do begin - p := ASymbol.Properties[k]; - if ( p.StorageOption = soOptional ) then - Inc(locStoredPropsNbr); - if p.DataType.InheritsFrom(TClassTypeDefinition) then - Inc(locClassPropNbr); - if p.DataType.InheritsFrom(TArrayDefinition) then - Inc(locArrayPropsNbr); + locOptionalPropsNbr := 0; + for k := 0 to Pred(ASymbol.Members.Count) do begin + elt := TPasElement(ASymbol.Members[k]); + if elt.InheritsFrom(TPasProperty) then begin + p := TPasProperty(elt); + locPropList.Add(p); + Inc(locPropCount); + if SymbolTable.IsOfType(p.VarType,TPasClassType) then + Inc(locClassPropNbr); + if SymbolTable.IsOfType(p.VarType,TPasArrayType) then + Inc(locArrayPropsNbr); + if AnsiSameText('HAS',Copy(p.StoredAccessorName,1,3)) then + Inc(locOptionalPropsNbr); + end; end; locClassPropNbr := locClassPropNbr + locArrayPropsNbr; end; procedure WriteDec(); var - s : string; + decBuffer, s : string; + elt : TPasElement; + ultimAnc, trueAncestor : TPasType; begin - if Assigned(ASymbol.Parent) then begin - {if ASymbol.Parent.InheritsFrom(TNativeSimpleTypeDefinition) and - Assigned(TNativeSimpleTypeDefinition(ASymbol.Parent).BoxedType) + if Assigned(ASymbol.AncestorType) then begin + trueAncestor := ASymbol.AncestorType; + if trueAncestor.InheritsFrom(TPasUnresolvedTypeRef) then begin + elt := SymbolTable.FindElement(SymbolTable.GetExternalName(trueAncestor)); + if elt.InheritsFrom(TPasType) then begin + trueAncestor := TPasType(elt); + end; + end; + ultimAnc := GetUltimeType(trueAncestor); + if ultimAnc.InheritsFrom(TPasNativeSimpleType) then begin + trueAncestor := ultimAnc; + end; + if trueAncestor.InheritsFrom(TPasNativeSimpleType) and + Assigned(TPasNativeSimpleType(trueAncestor).BoxedType) then begin - s := Format('%s',[TNativeSimpleTypeDefinition(ASymbol.Parent).BoxedType.Name]); - end else begin - s := Format('%s',[ASymbol.Parent.Name]); - end;} - s := Format('%s',[ASymbol.Parent.Name]); + trueAncestor := TPasNativeSimpleType(trueAncestor).BoxedType; + end; + s := Format('%s',[trueAncestor.Name]); end else begin - s := 'XX';//'TBaseComplexRemotable'; + s := '';//'TBaseComplexRemotable'; + end; + if IsStrEmpty(s) then begin + decBuffer := ''; + end else begin + decBuffer := Format('(%s)',[s]); end; Indent(); - WriteLn('%s = class(%s)',[ASymbol.Name,s]); + WriteLn('%s = class%s',[ASymbol.Name,decBuffer]); end; - procedure WritePropertyField(AProp : TPropertyDefinition); + procedure WritePropertyField(AProp : TPasProperty); begin Indent(); - WriteLn('F%s : %s;',[AProp.Name,AProp.DataType.Name]); + WriteLn('F%s : %s;',[AProp.Name,AProp.VarType.Name]); End; - procedure WriteProperty(AProp : TPropertyDefinition); + procedure WriteProperty(AProp : TPasProperty); var propName, locStore : string; begin propName := AProp.Name; - case AProp.StorageOption of - soAlways : locStore := ''; - soNever : locStore := ' stored False'; - soOptional : locStore := Format(' stored Has%s',[AProp.Name]); + if AnsiSameText('True',AProp.StoredAccessorName) then begin + locStore := ''; + end else begin + locStore := Format(' stored %s',[AProp.StoredAccessorName]); end; Indent(); - WriteLn('property %s : %s read F%s write F%s%s;',[propName,AProp.DataType.Name,propName,propName,locStore]); - if not AnsiSameText(AProp.Name,AProp.ExternalName) then begin + WriteLn('property %s : %s read F%s write F%s%s;',[propName,AProp.VarType.Name,propName,propName,locStore]); + if not AnsiSameText(AProp.Name,SymbolTable.GetExternalName(AProp)) then begin FImpLastStream.Indent(); - FImpLastStream.WriteLn('GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(%s,%s);',[ASymbol.Name,QuotedStr(AProp.Name),QuotedStr(AProp.ExternalName)]); + FImpLastStream.WriteLn('GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(%s,%s);',[ASymbol.Name,QuotedStr(AProp.Name),QuotedStr(SymbolTable.GetExternalName(AProp))]); end; - if AProp.IsAttribute then begin + if SymbolTable.IsAttributeProperty(AProp) then begin FImpLastStream.Indent(); FImpLastStream.WriteLn('%s.RegisterAttributeProperty(%s);',[ASymbol.Name,QuotedStr(AProp.Name)]); end; end; procedure WriteProperties(); - Var + var k : Integer; - p : TPropertyDefinition; + p : TPasProperty; + pt : TPasElement; begin - If ( ASymbol.PropertyCount > 0 ) Then begin + if ( locPropCount > 0 ) then begin Indent(); WriteLn('private'); IncIndent(); - for k := 0 to Pred(ASymbol.PropertyCount) do begin - p := ASymbol.Properties[k]; + for k := 0 to Pred(locPropCount) do begin + p := TPasProperty(locPropList[k]); + if p.VarType.InheritsFrom(TPasUnresolvedTypeRef) then begin + pt := SymbolTable.FindElement(SymbolTable.GetExternalName(p.VarType)); + if ( pt <> nil ) and pt.InheritsFrom(TPasType) and ( pt <> p.VarType ) then begin + p.VarType.Release(); + p.VarType := pt as TPasType; + p.VarType.AddRef(); + end; + end; WritePropertyField(p); end; DecIndent(); // - if ( locStoredPropsNbr > 0 ) then begin + if ( locOptionalPropsNbr > 0 ) then begin Indent(); WriteLn('private'); IncIndent(); - for k := 0 to Pred(ASymbol.PropertyCount) do begin - p := ASymbol.Properties[k]; - if ( p.StorageOption = soOptional ) then begin + for k := 0 to Pred(locPropCount) do begin + p := TPasProperty(locPropList[k]); + if AnsiSameText('HAS',Copy(p.StoredAccessorName,1,3)) then begin Indent(); - WriteLn('function Has%s() : Boolean;',[p.Name]); + WriteLn('function %s() : Boolean;',[p.StoredAccessorName]); end; end; DecIndent(); @@ -1517,13 +1669,13 @@ var Indent(); WriteLn('public'); end; - if ( locArrayPropsNbr > 0 ) then begin + if ( locArrayPropsNbr > 0 ) or ( locClassPropNbr > 0 ) then begin IncIndent(); Indent(); WriteLn('constructor Create();override;'); DecIndent(); end; - if ( locClassPropNbr > 0 ) then begin + if ( locArrayPropsNbr > 0 ) or ( locClassPropNbr > 0 ) then begin IncIndent(); Indent(); WriteLn('destructor Destroy();override;'); DecIndent(); @@ -1532,8 +1684,8 @@ var Indent(); WriteLn('published'); IncIndent(); - For k := 0 To Pred(ASymbol.PropertyCount) Do - WriteProperty(ASymbol.Properties[k]); + For k := 0 To Pred(locPropCount) Do + WriteProperty(TPasProperty(locPropList[k])); DecIndent(); end; end; @@ -1541,38 +1693,49 @@ var procedure WriteImp(); var k : Integer; - p : TPropertyDefinition; + p : TPasProperty; + ss : string; begin - if ( locClassPropNbr > 0 ) or ( locStoredPropsNbr > 0 ) then begin + if ( locClassPropNbr > 0 ) then begin NewLine(); WriteLn('{ %s }',[ASymbol.Name]); - if ( locArrayPropsNbr > 0 ) then begin + if ( locClassPropNbr > 0 ) or ( locClassPropNbr > 0 ) then begin NewLine(); WriteLn('constructor %s.Create();',[ASymbol.Name]); WriteLn('begin'); IncIndent(); Indent(); WriteLn('inherited Create();'); - for k := 0 to Pred(ASymbol.PropertyCount) do begin - p := ASymbol.Properties[k]; - if p.DataType.InheritsFrom(TArrayDefinition) then begin + for k := 0 to Pred(locPropCount) do begin + p := TPasProperty(locPropList[k]); + if SymbolTable.IsOfType(p.VarType,TPasClassType) or + SymbolTable.IsOfType(p.VarType,TPasArrayType) + then begin Indent(); - WriteLn('F%s := %s.Create();',[p.Name,p.DataType.Name]); + if AnsiSameText(p.Name,p.VarType.Name) or + ( SymbolTable.IsOfType(p.VarType,TPasClassType) and Assigned(FindMember(TPasClassType(ASymbol),p.VarType.Name)) ) + then + ss := Format('%s.%s',[SymbolTable.CurrentModule.Name,p.VarType.Name]) + else + ss := p.VarType.Name; + WriteLn('F%s := %s.Create();',[p.Name,ss{p.VarType.Name}]); end; end; DecIndent(); WriteLn('end;'); end; - if ( locClassPropNbr > 0 ) then begin + if ( locArrayPropsNbr > 0 ) or ( locClassPropNbr > 0 ) then begin NewLine(); WriteLn('destructor %s.Destroy();',[ASymbol.Name]); WriteLn('begin'); IncIndent(); - for k := 0 to Pred(ASymbol.PropertyCount) do begin - p := ASymbol.Properties[k]; - if p.DataType.InheritsFrom(TClassTypeDefinition) then begin + for k := 0 to Pred(locPropCount) do begin + p := TPasProperty(locPropList[k]); + if SymbolTable.IsOfType(p.VarType,TPasClassType) or + SymbolTable.IsOfType(p.VarType,TPasArrayType) + then begin Indent(); WriteLn('if Assigned(F%s) then',[p.Name]); IncIndent(); @@ -1586,52 +1749,54 @@ var DecIndent(); WriteLn('end;'); end; - - if ( locStoredPropsNbr > 0 ) then begin - for k := 0 to Pred(ASymbol.PropertyCount) do begin - p := ASymbol.Properties[k]; - if ( p.StorageOption = soOptional ) then begin - NewLine(); - WriteLn('function %s.Has%s() : Boolean;',[ASymbol.Name,p.Name]); - WriteLn('begin'); - IncIndent(); - Indent(); - WriteLn('Result := True;'); - DecIndent(); - WriteLn('end;'); - end; - end; + end; + for k := 0 to Pred(locPropCount) do begin + p := TPasProperty(locPropList[k]); + if AnsiSameText('HAS',Copy(p.StoredAccessorName,1,3)) then begin + NewLine(); + WriteLn('function %s.%s() : Boolean;',[ASymbol.Name,p.StoredAccessorName]); + WriteLn('begin'); + IncIndent(); + Indent(); + WriteLn('Result := True;'); + DecIndent(); + WriteLn('end;'); end; - end; end; begin - Prepare(); + locPropList := TObjectList.Create(False); try - loc_BaseComplexSimpleContentRemotable := FSymbolTable.ByName('TBaseComplexSimpleContentRemotable') as TClassTypeDefinition; - SetCurrentStream(FDecStream); - NewLine(); - IncIndent(); - WriteDec(); - WriteProperties(); - Indent(); WriteLn('end;'); - DecIndent(); + Prepare(); + try + SetCurrentStream(FDecStream); + NewLine(); + IncIndent(); + WriteDec(); + WriteProperties(); + Indent(); WriteLn('end;'); + DecIndent(); - FImpTempStream.Indent(); - FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(ASymbol.ExternalName)]); + FImpTempStream.Indent(); + FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(SymbolTable.GetExternalName(ASymbol))]); - SetCurrentStream(FImpStream); - WriteImp(); - except - on e : Exception do - System.WriteLn('TInftGenerator.GenerateClass()=', ASymbol.Name, ' ;; ', e.Message); + SetCurrentStream(FImpStream); + WriteImp(); + except + on e : Exception do begin + GetLogger.Log(mtError,'TInftGenerator.GenerateClass()=',[ASymbol.Name, ' ;; ', e.Message]); + raise; + end; + end; + finally + FreeAndNil(locPropList); end; end; -procedure TInftGenerator.GenerateEnum(ASymbol: TEnumTypeDefinition); +procedure TInftGenerator.GenerateEnum(ASymbol: TPasEnumType); var - itm : TEnumItemDefinition; + itm : TPasEnumValue; i : Integer; begin try @@ -1641,19 +1806,19 @@ begin Indent();WriteLn('%s = ( ',[ASymbol.Name]); FImpTempStream.Indent(); - FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(ASymbol.ExternalName)]); + FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(SymbolTable.GetExternalName(ASymbol))]); IncIndent(); - for i := 0 to Pred(ASymbol.ItemCount) do begin - itm := ASymbol.Item[i]; + for i := 0 to Pred(ASymbol.Values.Count) do begin + itm := TPasEnumValue(ASymbol.Values[i]); Indent(); if ( i > 0 ) then WriteLn(',%s',[itm.Name]) else WriteLn('%s',[itm.Name]); - if not AnsiSameText(itm.Name,itm.ExternalName) then begin + if not AnsiSameText(itm.Name,SymbolTable.GetExternalName(itm)) then begin FImpTempStream.Indent(); - FImpTempStream.WriteLn('GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(%s,%s);',[ASymbol.Name,QuotedStr(itm.Name),QuotedStr(itm.ExternalName)]); + FImpTempStream.WriteLn('GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(%s,%s);',[ASymbol.Name,QuotedStr(itm.Name),QuotedStr(SymbolTable.GetExternalName(itm))]); end; end; DecIndent(); @@ -1661,11 +1826,11 @@ begin DecIndent(); except on e : Exception do - System.WriteLn('TInftGenerator.GenerateClass()=', ASymbol.Name, ' ;; ', e.Message); + GetLogger.Log(mtError,'TInftGenerator.GenerateClass()=', [ASymbol.Name, ' ;; ', e.Message]); end; end; -procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); +procedure TInftGenerator.GenerateArray(ASymbol: TPasArrayType); procedure WriteObjectArray(); begin @@ -1676,10 +1841,10 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); try WriteLn('%s = class(TBaseObjectArrayRemotable)',[ASymbol.Name]); WriteLn('private'); - Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ItemType.Name]); + Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ElType.Name]); WriteLn('public'); Indent();WriteLn('class function GetItemClass():TBaseRemotableClass;override;'); - Indent();WriteLn('property Item[AIndex:Integer] : %s Read GetItem;Default;',[ASymbol.ItemType.Name]); + Indent();WriteLn('property Item[AIndex:Integer] : %s Read GetItem;Default;',[ASymbol.ElType.Name]); WriteLn('end;'); finally EndAutoIndent(); @@ -1691,10 +1856,10 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); WriteLn('{ %s }',[ASymbol.Name]); NewLine(); - WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ItemType.Name]); + WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ElType.Name]); WriteLn('begin'); IncIndent(); - Indent();WriteLn('Result := Inherited GetItem(AIndex) As %s;',[ASymbol.ItemType.Name]); + Indent();WriteLn('Result := Inherited GetItem(AIndex) As %s;',[ASymbol.ElType.Name]); DecIndent(); WriteLn('end;'); @@ -1702,7 +1867,7 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); WriteLn('class function %s.GetItemClass(): TBaseRemotableClass;',[ASymbol.Name]); WriteLn('begin'); IncIndent(); - Indent();WriteLn('Result:= %s;',[ASymbol.ItemType.Name]); + Indent();WriteLn('Result:= %s;',[ASymbol.ElType.Name]); DecIndent(); WriteLn('end;'); end; @@ -1716,10 +1881,10 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); try WriteLn('%s = class(TBaseSimpleTypeArrayRemotable)',[ASymbol.Name]); WriteLn('private'); - Indent();WriteLn('FData : array of %s;',[ASymbol.ItemType.Name]); + Indent();WriteLn('FData : array of %s;',[ASymbol.ElType.Name]); WriteLn('private'); - Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ItemType.Name]); - Indent();WriteLn('procedure SetItem(AIndex: Integer; const AValue: %s);',[ASymbol.ItemType.Name]); + Indent();WriteLn('function GetItem(AIndex: Integer): %s;',[ASymbol.ElType.Name]); + Indent();WriteLn('procedure SetItem(AIndex: Integer; const AValue: %s);',[ASymbol.ElType.Name]); WriteLn('protected'); Indent();WriteLn('function GetLength():Integer;override;'); Indent();WriteLn('procedure SaveItem(AStore : IFormatterBase;const AName : String;const AIndex : Integer);override;'); @@ -1727,7 +1892,7 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); WriteLn('public'); Indent();WriteLn('class function GetItemTypeInfo():PTypeInfo;override;'); Indent();WriteLn('procedure SetLength(const ANewSize : Integer);override;'); - Indent();WriteLn('property Item[AIndex:Integer] : %s read GetItem write SetItem; default;',[ASymbol.ItemType.Name]); + Indent();WriteLn('property Item[AIndex:Integer] : %s read GetItem write SetItem; default;',[ASymbol.ElType.Name]); WriteLn('end;'); finally EndAutoIndent(); @@ -1739,7 +1904,7 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); WriteLn('{ %s }',[ASymbol.Name]); NewLine(); - WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ItemType.Name]); + WriteLn('function %s.GetItem(AIndex: Integer): %s;',[ASymbol.Name,ASymbol.ElType.Name]); WriteLn('begin'); IncIndent(); Indent();WriteLn('CheckIndex(AIndex);'); @@ -1748,7 +1913,7 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); WriteLn('end;'); NewLine(); - WriteLn('procedure %s.SetItem(AIndex: Integer;const AValue: %S);',[ASymbol.Name,ASymbol.ItemType.Name]); + WriteLn('procedure %s.SetItem(AIndex: Integer;const AValue: %S);',[ASymbol.Name,ASymbol.ElType.Name]); WriteLn('begin'); IncIndent(); Indent();WriteLn('CheckIndex(AIndex);'); @@ -1768,7 +1933,7 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); WriteLn('procedure %s.SaveItem(AStore: IFormatterBase;const AName: String; const AIndex: Integer);',[ASymbol.Name]); WriteLn('begin'); IncIndent(); - Indent();WriteLn('AStore.Put(%s,TypeInfo(%s),FData[AIndex]);',[QuotedStr(ASymbol.ItemName),ASymbol.ItemType.Name]); + Indent();WriteLn('AStore.Put(%s,TypeInfo(%s),FData[AIndex]);',[QuotedStr(SymbolTable.GetArrayItemName(ASymbol)),ASymbol.ElType.Name]); DecIndent(); WriteLn('end;'); @@ -1778,8 +1943,8 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); WriteLn('var'); Indent();WriteLn('sName : string;'); WriteLn('begin'); - Indent();WriteLn('sName := %s;',[QuotedStr(ASymbol.ItemName)]); - Indent();WriteLn('AStore.Get(TypeInfo(%s),sName,FData[AIndex]);',[ASymbol.ItemType.Name]); + Indent();WriteLn('sName := %s;',[QuotedStr(SymbolTable.GetArrayItemName(ASymbol))]); + Indent();WriteLn('AStore.Get(TypeInfo(%s),sName,FData[AIndex]);',[ASymbol.ElType.Name]); DecIndent(); WriteLn('end;'); @@ -1787,7 +1952,7 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); WriteLn('class function %s.GetItemTypeInfo(): PTypeInfo;',[ASymbol.Name]); WriteLn('begin'); IncIndent(); - Indent();WriteLn('Result := TypeInfo(%s);',[ASymbol.ItemType.Name]); + Indent();WriteLn('Result := TypeInfo(%s);',[ASymbol.ElType.Name]); DecIndent(); WriteLn('end;'); @@ -1808,94 +1973,106 @@ procedure TInftGenerator.GenerateArray(ASymbol: TArrayDefinition); var classItemArray : Boolean; + eltType : TPasType; begin - classItemArray := ( ASymbol.ItemType is TClassTypeDefinition ) or - ( ASymbol.ItemType is TArrayDefinition ) ; + eltType := ASymbol.ElType; + if eltType.InheritsFrom(TPasUnresolvedTypeRef) then begin + eltType := SymbolTable.FindElement(SymbolTable.GetExternalName(eltType)) as TPasType; + end; + classItemArray := SymbolTable.IsOfType(eltType,TPasClassType) or SymbolTable.IsOfType(eltType,TPasArrayType); if classItemArray then begin WriteObjectArray(); end else begin WriteSimpleTypeArray(); end; - + FImpTempStream.Indent(); - FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(ASymbol.ExternalName)]); - if ( ASymbol.ItemName <> ASymbol.ItemExternalName ) then begin + FImpTempStream.WriteLn('GetTypeRegistry().Register(%s,TypeInfo(%s),%s);',[sNAME_SPACE,ASymbol.Name,QuotedStr(SymbolTable.GetExternalName(ASymbol))]); + if ( SymbolTable.GetArrayItemName(ASymbol) <> SymbolTable.GetArrayItemExternalName(ASymbol) ) then begin FImpTempStream.Indent(); FImpTempStream.WriteLn( 'GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(sARRAY_ITEM,%s);', - [ASymbol.Name,QuotedStr(ASymbol.ItemExternalName)] + [ASymbol.Name,QuotedStr(SymbolTable.GetArrayItemExternalName(ASymbol))] ); end; - if ( ASymbol.Style = asEmbeded ) then begin + if ( SymbolTable.GetArrayStyle(ASymbol) = asEmbeded ) then begin FImpTempStream.Indent(); FImpTempStream.WriteLn( 'GetTypeRegistry().ItemByTypeInfo[TypeInfo(%s)].RegisterExternalPropertyName(sARRAY_STYLE,sEmbedded);', - [ASymbol.Name,QuotedStr(ASymbol.ItemExternalName)] + [ASymbol.Name,QuotedStr(SymbolTable.GetArrayItemExternalName(ASymbol))] ); end; end; procedure TInftGenerator.GenerateCustomMetadatas(); - procedure WriteOperationDatas(AInftDef : TInterfaceDefinition; AOp : TMethodDefinition); + procedure WriteOperationDatas(AInftDef : TPasClassType; AOp : TPasProcedure); var k : Integer; pl : TStrings; begin - pl := AOp.Properties; - for k := 0 to Pred(pl.Count) do begin - if not IsStrEmpty(pl.ValueFromIndex[k]) then begin - Indent();WriteLn('mm.SetOperationCustomData('); - IncIndent(); - Indent(); WriteLn('%s,',[sUNIT_NAME]); - Indent(); WriteLn('%s,',[QuotedStr(AInftDef.Name)]); - Indent(); WriteLn('%s,',[QuotedStr(AOp.Name)]); - Indent(); WriteLn('%s,',[QuotedStr(pl.Names[k])]); - Indent(); WriteLn('%s' ,[QuotedStr(pl.ValueFromIndex[k])]); - DecIndent(); - Indent();WriteLn(');'); + pl := SymbolTable.Properties.FindList(AOp); + if ( pl <> nil ) then begin + for k := 0 to Pred(pl.Count) do begin + if not IsStrEmpty(pl.ValueFromIndex[k]) then begin + Indent();WriteLn('mm.SetOperationCustomData('); + IncIndent(); + Indent(); WriteLn('%s,',[sUNIT_NAME]); + Indent(); WriteLn('%s,',[QuotedStr(AInftDef.Name)]); + Indent(); WriteLn('%s,',[QuotedStr(AOp.Name)]); + Indent(); WriteLn('%s,',[QuotedStr(pl.Names[k])]); + Indent(); WriteLn('%s' ,[QuotedStr(pl.ValueFromIndex[k])]); + DecIndent(); + Indent();WriteLn(');'); + end; end; end; end; - procedure WriteServiceDatas(AIntf : TInterfaceDefinition); + procedure WriteServiceDatas(ABinding : TwstBinding); var k : Integer; + opList : TList; + elt : TPasElement; begin - if not IsStrEmpty(AIntf.Address) then begin + if not IsStrEmpty(ABinding.Address) then begin Indent();WriteLn('mm.SetServiceCustomData('); IncIndent(); Indent(); WriteLn('%s,',[sUNIT_NAME]); - Indent(); WriteLn('%s,',[QuotedStr(AIntf.Name)]); + Indent(); WriteLn('%s,',[QuotedStr(ABinding.Intf.Name)]); Indent(); WriteLn('%s,',[QuotedStr('TRANSPORT_Address')]); - Indent(); WriteLn('%s' ,[QuotedStr(AIntf.Address)]); + Indent(); WriteLn('%s' ,[QuotedStr(ABinding.Address)]); DecIndent(); Indent();WriteLn(');'); end; - if ( AIntf.BindingStyle = bsRPC ) then begin + if ( ABinding.BindingStyle = bsRPC ) then begin Indent();WriteLn('mm.SetServiceCustomData('); IncIndent(); Indent(); WriteLn('%s,',[sUNIT_NAME]); - Indent(); WriteLn('%s,',[QuotedStr(AIntf.Name)]); + Indent(); WriteLn('%s,',[QuotedStr(ABinding.Intf.Name)]); Indent(); WriteLn('%s,',[QuotedStr('FORMAT_Style')]); Indent(); WriteLn('%s' ,[QuotedStr('rpc')]); DecIndent(); Indent();WriteLn(');'); - end else if ( AIntf.BindingStyle = bsDocument ) then begin + end else if ( ABinding.BindingStyle = bsDocument ) then begin Indent();WriteLn('mm.SetServiceCustomData('); IncIndent(); Indent(); WriteLn('%s,',[sUNIT_NAME]); - Indent(); WriteLn('%s,',[QuotedStr(AIntf.Name)]); + Indent(); WriteLn('%s,',[QuotedStr(ABinding.Intf.Name)]); Indent(); WriteLn('%s,',[QuotedStr('FORMAT_Style')]); Indent(); WriteLn('%s' ,[QuotedStr('document')]); DecIndent(); Indent();WriteLn(');'); end; - for k := 0 to Pred(AIntf.MethodCount) do begin - WriteOperationDatas(AIntf,AIntf.Method[k]); + opList := ABinding.Intf.Members; + for k := 0 to Pred(opList.Count) do begin + elt := TPasElement(opList[k]); + if elt.InheritsFrom(TPasProcedure) then begin + WriteOperationDatas(ABinding.Intf,TPasProcedure(elt)); + end; end; end; @@ -1906,16 +2083,14 @@ begin IncIndent(); NewLine();NewLine(); - WriteLn('procedure Register_%s_ServiceMetadata();',[SymbolTable.Name]); + WriteLn('procedure Register_%s_ServiceMetadata();',[SymbolTable.CurrentModule.Name]); WriteLn('var'); Indent(); WriteLn('mm : IModuleMetadataMngr;'); WriteLn('begin'); Indent();WriteLn('mm := GetModuleMetadataMngr();'); Indent();WriteLn('mm.SetRepositoryNameSpace(%s, %s);',[sUNIT_NAME,sNAME_SPACE]); - for i := 0 to Pred(SymbolTable.Count) do begin - if SymbolTable.Item[i] is TInterfaceDefinition then begin - WriteServiceDatas(SymbolTable.Item[i] as TInterfaceDefinition); - end; + for i := 0 to Pred(SymbolTable.BindingCount) do begin + WriteServiceDatas(SymbolTable.Binding[i]); end; WriteLn('end;'); @@ -1924,11 +2099,11 @@ end; function TInftGenerator.GetDestUnitName(): string; begin - Result := SymbolTable.Name; + Result := SymbolTable.CurrentModule.Name; end; constructor TInftGenerator.Create( - ASymTable : TSymbolTable; + ASymTable : TwstPasTreeContainer; ASrcMngr : ISourceManager ); begin @@ -1944,62 +2119,78 @@ end; procedure TInftGenerator.Execute(); var i,c, j, k : Integer; - clssTyp : TClassTypeDefinition; + clssTyp : TPasClassType; gnrClssLst : TObjectList; objLst : TObjectList; + typeList : TList; + elt : TPasElement; + classAncestor : TPasElement; begin objLst := nil; gnrClssLst := TObjectList.Create(False); try GenerateUnitHeader(); GenerateUnitImplementationHeader(); - c := Pred(SymbolTable.Count); + typeList := SymbolTable.CurrentModule.InterfaceSection.Types; + c := Pred(typeList.Count); SetCurrentStream(FDecStream); IncIndent(); for i := 0 to c do begin - if SymbolTable.Item[i] is TForwardTypeDefinition then begin - WriteLn('// %s = unable to resolve this symbol.',[SymbolTable.Item[i].Name]); + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasUnresolvedTypeRef) then begin + WriteLn('// %s = unable to resolve this symbol.',[elt.Name]); end; end; DecIndent(); IncIndent(); for i := 0 to c do begin - if ( SymbolTable.Item[i] is TClassTypeDefinition ) or - ( SymbolTable.Item[i] is TArrayDefinition ) + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasType) and + ( not elt.InheritsFrom(TPasAliasType) ) and + ( ( SymbolTable.IsOfType(TPasType(elt),TPasClassType) and ( TPasClassType(GetUltimeType(TPasType(elt))).ObjKind = okClass ) ) or + SymbolTable.IsOfType(TPasType(elt),TPasArrayType) + ) then begin Indent(); - WriteLn('%s = class;',[SymbolTable.Item[i].Name]); + WriteLn('%s = class;',[elt.Name]); end; end; DecIndent(); for i := 0 to c do begin - if SymbolTable.Item[i] is TEnumTypeDefinition then begin - GenerateEnum(SymbolTable.Item[i] as TEnumTypeDefinition); + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasEnumType) then begin + GenerateEnum(TPasEnumType(elt)); end; end; for i := 0 to c do begin - if SymbolTable.Item[i] is TTypeAliasDefinition then begin - GenerateTypeAlias(SymbolTable.Item[i] as TTypeAliasDefinition); + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasAliasType) then begin + GenerateTypeAlias(TPasAliasType(elt)); end; end; objLst := TObjectList.Create(); objLst.OwnsObjects := False; for i := 0 to c do begin - if SymbolTable.Item[i].InheritsFrom(TClassTypeDefinition) then begin - clssTyp := SymbolTable.Item[i] as TClassTypeDefinition; + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okClass ) then begin + clssTyp := TPasClassType(elt); if ( gnrClssLst.IndexOf(clssTyp) = -1 ) then begin while ( objLst.Count > 0 ) do begin objLst.Clear(); end; while Assigned(clssTyp) do begin objLst.Add(clssTyp); - if Assigned(clssTyp.Parent) and clssTyp.Parent.InheritsFrom(TClassTypeDefinition) then begin - clssTyp := clssTyp.Parent as TClassTypeDefinition; + classAncestor := clssTyp.AncestorType; + if Assigned(classAncestor) and classAncestor.InheritsFrom(TPasUnresolvedTypeRef) then begin + classAncestor := SymbolTable.FindElement(SymbolTable.GetExternalName(classAncestor)); + end; + if Assigned(classAncestor) and classAncestor.InheritsFrom(TPasClassType) then begin + clssTyp := classAncestor as TPasClassType; end else begin clssTyp := nil; end; @@ -2007,9 +2198,9 @@ begin k := Pred(objLst.Count); for j := 0 to k do begin - clssTyp := objLst[k-j] as TClassTypeDefinition; + clssTyp := objLst[k-j] as TPasClassType; if ( gnrClssLst.IndexOf(clssTyp) = -1 ) then begin - if ( FSymbolTable.IndexOf(clssTyp) <> -1 ) then begin + if ( FSymbolTable.CurrentModule.InterfaceSection.Types.IndexOf(clssTyp) <> -1 ) then begin GenerateClass(clssTyp); gnrClssLst.Add(clssTyp); end; @@ -2020,20 +2211,22 @@ begin end; for i := 0 to c do begin - if SymbolTable.Item[i] is TArrayDefinition then begin - GenerateArray(SymbolTable.Item[i] as TArrayDefinition); + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasArrayType) then begin + GenerateArray(TPasArrayType(elt)); end; end; for i := 0 to c do begin - if SymbolTable.Item[i] is TInterfaceDefinition then begin - GenerateIntf(SymbolTable.Item[i] as TInterfaceDefinition); + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okInterface ) then begin + GenerateIntf(TPasClassType(elt)); end; end; NewLine(); IncIndent(); - Indent(); WriteLn('procedure Register_%s_ServiceMetadata();',[SymbolTable.Name]); + Indent(); WriteLn('procedure Register_%s_ServiceMetadata();',[SymbolTable.CurrentModule.Name]); DecIndent(); GenerateCustomMetadatas(); diff --git a/wst/trunk/ws_helper/logger_intf.pas b/wst/trunk/ws_helper/logger_intf.pas new file mode 100644 index 000000000..cb4af1841 --- /dev/null +++ b/wst/trunk/ws_helper/logger_intf.pas @@ -0,0 +1,78 @@ +unit logger_intf; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + + TMessageType = ( mtInfo, mtError ); + +const + MessageTypeNames : array[TMessageType] of string = ( 'Information', 'Error' ); + +type + + ILogger = interface + ['{158C90B5-BAC3-40A1-B471-C9327692A3BF}'] + procedure Log(const AMsgType : TMessageType; const AMsg : string);overload; + procedure Log(const AMsgType : TMessageType; const AMsg : string; const AArgs : array of const);overload; + function GetMessageCount(const AMsgType : TMessageType) : Integer; + end; + + { TSimpleConsoleLogger } + + TSimpleConsoleLogger = class(TInterfacedObject,ILogger) + private + FMessageCount : array[TMessageType] of Integer; + protected + procedure Log(const AMsgType : TMessageType; const AMsg : string);overload; + procedure Log(const AMsgType : TMessageType; const AMsg : string; const AArgs : array of const);overload; + function GetMessageCount(const AMsgType : TMessageType) : Integer; + end; + + + function SetLogger(ALogger : ILogger) : ILogger; + function GetLogger() : ILogger; + +implementation + +var FLogger : ILogger = nil; +function SetLogger(ALogger : ILogger) : ILogger; +begin + Result := FLogger; + FLogger := ALogger; +end; + +function GetLogger() : ILogger; +begin + Result := FLogger; +end; + +{ TSimpleConsoleLogger } + +procedure TSimpleConsoleLogger.Log(const AMsgType: TMessageType; const AMsg: string); +begin + Log(AMsgType,AMsg,[]); +end; + +procedure TSimpleConsoleLogger.Log( + const AMsgType : TMessageType; + const AMsg : string; + const AArgs : array of const +); +begin + Inc(FMessageCount[AMsgType]); + WriteLn(Format('%s : %s',[MessageTypeNames[AMsgType],Format(AMsg,AArgs)])); +end; + +function TSimpleConsoleLogger.GetMessageCount(const AMsgType: TMessageType): Integer; +begin + Result := FMessageCount[AMsgType]; +end; + +end. + diff --git a/wst/trunk/ws_helper/metadata_generator.pas b/wst/trunk/ws_helper/metadata_generator.pas index 4cfe1df87..52fd2c22c 100644 --- a/wst/trunk/ws_helper/metadata_generator.pas +++ b/wst/trunk/ws_helper/metadata_generator.pas @@ -25,7 +25,7 @@ interface uses Classes, SysUtils, - parserdefs, binary_streamer; + pastree, pascal_parser_intf, binary_streamer; const sWST_META = 'WST_METADATA_0.2.2.0'; @@ -37,13 +37,13 @@ type TMetadataGenerator = class private FStream : IDataStore; - FSymbolTable: TSymbolTable; + FSymbolTable: TwstPasTreeContainer; procedure GenerateHeader(); - procedure GenerateIntfMetadata(AIntf : TInterfaceDefinition); + procedure GenerateIntfMetadata(AIntf : TPasClassType); public constructor Create( - ASymTable : TSymbolTable; + ASymTable : TwstPasTreeContainer; ADstStream : IDataStore ); procedure Execute(); @@ -57,50 +57,76 @@ implementation procedure TMetadataGenerator.GenerateHeader(); var c, i, k : LongInt; + typeList : TList; + elt : TPasElement; begin FStream.WriteStr(sWST_META); - FStream.WriteStr(FSymbolTable.Name); + FStream.WriteStr(FSymbolTable.CurrentModule.Name); k := 0; - c := FSymbolTable.Count; + typeList := FSymbolTable.CurrentModule.InterfaceSection.Types; + c := typeList.Count; for i := 0 to pred(c) do begin - if FSymbolTable.Item[i] is TInterfaceDefinition then + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okInterface ) then inc(k); end; FStream.WriteInt8U(k); end; -procedure TMetadataGenerator.GenerateIntfMetadata(AIntf: TInterfaceDefinition); +procedure TMetadataGenerator.GenerateIntfMetadata(AIntf: TPasClassType); - procedure WriteMethod(AMeth:TMethodDefinition); + procedure WriteMethod(AMeth : TPasProcedure); - procedure WriteParam(APrm : TParameterDefinition); + procedure WriteParam(APrm : TPasArgument); begin - FStream.WriteStr(APrm.ExternalName); - FStream.WriteStr(APrm.DataType.ExternalName); - FStream.WriteEnum(Ord(APrm.Modifier)); + FStream.WriteStr(FSymbolTable.GetExternalName(APrm)); + FStream.WriteStr(FSymbolTable.GetExternalName(APrm.ArgType)); + FStream.WriteEnum(Ord(APrm.Access)); + end; + + procedure WriteResult(ARes : TPasResultElement); + begin + FStream.WriteStr(FSymbolTable.GetExternalName(ARes)); + FStream.WriteStr(FSymbolTable.GetExternalName(ARes.ResultType)); + FStream.WriteEnum(Ord(argOut)); end; var j, k : LongInt; + argLst : TList; begin - k := AMeth.ParameterCount; + argLst := AMeth.ProcType.Args; + k := argLst.Count; FStream.WriteStr(AMeth.Name); - FStream.WriteInt8U(k); - for j := 0 to pred(k) do - WriteParam(AMeth.Parameter[j]); + if AMeth.InheritsFrom(TPasFunction) then begin + FStream.WriteInt8U(k + 1); + end; + for j := 0 to pred(k) do begin + WriteParam(TPasArgument(argLst[j])); + end; + if AMeth.InheritsFrom(TPasFunction) then begin + WriteResult(TPasFunctionType(AMeth.ProcType).ResultEl); + end; end; var i, c : LongInt; + mbrs : TList; + elt : TPasElement; begin FStream.WriteStr(AIntf.Name); - c := AIntf.MethodCount; + c := GetElementCount(AIntf.Members,TPasProcedure); FStream.WriteInt8U(c); - for i := 0 to pred(c) do - WriteMethod(AIntf.Method[i]); + mbrs := AIntf.Members; + for i := 0 to pred(mbrs.Count) do begin + elt := TPasElement(mbrs[i]); + if elt.InheritsFrom(TPasProcedure) then begin + WriteMethod(TPasProcedure(elt)); + end; + end; end; -constructor TMetadataGenerator.Create(ASymTable: TSymbolTable;ADstStream: IDataStore); +constructor TMetadataGenerator.Create(ASymTable: TwstPasTreeContainer;ADstStream: IDataStore); begin Assert(Assigned(ASymTable)); Assert(Assigned(ADstStream)); @@ -111,13 +137,17 @@ end; procedure TMetadataGenerator.Execute(); Var i,c : Integer; - intf : TInterfaceDefinition; + intf : TPasClassType; + typeList : TList; + elt : TPasElement; begin GenerateHeader(); - c := Pred(FSymbolTable.Count); + typeList := FSymbolTable.CurrentModule.InterfaceSection.Types; + c := Pred(typeList.Count); for i := 0 to c do begin - if FSymbolTable.Item[i] is TInterfaceDefinition then begin - intf := FSymbolTable.Item[i] as TInterfaceDefinition; + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasClassType) and ( TPasClassType(elt).ObjKind = okInterface ) then begin + intf := TPasClassType(elt); GenerateIntfMetadata(intf); end; end; diff --git a/wst/trunk/ws_helper/parserutils.pas b/wst/trunk/ws_helper/parserutils.pas index d3434dfe5..18ea4d96d 100644 --- a/wst/trunk/ws_helper/parserutils.pas +++ b/wst/trunk/ws_helper/parserutils.pas @@ -32,7 +32,36 @@ const function IsStrEmpty(Const AStr : String):Boolean; function ExtractIdentifier(const AValue : string) : string ; + function IsReservedKeyWord(const AValue : string):Boolean ; + implementation +uses StrUtils; + +const LANGAGE_TOKEN : array[0..107] of string = ( + 'ABSTRACT', 'AND', 'ARRAY', 'AS', 'ASM', + 'BEGIN', 'BOOLEAN', 'BYTE', + 'CASE', 'CDECL', 'CHAR', 'CLASS', 'COMP', 'CONST', 'CONSTRUCTOR', 'CONTAINS', 'CURRENCY', + 'DEFAULT', 'DESTRUCTOR', 'DIV', 'DO', 'DOUBLE', 'DOWNTO', 'DYNAMIC', + 'END', 'EXPORT', 'EXPORTS', 'EXTERNAL', + 'FAR', 'FILE', 'FINALLY', 'FOR', 'FORWARD', 'FUNCTION', 'GOTO', + 'ELSE', 'EXCEPT', 'EXTENDED', + 'IF', 'IMPLEMENTATION', 'IMPLEMENTS', 'IN', 'INHERITED', 'INT64', 'INITIALIZATION', + 'INTEGER', 'INTERFACE', 'IS', + 'LABEL', 'LIBRARY', 'LOCAL', 'LONGINT', 'LONGWORD', + 'MOD', 'NEAR', 'NIL', 'NODEFAULT', 'NOT', + 'OBJECT', 'OF', 'OLEVARIANT', 'OR', 'OUT', 'OVERLOAD', 'OVERRIDE', + 'PACKAGE', 'PACKED', 'PASCAL', 'PCHAR', 'PRIVATE', 'PROCEDURE', 'PROGRAM', 'PUBLISHED', + 'RAISE', 'READ', 'REAL', 'RECORD', 'REGISTER', 'REINTRODUCE', 'REPEAT', 'REQUIRES', 'RESULT', + 'SAFECALL', 'SET', 'SHL', 'SHORTINT', 'SHR', 'SINGLE', 'SMALLINT', 'STDCALL', 'STORED', + 'THEN', 'TO', 'TRY', 'TYPE', 'UNIT', 'UNTIL', 'USES', + 'VAR', 'VARARGS', 'VARIANT', 'VIRTUAL', 'WHILE', 'WIDECHAR', 'WITH', 'WORD', 'WRITE', 'XOR' +); +const WST_RESERVED_TOKEN : array[0..1] of string = ( 'Item', 'Item' ); +function IsReservedKeyWord(const AValue : string):Boolean ; +begin + Result := AnsiMatchText(AValue,LANGAGE_TOKEN) or + AnsiMatchText(AValue,WST_RESERVED_TOKEN); +end; function IsStrEmpty(Const AStr : String):Boolean; begin diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas new file mode 100644 index 000000000..7bdc4f2f2 --- /dev/null +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -0,0 +1,719 @@ +unit pascal_parser_intf; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Contnrs, + pparser, pastree; + +const + sEXTERNAL_NAME = '_E_N_'; + sATTRIBUTE = '_ATTRIBUTE_'; + sARRAY_ITEM_NAME = 'ARRAY_ITEM_NAME'; + sARRAY_ITEM_EXT_NAME = 'ARRAY_ITEM_EXT_NAME'; + sARRAY_STYLE = 'ARRAY_STYLE'; + sARRAY_STYLE_SCOPED = 'ARRAY_STYLE_SCOPED'; + sARRAY_STYLE_EMBEDDED = 'ARRAY_STYLE_EMBEDDED'; + + sXSD_NS = 'http://www.w3.org/2001/XMLSchema'; + +type + + TBindingStyle = ( bsDocument, bsRPC, bsUnknown ); + TArrayStyle = ( asScoped, asEmbeded ); + + ESymbolException = class(Exception) + end; + { TwstBinding } + + TwstBinding = class + private + FAddress: string; + FBindingStyle: TBindingStyle; + FIntf: TPasClassType; + FName: string; + public + constructor Create(const AName : string; AIntf : TPasClassType); + destructor Destroy();override; + property Name : string read FName; + property Intf : TPasClassType read FIntf; + property Address : string read FAddress write FAddress; + property BindingStyle : TBindingStyle read FBindingStyle write FBindingStyle; + end; + + { TPropertyHolder } + + TPropertyHolder = class + private + FObjects : TObjectList; + FProps : TObjectList; + private + public + constructor Create(); + destructor Destroy();override; + procedure SetValue(AOwner : TObject; const AName, AValue : string); + function GetValue(AOwner : TObject; const AName : string) : string; + function FindList(AOwner : TObject) : TStrings; + function GetList(AOwner : TObject) : TStrings; + end; + + { TwstPasTreeContainer } + + TwstPasTreeContainer = class(TPasTreeContainer) + private + FCurrentModule: TPasModule; + FBindingList : TObjectList; + FProperties : TPropertyHolder; + private + function GetBinding(AIndex : Integer): TwstBinding; + function GetBindingCount: Integer; + public + constructor Create(); + destructor Destroy();override; + function CreateElement( + AClass : TPTreeElement; + const AName : String; + AParent : TPasElement; + AVisibility : TPasMemberVisibility; + const ASourceFilename : String; + ASourceLinenumber : Integer + ): TPasElement;override; + function CreateArray( + const AName : string; + AItemType : TPasType; + const AItemName, + AItemExternalName : string; + const AStyle : TArrayStyle + ) : TPasArrayType; + function GetArrayItemName(AArray : TPasArrayType) : string; + function GetArrayItemExternalName(AArray : TPasArrayType) : string; + function GetArrayStyle(AArray : TPasArrayType) : TArrayStyle; + function FindElement(const AName: String): TPasElement; override; + function FindElementInModule(const AName: String; AModule: TPasModule): TPasElement; + function FindModule(const AName: String): TPasModule;override; + function IsEnumItemNameUsed(const AName : string) : Boolean; + procedure SetCurrentModule(AModule : TPasModule); + property CurrentModule : TPasModule read FCurrentModule; + + function AddBinding(const AName : string; AIntf : TPasClassType):TwstBinding; + function FindBinding(const AName : string):TwstBinding; + property BindingCount : Integer read GetBindingCount; + property Binding[AIndex : Integer] : TwstBinding read GetBinding; + property Properties : TPropertyHolder read FProperties; + + procedure RegisterExternalAlias(AObject : TPasElement; const AExternalName : String); + function SameName(AObject : TPasElement; const AName : string) : Boolean; + function GetExternalName(AObject : TPasElement) : string; + function IsAttributeProperty(AObject : TPasProperty) : Boolean; + procedure SetPropertyAsAttribute(AObject : TPasProperty; const AValue : Boolean); + + function IsInitNeed(AType: TPasType): Boolean; + function IsOfType(AType: TPasType; AClass: TClass): Boolean; + end; + + TPasClassTypeClass = class of TPasClassType; + TPasNativeClassType = class(TPasClassType) end; + TPasNativeSimpleContentClassType = class(TPasNativeClassType) end; + + { TPasNativeSimpleType } + + TPasNativeSimpleType = class(TPasType) + private + FBoxedType: TPasNativeSimpleContentClassType; + public + destructor Destroy();override; + procedure SetBoxedType(ABoxedType : TPasNativeSimpleContentClassType); + property BoxedType : TPasNativeSimpleContentClassType read FBoxedType; + end; + + function GetParameterIndex(AProcType : TPasProcedureType; const AParamName : string) : Integer; + function FindParameter(AProcType : TPasProcedureType; const AParamName : string) : TPasArgument; + function FindMember(AClass : TPasClassType; const AName : string) : TPasElement ; + function GetElementCount(AList : TList; AElementClass : TPTreeElement):Integer ; + + function GetUltimeType(AType : TPasType) : TPasType; + function MakeInternalSymbolNameFrom(const AName : string) : string ; + + + function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule; + +implementation +uses parserutils; + +const SIMPLE_TYPES : Array[0..14] Of array[0..2] of string = ( + ('string', 'TComplexStringContentRemotable', 'string'), + ('integer', 'TComplexInt32SContentRemotable', 'int'), + ('LongWord', 'TComplexInt32UContentRemotable', 'unsignedInt' ), + ('SmallInt', 'TComplexInt16SContentRemotable', 'short'), + ('ShortInt', 'TComplexInt8SContentRemotable', 'byte'), + ('char', '', ''), + ('boolean', 'TComplexBooleanContentRemotable', 'boolean'), + ('Byte', 'TComplexInt8UContentRemotable', 'unsignedByte'), + ('Word', 'TComplexInt16UContentRemotable', 'unsignedShort'), + ('Longint', 'TComplexInt32SContentRemotable', 'int'), + ('Int64', 'TComplexInt64SContentRemotable', 'long'), + ('Qword', 'TComplexInt64UContentRemotable', 'unsignedLong'), + ('Single', 'TComplexFloatSingleContentRemotable', 'single'), + ('Double', 'TComplexFloatDoubleContentRemotable', 'double'), + ('Extended', 'TComplexFloatExtendedContentRemotable', 'decimal') + ); + +procedure AddSystemSymbol( + ADest : TPasModule; + AContainer : TwstPasTreeContainer +); +var + i : Integer; + splTyp : TPasNativeSimpleType; + syb : TPasNativeSimpleContentClassType; + s : string; +begin + for i := Low(SIMPLE_TYPES) to High(SIMPLE_TYPES) do begin + splTyp := TPasNativeSimpleType(AContainer.CreateElement(TPasNativeSimpleType,SIMPLE_TYPES[i][0],ADest.InterfaceSection,visPublic,'',0)); + ADest.InterfaceSection.Declarations.Add(splTyp); + ADest.InterfaceSection.Types.Add(splTyp); + s := SIMPLE_TYPES[i][1]; + if not IsStrEmpty(s) then begin + syb := AContainer.FindElementInModule(SIMPLE_TYPES[i][1],ADest) as TPasNativeSimpleContentClassType; + if not Assigned(syb) then begin + syb := TPasNativeSimpleContentClassType(AContainer.CreateElement(TPasNativeSimpleContentClassType,s,ADest.InterfaceSection,visDefault,'',0)); + ADest.InterfaceSection.Declarations.Add(syb); + ADest.InterfaceSection.Types.Add(splTyp); + end; + splTyp.SetBoxedType(syb); + end; + end; + for i := Low(SIMPLE_TYPES) to High(SIMPLE_TYPES) do begin + splTyp := AContainer.FindElementInModule(SIMPLE_TYPES[i][0],ADest) as TPasNativeSimpleType; + if not IsStrEmpty(SIMPLE_TYPES[i][2]) then begin + AContainer.RegisterExternalAlias(splTyp,SIMPLE_TYPES[i][2]); + end; + end; +end; + +function CreateWstInterfaceSymbolTable(AContainer : TwstPasTreeContainer) : TPasModule; + function AddClassDef( + ATable : TPasModule; + const AClassName, + AParentName : string; + const AClassType : TPasClassTypeClass = nil + ):TPasClassType; + var + locClassType : TPasClassTypeClass; + begin + if Assigned(AClassType) then begin + locClassType := AClassType; + end else begin + locClassType := TPasClassType; + end; + Result := TPasClassType(AContainer.CreateElement(locClassType,AClassName,ATable.InterfaceSection,visDefault,'',0)); + if not IsStrEmpty(AParentName) then begin + Result.AncestorType := AContainer.FindElementInModule(AParentName,ATable) as TPasType; + if Assigned(Result.AncestorType) then + Result.AncestorType.AddRef(); + end; + ATable.InterfaceSection.Classes.Add(Result); + ATable.InterfaceSection.Declarations.Add(Result); + ATable.InterfaceSection.Types.Add(Result); + end; + + function AddAlias(const AName, ABaseType : string; ATable : TPasModule) : TPasTypeAliasType; + begin + Result := TPasTypeAliasType(AContainer.CreateElement(TPasAliasType,AName,ATable,visPublic,'',0)); + Result.DestType := AContainer.FindElementInModule(ABaseType,ATable) as TPasType; + if Assigned(Result.DestType) then + Result.DestType.AddRef(); + ATable.InterfaceSection.Declarations.Add(Result); + ATable.InterfaceSection.Classes.Add(Result); + ATable.InterfaceSection.Types.Add(Result); + end; + +var + loc_TBaseComplexSimpleContentRemotable : TPasClassType; +begin + Result := TPasModule(AContainer.CreateElement(TPasModule,'base_service_intf',AContainer.Package,visPublic,'',0)); + try + AContainer.RegisterExternalAlias(Result,sXSD_NS); + Result.InterfaceSection := TPasSection(AContainer.CreateElement(TPasSection,'',Result,visDefault,'',0)); + AddSystemSymbol(Result,AContainer); + AddClassDef(Result,'TBaseRemotable','',TPasNativeClassType); + AddClassDef(Result,'TAbstractSimpleRemotable','TBaseRemotable',TPasNativeClassType); + AContainer.RegisterExternalAlias(AddClassDef(Result,'TDateRemotable','TAbstractSimpleRemotable'),'dateTime'); + AContainer.RegisterExternalAlias(AddClassDef(Result,'TDurationRemotable','TAbstractSimpleRemotable'),'duration'); + AContainer.RegisterExternalAlias(AddClassDef(Result,'TTimeRemotable','TAbstractSimpleRemotable'),'time'); + + AddClassDef(Result,'TAbstractComplexRemotable','TBaseRemotable',TPasNativeClassType); + loc_TBaseComplexSimpleContentRemotable := AddClassDef(Result,'TBaseComplexSimpleContentRemotable','TAbstractComplexRemotable',TPasNativeClassType); + (AContainer.FindElementInModule('TComplexInt16SContentRemotable',Result) as TPasClassType).AncestorType := loc_TBaseComplexSimpleContentRemotable; + (AContainer.FindElementInModule('TComplexFloatDoubleContentRemotable',Result) as TPasClassType).AncestorType := loc_TBaseComplexSimpleContentRemotable; + + AddClassDef(Result,'TBaseComplexRemotable','TAbstractComplexRemotable',TPasNativeClassType); + AddClassDef(Result,'THeaderBlock','TBaseComplexRemotable'); + AddClassDef(Result,'TBaseArrayRemotable','TAbstractComplexRemotable'); + AddClassDef(Result,'TBaseObjectArrayRemotable','TBaseArrayRemotable'); + AddClassDef(Result,'TBaseSimpleTypeArrayRemotable','TBaseArrayRemotable'); + AddClassDef(Result,'TArrayOfStringRemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfBooleanRemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfInt8URemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfInt8SRemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfInt16SRemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfInt16URemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfInt32URemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfInt32SRemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfInt64SRemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfInt64URemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfFloatSingleRemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfFloatDoubleRemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfFloatExtendedRemotable','TBaseSimpleTypeArrayRemotable'); + AddClassDef(Result,'TArrayOfFloatCurrencyRemotable','TBaseSimpleTypeArrayRemotable'); + + AddAlias('token','string',Result); + AddAlias('anyURI','string',Result); + AddAlias('float','Single',Result); + AddAlias('nonNegativeInteger','LongWord',Result); + AddAlias('positiveInteger','nonNegativeInteger',Result); + AddAlias('base64Binary','string',Result); + except + FreeAndNil(Result); + raise; + end; +end; + +function GetUltimeType(AType : TPasType) : TPasType; +begin + Result := AType; + if ( Result <> nil ) then begin + while Result.InheritsFrom(TPasAliasType) and + ( TPasAliasType(Result).DestType <> nil ) + do begin + Result := TPasAliasType(Result).DestType; + end; + end; +end; + +function GetElementCount(AList : TList; AElementClass : TPTreeElement):Integer ; +var + i : Integer; +begin + Result := 0; + if Assigned(AList) then begin + for i := 0 to Pred(AList.Count) do begin + if TObject(AList[i]).InheritsFrom(AElementClass) then begin + Inc(Result); + end; + end; + end; +end; + +function GetParameterIndex(AProcType : TPasProcedureType; const AParamName : string) : Integer; +var + pl : TList; + i : Integer; +begin + pl := AProcType.Args; + for i := 0 to Pred(pl.Count) do begin + if AnsiSameText(AParamName,TPasArgument(pl[i]).Name) then begin + Result := i; + Exit; + end; + end; + Result := -1; +end; + +function FindParameter(AProcType : TPasProcedureType; const AParamName : string) : TPasArgument; +var + i : Integer; +begin + i := GetParameterIndex(AProcType,AParamName); + if ( i >= 0 ) then begin + Result := TPasArgument(AProcType.Args[i]); + end else begin + Result := nil; + end; +end; + +function FindMember(AClass : TPasClassType; const AName : string) : TPasElement ; +var + memberList : TList; + i : Integer; +begin + Result := nil; + if ( AClass <> nil ) then begin + memberList := AClass.Members; + for i := 0 to Pred(memberList.Count) do begin + if AnsiSameText(AName,TPasElement(memberList[i]).Name) then begin + Result := TPasElement(memberList[i]); + end; + end; + end; +end; + +function MakeInternalSymbolNameFrom(const AName : string) : string ; +begin + Result := ExtractIdentifier(AName); + if IsStrEmpty(AName) then begin + raise ESymbolException.CreateFmt('Unable to make an internal symbol Name from "%s".',[AName]); + end; + if IsReservedKeyWord(Result) then begin + Result := '_' + Result; + end; +end; + + +{ TwstPasTreeContainer } + +function TwstPasTreeContainer.GetBinding(AIndex : Integer): TwstBinding; +begin + Result := TwstBinding(FBindingList[AIndex]); +end; + +function TwstPasTreeContainer.GetBindingCount: Integer; +begin + Result := FBindingList.Count; +end; + +constructor TwstPasTreeContainer.Create(); +begin + FPackage := TPasPackage.Create('sample',nil); + FBindingList := TObjectList.Create(True); + FProperties := TPropertyHolder.Create(); +end; + +destructor TwstPasTreeContainer.Destroy(); +begin + FreeAndNil(FProperties); + FreeAndNil(FBindingList); + FreeAndNil(FPackage); + inherited Destroy(); +end; + +function TwstPasTreeContainer.CreateElement( + AClass : TPTreeElement; + const AName : String; + AParent : TPasElement; + AVisibility : TPasMemberVisibility; + const ASourceFilename : String; + ASourceLinenumber : Integer +) : TPasElement; +begin + //WriteLn('TwstPasTreeContainer.CreateElement(',AName,')'); + Result := AClass.Create(AName,AParent); + Result.Visibility := AVisibility; + Result.SourceFilename := ASourceFilename; + Result.SourceLinenumber := ASourceLinenumber; + if Result.InheritsFrom(TPasModule) then begin + FCurrentModule := Result as TPasModule; + Package.Modules.Add(Result); + end; +end; + +function TwstPasTreeContainer.CreateArray( + const AName : string; + AItemType : TPasType; + const AItemName, + AItemExternalName : string; + const AStyle : TArrayStyle +) : TPasArrayType; +var + s : string; +begin + Result := TPasArrayType(CreateElement(TPasArrayType,AName,CurrentModule.InterfaceSection,visDefault,'',0)); + Result.ElType := AItemType; + AItemType.AddRef(); + Properties.SetValue(Result,sARRAY_ITEM_NAME,AItemName); + Properties.SetValue(Result,sARRAY_ITEM_EXT_NAME,AItemExternalName); + if ( AStyle = asEmbeded ) then + s := sARRAY_STYLE_EMBEDDED + else + s := sARRAY_STYLE_SCOPED; + Properties.SetValue(Result,sARRAY_STYLE,s); +end; + +function TwstPasTreeContainer.GetArrayItemName(AArray: TPasArrayType): string; +begin + Result := Properties.GetValue(AArray,sARRAY_ITEM_NAME); +end; + +function TwstPasTreeContainer.GetArrayItemExternalName(AArray: TPasArrayType): string; +begin + Result := Properties.GetValue(AArray,sARRAY_ITEM_EXT_NAME); +end; + +function TwstPasTreeContainer.GetArrayStyle(AArray: TPasArrayType): TArrayStyle; +begin + if AnsiSameText(sARRAY_STYLE_EMBEDDED,Properties.GetValue(AArray,sARRAY_STYLE)) then + Result := asEmbeded + else + Result := asScoped; +end; + +function TwstPasTreeContainer.FindElementInModule(const AName: String; AModule : TPasModule): TPasElement; +var + decs : TList; + i, c : Integer; +begin + Result := nil; + if Assigned(AModule) and Assigned(AModule.InterfaceSection.Declarations) then begin + decs := AModule.InterfaceSection.Declarations; + c := decs.Count; + for i := 0 to Pred(c) do begin + if SameName(TPasElement(decs[i]),AName) then begin + Result := TPasElement(decs[i]); + Exit; + end; + end; + end; +end; + +function TwstPasTreeContainer.FindElement(const AName: String): TPasElement; +var + i : Integer; + mls : TList; + mdl : TPasModule; +begin + Result := FindElementInModule(AName,CurrentModule); + if ( Result = nil ) then begin + mls := Package.Modules; + for i := 0 to Pred(mls.Count) do begin + mdl := TPasModule(mls[i]); + if ( CurrentModule <> mdl ) then begin + Result := FindElementInModule(AName,mdl); + if ( Result <> nil ) then begin + Break; + end; + end; + end; + end; +end; + +function TwstPasTreeContainer.FindModule(const AName: String): TPasModule; +var + i , c : Integer; + mdl : TList; +begin + Result := nil; + mdl := Package.Modules; + c := mdl.Count; + for i := 0 to Pred(c) do begin + if AnsiSameText(AName,TPasModule(mdl[i]).Name) then begin + Result := TPasModule(mdl[i]); + end; + end; +end; + +function TwstPasTreeContainer.IsEnumItemNameUsed(const AName: string): Boolean; +var + i, c, j : Integer; + elt : TPasElement; + enumList : TList; + typeList : TList; +begin + Result := False; + typeList := CurrentModule.InterfaceSection.Declarations; + c := typeList.Count; + for i := 0 to Pred(c) do begin + elt := TPasElement(typeList[i]); + if elt.InheritsFrom(TPasEnumType) then begin + enumList := TPasEnumType(elt).Values; + for j := 0 to Pred(enumList.Count) do begin + if AnsiSameText(AName,TPasEnumValue(enumList[j]).Name) then begin + Result := True; + Exit; + end; + end; + end; + end; +end; + +function TwstPasTreeContainer.IsOfType(AType : TPasType; AClass : TClass) : Boolean; +var + ut : TPasType; +begin + Result := False; + if Assigned(AType) then begin + ut := AType; + if ut.InheritsFrom(TPasUnresolvedTypeRef) then begin + ut := FindElement(GetExternalName(ut)) as TPasType; + if ( ut = nil ) then + ut := AType; + end; + ut := GetUltimeType(ut); + if ut.InheritsFrom(AClass) then begin + Result := True; + end; + end; +end; + +function TwstPasTreeContainer.IsInitNeed(AType : TPasType) : Boolean; +begin + Result := IsOfType(AType,TPasClassType) or + IsOfType(AType,TPasPointerType) or + IsOfType(AType,TPasArrayType); +end; + +procedure TwstPasTreeContainer.SetCurrentModule(AModule: TPasModule); +begin + FCurrentModule := AModule; +end; + +function TwstPasTreeContainer.AddBinding(const AName : string; AIntf : TPasClassType):TwstBinding; +begin + Result := FindBinding(AName); + if Assigned(Result) then begin + raise Exception.CreateFmt('Duplicated binding : "%s"',[AName]); + end; + Result := TwstBinding.Create(AName, AIntf); + FBindingList.Add(Result); +end; + +function TwstPasTreeContainer.FindBinding(const AName: string): TwstBinding; +var + i : Integer; +begin + for i := 0 to Pred(BindingCount) do begin + if AnsiSameText(AName,Binding[i].Name) then begin + Result := Binding[i]; + Exit; + end; + end; + Result := nil; +end; + +procedure TwstPasTreeContainer.RegisterExternalAlias( + AObject : TPasElement; + const AExternalName : String +); +begin + Properties.SetValue(AObject,sEXTERNAL_NAME,AExternalName); +end; + +function TwstPasTreeContainer.SameName( + AObject : TPasElement; + const AName : string +): Boolean; +begin + Result := AnsiSameText(AName,AObject.Name) or AnsiSameText(AName,GetExternalName(AObject)) ; +end; + +function TwstPasTreeContainer.GetExternalName(AObject: TPasElement): string; +begin + Result := Properties.GetValue(AObject,sEXTERNAL_NAME); + if IsStrEmpty(Result) then begin + Result := AObject.Name; + end; +end; + +function TwstPasTreeContainer.IsAttributeProperty(AObject: TPasProperty): Boolean; +begin + Result := AnsiSameText(Properties.GetValue(AObject,sATTRIBUTE),'True'); +end; + +procedure TwstPasTreeContainer.SetPropertyAsAttribute(AObject: TPasProperty; const AValue: Boolean); +var + s : string; +begin + if AValue then + s := 'True' + else + s := 'False'; + Properties.SetValue(AObject,sATTRIBUTE,s); +end; + +{ TwstBinding } + +constructor TwstBinding.Create(const AName : string; AIntf: TPasClassType); +begin + Assert((not IsStrEmpty(AName)) and Assigned(AIntf) and ( AIntf.ObjKind = okInterface )); + FIntf := AIntf; + FIntf.AddRef(); +end; + +destructor TwstBinding.Destroy(); +begin + if Assigned(FIntf) then begin + FIntf.Release(); + FIntf := nil; + end; + inherited Destroy(); +end; + +{ TPropertyHolder } + +function TPropertyHolder.FindList(AOwner: TObject): TStrings; +var + i : Integer; +begin + i := FObjects.IndexOf(AOwner); + if ( i >= 0 ) then begin + Result := FProps[i] as TStrings; + end else begin + Result := nil ; + end; +end; + +function TPropertyHolder.GetList(AOwner: TObject): TStrings; +begin + Result := FindList(AOwner); + if ( Result = nil ) then begin + FObjects.Add(AOwner); + Result := TStringList.Create(); + FProps.Add(Result); + end; +end; + +constructor TPropertyHolder.Create(); +begin + FObjects := TObjectList.Create(False); + FProps := TObjectList.Create(True); +end; + +destructor TPropertyHolder.Destroy(); +begin + FreeAndNil(FProps); + FreeAndNil(FObjects); + inherited Destroy(); +end; + +procedure TPropertyHolder.SetValue(AOwner: TObject; const AName, AValue: string); +begin + GetList(AOwner).Values[AName] := AValue; +end; + +function TPropertyHolder.GetValue(AOwner: TObject; const AName: string): string; +var + ls : TStrings; +begin + ls := FindList(AOwner); + if ( ls = nil ) then begin + Result := ''; + end else begin + Result := ls.Values[AName]; + end; +end; + +{ TPasNativeSimpleTypeDefinition } + +destructor TPasNativeSimpleType.Destroy(); +begin + if Assigned(FBoxedType) then begin + FBoxedType.Release(); + FBoxedType := nil + end; + inherited Destroy(); +end; + +procedure TPasNativeSimpleType.SetBoxedType( + ABoxedType : TPasNativeSimpleContentClassType +); +begin + if ( FBoxedType <> nil ) then begin + FBoxedType.Release(); + end; + FBoxedType := ABoxedType; + FBoxedType.AddRef(); +end; + +end. + diff --git a/wst/trunk/ws_helper/source_utils.pas b/wst/trunk/ws_helper/source_utils.pas index 8e6e6a0fe..b63fa12ec 100644 --- a/wst/trunk/ws_helper/source_utils.pas +++ b/wst/trunk/ws_helper/source_utils.pas @@ -29,9 +29,10 @@ uses Type EsourceException = class(Exception) - End; + end; - ISourceStream = Interface + ISourceStream = interface + ['{91EA7DA6-340C-477A-A6FD-06F2BAEA9A97}'] function GetFileName():string; procedure SaveToFile(const APath : string); procedure Indent(); @@ -44,9 +45,10 @@ Type procedure NewLine(); procedure BeginAutoIndent(); procedure EndAutoIndent(); - End; + end; ISourceManager = Interface + ['{91348FC9-C39E-45D4-A692-C8A363695D78}'] function CreateItem(const AFileName : string):ISourceStream; function Find(const AFileName : string):ISourceStream; function Merge( @@ -54,24 +56,27 @@ Type const ASourceList : array of ISourceStream ) : ISourceStream; procedure SaveToFile(const APath : string); - End; + function GetCount():Integer; + function GetItem(const AIndex :Integer):ISourceStream; + end; + + ISavableSourceStream = Interface(ISourceStream) + ['{B5F03006-FD33-4DA8-A2E7-168BDABE8832}'] + procedure SaveToStream(AStream : TStream); + procedure SaveToFile(const APath : string); + function GetStream(): TStream; + end; function CreateSourceManager():ISourceManager; implementation uses StrUtils, parserutils; -Type - - ISavableSourceStream = Interface(ISourceStream) - procedure SaveToStream(AStream : TStream); - procedure SaveToFile(const APath : string); - function GetStream(): TStream; - End; +type { TSourceStream } - TSourceStream = class(TInterfacedObject,ISavableSourceStream) + TSourceStream = class(TInterfacedObject,ISourceStream,ISavableSourceStream) Private FStream : TMemoryStream; FIndentCount : Integer; @@ -106,9 +111,6 @@ Type Private procedure Error(AText : String);overload; procedure Error(AText : String; Const AArgs : array of const);overload; - - function GetCount():Integer; - function GetItem(const AIndex:Integer):ISourceStream; Protected function CreateItem(const AFileName : string):ISourceStream; function Find(const AFileName : string):ISourceStream; @@ -117,6 +119,8 @@ Type const AFinalFileName : string; const ASourceList : array of ISourceStream ) : ISourceStream; + function GetCount():Integer; + function GetItem(const AIndex:Integer):ISourceStream; Public constructor Create(); End; diff --git a/wst/trunk/ws_helper/ws_helper.lpi b/wst/trunk/ws_helper/ws_helper.lpi index 201498085..ea16b9a23 100644 --- a/wst/trunk/ws_helper/ws_helper.lpi +++ b/wst/trunk/ws_helper/ws_helper.lpi @@ -1,7 +1,7 @@ - + @@ -10,12 +10,13 @@ - + - + + @@ -23,8 +24,8 @@ - - + + @@ -32,13 +33,13 @@ - + - - + + @@ -47,452 +48,474 @@ - + + + - - + + + - - - + + + + - - + + + + - - + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - - - - + + + + - - - - + + + + - - - + + + - - + + - - + + + - - - + + + + - - + + - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - + + + + - + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - + + + + - - - - + + + + - - - - + + + + - - - - + + + + - - - - + + + + - - - - - - - - - - - - - - - - + + + + - - - - + + + + - - - - - - - - - - - - - - - - - - + + + + - - - - + + + + - - - - + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - + + + + + - - - - + + + + - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - + + @@ -504,26 +527,25 @@ - + - + - + + - - - - + diff --git a/wst/trunk/ws_helper/ws_helper.pas b/wst/trunk/ws_helper/ws_helper.pas index 3661ce39c..b113d579e 100644 --- a/wst/trunk/ws_helper/ws_helper.pas +++ b/wst/trunk/ws_helper/ws_helper.pas @@ -24,9 +24,12 @@ program ws_helper; uses Classes, SysUtils, wst_resources_utils, - parserdefs, ws_parser, generator, parserutils, source_utils, + //parserdefs, ws_parser, + generator, parserutils, source_utils, command_line_parser, metadata_generator, binary_streamer, - DOM, xmlread, wsdl2pas_imp; + DOM, xmlread, wsdl2pas_imp, + + pastree, pparser, pascal_parser_intf, logger_intf; resourcestring sUSAGE = 'ws_helper [-uMODE] [-p] [-b] [-i] [-oPATH] inputFilename' + sNEW_LINE + @@ -45,14 +48,16 @@ const type TSourceFileType = ( sftPascal, sftWSDL ); -Var +var inFileName,outPath,errStr : string; srcMngr : ISourceManager; AppOptions : TComandLineOptions; NextParam : Integer; sourceType : TSourceFileType; - symtable : TSymbolTable; + symtable : TwstPasTreeContainer; parserMode : TParserMode; + + osParam, targetParam : string; function ProcessCmdLine():boolean; begin @@ -93,21 +98,8 @@ Var function GenerateSymbolTable() : Boolean ; procedure ParsePascalFile(); - var - s : TFileStream; - p : TPascalParser; begin - s := nil; - p := nil; - try - s := TFileStream.Create(inFileName,fmOpenRead); - p := TPascalParser.Create(s,symtable); - if not p.Parse() then - p.Error('"%s" at line %d',[p.ErrorMessage,p.SourceLine]); - finally - FreeAndNil(p); - FreeAndNil(s); - end; + ParseSource(symtable,inFileName,osParam,targetParam); end; procedure ParseWsdlFile(); @@ -119,7 +111,7 @@ Var ReadXMLFile(locDoc,inFileName); try prsr := TWsdlParser.Create(locDoc,symtable); - prsr.Parse(parserMode); + prsr.Parse(parserMode,ChangeFileExt(ExtractFileName(inFileName),'')); finally FreeAndNil(prsr); FreeAndNil(locDoc); @@ -192,7 +184,7 @@ Var mtdaFS.SaveToFile(ChangeFileExt(inFileName,'.' + sWST_META)); rsrcStrm := TMemoryStream.Create(); mtdaFS.Position := 0; - BinToWstRessource(UpperCase(symtable.Name),mtdaFS,rsrcStrm); + BinToWstRessource(UpperCase(symtable.CurrentModule.Name),mtdaFS,rsrcStrm); rsrcStrm.SaveToFile(outPath + ChangeFileExt(ExtractFileName(inFileName),'.' + sWST_EXTENSION)); end; @@ -213,6 +205,11 @@ Var begin + osParam := 'windows'; + targetParam := 'x86'; + + SetLogger(TSimpleConsoleLogger.Create()); + symtable := nil; try try @@ -226,7 +223,7 @@ begin WriteLn(errStr); Exit; end; - symtable := TSymbolTable.Create(ChangeFileExt(ExtractFileName(inFileName),'')); + symtable := TwstPasTreeContainer.Create();//ChangeFileExt(ExtractFileName(inFileName),'') srcMngr := CreateSourceManager(); if not GenerateSymbolTable() then begin @@ -240,12 +237,17 @@ begin End; srcMngr.SaveToFile(outPath); - WriteLn(Format('File "%s" parsed succesfully.',[inFileName])); + if ( GetLogger().GetMessageCount(mtError) = 0 ) then begin + WriteLn(Format('File "%s" parsed succesfully.',[inFileName])); + end else begin + WriteLn(Format('Paring complete with %d error(s).',[GetLogger().GetMessageCount(mtError)])); + end; except on e:exception Do Writeln('Exception : ' + e.Message) end; finally FreeAndNil(symtable); + SetLogger(nil); end; end. diff --git a/wst/trunk/ws_helper/wsdl2pas_imp.pas b/wst/trunk/ws_helper/wsdl2pas_imp.pas index bde4a58e4..876ac4279 100644 --- a/wst/trunk/ws_helper/wsdl2pas_imp.pas +++ b/wst/trunk/ws_helper/wsdl2pas_imp.pas @@ -6,44 +6,51 @@ interface uses Classes, SysUtils, DOM, - parserdefs, cursor_intf, rtti_filters; + cursor_intf, rtti_filters, + pparser, pastree, pascal_parser_intf, logger_intf; type EWslParserException = class(Exception) end; + EWslTypeNotFoundException = class(EWslParserException) + end; + + TOnParserMessage = procedure (const AMsgType : TMessageType; const AMsg : string) of object; + TWsdlParser = class; TAbstractTypeParserClass = class of TAbstractTypeParser; + { TAbstractTypeParser } TAbstractTypeParser = class private FOwner : TWsdlParser; FTypeNode : TDOMNode; - FSymbols : TSymbolTable; + FSymbols : TwstPasTreeContainer; FTypeName : string; FEmbededDef : Boolean; public constructor Create( AOwner : TWsdlParser; ATypeNode : TDOMNode; - ASymbols : TSymbolTable; + ASymbols : TwstPasTreeContainer; const ATypeName : string; const AEmbededDef : Boolean ); class function ExtractEmbeddedTypeFromElement( AOwner : TWsdlParser; AEltNode : TDOMNode; - ASymbols : TSymbolTable; + ASymbols : TwstPasTreeContainer; const ATypeName : string - ) : TTypeDefinition; + ) : TPasType; class function GetParserSupportedStyle():string;virtual;abstract; class procedure RegisterParser(AParserClass : TAbstractTypeParserClass); class function GetRegisteredParserCount() : Integer; class function GetRegisteredParser(const AIndex : Integer):TAbstractTypeParserClass; - function Parse():TTypeDefinition;virtual;abstract; + function Parse():TPasType;virtual;abstract; end; TDerivationMode = ( dmNone, dmExtension, dmRestriction ); @@ -57,7 +64,7 @@ type FChildCursor : IObjectCursor; FContentNode : TDOMNode; FContentType : string; - FBaseType : TTypeDefinition; + FBaseType : TPasType; FDerivationMode : TDerivationMode; FDerivationNode : TDOMNode; FSequenceType : TSequenceType; @@ -66,12 +73,12 @@ type procedure ExtractTypeName(); procedure ExtractContentType(); procedure ExtractBaseType(); - function ParseComplexContent(const ATypeName : string):TTypeDefinition; - function ParseSimpleContent(const ATypeName : string):TTypeDefinition; - function ParseEmptyContent(const ATypeName : string):TTypeDefinition; + function ParseComplexContent(const ATypeName : string):TPasType; + function ParseSimpleContent(const ATypeName : string):TPasType; + function ParseEmptyContent(const ATypeName : string):TPasType; public class function GetParserSupportedStyle():string;override; - function Parse():TTypeDefinition;override; + function Parse():TPasType;override; end; { TSimpleTypeParser } @@ -87,11 +94,11 @@ type procedure CreateNodeCursors(); procedure ExtractTypeName(); function ExtractContentType() : Boolean; - function ParseEnumContent():TTypeDefinition; - function ParseOtherContent():TTypeDefinition; + function ParseEnumContent():TPasType; + function ParseOtherContent():TPasType; public class function GetParserSupportedStyle():string;override; - function Parse():TTypeDefinition;override; + function Parse():TPasType;override; end; TParserMode = ( pmUsedTypes, pmAllTypes ); @@ -101,7 +108,8 @@ type TWsdlParser = class private FDoc : TXMLDocument; - FSymbols : TSymbolTable; + FSymbols : TwstPasTreeContainer; + FModule : TPasModule; private FWsdlShortNames : TStringList; FSoapShortNames : TStringList; @@ -113,27 +121,33 @@ type FMessageCursor : IObjectCursor; FTypesCursor : IObjectCursor; FSchemaCursor : IObjectCursor; + FOnMessage: TOnParserMessage; + private + procedure DoOnMessage(const AMsgType : TMessageType; const AMsg : string); private function CreateWsdlNameFilter(const AName : WideString):IObjectFilter; - function FindNamedNode(AList : IObjectCursor; const AName : WideString):TDOMNode; - procedure Prepare(); + function FindNamedNode(AList : IObjectCursor; const AName : WideString; const AOrder : Integer = 0):TDOMNode; + procedure Prepare(const AModuleName : string); procedure ParseService(ANode : TDOMNode); procedure ParsePort(ANode : TDOMNode); function ParsePortType( - ANode, ABindingNode : TDOMNode - ) : TInterfaceDefinition; + ANode, ABindingNode : TDOMNode; + const ABindingStyle : string + ) : TPasClassType; function ParseOperation( - AOwner : TInterfaceDefinition; + AOwner : TPasClassType; ANode : TDOMNode; const ASoapBindingStyle : string - ) : TMethodDefinition; - function ParseType(const AName, ATypeOrElement : string) : TTypeDefinition; + ) : TPasProcedure; + function ParseType(const AName, ATypeOrElement : string) : TPasType; procedure ParseTypes(); public - constructor Create(ADoc : TXMLDocument; ASymbols : TSymbolTable); + constructor Create(ADoc : TXMLDocument; ASymbols : TwstPasTreeContainer); destructor Destroy();override; - procedure Parse(const AMode : TParserMode); - property SymbolTable : TSymbolTable read FSymbols; + procedure Parse(const AMode : TParserMode; const AModuleName : string); + property SymbolTable : TwstPasTreeContainer read FSymbols; + + property OnMessage : TOnParserMessage read FOnMessage write FOnMessage; end; @@ -264,6 +278,15 @@ end; { TWsdlParser } +procedure TWsdlParser.DoOnMessage(const AMsgType : TMessageType; const AMsg : string); +begin + if Assigned(FOnMessage) then begin + FOnMessage(AMsgType,AMsg); + end else if IsConsole then begin + GetLogger().Log(AMsgType, AMsg); + end; +end; + function TWsdlParser.CreateWsdlNameFilter(const AName: WideString): IObjectFilter; begin Result := ParseFilter(CreateQualifiedNameFilterStr(AName,FWsdlShortNames),TDOMNodeRttiExposer); @@ -271,17 +294,20 @@ end; function TWsdlParser.FindNamedNode( AList : IObjectCursor; - const AName : WideString + const AName : WideString; + const AOrder : Integer ): TDOMNode; var attCrs, crs : IObjectCursor; curObj : TDOMNodeRttiExposer; fltr : IObjectFilter; + locOrder : Integer; begin Result := nil; if Assigned(AList) then begin fltr := ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer); AList.Reset(); + locOrder := AOrder; while AList.MoveNext() do begin curObj := AList.GetCurrent() as TDOMNodeRttiExposer; attCrs := CreateAttributesCursor(curObj.InnerObject,cetRttiNode); @@ -289,8 +315,11 @@ begin crs := CreateCursorOn(attCrs,fltr); crs.Reset(); if crs.MoveNext() and AnsiSameText(AName,TDOMNodeRttiExposer(crs.GetCurrent()).NodeValue) then begin - Result := curObj.InnerObject; - exit; + Dec(locOrder); + if ( locOrder <= 0 ) then begin + Result := curObj.InnerObject; + exit; + end; end; end; end; @@ -356,11 +385,16 @@ begin end; end; -procedure TWsdlParser.Prepare(); +procedure TWsdlParser.Prepare(const AModuleName : string); var locAttCursor : IObjectCursor; locObj : TDOMNodeRttiExposer; + begin + CreateWstInterfaceSymbolTable(SymbolTable); + FModule := TPasModule(SymbolTable.CreateElement(TPasModule,AModuleName,SymbolTable.Package,visDefault,'',0)); + FModule.InterfaceSection := TPasSection(SymbolTable.CreateElement(TPasSection,'',FModule,visDefault,'',0)); + FPortTypeCursor := nil; FWsdlShortNames.Clear(); locAttCursor := CreateAttributesCursor(FDoc.DocumentElement,cetRttiNode); @@ -435,6 +469,19 @@ begin end; end; +function StrToBindingStyle(const AStr : string):TBindingStyle; +begin + if IsStrEmpty(AStr) then begin + Result := bsDocument; + end else if AnsiSameText(AStr,s_document) then begin + Result := bsDocument; + end else if AnsiSameText(AStr,s_rpc) then begin + Result := bsRPC; + end else begin + Result := bsUnknown; + end; +end; + procedure TWsdlParser.ParsePort(ANode: TDOMNode); function FindBindingNode(const AName : WideString):TDOMNode; @@ -520,46 +567,7 @@ procedure TWsdlParser.ParsePort(ANode: TDOMNode); end; end; -var - bindingName, typeName : WideString; - i : Integer; - bindingNode, typeNode : TDOMNode; - intfDef : TInterfaceDefinition; -begin - if ExtractBindingQName(bindingName) then begin - i := Pos(':',bindingName); - bindingName := Copy(bindingName,( i + 1 ), MaxInt); - bindingNode := FindBindingNode(bindingName); - if Assigned(bindingNode) then begin - if ExtractTypeQName(bindingNode,typeName) then begin - i := Pos(':',typeName); - typeName := Copy(typeName,( i + 1 ), MaxInt); - typeNode := FindTypeNode(typeName); - if Assigned(typeNode) then begin - intfDef := ParsePortType(typeNode,bindingNode); - intfDef.Address := ExtractAddress(); - end; - end; - end; - end; -end; - -function StrToBindingStyle(const AStr : string):TBindingStyle; -begin - if IsStrEmpty(AStr) then begin - Result := bsDocument; - end else if AnsiSameText(AStr,s_document) then begin - Result := bsDocument; - end else if AnsiSameText(AStr,s_rpc) then begin - Result := bsRPC; - end else begin - Result := bsUnknown; - end; -end; - -function TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode) : TInterfaceDefinition; - - function ExtractSoapBindingStyle(out AName : WideString):Boolean ; + function ExtractSoapBindingStyle(ABindingNode : TDOMNode;out AName : WideString):Boolean ; var childrenCrs, crs, attCrs : IObjectCursor; s : string; @@ -586,7 +594,46 @@ function TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode) : TInterfaceD end; end; end; - + +var + bindingName, typeName : WideString; + i : Integer; + bindingNode, typeNode : TDOMNode; + intfDef : TPasClassType; + bdng : TwstBinding; + locSoapBindingStyle : string; + locWStrBuffer : WideString; +begin + if ExtractBindingQName(bindingName) then begin + i := Pos(':',bindingName); + bindingName := Copy(bindingName,( i + 1 ), MaxInt); + bindingNode := FindBindingNode(bindingName); + if Assigned(bindingNode) then begin + if ExtractTypeQName(bindingNode,typeName) then begin + i := Pos(':',typeName); + typeName := Copy(typeName,( i + 1 ), MaxInt); + typeNode := FindTypeNode(typeName); + if Assigned(typeNode) then begin + ExtractSoapBindingStyle(bindingNode,locWStrBuffer); + locSoapBindingStyle := locWStrBuffer; + intfDef := ParsePortType(typeNode,bindingNode,locSoapBindingStyle); + bdng := SymbolTable.AddBinding(bindingName,intfDef); + bdng.Address := ExtractAddress(); + bdng.BindingStyle := StrToBindingStyle(locSoapBindingStyle); + end; + end; + end; + end; +end; + +function TWsdlParser.ParsePortType( + ANode, ABindingNode : TDOMNode; + const ABindingStyle : string +) : TPasClassType; +var + s : string; + ws : widestring; + function ExtractBindingOperationCursor() : IObjectCursor ; begin Result := nil; @@ -598,14 +645,14 @@ function TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode) : TInterfaceD end; end; - procedure ParseOperation_EncodingStyle(ABndngOpCurs : IObjectCursor; AOp : TMethodDefinition); + procedure ParseOperation_EncodingStyle(ABndngOpCurs : IObjectCursor; AOp : TPasProcedure); var nd, ndSoap : TDOMNode; tmpCrs, tmpSoapCrs, tmpXcrs : IObjectCursor; in_out_count : Integer; strBuffer : string; begin - nd := FindNamedNode(ABndngOpCurs,AOp.ExternalName); + nd := FindNamedNode(ABndngOpCurs,SymbolTable.GetExternalName(AOp)); if Assigned(nd) and nd.HasChildNodes() then begin tmpCrs := CreateCursorOn( CreateChildrenCursor(nd,cetRttiNode), @@ -644,7 +691,7 @@ function TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode) : TInterfaceD end else begin strBuffer := s_soapOutputEncoding; end; - AOp.Properties.Values[s_FORMAT + '_' + strBuffer] := (tmpXcrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject.NodeValue; + SymbolTable.Properties.SetValue(AOp,s_FORMAT + '_' + strBuffer,(tmpXcrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject.NodeValue); end; end; end; @@ -653,12 +700,17 @@ function TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode) : TInterfaceD end; end; - procedure ParseOperationAttributes(ABndngOpCurs : IObjectCursor; AOp : TMethodDefinition); + procedure ParseOperationAttributes(ABndngOpCurs : IObjectCursor; AOp : TPasProcedure); var nd : TDOMNode; tmpCrs : IObjectCursor; + //s : string; + //ws : widestring; begin - nd := FindNamedNode(ABndngOpCurs,AOp.ExternalName); + ws := ''; + s := SymbolTable.GetExternalName(AOp); + ws := s; + nd := FindNamedNode(ABndngOpCurs,ws); if Assigned(nd) and nd.HasChildNodes() then begin tmpCrs := CreateCursorOn( CreateChildrenCursor(nd,cetRttiNode), @@ -683,9 +735,9 @@ function TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode) : TInterfaceD if tmpCrs.MoveNext() then begin nd := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; if AnsiSameText(nd.NodeName,s_style) then begin - AOp.Properties.Values[s_soapStyle] := nd.NodeValue; + SymbolTable.Properties.SetValue(AOp,s_soapStyle,nd.NodeValue); end else if AnsiSameText(nd.NodeName,s_soapAction) then begin - AOp.Properties.Values[s_TRANSPORT + '_' + s_soapAction] := nd.NodeValue; + SymbolTable.Properties.SetValue(AOp,s_TRANSPORT + '_' + s_soapAction,nd.NodeValue); end; end; end; @@ -695,14 +747,13 @@ function TWsdlParser.ParsePortType(ANode, ABindingNode : TDOMNode) : TInterfaceD end; var - locIntf : TInterfaceDefinition; + locIntf : TPasClassType; locAttCursor : IObjectCursor; locCursor, locOpCursor, locBindingOperationCursor : IObjectCursor; locObj : TDOMNodeRttiExposer; - locSoapBindingStyle : string; - locWStrBuffer : WideString; - locMthd : TMethodDefinition; + locMthd : TPasProcedure; inft_guid : TGuid; + ansiStrBuffer : ansistring; begin locAttCursor := CreateAttributesCursor(ANode,cetRttiNode); locCursor := CreateCursorOn(locAttCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_name)]),TDOMNodeRttiExposer)); @@ -710,13 +761,12 @@ begin if not locCursor.MoveNext() then raise EWslParserException.CreateFmt('PortType Attribute not found : "%s"',[s_name]); locObj := locCursor.GetCurrent() as TDOMNodeRttiExposer; - locIntf := TInterfaceDefinition.Create(locObj.NodeValue); - try - FSymbols.Add(locIntf); - except - FreeAndNil(locIntf); - raise; - end; + ansiStrBuffer := locObj.NodeValue; + locIntf := TPasClassType(SymbolTable.CreateElement(TPasClassType,ansiStrBuffer,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + FModule.InterfaceSection.Declarations.Add(locIntf); + FModule.InterfaceSection.Types.Add(locIntf); + FModule.InterfaceSection.Classes.Add(locIntf); + locIntf.ObjKind := okInterface; Result := locIntf; if ( CreateGUID(inft_guid) = 0 ) then locIntf.InterfaceGUID := GUIDToString(inft_guid); @@ -724,13 +774,10 @@ begin if Assigned(locCursor) then begin locOpCursor := CreateCursorOn(locCursor,ParseFilter(CreateQualifiedNameFilterStr(s_operation,FWsdlShortNames),TDOMNodeRttiExposer)); locOpCursor.Reset(); - ExtractSoapBindingStyle(locWStrBuffer); - locSoapBindingStyle := locWStrBuffer; - locIntf.BindingStyle := StrToBindingStyle(locSoapBindingStyle); locBindingOperationCursor := ExtractBindingOperationCursor(); while locOpCursor.MoveNext() do begin locObj := locOpCursor.GetCurrent() as TDOMNodeRttiExposer; - locMthd := ParseOperation(locIntf,locObj.InnerObject,locSoapBindingStyle); + locMthd := ParseOperation(locIntf,locObj.InnerObject,ABindingStyle); if Assigned(locMthd) then begin ParseOperationAttributes(locBindingOperationCursor,locMthd); end; @@ -740,23 +787,32 @@ end; type - TParamDefCrack = class(TParameterDefinition); + { TPasEmentCrack } - TMethodDefinitionCrack = class(TMethodDefinition); + TPasEmentCrack = class(TPasElement) + protected + procedure SetName(const AName : string); + end; + +{ TPasEmentCrack } + +procedure TPasEmentCrack.SetName(const AName: string); +begin + Name := AName; +end; - TTypeDefinitionCrack = class(TTypeDefinition); - function TWsdlParser.ParseOperation( - AOwner : TInterfaceDefinition; + AOwner : TPasClassType; ANode : TDOMNode; const ASoapBindingStyle : string -) : TMethodDefinition; +) : TPasProcedure; function ExtractOperationName(out AName : string):Boolean; var attCrs, crs : IObjectCursor; begin Result := False; + AName := ''; attCrs := CreateAttributesCursor(ANode,cetRttiNode); if Assigned(attCrs) then begin crs := CreateCursorOn(attCrs,ParseFilter(s_NODE_NAME + '=' + QuotedStr(s_name) ,TDOMNodeRttiExposer)); @@ -806,23 +862,25 @@ function TWsdlParser.ParseOperation( Result := CreateCursorOn(Result,CreateWsdlNameFilter(s_part)); end; - function GetDataType(const AName, ATypeOrElement : string):TTypeDefinition; + function GetDataType(const AName, ATypeOrElement : string):TPasType; begin + Result := nil; try Result := ParseType(AName,ATypeOrElement); except on e : Exception do begin - WriteLn(e.Message + ' ' + AName + ' ' + ATypeOrElement); + DoOnMessage(mtError, e.Message + ' ' + AName + ' ' + ATypeOrElement); end; end; end; procedure ExtractMethod( const AMthdName : string; - out AMthd : TMethodDefinition + out AMthd : TPasProcedure ); var - tmpMthd : TMethodDefinition; + tmpMthd : TPasProcedure; + tmpMthdType : TPasProcedureType; procedure ParseInputMessage(); var @@ -832,9 +890,11 @@ function TWsdlParser.ParseOperation( prmName, prmTypeName, prmTypeType, prmTypeInternalName : string; prmInternameName : string; prmHasInternameName : Boolean; - prmDef : TParameterDefinition; - prmTypeDef : TTypeDefinition; + prmDef : TPasArgument; + prmTypeDef : TPasType; begin + tmpMthdType := TPasProcedureType(SymbolTable.CreateElement(TPasProcedureType,'',tmpMthd,visDefault,'',0)); + tmpMthd.ProcType := tmpMthdType; if ExtractMsgName(s_input,inMsg) then begin inMsgNode := FindMessageNode(inMsg); if ( inMsgNode <> nil ) then begin @@ -881,22 +941,27 @@ function TWsdlParser.ParseOperation( end; prmHasInternameName := IsReservedKeyWord(prmInternameName) or ( not IsValidIdent(prmInternameName) ) or - ( tmpMthd.GetParameterIndex(prmInternameName) >= 0 ); + ( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 ); if prmHasInternameName then begin prmInternameName := '_' + prmInternameName; end; prmHasInternameName := not AnsiSameText(prmInternameName,prmName); prmTypeDef := GetDataType(prmTypeName,prmTypeType); - prmDef := tmpMthd.AddParameter(prmInternameName,pmConst,prmTypeDef); + prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0)); + tmpMthdType.Args.Add(prmDef); + prmDef.ArgType := prmTypeDef; + prmTypeDef.AddRef(); + prmDef.Access := argConst; if prmHasInternameName then begin - prmDef.RegisterExternalAlias(prmName); + SymbolTable.RegisterExternalAlias(prmDef,prmName); end; if AnsiSameText(tmpMthd.Name,prmTypeDef.Name) then begin - prmTypeInternalName := prmTypeDef.Name + 'Type'; - while ( FSymbols.IndexOf(prmTypeInternalName) >= 0 ) do begin + prmTypeInternalName := prmTypeDef.Name + '_Type'; + while Assigned(FSymbols.FindElement(prmTypeInternalName)) do begin prmTypeInternalName := '_' + prmTypeInternalName; end; - TTypeDefinitionCrack(prmTypeDef).SetName(prmTypeInternalName); + SymbolTable.RegisterExternalAlias(prmTypeDef,SymbolTable.GetExternalName(prmTypeDef)); + TPasEmentCrack(prmTypeDef).SetName(prmTypeInternalName); end; end; end; @@ -910,9 +975,13 @@ function TWsdlParser.ParseOperation( outMsgNode, tmpNode : TDOMNode; crs, tmpCrs : IObjectCursor; prmName, prmTypeName, prmTypeType : string; - prmDef : TParameterDefinition; + prmDef : TPasArgument; prmInternameName : string; prmHasInternameName : Boolean; + locProcType : TPasProcedureType; + locFunc : TPasFunction; + locFuncType : TPasFunctionType; + j : Integer; begin if ExtractMsgName(s_output,outMsg) then begin outMsgNode := FindMessageNode(outMsg); @@ -921,7 +990,7 @@ function TWsdlParser.ParseOperation( if ( crs <> nil ) then begin prmDef := nil; crs.Reset(); - While crs.MoveNext() do begin + while crs.MoveNext() do begin tmpNode := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; if ( tmpNode.Attributes = nil ) or ( tmpNode.Attributes.Length < 1 ) then raise EWslParserException.CreateFmt('Invalid message part : "%s"',[tmpNode.NodeName]); @@ -952,38 +1021,58 @@ function TWsdlParser.ParseOperation( if AnsiSameText(prmInternameName,tmpMthd.Name) then begin prmInternameName := prmInternameName + 'Param'; end; - //prmHasInternameName := IsReservedKeyWord(prmInternameName) or ( not IsValidIdent(prmInternameName) ); prmHasInternameName := IsReservedKeyWord(prmInternameName) or ( not IsValidIdent(prmInternameName) ) or - ( tmpMthd.GetParameterIndex(prmInternameName) >= 0 ); + ( GetParameterIndex(tmpMthdType,prmInternameName) >= 0 ); if prmHasInternameName then prmInternameName := '_' + prmInternameName; prmHasInternameName := not AnsiSameText(prmInternameName,prmName); - prmDef := tmpMthd.FindParameter(prmInternameName);//(prmName); + prmDef := FindParameter(tmpMthdType,prmInternameName); if ( prmDef = nil ) then begin - prmDef := tmpMthd.AddParameter(prmInternameName,pmOut,GetDataType(prmTypeName,prmTypeType)); - prmDef.RegisterExternalAlias(prmName); + prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0)); + tmpMthdType.Args.Add(prmDef); + prmDef.ArgType := GetDataType(prmTypeName,prmTypeType); + prmDef.Access := argOut; + if prmHasInternameName then begin + SymbolTable.RegisterExternalAlias(prmDef,prmName); + end; end else begin - if prmDef.DataType.SameName(prmTypeName) then begin - TParamDefCrack(prmDef).SetModifier(pmVar); + if SymbolTable.SameName(prmDef.ArgType,prmTypeName) then begin + prmDef.Access := argVar; end else begin prmInternameName := '_' + prmInternameName; - prmDef := tmpMthd.AddParameter(prmInternameName,pmOut,GetDataType(prmTypeName,prmTypeType)); - prmDef.RegisterExternalAlias(prmName); + prmDef := TPasArgument(SymbolTable.CreateElement(TPasArgument,prmInternameName,tmpMthdType,visDefault,'',0)); + prmDef.Access := argOut; + tmpMthdType.Args.Add(prmDef); + SymbolTable.RegisterExternalAlias(prmDef,prmName); end; end; end; if ( SameText(ASoapBindingStyle,s_rpc) and - ( prmDef <> nil ) and ( prmDef.Modifier = pmOut ) and//and SameText(prmDef.Name,s_return) and - ( prmDef = tmpMthd.Parameter[Pred(tmpMthd.ParameterCount)] ) + ( prmDef <> nil ) and ( prmDef.Access = argOut ) and + ( prmDef = TPasArgument(tmpMthdType.Args[Pred(tmpMthdType.Args.Count)]) ) ) or ( SameText(ASoapBindingStyle,s_document) and ( prmDef <> nil ) and - ( prmDef.Modifier = pmOut ) and - ( prmDef = tmpMthd.Parameter[Pred(tmpMthd.ParameterCount)] ) + ( prmDef.Access = argOut ) and + ( prmDef = TPasArgument(tmpMthdType.Args[Pred(tmpMthdType.Args.Count)]) ) ) then begin - TMethodDefinitionCrack(tmpMthd).SetMethodType(mtFunction); + locProcType := tmpMthd.ProcType; + locFunc := TPasFunction(SymbolTable.CreateElement(TPasFunction,tmpMthd.Name,AOwner,visDefault,'',0)); + locFuncType := SymbolTable.CreateFunctionType('','Result',locFunc,True,'',0); + locFunc.ProcType := locFuncType; + for j := 0 to ( locProcType.Args.Count - 2 ) do begin + locFuncType.Args.Add(locProcType.Args[j]); + end; + j := locProcType.Args.Count - 1; + locFuncType.ResultEl.ResultType := TPasType(TPasArgument(locProcType.Args[j]).ArgType); + SymbolTable.RegisterExternalAlias(locFuncType.ResultEl,SymbolTable.GetExternalName(TPasArgument(locProcType.Args[j]))); + locFuncType.ResultEl.ResultType.AddRef(); + TPasArgument(locProcType.Args[j]).Release(); + tmpMthdType.Args.Clear(); + tmpMthd.Release(); + tmpMthd := locFunc; end; end; end; @@ -992,7 +1081,7 @@ function TWsdlParser.ParseOperation( begin AMthd := nil; - tmpMthd := TMethodDefinition.Create(AMthdName,mtProcedure); + tmpMthd := TPasProcedure(SymbolTable.CreateElement(TPasProcedure,AMthdName,AOwner,visDefault,'',0)); try ParseInputMessage(); ParseOutputMessage(); @@ -1005,7 +1094,7 @@ function TWsdlParser.ParseOperation( end; var - locMthd : TMethodDefinition; + locMthd : TPasProcedure; mthdName : string; begin Result := nil; @@ -1014,17 +1103,19 @@ begin raise EWslParserException.CreateFmt('Operation Attribute not found : "%s"',[s_name]); if SameText(s_document,ASoapBindingStyle) then begin ExtractMethod(mthdName,locMthd); - if ( locMthd <> nil ) then - AOwner.AddMethod(locMthd); + if ( locMthd <> nil ) then begin + AOwner.Members.Add(locMthd); + end; end else if SameText(s_rpc,ASoapBindingStyle) then begin ExtractMethod(mthdName,locMthd); - if ( locMthd <> nil ) then - AOwner.AddMethod(locMthd); + if ( locMthd <> nil ) then begin + AOwner.Members.Add(locMthd); + end; end; Result := locMthd; end; -function TWsdlParser.ParseType(const AName, ATypeOrElement: string): TTypeDefinition; +function TWsdlParser.ParseType(const AName, ATypeOrElement: string): TPasType; var crsSchemaChild : IObjectCursor; typNd : TDOMNode; @@ -1046,24 +1137,37 @@ var crsSchemaChild := CreateChildrenCursor(nd.InnerObject,cetRttiNode); end; - procedure FindTypeNode(); + function FindTypeNode(out ASimpleTypeAlias : TPasType) : Boolean; var - nd : TDOMNode; + nd, oldTypeNode : TDOMNode; crs : IObjectCursor; locStrFilter : string; begin + ASimpleTypeAlias := nil; + Result := True; typNd := FindNamedNode(crsSchemaChild,ExtractNameFromQName(AName)); if not Assigned(typNd) then - raise EWslParserException.CreateFmt('Type definition not found 1 : "%s"',[AName]); + raise EWslTypeNotFoundException.CreateFmt('Type definition not found 1 : "%s"',[AName]); if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_element) then begin crs := CreateCursorOn(CreateAttributesCursor(typNd,cetRttiNode),ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_type)]),TDOMNodeRttiExposer)); crs.Reset(); if crs.MoveNext() then begin nd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; - typNd := FindNamedNode(crsSchemaChild,ExtractNameFromQName(nd.NodeValue)); - if not Assigned(typNd) then - raise EWslParserException.CreateFmt('Type definition not found 2 : "%s"',[AName]); - embededType := False; + ASimpleTypeAlias := FSymbols.FindElement(ExtractNameFromQName(nd.NodeValue)) as TPasType; + if Assigned(ASimpleTypeAlias) then begin + Result := False; + end else begin + oldTypeNode := typNd; + typNd := FindNamedNode(crsSchemaChild,ExtractNameFromQName(nd.NodeValue)); + if not Assigned(typNd) then + raise EWslTypeNotFoundException.CreateFmt('Type definition not found 2 : "%s"',[AName]); + embededType := False; + if ( typNd = oldTypeNode ) then begin + typNd := FindNamedNode(crsSchemaChild,ExtractNameFromQName(nd.NodeValue),2); + if not Assigned(typNd) then + raise EWslTypeNotFoundException.CreateFmt('Type definition not found 2.1 : "%s"',[AName]); + end; + end; end else begin //locStrFilter := Format('%s = %s or %s = %s ',[s_NODE_NAME,QuotedStr(s_complexType),s_NODE_NAME,QuotedStr(s_simpleType)]); locStrFilter := CreateQualifiedNameFilterStr(s_complexType,FXSShortNames) + ' or ' + @@ -1071,7 +1175,7 @@ var crs := CreateCursorOn(CreateChildrenCursor(typNd,cetRttiNode),ParseFilter(locStrFilter,TDOMNodeRttiExposer)); crs.Reset(); if not crs.MoveNext() then begin - raise EWslParserException.CreateFmt('Type definition not found 3 : "%s"',[AName]); + raise EWslTypeNotFoundException.CreateFmt('Type definition not found 3 : "%s"',[AName]); end; typNd := (crs.GetCurrent() as TDOMNodeRttiExposer).InnerObject; typName := ExtractNameFromQName(AName); @@ -1080,7 +1184,7 @@ var end; end; - function ParseComplexType():TTypeDefinition; + function ParseComplexType():TPasType; var locParser : TComplexTypeParser; begin @@ -1092,7 +1196,7 @@ var end; end; - function ParseSimpleType():TTypeDefinition; + function ParseSimpleType():TPasType; var locParser : TSimpleTypeParser; begin @@ -1103,28 +1207,87 @@ var FreeAndNil(locParser); end; end; - -var - frwType : TTypeDefinition; -begin - embededType := False; - Result := nil; - Result := FSymbols.Find(ExtractNameFromQName(AName),TTypeDefinition) as TTypeDefinition; - if ( not Assigned(Result) ) or ( Result is TForwardTypeDefinition ) then begin - frwType := Result; - Result := nil; - Init(); - FindTypeNode(); - if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_complexType) then begin - Result := ParseComplexType(); - end else if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_simpleType) then begin - Result := ParseSimpleType(); + + function CreateTypeAlias(const ABase : TPasType): TPasType; + var + hasInternameName : Boolean; + internameName : string; + begin + internameName := ExtractNameFromQName(AName); + hasInternameName := IsReservedKeyWord(internameName) or + ( not IsValidIdent(internameName) ); + if hasInternameName then begin + internameName := '_' + internameName; end; - if Assigned(Result) then begin - if Assigned(frwType) and AnsiSameText(Result.ExternalName,frwType.ExternalName) then begin - TTypeDefinitionCrack(Result).SetName(frwType.Name); + Result := TPasType(SymbolTable.CreateElement(TPasAliasType,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + TPasAliasType(Result).DestType := ABase; + ABase.AddRef(); + end; + + function CreateUnresolveType(): TPasType; + var + hasInternameName : Boolean; + internameName : string; + begin + internameName := ExtractNameFromQName(AName); + hasInternameName := IsReservedKeyWord(internameName) or + ( not IsValidIdent(internameName) ); + if hasInternameName then begin + internameName := '_' + internameName; + end; + Result := TPasUnresolvedTypeRef(SymbolTable.CreateElement(TPasUnresolvedTypeRef,internameName,SymbolTable.CurrentModule.InterfaceSection,visDefault,'',0)); + if not AnsiSameText(internameName,AName) then + SymbolTable.RegisterExternalAlias(Result,AName); + end; + +var + frwType, aliasType : TPasType; + sct : TPasSection; +begin + DoOnMessage(mtInfo, Format('Parsing "%s" ...',[AName])); + try + embededType := False; + aliasType := nil; + Result := nil; + Result := FSymbols.FindElement(ExtractNameFromQName(AName)) as TPasType; + if ( Result = nil ) or Result.InheritsFrom(TPasUnresolvedTypeRef) then begin + sct := FSymbols.CurrentModule.InterfaceSection; + frwType := Result; + Result := nil; + Init(); + if FindTypeNode(aliasType) then begin + if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_complexType) then begin + Result := ParseComplexType(); + end else if AnsiSameText(ExtractNameFromQName(typNd.NodeName),s_simpleType) then begin + Result := ParseSimpleType(); + end; + if Assigned(Result) then begin + if Assigned(frwType) and AnsiSameText(SymbolTable.GetExternalName(Result),SymbolTable.GetExternalName(frwType)) then begin + TPasEmentCrack(Result).SetName(frwType.Name); + SymbolTable.RegisterExternalAlias(Result,SymbolTable.GetExternalName(frwType)); + end; + end else begin + raise EWslTypeNotFoundException.CreateFmt('Type node found but unable to parse it : "%s"',[AName]); + end; + end else begin + Result := CreateTypeAlias(aliasType); end; - FSymbols.Add(Result); + if ( frwType <> nil ) then begin + sct.Declarations.Extract(frwType); + sct.Types.Extract(frwType); + frwType.Release(); + end; + sct.Declarations.Add(Result); + sct.Types.Add(Result); + if Result.InheritsFrom(TPasClassType) then begin + sct.Classes.Add(Result); + end; + end; + except + on e : EWslTypeNotFoundException do begin + Result := CreateUnresolveType(); + sct.Declarations.Add(Result); + sct.Types.Add(Result); end; end; end; @@ -1172,7 +1335,7 @@ begin end; end; -constructor TWsdlParser.Create(ADoc: TXMLDocument; ASymbols : TSymbolTable); +constructor TWsdlParser.Create(ADoc: TXMLDocument; ASymbols : TwstPasTreeContainer); begin Assert(Assigned(ADoc)); Assert(Assigned(ASymbols)); @@ -1181,7 +1344,6 @@ begin FSoapShortNames := TStringList.Create(); FXSShortNames := TStringList.Create(); FSymbols := ASymbols; - FSymbols.Add(CreateWstInterfaceSymbolTable()); end; destructor TWsdlParser.Destroy(); @@ -1192,15 +1354,16 @@ begin inherited Destroy(); end; -procedure TWsdlParser.Parse(const AMode : TParserMode); +procedure TWsdlParser.Parse(const AMode : TParserMode; const AModuleName : string); procedure ParseForwardDeclarations(); var i, c : Integer; - sym : TAbstractSymbolDefinition; + sym, symNew : TPasElement; typeCursor : IObjectCursor; tmpNode : TDOMNode; s : string; + typeList : TList; begin if Assigned(FSchemaCursor) then begin FSchemaCursor.Reset(); @@ -1214,19 +1377,27 @@ procedure TWsdlParser.Parse(const AMode : TParserMode); typeCursor := CreateCursorOn(typeCursor,ParseFilter(s,TDOMNodeRttiExposer)); typeCursor.Reset(); if typeCursor.MoveNext() then begin - c := FSymbols.Count; + typeList := FSymbols.CurrentModule.InterfaceSection.Declarations; + c := typeList.Count; i := 0; while ( i < c ) do begin - sym := FSymbols[i]; - if ( sym is TForwardTypeDefinition ) then begin + sym := TPasElement(typeList[i]); + if sym.InheritsFrom(TPasUnresolvedTypeRef) then begin typeCursor.Reset(); - tmpNode := FindNamedNode(typeCursor,sym.ExternalName); + tmpNode := FindNamedNode(typeCursor,FSymbols.GetExternalName(sym)); if Assigned(tmpNode) then begin - ParseType(sym.ExternalName,ExtractNameFromQName(tmpNode.NodeName)); - Dec(i); - c := FSymbols.Count; + symNew := ParseType(FSymbols.GetExternalName(sym),ExtractNameFromQName(tmpNode.NodeName)); + if ( sym <> symNew ) then begin + FModule.InterfaceSection.Declarations.Extract(sym); + FModule.InterfaceSection.Types.Extract(sym); + TPasEmentCrack(symNew).SetName(sym.Name); + GetLogger().Log(mtInfo,'forward type paring %s = %s',[sym.Name, symNew.Name]); + //sym.Release(); + end; + i := 0; //Dec(i); + c := typeList.Count; end else begin - WriteLn('XXXXXXXXXXXXXX = ',sym.Name); + DoOnMessage(mtInfo, 'unable to find the node of this type : ' + sym.Name); end; end; Inc(i); @@ -1253,7 +1424,7 @@ procedure TWsdlParser.Parse(const AMode : TParserMode); if tmpCrs.MoveNext() then begin s := (tmpCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue; if not IsStrEmpty(s) then begin - FSymbols.RegisterExternalAlias(s); + FSymbols.RegisterExternalAlias(FSymbols.CurrentModule,s); end; end; end; @@ -1263,7 +1434,7 @@ var locSrvcCrs : IObjectCursor; locObj : TDOMNodeRttiExposer; begin - Prepare(); + Prepare(AModuleName); locSrvcCrs := FServiceCursor.Clone() as IObjectCursor; locSrvcCrs.Reset(); @@ -1277,6 +1448,7 @@ begin end; ParseForwardDeclarations(); ExtractNameSpace(); + SymbolTable.SetCurrentModule(FModule); end; { TAbstractTypeParser } @@ -1284,7 +1456,7 @@ end; constructor TAbstractTypeParser.Create( AOwner : TWsdlParser; ATypeNode : TDOMNode; - ASymbols : TSymbolTable; + ASymbols : TwstPasTreeContainer; const ATypeName : string; const AEmbededDef : Boolean ); @@ -1302,9 +1474,9 @@ end; class function TAbstractTypeParser.ExtractEmbeddedTypeFromElement( AOwner : TWsdlParser; AEltNode : TDOMNode; - ASymbols : TSymbolTable; + ASymbols : TwstPasTreeContainer; const ATypeName : string -): TTypeDefinition; +): TPasType; function ExtractTypeName() : string; var @@ -1464,7 +1636,7 @@ end; procedure TComplexTypeParser.ExtractBaseType(); var locContentChildCrs, locCrs : IObjectCursor; - locSymbol : TAbstractSymbolDefinition; + locSymbol : TPasElement; locBaseTypeName, locBaseTypeInternalName, locFilterStr : string; begin locFilterStr := CreateQualifiedNameFilterStr(s_extension,FOwner.FXSShortNames); @@ -1501,16 +1673,16 @@ begin if not locCrs.MoveNext() then raise EWslParserException.CreateFmt('Invalid extention/restriction of type "%s" : "base" attribute not found.',[FTypeName]); locBaseTypeName := ExtractNameFromQName((locCrs.GetCurrent() as TDOMNodeRttiExposer).NodeValue); - locSymbol := FSymbols.Find(locBaseTypeName); + locSymbol := FSymbols.FindElement(locBaseTypeName); if Assigned(locSymbol) then begin - if locSymbol.InheritsFrom(TTypeDefinition) then begin - FBaseType := locSymbol as TTypeDefinition; - while Assigned(FBaseType) and FBaseType.InheritsFrom(TTypeAliasDefinition) do begin - FBaseType := (FBaseType as TTypeAliasDefinition).BaseType; + if locSymbol.InheritsFrom(TPasType) then begin + FBaseType := locSymbol as TPasType; + while Assigned(FBaseType) and FBaseType.InheritsFrom(TPasAliasType) do begin + FBaseType := (FBaseType as TPasAliasType).DestType; end; - if FBaseType.InheritsFrom(TNativeSimpleTypeDefinition) then begin - Assert(Assigned(TNativeSimpleTypeDefinition(FBaseType).BoxedType)); - FBaseType := TNativeSimpleTypeDefinition(FBaseType).BoxedType; + if FBaseType.InheritsFrom(TPasNativeSimpleType) then begin + Assert(Assigned(TPasNativeSimpleType(FBaseType).BoxedType)); + FBaseType := TPasNativeSimpleType(FBaseType).BoxedType; end; end else begin raise EWslParserException.CreateFmt('"%s" was expected to be a type definition.',[locSymbol.Name]); @@ -1519,15 +1691,16 @@ begin locBaseTypeInternalName := ExtractIdentifier(locBaseTypeName); if IsReservedKeyWord(locBaseTypeInternalName) then locBaseTypeInternalName := '_' + locBaseTypeInternalName ; - FBaseType := TForwardTypeDefinition.Create(locBaseTypeInternalName); + FBaseType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locBaseTypeInternalName,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0)); + FSymbols.CurrentModule.InterfaceSection.Declarations.Add(FBaseType); + FSymbols.CurrentModule.InterfaceSection.Types.Add(FBaseType); if not AnsiSameText(locBaseTypeInternalName,locBaseTypeName) then - FBaseType.RegisterExternalAlias(locBaseTypeName); - FSymbols.Add(FBaseType); + FSymbols.RegisterExternalAlias(FBaseType,locBaseTypeName); end; end; end; -function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TTypeDefinition; +function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TPasType; function ExtractElementCursor(out AAttCursor : IObjectCursor):IObjectCursor; var @@ -1586,7 +1759,7 @@ function TComplexTypeParser.ParseComplexContent(const ATypeName : string) : TTyp end; var - classDef : TClassTypeDefinition; + classDef : TPasClassType; isArrayDef : Boolean; arrayItems : TObjectList; @@ -1594,9 +1767,9 @@ var var locAttCursor, locPartCursor : IObjectCursor; locName, locTypeName, locTypeInternalName : string; - locType : TAbstractSymbolDefinition; + locType : TPasElement; locInternalEltName : string; - locProp : TPropertyDefinition; + locProp : TPasProperty; locHasInternalName : Boolean; locMinOccur, locMaxOccur : Integer; locMaxOccurUnbounded : Boolean; @@ -1636,30 +1809,36 @@ var if ( locType = nil ) then begin raise EWslParserException.CreateFmt('Invalid definition : unable to determine the type.'#13'Type name : "%s"; Element name :"%s".',[FTypeName,locName]); end; - FSymbols.Add(locType); + FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locType); + FSymbols.CurrentModule.InterfaceSection.Types.Add(locType); + if locType.InheritsFrom(TPasClassType) then begin + FSymbols.CurrentModule.InterfaceSection.Classes.Add(locType); + end; end; end; if IsStrEmpty(locTypeName) then raise EWslParserException.Create('Invalid definition : empty "type".'); - locType := FSymbols.Find(locTypeName); + locType := FSymbols.FindElement(locTypeName); if Assigned(locType) then begin if locIsRefElement then begin locTypeInternalName := locTypeName; locTypeInternalName := locTypeInternalName + '_Type'; - TTypeDefinitionCrack(locType).SetName(locTypeInternalName); + TPasEmentCrack(locType).SetName(locTypeInternalName); + FSymbols.RegisterExternalAlias(locType,locTypeName); end; end else begin locTypeInternalName := locTypeName; - if locIsRefElement then begin + if locIsRefElement or AnsiSameText(locInternalEltName,locInternalEltName) then begin locTypeInternalName := locTypeInternalName + '_Type'; end; if IsReservedKeyWord(locTypeInternalName) then begin locTypeInternalName := '_' + locTypeInternalName; end; - locType := TForwardTypeDefinition.Create(locTypeInternalName); + locType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locTypeInternalName,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0)); + FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locType); + FSymbols.CurrentModule.InterfaceSection.Types.Add(locType); if not AnsiSameText(locTypeInternalName,locTypeName) then - locType.RegisterExternalAlias(locTypeName); - FSymbols.Add(locType); + FSymbols.RegisterExternalAlias(locType,locTypeName); end; locInternalEltName := locName; @@ -1667,9 +1846,16 @@ var if locHasInternalName then locInternalEltName := Format('_%s',[locInternalEltName]); - locProp := classDef.AddProperty(locInternalEltName,locType as TTypeDefinition); + locProp := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,classDef,visPublished,'',0)); + classDef.Members.Add(locProp); + locProp.VarType := locType as TPasType; + locType.AddRef(); if locHasInternalName then - locProp.RegisterExternalAlias(locName); + FSymbols.RegisterExternalAlias(locProp,locName); + {if AnsiSameText(locType.Name,locProp.Name) then begin + FSymbols.RegisterExternalAlias(locType,FSymbols.GetExternalName(locType)); + TPasEmentCrack(locType).SetName(locType.Name + '_Type'); + end;} locMinOccur := 1; locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_minOccurs)]),TDOMNodeRttiExposer)); @@ -1680,8 +1866,13 @@ var if ( locMinOccur < 0 ) then raise EWslParserException.CreateFmt('Invalid "minOccurs" value : "%s.%s".',[FTypeName,locName]); end; - if ( locMinOccur = 0 ) then - locProp.StorageOption := soOptional; + locProp.ReadAccessorName := 'F' + locProp.Name; + locProp.WriteAccessorName := 'F' + locProp.Name; + if ( locMinOccur = 0 ) then begin + locProp.StoredAccessorName := 'Has' + locProp.Name; + end else begin + locProp.StoredAccessorName := 'True'; + end; locMaxOccur := 1; locMaxOccurUnbounded := False; @@ -1703,7 +1894,7 @@ var arrayItems.Add(locProp); end; if AnsiSameText(s_attribute,ExtractNameFromQName(AElement.NodeName)) then begin - locProp.IsAttribute := True; + FSymbols.SetPropertyAsAttribute(locProp,True); end; end; @@ -1712,36 +1903,36 @@ var AArrayPropList : TObjectList ); var - locPropTyp : TPropertyDefinition; + locPropTyp : TPasProperty; k : Integer; locString : string; - locSym : TAbstractSymbolDefinition; + locSym : TPasElement; begin for k := 0 to Pred(AArrayPropList.Count) do begin - locPropTyp := AArrayPropList[k] as TPropertyDefinition; + locPropTyp := AArrayPropList[k] as TPasProperty; locString := Format('%s_%sArray',[AClassName,locPropTyp.Name]); - locSym := FSymbols.Find(locString); + locSym := FSymbols.FindElement(locString); if ( locSym = nil ) then begin - FSymbols.Add( - TArrayDefinition.Create( - locString, - locPropTyp.DataType, - locPropTyp.Name, - locPropTyp.ExternalName, - asEmbeded - ) + locSym := FSymbols.CreateArray( + locString, + locPropTyp.VarType, + locPropTyp.Name, + FSymbols.GetExternalName(locPropTyp), + asEmbeded ); + FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locSym); + FSymbols.CurrentModule.InterfaceSection.Types.Add(locSym); end; end; end; - function ExtractSoapArray(const AInternalName : string; const AHasInternalName : Boolean) : TArrayDefinition; + function ExtractSoapArray(const AInternalName : string; const AHasInternalName : Boolean) : TPasArrayType; var ls : TStringList; crs, locCrs : IObjectCursor; s : string; i : Integer; - locSym : TAbstractSymbolDefinition; + locSym : TPasElement; ok : Boolean; nd : TDOMNode; begin @@ -1787,25 +1978,26 @@ var i := MaxInt; end; s := Copy(s,1,Pred(i)); - locSym := FSymbols.Find(s); + locSym := FSymbols.FindElement(s); if not Assigned(locSym) then begin - locSym := TForwardTypeDefinition.Create(s); - FSymbols.Add(locSym); + locSym := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,s,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0)); + FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locSym); + FSymbols.CurrentModule.InterfaceSection.Types.Add(locSym); end; - if not locSym.InheritsFrom(TTypeDefinition) then + if not locSym.InheritsFrom(TPasType) then raise EWslParserException.CreateFmt('Invalid array type definition, invalid item type definition : "%s".',[FTypeName]); - Result := TArrayDefinition.Create(AInternalName,locSym as TTypeDefinition,s_item,s_item,asScoped); + Result := FSymbols.CreateArray(AInternalName,locSym as TPasType,s_item,s_item,asScoped); if AHasInternalName then - Result.RegisterExternalAlias(ATypeName); + FSymbols.RegisterExternalAlias(Result,ATypeName); end; var eltCrs, eltAttCrs : IObjectCursor; internalName : string; hasInternalName : Boolean; - arrayDef : TArrayDefinition; - propTyp, tmpPropTyp : TPropertyDefinition; - tmpClassDef : TClassTypeDefinition; + arrayDef : TPasArrayType; + propTyp, tmpPropTyp : TPasProperty; + tmpClassDef : TPasClassType; i : Integer; begin ExtractBaseType(); @@ -1820,24 +2012,23 @@ begin internalName := Format('_%s',[internalName]); end; - if ( FDerivationMode = dmRestriction ) and FBaseType.SameName(s_array) then begin + if ( FDerivationMode = dmRestriction ) and FSymbols.SameName(FBaseType,s_array) then begin Result := ExtractSoapArray(internalName,hasInternalName); end else begin arrayItems := TObjectList.Create(False); try - classDef := TClassTypeDefinition.Create(internalName); + classDef := TPasClassType(FSymbols.CreateElement(TPasClassType,internalName,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0)); try + classDef.ObjKind := okClass; Result := classDef; if hasInternalName then - classDef.RegisterExternalAlias(ATypeName); + FSymbols.RegisterExternalAlias(classDef,ATypeName); if ( FDerivationMode in [dmExtension, dmRestriction] ) then begin - classDef.SetParent(FBaseType); + classDef.AncestorType := FBaseType; end; - if ( classDef.Parent = nil ) then - classDef.SetParent( - (FSymbols.ByName('base_service_intf') as TSymbolTable) - .ByName('TBaseComplexRemotable') as TClassTypeDefinition - ); + if ( classDef.AncestorType = nil ) then + classDef.AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType; + classDef.AncestorType.AddRef(); if Assigned(eltCrs) or Assigned(eltAttCrs) then begin isArrayDef := False; if Assigned(eltCrs) then begin @@ -1853,34 +2044,45 @@ begin end; end; if ( arrayItems.Count > 0 ) then begin - if ( arrayItems.Count = 1 ) and ( classDef.PropertyCount = 1 ) then begin + if ( arrayItems.Count = 1 ) and ( GetElementCount(classDef.Members,TPasProperty) = 1 ) then begin Result := nil; - propTyp := arrayItems[0] as TPropertyDefinition; - arrayDef := TArrayDefinition.Create(internalName,propTyp.DataType,propTyp.Name,propTyp.ExternalName,asScoped); + propTyp := arrayItems[0] as TPasProperty; + arrayDef := FSymbols.CreateArray(internalName,propTyp.VarType,propTyp.Name,FSymbols.GetExternalName(propTyp),asScoped); FreeAndNil(classDef); Result := arrayDef; if hasInternalName then - arrayDef.RegisterExternalAlias(ATypeName); + FSymbols.RegisterExternalAlias(arrayDef,ATypeName); end else begin GenerateArrayTypes(internalName,arrayItems); tmpClassDef := classDef; - classDef := TClassTypeDefinition.Create(tmpClassDef.Name); + classDef := TPasClassType(FSymbols.CreateElement(TPasClassType,tmpClassDef.Name,FSymbols.CurrentModule.InterfaceSection,visPublic,'',0)); + classDef.ObjKind := okClass; Result := classDef; - classDef.SetParent(tmpClassDef.Parent); + classDef.AncestorType := tmpClassDef.AncestorType; + classDef.AncestorType.AddRef(); if hasInternalName then - classDef.RegisterExternalAlias(ATypeName); - for i := 0 to Pred(tmpClassDef.PropertyCount) do begin - propTyp := tmpClassDef.Properties[i]; - if ( arrayItems.IndexOf(propTyp) = -1 ) then begin - tmpPropTyp := classDef.AddProperty(propTyp.Name,propTyp.DataType); - tmpPropTyp.IsAttribute := propTyp.IsAttribute; - tmpPropTyp.StorageOption := propTyp.StorageOption; - tmpPropTyp.RegisterExternalAlias(propTyp.ExternalName); - end else begin - classDef.AddProperty( - propTyp.Name, - FSymbols.ByName(Format('%s_%sArray',[internalName,propTyp.Name])) as TTypeDefinition - ).RegisterExternalAlias(propTyp.ExternalName); + FSymbols.RegisterExternalAlias(classDef,ATypeName); + for i := 0 to Pred(tmpClassDef.Members.Count) do begin + if TPasElement(tmpClassDef.Members[i]).InheritsFrom(TPasProperty) then begin + propTyp := TPasProperty(tmpClassDef.Members[i]); + if ( arrayItems.IndexOf(propTyp) = -1 ) then begin + tmpPropTyp := TPasProperty(FSymbols.CreateElement(TPasProperty,propTyp.Name,classDef,visPublished,'',0)); + if FSymbols.IsAttributeProperty(propTyp) then begin + FSymbols.SetPropertyAsAttribute(tmpPropTyp,True); + end; + tmpPropTyp.VarType := propTyp.VarType; + tmpPropTyp.VarType.AddRef(); + tmpPropTyp.StoredAccessorName := propTyp.StoredAccessorName; + FSymbols.RegisterExternalAlias(tmpPropTyp,FSymbols.GetExternalName(propTyp)); + classDef.Members.Add(tmpPropTyp); + end else begin + tmpPropTyp := TPasProperty(FSymbols.CreateElement(TPasProperty,propTyp.Name,classDef,visPublished,'',0)); + tmpPropTyp.StoredAccessorName := propTyp.StoredAccessorName; + tmpPropTyp.VarType := FSymbols.FindElement(Format('%s_%sArray',[internalName,propTyp.Name])) as TPasType; + tmpPropTyp.VarType.AddRef(); + FSymbols.RegisterExternalAlias(tmpPropTyp,FSymbols.GetExternalName(propTyp)); + classDef.Members.Add(tmpPropTyp); + end; end; end; FreeAndNil(tmpClassDef); @@ -1897,7 +2099,7 @@ begin end; end; -function TComplexTypeParser.ParseSimpleContent(const ATypeName : string) : TTypeDefinition; +function TComplexTypeParser.ParseSimpleContent(const ATypeName : string) : TPasType; function ExtractAttributeCursor():IObjectCursor; var @@ -1932,15 +2134,15 @@ function TComplexTypeParser.ParseSimpleContent(const ATypeName : string) : TType end; var - locClassDef : TClassTypeDefinition; + locClassDef : TPasClassType; procedure ParseAttribute(AElement : TDOMNode); var locAttCursor, locPartCursor : IObjectCursor; locName, locTypeName, locStoreOpt : string; - locType : TAbstractSymbolDefinition; + locType : TPasElement; locStoreOptIdx : Integer; - locAttObj : TPropertyDefinition; + locAttObj : TPasProperty; locInternalEltName : string; locHasInternalName : boolean; begin @@ -1960,10 +2162,11 @@ var locTypeName := ExtractNameFromQName((locPartCursor.GetCurrent() as TDOMNodeRttiExposer).NodeValue); if IsStrEmpty(locTypeName) then raise EWslParserException.CreateFmt('Invalid <%s> definition : empty "type".',[s_attribute]); - locType := FSymbols.Find(locTypeName); + locType := FSymbols.FindElement(locTypeName) as TPasType; if not Assigned(locType) then begin - locType := TForwardTypeDefinition.Create(locTypeName); - FSymbols.Add(locType); + locType := TPasUnresolvedTypeRef(FSymbols.CreateElement(TPasUnresolvedTypeRef,locTypeName,FSymbols.CurrentModule.InterfaceSection,visPublic,'',0)); + FSymbols.CurrentModule.InterfaceSection.Declarations.Add(locType); + FSymbols.CurrentModule.InterfaceSection.Types.Add(locType); end; locPartCursor := CreateCursorOn(locAttCursor.Clone() as IObjectCursor,ParseFilter(Format('%s = %s',[s_NODE_NAME,QuotedStr(s_use)]),TDOMNodeRttiExposer)); @@ -1973,7 +2176,7 @@ var if IsStrEmpty(locStoreOpt) then raise EWslParserException.CreateFmt('Invalid <%s> definition : empty "use".',[s_attribute]); locStoreOptIdx := AnsiIndexText(locStoreOpt,[s_required,s_optional,s_prohibited]); - if ( locStoreOptIdx < Ord(Low(TStorageOption)) ) or ( locStoreOptIdx > Ord(High(TStorageOption)) ) then + if ( locStoreOptIdx < 0 ) then raise EWslParserException.CreateFmt('Invalid <%s> definition : invalid "use" value "%s".',[s_attribute,locStoreOpt]); end else begin locStoreOptIdx := 0; @@ -1984,11 +2187,18 @@ var if locHasInternalName then locInternalEltName := Format('_%s',[locInternalEltName]); - locAttObj := locClassDef.AddProperty(locInternalEltName,locType as TTypeDefinition); + locAttObj := TPasProperty(FSymbols.CreateElement(TPasProperty,locInternalEltName,locClassDef,visPublished,'',0)); + locClassDef.Members.Add(locAttObj); + locAttObj.VarType := locType as TPasType; + locAttObj.VarType.AddRef(); if locHasInternalName then - locAttObj.RegisterExternalAlias(locName); - locAttObj.IsAttribute := True; - locAttObj.StorageOption := TStorageOption(locStoreOptIdx); + FSymbols.RegisterExternalAlias(locAttObj,locName); + FSymbols.SetPropertyAsAttribute(locAttObj,True); + case locStoreOptIdx of + 0 : locAttObj.StoredAccessorName := 'True'; + 1 : locAttObj.StoredAccessorName := 'Has' + locAttObj.Name; + 2 : locAttObj.StoredAccessorName := 'False'; + end; end; var @@ -2008,20 +2218,19 @@ begin internalName := Format('_%s',[internalName]); locAttCrs := ExtractAttributeCursor(); - locClassDef := TClassTypeDefinition.Create(Trim(internalName)); + locClassDef := TPasClassType(FSymbols.CreateElement(TPasClassType,Trim(internalName),FSymbols.CurrentModule.InterfaceSection,visDefault,'',0)); try + locClassDef.ObjKind := okClass; Result := locClassDef; if hasInternalName then - locClassDef.RegisterExternalAlias(ATypeName); + FSymbols.RegisterExternalAlias(locClassDef,ATypeName); if ( FDerivationMode in [dmExtension, dmRestriction] ) then begin - locClassDef.SetParent(FBaseType); + locClassDef.AncestorType := FBaseType; end; - if ( locClassDef.Parent = nil ) then begin - locClassDef.SetParent( - (FSymbols.ByName('base_service_intf') as TSymbolTable) - .ByName('TBaseComplexRemotable') as TClassTypeDefinition - ); + if ( locClassDef.AncestorType = nil ) then begin + locClassDef.AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType; end; + locClassDef.AncestorType.AddRef(); if ( locAttCrs <> nil ) then begin locAttCrs.Reset(); while locAttCrs.MoveNext() do begin @@ -2034,7 +2243,7 @@ begin end; end; -function TComplexTypeParser.ParseEmptyContent(const ATypeName: string): TTypeDefinition; +function TComplexTypeParser.ParseEmptyContent(const ATypeName: string): TPasType; var internalName : string; hasInternalName : Boolean; @@ -2045,13 +2254,12 @@ begin ( FSymbols.IndexOf(internalName) <> -1 );} if hasInternalName then internalName := Format('_%s',[internalName]); - Result := TClassTypeDefinition.Create(internalName); + Result := TPasClassType(FSymbols.CreateElement(TPasClassType,internalName,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0)); + TPasClassType(Result).ObjKind := okClass; if hasInternalName then - Result.RegisterExternalAlias(ATypeName); - TClassTypeDefinition(Result).SetParent( - (FSymbols.ByName('base_service_intf') as TSymbolTable) - .ByName('TBaseComplexRemotable') as TClassTypeDefinition - ); + FSymbols.RegisterExternalAlias(Result,ATypeName); + TPasClassType(Result).AncestorType := FSymbols.FindElementInModule('TBaseComplexRemotable',FSymbols.FindModule('base_service_intf') as TPasModule) as TPasType; + TPasClassType(Result).AncestorType.AddRef(); end; class function TComplexTypeParser.GetParserSupportedStyle(): string; @@ -2059,9 +2267,9 @@ begin Result := s_complexType; end; -function TComplexTypeParser.Parse() : TTypeDefinition; +function TComplexTypeParser.Parse() : TPasType; var - locSym : TAbstractSymbolDefinition; + locSym : TPasElement; locContinue : Boolean; begin if not AnsiSameText(ExtractNameFromQName(FTypeNode.NodeName),s_complexType) then @@ -2069,13 +2277,13 @@ begin CreateNodeCursors(); ExtractTypeName(); locContinue := True; - locSym := FSymbols.Find(FTypeName); + locSym := FSymbols.FindElement(FTypeName); if Assigned(locSym) then begin - if not locSym.InheritsFrom(TTypeDefinition) then + if not locSym.InheritsFrom(TPasType) then raise EWslParserException.CreateFmt('Symbol found in the symbol table but is not a type definition : %s.',[FTypeName]); - locContinue := locSym.InheritsFrom(TForwardTypeDefinition); + locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef); if not locContinue then; - Result := locSym as TTypeDefinition; + Result := locSym as TPasType; end; if locContinue then begin ExtractContentType(); @@ -2167,7 +2375,7 @@ begin end; end; -function TSimpleTypeParser.ParseEnumContent(): TTypeDefinition; +function TSimpleTypeParser.ParseEnumContent(): TPasType; function ExtractEnumCursor():IObjectCursor ; begin @@ -2178,7 +2386,7 @@ function TSimpleTypeParser.ParseEnumContent(): TTypeDefinition; end; var - locRes : TEnumTypeDefinition; + locRes : TPasEnumType; locOrder : Integer; procedure ParseEnumItem(AItemNode : TDOMNode); @@ -2186,7 +2394,7 @@ var tmpNode : TDOMNode; locItemName, locInternalItemName : string; locCrs : IObjectCursor; - locItem : TEnumItemDefinition; + locItem : TPasEnumValue; locHasInternalName : Boolean; locBuffer : string; begin @@ -2204,21 +2412,23 @@ var locInternalItemName := ExtractIdentifier(locItemName); locHasInternalName := IsReservedKeyWord(locInternalItemName) or ( not IsValidIdent(locInternalItemName) ) or - ( FSymbols.IndexOf(locInternalItemName) <> -1 ) or + ( FSymbols.FindElementInModule(locInternalItemName,FSymbols.CurrentModule) <> nil ) or + FSymbols.IsEnumItemNameUsed(locInternalItemName) or ( not AnsiSameText(locInternalItemName,locItemName) ); if locHasInternalName then begin - locBuffer := ExtractIdentifier(locRes.ExternalName); - if IsStrEmpty(locBuffer) and ( locBuffer[Length(locBuffer)] <> '_' ) then begin + locBuffer := ExtractIdentifier(FSymbols.GetExternalName(locRes)); + if ( not IsStrEmpty(locBuffer) ) and ( locBuffer[Length(locBuffer)] <> '_' ) then begin locInternalItemName := Format('%s_%s',[locBuffer,locInternalItemName]); end else begin locInternalItemName := Format('%s%s',[locBuffer,locInternalItemName]); end; end; - locItem := TEnumItemDefinition.Create(locInternalItemName,locRes,locOrder); + locItem := TPasEnumValue(FSymbols.CreateElement(TPasEnumValue,locInternalItemName,locRes,visDefault,'',0)); + locItem.Value := locOrder; + locRes.Values.Add(locItem); + //locItem := TEnumItemDefinition.Create(locInternalItemName,locRes,locOrder); if locHasInternalName then - locItem.RegisterExternalAlias(locItemName); - FSymbols.Add(locItem); - locRes.AddItem(locItem); + FSymbols.RegisterExternalAlias(locItem,locItemName); Inc(locOrder); end; @@ -2231,15 +2441,15 @@ begin intrName := FTypeName; hasIntrnName := IsReservedKeyWord(FTypeName) or - ( ( FSymbols.IndexOf(intrName) >= 0 ) and ( not FSymbols.ByName(intrName).InheritsFrom(TForwardTypeDefinition) ) ); + ( ( FSymbols.FindElement(intrName) <> nil ) and ( not FSymbols.FindElement(intrName).InheritsFrom(TPasUnresolvedTypeRef) ) ); if hasIntrnName then intrName := '_' + intrName; - locRes := TEnumTypeDefinition.Create(Trim(intrName)); + locRes := TPasEnumType(FSymbols.CreateElement(TPasEnumType,Trim(intrName),FSymbols.CurrentModule.InterfaceSection,visDefault,'',0)); try Result := locRes; if hasIntrnName then - locRes.RegisterExternalAlias(FTypeName); + FSymbols.RegisterExternalAlias(locRes,FTypeName); locEnumCrs.Reset(); locOrder := 0; while locEnumCrs.MoveNext() do begin @@ -2251,11 +2461,13 @@ begin end; end; -function TSimpleTypeParser.ParseOtherContent(): TTypeDefinition; +function TSimpleTypeParser.ParseOtherContent(): TPasType; begin // todo : implement TSimpleTypeParser.ParseOtherContent if IsStrEmpty(FBaseName) then raise EWslParserException.CreateFmt('Invalid simple type definition : base type not provided, "%s".',[FTypeName]); - Result := TTypeAliasDefinition.Create(FTypeName,FSymbols.ByName(FBaseName) as TTypeDefinition); + Result := TPasTypeAliasType(FSymbols.CreateElement(TPasTypeAliasType,FTypeName,FSymbols.CurrentModule.InterfaceSection,visDefault,'',0)); + TPasTypeAliasType(Result).DestType := FSymbols.FindElement(FBaseName) as TPasType; + TPasTypeAliasType(Result).DestType.AddRef(); end; class function TSimpleTypeParser.GetParserSupportedStyle(): string; @@ -2263,9 +2475,9 @@ begin Result := s_simpleType; end; -function TSimpleTypeParser.Parse(): TTypeDefinition; +function TSimpleTypeParser.Parse(): TPasType; var - locSym : TAbstractSymbolDefinition; + locSym : TPasElement; locContinue : Boolean; begin if not AnsiSameText(ExtractNameFromQName(FTypeNode.NodeName),s_simpleType) then @@ -2273,13 +2485,13 @@ begin CreateNodeCursors(); ExtractTypeName(); locContinue := True; - locSym := FSymbols.Find(FTypeName); + locSym := FSymbols.FindElement(FTypeName); if Assigned(locSym) then begin - if not locSym.InheritsFrom(TTypeDefinition) then + if not locSym.InheritsFrom(TPasType) then raise EWslParserException.CreateFmt('Symbol found in the symbol table but is not a type definition : %s.',[FTypeName]); - locContinue := locSym.InheritsFrom(TForwardTypeDefinition); + locContinue := locSym.InheritsFrom(TPasUnresolvedTypeRef); if not locContinue then begin - Result := locSym as TTypeDefinition; + Result := locSym as TPasType; end; end; if locContinue then begin diff --git a/wst/trunk/ws_helper/wst_resources_utils.pas b/wst/trunk/ws_helper/wst_resources_utils.pas index f429336ca..9763e023e 100644 --- a/wst/trunk/ws_helper/wst_resources_utils.pas +++ b/wst/trunk/ws_helper/wst_resources_utils.pas @@ -21,7 +21,7 @@ procedure BinToWstRessource( AWstRstream : TStream ); const MAX_LINE_LEN = 80; READ_LEN = 1024; WRITE_LEN = 1024; -type TWritingState = ( wsBegin, wsInString, wsOutString); +type TWritingState = ( wsBegin, wsInString, wsOutString ); var locInBuffer, locOutBuffer : string; locInBufferLen, locOutBufferLen, locLineLen, locInIdx : Integer; diff --git a/wst/trunk/wst_rtti_filter/cursor_intf.pas b/wst/trunk/wst_rtti_filter/cursor_intf.pas index 51e9240d7..eea76cb18 100644 --- a/wst/trunk/wst_rtti_filter/cursor_intf.pas +++ b/wst/trunk/wst_rtti_filter/cursor_intf.pas @@ -39,20 +39,6 @@ type AInputCursor : IObjectCursor; AFilter : IObjectFilter ) : IFilterableObjectCursor ; - - - (* - ['{4E3C49EE-5EA6-47CD-8862-3AA4F96BD86E}'] - ['{65D250B6-90AC-40DC-A6EE-4750188D1D94}'] - ['{8B4AE228-C231-45E5-B8A4-2864481B9263}'] - ['{658709D2-2D25-44DB-83CF-DC430D55A21F}'] - ['{B2CFB744-43CF-4787-8256-A0F34E26A729}'] - ['{D3A4A37A-B63A-42AD-8E44-4AD4C28E3C34}'] - ['{DB7A8303-0621-41A0-A948-A7BD71CA99F8}'] - ['{3BB114EB-73CF-4555-ABC7-ABA4A643DBDA}'] - ['{C64B6235-54BE-4DA9-A5E8-D67B579FA14F}'] - - *) implementation diff --git a/wst/trunk/wst_rtti_filter/rtti_filters.pas b/wst/trunk/wst_rtti_filter/rtti_filters.pas index fd7166ede..ae70ced70 100644 --- a/wst/trunk/wst_rtti_filter/rtti_filters.pas +++ b/wst/trunk/wst_rtti_filter/rtti_filters.pas @@ -324,6 +324,7 @@ begin prsr.NextToken(); end; finally + FreeAndNil(prsr); FreeAndNil(strm); end; end;