/components/jcf2/Process/Nesting.pas

http://github.com/graemeg/lazarus · Pascal · 160 lines · 85 code · 27 blank · 48 comment · 6 complexity · c214d4b2cc677a2175086f471fef1091 MD5 · raw file

  1. unit Nesting;
  2. {(*}
  3. (*------------------------------------------------------------------------------
  4. Delphi Code formatter source code
  5. The Original Code is Nesting, released May 2003.
  6. The Initial Developer of the Original Code is Anthony Steele.
  7. Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
  8. All Rights Reserved.
  9. Contributor(s):
  10. Anthony Steele.
  11. Adem Baba
  12. The contents of this file are subject to the Mozilla Public License Version 1.1
  13. (the "License"). you may not use this file except in compliance with the License.
  14. You may obtain a copy of the License at http://www.mozilla.org/NPL/
  15. Software distributed under the License is distributed on an "AS IS" basis,
  16. WITHOUT WARRANTY OF ANY KIND, either express or implied.
  17. See the License for the specific language governing rights and limitations
  18. under the License.
  19. Alternatively, the contents of this file may be used under the terms of
  20. the GNU General Public License Version 2 or later (the "GPL")
  21. See http://www.gnu.org/licenses/gpl.html
  22. ------------------------------------------------------------------------------*)
  23. {*)}
  24. {$I JcfGlobal.inc}
  25. interface
  26. { AFS 10 Jan 2002
  27. This is fairly generic code so it has it's own class
  28. to store on each token nesting level info for a variety of indicators
  29. such as
  30. - begin end block nesting level
  31. - record case nesting level
  32. - case statement, try statment etc.
  33. - procedure nesting level
  34. Easier and faster to set this up once
  35. with a visitor and store it on a leaf node
  36. than the generate it on the fly
  37. }
  38. type
  39. TNestingLevelType = (
  40. nlBlock, // generic code indent
  41. nlCaseSelector,
  42. nlRecordType,
  43. nlRecordVariantSection,
  44. nlProcedure,
  45. nlRoundBracket, nlSquareBracket,
  46. nlStatementLabel);
  47. TNestingLevelList = class(TObject)
  48. private
  49. { store a nesting level for one of the above enums
  50. Adem Baba suggested that an array indexed by enum
  51. would be simpler and faster than a TObjectList }
  52. fiValues: array[TNestingLevelType] of integer;
  53. public
  54. procedure Clear;
  55. procedure Assign(const pcSource: TNestingLevelList);
  56. { clients do not have unrestricted write access to these values
  57. should only increment and dec them,
  58. e.g. nlRoundBracket is incremented on each '(' and decemented on ')' }
  59. procedure IncLevel(const peItemType: TNestingLevelType);
  60. procedure DecLevel(const peItemType: TNestingLevelType);
  61. function GetLevel(const peItemType: TNestingLevelType): integer;
  62. { by the end of the unit, everything opened should have been closed }
  63. function FinalTest: string;
  64. function Total: integer;
  65. end;
  66. implementation
  67. uses SysUtils;
  68. procedure TNestingLevelList.DecLevel(const peItemType: TNestingLevelType);
  69. begin
  70. dec(fiValues[peItemType]);
  71. end;
  72. procedure TNestingLevelList.IncLevel(const peItemType: TNestingLevelType);
  73. begin
  74. inc(fiValues[peItemType]);
  75. end;
  76. function TNestingLevelList.GetLevel(const peItemType: TNestingLevelType): integer;
  77. begin
  78. Result := fiValues[peItemType];
  79. end;
  80. { at the end of it all, all should be back to zero }
  81. function TNestingLevelList.FinalTest: string;
  82. var
  83. leLoop: TNestingLevelType;
  84. begin
  85. Result := '';
  86. for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
  87. begin
  88. if fiValues[leLoop] > 0 then
  89. begin
  90. Result := 'Final nesting level = ' + IntToStr(fiValues[leLoop]);
  91. break;
  92. end;
  93. end;
  94. end;
  95. procedure TNestingLevelList.Assign(const pcSource: TNestingLevelList);
  96. var
  97. leLoop: TNestingLevelType;
  98. begin
  99. if pcSource = nil then
  100. begin
  101. Clear;
  102. end
  103. else
  104. begin
  105. for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
  106. begin
  107. fiValues[leLoop] := pcSource.GetLevel(leLoop);
  108. end;
  109. end;
  110. end;
  111. procedure TNestingLevelList.Clear;
  112. var
  113. leLoop: TNestingLevelType;
  114. begin
  115. for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
  116. fiValues[leLoop] := 0;
  117. end;
  118. function TNestingLevelList.Total: integer;
  119. var
  120. leLoop: TNestingLevelType;
  121. begin
  122. Result := 0;
  123. for leLoop := low(TNestingLevelType) to High(TNestingLevelType) do
  124. begin
  125. Result := Result + fiValues[leLoop];
  126. end;
  127. end;
  128. end.