mirror of
https://github.com/ddnet/ddnet.git
synced 2024-11-10 18:18:18 +00:00
144 lines
4.7 KiB
Perl
144 lines
4.7 KiB
Perl
###############################################################################
|
|
#
|
|
# 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 (C) 2003-2008 Greg Valure
|
|
# Natural Docs is licensed under the GPL
|
|
|
|
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;
|