htdump.pp 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185
  1. // $Id$
  2. {
  3. This program takes an W3 IDL XML file with interface definitions and
  4. dumps a interface definition.
  5. }
  6. {$MODE objfpc}
  7. {$H+}
  8. program htdump;
  9. uses sysutils, DOM, xmlread;
  10. Var DoImplementation : Boolean;
  11. procedure DumpNode(node: TDOMNode; spc: String);forward;
  12. procedure DumpMethodNode(node: TDOMElement; spc: String);
  13. var N,NN : TDOMNode;
  14. rettype : DOMString;
  15. firstparam : boolean;
  16. i : longint;
  17. begin
  18. N:=Node.FindNode('returns');
  19. If N<>Nil then
  20. rettype:=TDomElement(N).GetAttribute('type');
  21. If Not DoImplementation then
  22. Write (spc);
  23. If RetType='void' then
  24. Write ('Procedure ')
  25. else
  26. Write ('Function ');
  27. If DoImplementation then
  28. Write(TDomElement(Node.ParentNode).GetAttribute('name'),'.');
  29. Write (Node.GetAttribute('name'));
  30. N:=Node.FindNode('params');
  31. If N<>Nil then
  32. begin
  33. FirstParam:=True;
  34. for I:=1 to N.ChildNodes.Count-1 do
  35. begin
  36. NN:=N.ChildNodes.Item[i];
  37. If NN.NodeName<>'param' then
  38. begin
  39. If Firstparam then
  40. begin
  41. Write('(');
  42. FirstParam:=False
  43. end
  44. else
  45. Write(';');
  46. writeln (spc,NN.NodeName,' : ',TDOMElement(NN).GetAttribute('type'));
  47. end;
  48. end;
  49. If Not FirstParam then
  50. Write (')');
  51. end;
  52. If RetType <>'void' then
  53. Write (' : ',Rettype);
  54. Writeln(';');
  55. If DoImplementation then
  56. begin
  57. Writeln;
  58. Writeln('Begin');
  59. Writeln('End;');
  60. Writeln;
  61. Writeln;
  62. end;
  63. end;
  64. procedure DumpAttributeNode(Doprivate: Boolean;node: TDOMElement; spc: String);
  65. Var PropName : DOMString;
  66. begin
  67. PropName:=Node.GetAttribute('name');
  68. If DOPrivate then
  69. Write (spc,'F')
  70. else
  71. Write (spc,'Property ');
  72. Write (PropName,' : ',Node.getAttribute('type'));
  73. If Not DoPrivate then
  74. begin
  75. Write (' Read F',PropName);
  76. If not(Node.getAttribute('readonly')='yes') then
  77. Write (' Write F',PropName)
  78. end;
  79. Writeln(';');
  80. end;
  81. Procedure DumpInterfaceNode (node : TDomElement; spc : String);
  82. Var N : TDOMNode;
  83. C : TDOMNodeList;
  84. I : longint;
  85. begin
  86. If not DoImplementation then
  87. begin
  88. Write(spc,Node.GetAttribute('name'),' = Class');
  89. N:=Node.Attributes.GetNamedItem('inherits');
  90. If N<>Nil then
  91. Write('(',N.NodeValue,')');
  92. Writeln;
  93. // Dump Property fields
  94. Writeln (Spc+' Private');
  95. N:=Node.FirstChild;
  96. While N<>Nil do
  97. begin
  98. If N.NodeName='attribute' then
  99. DumpAttributeNode(True,TDOMElement(N), spc + ' ');
  100. N:=N.NextSibling;
  101. end;
  102. Writeln (Spc,' Public');
  103. end;
  104. N:=Node.FirstChild;
  105. While N<>Nil do
  106. begin
  107. If N.NodeName='method' then
  108. DumpMethodNode(TDomElement(N), spc + ' ');
  109. N:=N.NextSibling;
  110. end;
  111. If Not DoImplementation then
  112. begin
  113. N:=Node.FirstChild;
  114. While N<>Nil do
  115. begin
  116. If N.NodeName='attribute' then
  117. DumpAttributeNode(False,TDomElement(N), spc + ' ');
  118. N:=N.NextSibling;
  119. end;
  120. writeln (spc,'End;')
  121. end;
  122. end;
  123. procedure DumpNode(node: TDOMNode; spc: String);
  124. var
  125. i: Integer;
  126. attr: TDOMNode;
  127. begin
  128. If Node.NodeName='interface' then
  129. DumpInterfaceNode(TDOMElement(Node),Spc)
  130. else if Node.NodeName='method' then
  131. DumpMethodNode(TDOMELEMENt(Node),Spc)
  132. else if Node.NodeName='attribute' then
  133. DumpAttributeNode(True,TDomelement(node),spc)
  134. else
  135. if node.FirstChild <> nil then
  136. DumpNode(node.FirstChild, spc + ' ');
  137. if node.NextSibling <> nil then
  138. DumpNode(node.NextSibling, spc);
  139. end;
  140. var
  141. i : longint;
  142. xml: TXMLDocument;
  143. begin
  144. if (ParamCount <1) or (paramcount>2) then begin
  145. WriteLn('htdump -m <xml>');
  146. exit;
  147. end;
  148. I:=1;
  149. If paramstr(1)='-m' then
  150. begin
  151. I:=2;
  152. DoImplementation:=True;
  153. end;
  154. ReadXMLFile(xml, ParamStr(i));
  155. WriteLn ('// Created From file ',paramstr(I));
  156. DumpNode(xml, '');
  157. end.
  158. {
  159. $Log$
  160. Revision 1.2 2000-07-13 11:33:04 michael
  161. + removed logs
  162. }