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
|
###############################################################################
#
# Class: NaturalDocs::Languages::Pascal
#
###############################################################################
#
# A subclass to handle the language variations of Pascal and Delphi.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright 2003-2010 Greg Valure
# Natural Docs is licensed under version 3 of the GNU Affero General Public License (AGPL)
# Refer to License.txt for the complete details
use strict;
use integer;
package NaturalDocs::Languages::Pascal;
use base 'NaturalDocs::Languages::Simple';
#
# hash: prototypeDirectives
#
# An existence hash of all the directives that can appear after a function prototype and will be included. The keys are the all
# lowercase keywords.
#
my %prototypeDirectives = ( 'overload' => 1,
'override' => 1,
'virtual' => 1,
'abstract' => 1,
'reintroduce' => 1,
'export' => 1,
'public' => 1,
'interrupt' => 1,
'register' => 1,
'pascal' => 1,
'cdecl' => 1,
'stdcall' => 1,
'popstack' => 1,
'saveregisters' => 1,
'inline' => 1,
'safecall' => 1 );
#
# hash: longPrototypeDirectives
#
# An existence hash of all the directives with parameters that can appear after a function prototype and will be included. The
# keys are the all lowercase keywords.
#
my %longPrototypeDirectives = ( 'alias' => 1,
'external' => 1 );
#
# bool: checkingForDirectives
#
# Set after the first function semicolon, which means we're in directives mode.
#
my $checkingForDirectives;
#
# Function: OnCode
#
# Just overridden to reset <checkingForDirectives>.
#
sub OnCode #(...)
{
my ($self, @parameters) = @_;
$checkingForDirectives = 0;
return $self->SUPER::OnCode(@parameters);
};
#
# Function: OnPrototypeEnd
#
# Pascal's syntax has directives after the prototype that should be included.
#
# > function MyFunction ( param1: type ); virtual; abstract;
#
# Parameters:
#
# type - The <TopicType> of the prototype.
# prototypeRef - A reference to the prototype so far, minus the ender in dispute.
# ender - The ender symbol.
#
# Returns:
#
# ENDER_ACCEPT - The ender is accepted and the prototype is finished.
# ENDER_IGNORE - The ender is rejected and parsing should continue. Note that the prototype will be rejected as a whole
# if all enders are ignored before reaching the end of the code.
# ENDER_ACCEPT_AND_CONTINUE - The ender is accepted so the prototype may stand as is. However, the prototype might
# also continue on so continue parsing. If there is no accepted ender between here and
# the end of the code this version will be accepted instead.
# ENDER_REVERT_TO_ACCEPTED - The expedition from ENDER_ACCEPT_AND_CONTINUE failed. Use the last accepted
# version and end parsing.
#
sub OnPrototypeEnd #(type, prototypeRef, ender)
{
my ($self, $type, $prototypeRef, $ender) = @_;
if ($type eq ::TOPIC_FUNCTION() && $ender eq ';')
{
if (!$checkingForDirectives)
{
$checkingForDirectives = 1;
return ::ENDER_ACCEPT_AND_CONTINUE();
}
elsif ($$prototypeRef =~ /;[ \t]*([a-z]+)([^;]*)$/i)
{
my ($lastDirective, $extra) = (lc($1), $2);
if (exists $prototypeDirectives{$lastDirective} && $extra =~ /^[ \t]*$/)
{ return ::ENDER_ACCEPT_AND_CONTINUE(); }
elsif (exists $longPrototypeDirectives{$lastDirective})
{ return ::ENDER_ACCEPT_AND_CONTINUE(); }
else
{ return ::ENDER_REVERT_TO_ACCEPTED(); };
}
else
{ return ::ENDER_REVERT_TO_ACCEPTED(); };
}
else
{ return ::ENDER_ACCEPT(); };
};
sub ParseParameterLine #(...)
{
my ($self, @params) = @_;
return $self->SUPER::ParsePascalParameterLine(@params);
};
sub TypeBeforeParameter
{
return 0;
};
1;
|
