File: SourceToken.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (290 lines) | stat: -rw-r--r-- 7,531 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
{(*}
(*------------------------------------------------------------------------------
 Delphi Code formatter source code 

The Original Code is Token.pas, released April 2000.
The Initial Developer of the Original Code is Anthony Steele. 
Portions created by Anthony Steele are Copyright (C) 1999-2008 Anthony Steele.
All Rights Reserved. 
Contributor(s): Anthony Steele. 

The contents of this file are subject to the Mozilla Public License Version 1.1
(the "License"). you may not use this file except in compliance with the License.
You may obtain a copy of the License at http://www.mozilla.org/NPL/

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied.
See the License for the specific language governing rights and limitations 
under the License.

Alternatively, the contents of this file may be used under the terms of
the GNU General Public License Version 2 or later (the "GPL") 
See http://www.gnu.org/licenses/gpl.html
------------------------------------------------------------------------------*)
{*)}

unit SourceToken;

{ Created AFS 29 Nov 1999
  Token  - element of source code text }

{$I JcfGlobal.inc}

interface

uses
  { local }
  Tokens, ParseTreeNode;

type

  TSourceToken = class(TParseTreeNode)
  private
    { property implementation }
    fsSourceCode: String;
    feTokenType: TTokenType;
    feWordType: TWordType;
    feCommentStyle: TCommentStyle;

    fsFileName: string;
    fiXPosition, fiYPosition: integer;
    fiSolidTokenOnLineIndex: integer;
    fbPreprocessedOut: boolean;

    fePreprocessorSymbol: TPreProcessorSymbolType;
    fsPreProcessorText: String;

  protected
  public
    constructor Create;

    function Describe: string; override;
    function DescribePosition: string;

    function IsSolid: boolean;
    function SourceLine: string;

    function HasChildNode(const peTokens: TTokenTypeSet): boolean; override;
    function HasChildNode(const peTokens: TTokenTypeSet;
      const {%H-}piMaxDepth: integer): boolean; override;

    function SolidChildCount: integer; override;
    function FirstSolidLeaf: TParseTreeNode; override;
    function IsLeaf: boolean; override;

    { navigating the source tree as if it was a list }
    function NextToken: TSourceToken;
    function PriorToken: TSourceToken;
    function NextSolidToken: TSourceToken;
    function PriorSolidToken: TSourceToken;
    function NextTokenWithExclusions(const peExclusions: TTokenTypeSet): TSourceToken;
    function PriorTokenWithExclusions(const peExclusions: TTokenTypeSet): TSourceToken;

    procedure GeneratePreProcessorData;

    property TokenType: TTokenType Read feTokenType Write feTokenType;
    property WordType: TWordType Read feWordType Write feWordType;

    property SourceCode: String Read fsSourceCode Write fsSourceCode;
    property CommentStyle: TCommentStyle Read feCommentStyle Write feCommentStyle;

    property FileName: string read fsFileName write fsFileName;
    property XPosition: integer Read fiXPosition Write fiXPosition;
    property YPosition: integer Read fiYPosition Write fiYPosition;
    property SolidTokenOnLineIndex: integer
      Read fiSolidTokenOnLineIndex Write fiSolidTokenOnLineIndex;

    property PreprocessorSymbol: TPreProcessorSymbolType Read fePreprocessorSymbol;
    property PreProcessorText: String Read fsPreProcessorText;

    property PreprocessedOut: boolean Read fbPreprocessedOut Write fbPreprocessedOut;
  end;

  TSourceTokenProcedure = procedure(const pt: TSourceToken) of object;

implementation

uses
  { delphi }
  SysUtils;

{-------------------------------------------------------------------------------
 TSourceToken }

constructor TSourceToken.Create;
begin
  inherited;

  feTokenType  := ttUnknown;
  fsSourceCode := '';

  feWordType     := wtNotAWord;
  feCommentStyle := eNotAComment;

  fiXPosition := -1;
  fiYPosition := -1;
  fiSolidTokenOnLineIndex := -1;

  fePreprocessorSymbol := ppNone;
  fsPreProcessorText   := '';
  fbPreprocessedOut    := False;
