Chris@0
|
1 module CodeRay
|
Chris@0
|
2 module Scanners
|
Chris@0
|
3
|
Chris@0
|
4 class Delphi < Scanner
|
Chris@0
|
5
|
Chris@0
|
6 register_for :delphi
|
Chris@0
|
7 file_extension 'pas'
|
Chris@0
|
8
|
Chris@0
|
9 RESERVED_WORDS = [
|
Chris@0
|
10 'and', 'array', 'as', 'at', 'asm', 'at', 'begin', 'case', 'class',
|
Chris@0
|
11 'const', 'constructor', 'destructor', 'dispinterface', 'div', 'do',
|
Chris@0
|
12 'downto', 'else', 'end', 'except', 'exports', 'file', 'finalization',
|
Chris@0
|
13 'finally', 'for', 'function', 'goto', 'if', 'implementation', 'in',
|
Chris@0
|
14 'inherited', 'initialization', 'inline', 'interface', 'is', 'label',
|
Chris@0
|
15 'library', 'mod', 'nil', 'not', 'object', 'of', 'or', 'out', 'packed',
|
Chris@0
|
16 'procedure', 'program', 'property', 'raise', 'record', 'repeat',
|
Chris@0
|
17 'resourcestring', 'set', 'shl', 'shr', 'string', 'then', 'threadvar',
|
Chris@0
|
18 'to', 'try', 'type', 'unit', 'until', 'uses', 'var', 'while', 'with',
|
Chris@0
|
19 'xor', 'on'
|
Chris@0
|
20 ]
|
Chris@0
|
21
|
Chris@0
|
22 DIRECTIVES = [
|
Chris@0
|
23 'absolute', 'abstract', 'assembler', 'at', 'automated', 'cdecl',
|
Chris@0
|
24 'contains', 'deprecated', 'dispid', 'dynamic', 'export',
|
Chris@0
|
25 'external', 'far', 'forward', 'implements', 'local',
|
Chris@0
|
26 'near', 'nodefault', 'on', 'overload', 'override',
|
Chris@0
|
27 'package', 'pascal', 'platform', 'private', 'protected', 'public',
|
Chris@0
|
28 'published', 'read', 'readonly', 'register', 'reintroduce',
|
Chris@0
|
29 'requires', 'resident', 'safecall', 'stdcall', 'stored', 'varargs',
|
Chris@0
|
30 'virtual', 'write', 'writeonly'
|
Chris@0
|
31 ]
|
Chris@0
|
32
|
Chris@0
|
33 IDENT_KIND = CaseIgnoringWordList.new(:ident).
|
Chris@0
|
34 add(RESERVED_WORDS, :reserved).
|
Chris@0
|
35 add(DIRECTIVES, :directive)
|
Chris@0
|
36
|
Chris@0
|
37 NAME_FOLLOWS = CaseIgnoringWordList.new(false).
|
Chris@0
|
38 add(%w(procedure function .))
|
Chris@0
|
39
|
Chris@0
|
40 private
|
Chris@0
|
41 def scan_tokens tokens, options
|
Chris@0
|
42
|
Chris@0
|
43 state = :initial
|
Chris@0
|
44 last_token = ''
|
Chris@0
|
45
|
Chris@0
|
46 until eos?
|
Chris@0
|
47
|
Chris@0
|
48 kind = nil
|
Chris@0
|
49 match = nil
|
Chris@0
|
50
|
Chris@0
|
51 if state == :initial
|
Chris@0
|
52
|
Chris@0
|
53 if scan(/ \s+ /x)
|
Chris@0
|
54 tokens << [matched, :space]
|
Chris@0
|
55 next
|
Chris@0
|
56
|
Chris@0
|
57 elsif scan(%r! \{ \$ [^}]* \}? | \(\* \$ (?: .*? \*\) | .* ) !mx)
|
Chris@0
|
58 tokens << [matched, :preprocessor]
|
Chris@0
|
59 next
|
Chris@0
|
60
|
Chris@0
|
61 elsif scan(%r! // [^\n]* | \{ [^}]* \}? | \(\* (?: .*? \*\) | .* ) !mx)
|
Chris@0
|
62 tokens << [matched, :comment]
|
Chris@0
|
63 next
|
Chris@0
|
64
|
Chris@0
|
65 elsif match = scan(/ <[>=]? | >=? | :=? | [-+=*\/;,@\^|\(\)\[\]] | \.\. /x)
|
Chris@0
|
66 kind = :operator
|
Chris@0
|
67
|
Chris@0
|
68 elsif match = scan(/\./)
|
Chris@0
|
69 kind = :operator
|
Chris@0
|
70 if last_token == 'end'
|
Chris@0
|
71 tokens << [match, kind]
|
Chris@0
|
72 next
|
Chris@0
|
73 end
|
Chris@0
|
74
|
Chris@0
|
75 elsif match = scan(/ [A-Za-z_][A-Za-z_0-9]* /x)
|
Chris@0
|
76 kind = NAME_FOLLOWS[last_token] ? :ident : IDENT_KIND[match]
|
Chris@0
|
77
|
Chris@0
|
78 elsif match = scan(/ ' ( [^\n']|'' ) (?:'|$) /x)
|
Chris@0
|
79 tokens << [:open, :char]
|
Chris@0
|
80 tokens << ["'", :delimiter]
|
Chris@0
|
81 tokens << [self[1], :content]
|
Chris@0
|
82 tokens << ["'", :delimiter]
|
Chris@0
|
83 tokens << [:close, :char]
|
Chris@0
|
84 next
|
Chris@0
|
85
|
Chris@0
|
86 elsif match = scan(/ ' /x)
|
Chris@0
|
87 tokens << [:open, :string]
|
Chris@0
|
88 state = :string
|
Chris@0
|
89 kind = :delimiter
|
Chris@0
|
90
|
Chris@0
|
91 elsif scan(/ \# (?: \d+ | \$[0-9A-Fa-f]+ ) /x)
|
Chris@0
|
92 kind = :char
|
Chris@0
|
93
|
Chris@0
|
94 elsif scan(/ \$ [0-9A-Fa-f]+ /x)
|
Chris@0
|
95 kind = :hex
|
Chris@0
|
96
|
Chris@0
|
97 elsif scan(/ (?: \d+ ) (?![eE]|\.[^.]) /x)
|
Chris@0
|
98 kind = :integer
|
Chris@0
|
99
|
Chris@0
|
100 elsif scan(/ \d+ (?: \.\d+ (?: [eE][+-]? \d+ )? | [eE][+-]? \d+ ) /x)
|
Chris@0
|
101 kind = :float
|
Chris@0
|
102
|
Chris@0
|
103 else
|
Chris@0
|
104 kind = :error
|
Chris@0
|
105 getch
|
Chris@0
|
106
|
Chris@0
|
107 end
|
Chris@0
|
108
|
Chris@0
|
109 elsif state == :string
|
Chris@0
|
110 if scan(/[^\n']+/)
|
Chris@0
|
111 kind = :content
|
Chris@0
|
112 elsif scan(/''/)
|
Chris@0
|
113 kind = :char
|
Chris@0
|
114 elsif scan(/'/)
|
Chris@0
|
115 tokens << ["'", :delimiter]
|
Chris@0
|
116 tokens << [:close, :string]
|
Chris@0
|
117 state = :initial
|
Chris@0
|
118 next
|
Chris@0
|
119 elsif scan(/\n/)
|
Chris@0
|
120 tokens << [:close, :string]
|
Chris@0
|
121 kind = :error
|
Chris@0
|
122 state = :initial
|
Chris@0
|
123 else
|
Chris@0
|
124 raise "else case \' reached; %p not handled." % peek(1), tokens
|
Chris@0
|
125 end
|
Chris@0
|
126
|
Chris@0
|
127 else
|
Chris@0
|
128 raise 'else-case reached', tokens
|
Chris@0
|
129
|
Chris@0
|
130 end
|
Chris@0
|
131
|
Chris@0
|
132 match ||= matched
|
Chris@0
|
133 if $CODERAY_DEBUG and not kind
|
Chris@0
|
134 raise_inspect 'Error token %p in line %d' %
|
Chris@0
|
135 [[match, kind], line], tokens, state
|
Chris@0
|
136 end
|
Chris@0
|
137 raise_inspect 'Empty token', tokens unless match
|
Chris@0
|
138
|
Chris@0
|
139 last_token = match
|
Chris@0
|
140 tokens << [match, kind]
|
Chris@0
|
141
|
Chris@0
|
142 end
|
Chris@0
|
143
|
Chris@0
|
144 tokens
|
Chris@0
|
145 end
|
Chris@0
|
146
|
Chris@0
|
147 end
|
Chris@0
|
148
|
Chris@0
|
149 end
|
Chris@0
|
150 end
|