end;

function TSourceToken.Describe: string;
const
  StructuredTokens: TTokenTypeSet =
    [ttComment, ttNumber, ttQuotedLiteralString, ttUnknown, ttPunctuation, ttIdentifier];
begin
  if TokenType = ttIdentifier then
    Result := SourceCode
  else
  begin
    Result := TokenTypeToString(TokenType);
    if (TokenType in StructuredTokens) then
      Result := Result + ' ' + SourceCode;
  end;
end;

function TSourceToken.DescribePosition: string;
begin
  Result := '';

  if YPosition > 0 then
  begin
    Result := Result + 'on line ' + IntToStr(YPosition);

    if XPosition > 0 then
      Result := Result + ' position ' + IntToStr(XPosition);
  end;
end;

function TSourceToken.HasChildNode(const peTokens: TTokenTypeSet): boolean;
begin
  Result := (TokenType in peTokens);
end;

function TSourceToken.HasChildNode(const peTokens: TTokenTypeSet;
  const piMaxDepth: integer): boolean;
begin
  Result := (TokenType in peTokens);
end;

function TSourceToken.IsSolid: boolean;
begin
  Result := not (TokenType in NotSolidTokens);
end;


function TSourceToken.NextToken: TSourceToken;
var
  lcTemp: TParseTreeNode;
begin
  Result := nil;
  lcTemp := NextLeafNode;
  if lcTemp = nil then
    exit;

  Assert(lcTemp is TSourceToken, 'Next leaf is not token at ' + Describe);
  Result := TSourceToken(lcTemp);
end;

function TSourceToken.PriorToken: TSourceToken;
var
  lcTemp: TParseTreeNode;
begin
  Result := nil;
  lcTemp := PriorLeafNode;
  if lcTemp = nil then
    exit;

  Assert(lcTemp is TSourceToken, 'prior leaf is not token at ' + Describe);
  Result := TSourceToken(lcTemp);
end;

function TSourceToken.NextSolidToken: TSourceToken;
begin
  Result := NextToken;

  while (Result <> nil) and ( not Result.IsSolid) do
    Result := Result.NextToken;
end;

function TSourceToken.NextTokenWithExclusions(
  const peExclusions: TTokenTypeSet): TSourceToken;
begin
  Result := NextToken;

  while (Result <> nil) and (Result.TokenType in peExclusions) do
    Result := Result.NextToken;
end;

function TSourceToken.PriorTokenWithExclusions(
  const peExclusions: TTokenTypeSet): TSourceToken;
begin
  Result := PriorToken;

  while (Result <> nil) and (Result.TokenType in peExclusions) do
    Result := Result.PriorToken;
end;


function TSourceToken.PriorSolidToken: TSourceToken;
begin
  Result := PriorToken;

  while (Result <> nil) and ( not Result.IsSolid) do
    Result := Result.PriorToken;
end;

function TSourceToken.SolidChildCount: integer;
begin
  if IsSolid then
    Result := 1
  else
    Result := 0;
end;

function TSourceToken.SourceLine: string;
var
  lcLineToken: TSourceToken;
begin
  // find the return at the start of the line
  // or nil for start of first line
  lcLineToken := self;

  while lcLineToken.PriorToken <> nil do
  begin
    if lcLineToken.PriorToken.TokenType = ttReturn then
      break
    else
      lcLineToken := lcLineToken.PriorToken;
  end;

  // walk to the end of the line
  Result := '';
  while (lcLineToken <> nil) and (lcLineToken.TokenType <> ttReturn) do
  begin
    Result := Result + lcLineToken.SourceCode;
    lcLineToken := lcLineToken.NextToken;
  end;
end;

function TSourceToken.FirstSolidLeaf: TParseTreeNode;
begin
  if IsSolid then
    Result := self
  else
    Result := nil;
end;

function TSourceToken.IsLeaf: boolean;
begin
  Result := True;
end;

procedure TSourceToken.GeneratePreProcessorData;
begin
  GetPreprocessorSymbolData(SourceCode, fePreprocessorSymbol, fsPreProcessorText);
end;

end.