1
0
mirror of https://github.com/lxsang/antd-lua-plugin synced 2025-07-15 13:29:45 +02:00

mimgrating from another repo

This commit is contained in:
Xuan Sang LE
2018-09-19 15:08:49 +02:00
parent 91320521e8
commit 38bd13b46b
600 changed files with 362490 additions and 1 deletions

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,39 @@
###############################################################################
#
# Class: NaturalDocs::Languages::Ada
#
###############################################################################
#
# A subclass to handle the language variations of Ada
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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::Ada;
use base 'NaturalDocs::Languages::Simple';
#
# Function: ParseParameterLine
# Overridden because Ada uses Pascal-style parameters
#
sub ParseParameterLine #(...)
{
my ($self, @params) = @_;
return $self->SUPER::ParsePascalParameterLine(@params);
};
sub TypeBeforeParameter
{
return 0;
};
1;

View File

@ -0,0 +1,817 @@
###############################################################################
#
# Class: NaturalDocs::Languages::Advanced
#
###############################################################################
#
# The base class for all languages that have full support in Natural Docs. Each one will have a custom parser capable
# of documenting undocumented aspects of the code.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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;
use NaturalDocs::Languages::Advanced::Scope;
use NaturalDocs::Languages::Advanced::ScopeChange;
package NaturalDocs::Languages::Advanced;
use base 'NaturalDocs::Languages::Base';
#############################################################################
# Group: Implementation
#
# Constants: Members
#
# The class is implemented as a blessed arrayref. The following constants are used as indexes.
#
# TOKENS - An arrayref of tokens used in all the <Parsing Functions>.
# SCOPE_STACK - An arrayref of <NaturalDocs::Languages::Advanced::Scope> objects serving as a scope stack for parsing.
# There will always be one available, with a symbol of undef, for the top level.
# SCOPE_RECORD - An arrayref of <NaturalDocs::Languages::Advanced::ScopeChange> objects, as generated by the scope
# stack. If there is more than one change per line, only the last is stored.
# AUTO_TOPICS - An arrayref of <NaturalDocs::Parser::ParsedTopics> generated automatically from the code.
#
use NaturalDocs::DefineMembers 'TOKENS', 'SCOPE_STACK', 'SCOPE_RECORD', 'AUTO_TOPICS';
#############################################################################
# Group: Functions
#
# Function: New
#
# Creates and returns a new object.
#
# Parameters:
#
# name - The name of the language.
#
sub New #(name)
{
my ($package, @parameters) = @_;
my $object = $package->SUPER::New(@parameters);
$object->[TOKENS] = undef;
$object->[SCOPE_STACK] = undef;
$object->[SCOPE_RECORD] = undef;
return $object;
};
# Function: Tokens
# Returns the tokens found by <ParseForCommentsAndTokens()>.
sub Tokens
{ return $_[0]->[TOKENS]; };
# Function: SetTokens
# Replaces the tokens.
sub SetTokens #(tokens)
{ $_[0]->[TOKENS] = $_[1]; };
# Function: ClearTokens
# Resets the token list. You may want to do this after parsing is over to save memory.
sub ClearTokens
{ $_[0]->[TOKENS] = undef; };
# Function: AutoTopics
# Returns the arrayref of automatically generated topics, or undef if none.
sub AutoTopics
{ return $_[0]->[AUTO_TOPICS]; };
# Function: AddAutoTopic
# Adds a <NaturalDocs::Parser::ParsedTopic> to <AutoTopics()>.
sub AddAutoTopic #(topic)
{
my ($self, $topic) = @_;
if (!defined $self->[AUTO_TOPICS])
{ $self->[AUTO_TOPICS] = [ ]; };
push @{$self->[AUTO_TOPICS]}, $topic;
};
# Function: ClearAutoTopics
# Resets the automatic topic list. Not necessary if you call <ParseForCommentsAndTokens()>.
sub ClearAutoTopics
{ $_[0]->[AUTO_TOPICS] = undef; };
# Function: ScopeRecord
# Returns an arrayref of <NaturalDocs::Languages::Advanced::ScopeChange> objects describing how and when the scope
# changed thoughout the file. There will always be at least one entry, which will be for line 1 and undef as the scope.
sub ScopeRecord
{ return $_[0]->[SCOPE_RECORD]; };
###############################################################################
#
# Group: Parsing Functions
#
# These functions are good general language building blocks. Use them to create your language-specific parser.
#
# All functions work on <Tokens()> and assume it is set by <ParseForCommentsAndTokens()>.
#
#
# Function: ParseForCommentsAndTokens
#
# Loads the passed file, sends all appropriate comments to <NaturalDocs::Parser->OnComment()>, and breaks the rest into
# an arrayref of tokens. Tokens are defined as
#
# - All consecutive alphanumeric and underscore characters.
# - All consecutive whitespace.
# - A single line break. It will always be "\n"; you don't have to worry about platform differences.
# - A single character not included above, which is usually a symbol. Multiple consecutive ones each get their own token.
#
# The result will be placed in <Tokens()>.
#
# Parameters:
#
# sourceFile - The source <FileName> to load and parse.
# lineCommentSymbols - An arrayref of symbols that designate line comments, or undef if none.
# blockCommentSymbols - An arrayref of symbol pairs that designate multiline comments, or undef if none. Symbol pairs are
# designated as two consecutive array entries, the opening symbol appearing first.
# javadocLineCommentSymbols - An arrayref of symbols that designate the start of a JavaDoc comment, or undef if none.
# javadocBlockCommentSymbols - An arrayref of symbol pairs that designate multiline JavaDoc comments, or undef if none.
#
# Notes:
#
# - This function automatically calls <ClearAutoTopics()> and <ClearScopeStack()>. You only need to call those functions
# manually if you override this one.
# - To save parsing time, all comment lines sent to <NaturalDocs::Parser->OnComment()> will be replaced with blank lines
# in <Tokens()>. It's all the same to most languages.
#
sub ParseForCommentsAndTokens #(FileName sourceFile, string[] lineCommentSymbols, string[] blockCommentSymbols, string[] javadocLineCommentSymbols, string[] javadocBlockCommentSymbols)
{
my ($self, $sourceFile, $lineCommentSymbols, $blockCommentSymbols,
$javadocLineCommentSymbols, $javadocBlockCommentSymbols) = @_;
open(SOURCEFILEHANDLE, '<' . $sourceFile)
or die "Couldn't open input file " . $sourceFile . "\n";
my $lineReader = NaturalDocs::LineReader->New(\*SOURCEFILEHANDLE);
my $tokens = [ ];
$self->SetTokens($tokens);
# For convenience.
$self->ClearAutoTopics();
$self->ClearScopeStack();
# Load and preprocess the file
my @lines = $lineReader->GetAll();
close(SOURCEFILEHANDLE);
$self->PreprocessFile(\@lines);
# Go through the file
my $lineIndex = 0;
while ($lineIndex < scalar @lines)
{
my $line = $lines[$lineIndex];
my @commentLines;
my $commentLineNumber;
my $isJavaDoc;
my $closingSymbol;
# Retrieve single line comments. This leaves $lineIndex at the next line.
if ( ($isJavaDoc = $self->StripOpeningJavaDocSymbols(\$line, $javadocLineCommentSymbols)) ||
$self->StripOpeningSymbols(\$line, $lineCommentSymbols))
{
$commentLineNumber = $lineIndex + 1;
do
{
push @commentLines, $line;
push @$tokens, "\n";
$lineIndex++;
if ($lineIndex >= scalar @lines)
{ goto EndDo; };
$line = $lines[$lineIndex];
}
while ($self->StripOpeningSymbols(\$line, $lineCommentSymbols));
EndDo: # I hate Perl sometimes.
}
# Retrieve multiline comments. This leaves $lineIndex at the next line.
elsif ( ($isJavaDoc = $self->StripOpeningJavaDocBlockSymbols(\$line, $javadocBlockCommentSymbols)) ||
($closingSymbol = $self->StripOpeningBlockSymbols(\$line, $blockCommentSymbols)) )
{
$commentLineNumber = $lineIndex + 1;
if ($isJavaDoc)
{ $closingSymbol = $isJavaDoc; };
# Note that it is possible for a multiline comment to start correctly but not end so. We want those comments to stay in
# the code. For example, look at this prototype with this splint annotation:
#
# int get_array(integer_t id,
# /*@out@*/ array_t array);
#
# The annotation starts correctly but doesn't end so because it is followed by code on the same line.
my ($lineRemainder, $isMultiLine);
for (;;)
{
$lineRemainder = $self->StripClosingSymbol(\$line, $closingSymbol);
push @commentLines, $line;
# If we found an end comment symbol...
if (defined $lineRemainder)
{ last; };
push @$tokens, "\n";
$lineIndex++;
$isMultiLine = 1;
if ($lineIndex >= scalar @lines)
{ last; };
$line = $lines[$lineIndex];
};
if ($lineRemainder !~ /^[ \t]*$/)
{
# If there was something past the closing symbol this wasn't an acceptable comment.
if ($isMultiLine)
{ $self->TokenizeLine($lineRemainder); }
else
{
# We go back to the original line if it wasn't a multiline comment because we want the comment to stay in the
# code. Otherwise the /*@out@*/ from the example would be removed.
$self->TokenizeLine($lines[$lineIndex]);
};
@commentLines = ( );
}
else
{
push @$tokens, "\n";
};
$lineIndex++;
}
# Otherwise just add it to the code.
else
{
$self->TokenizeLine($line);
$lineIndex++;
};
# If there were comments, send them to Parser->OnComment().
if (scalar @commentLines)
{
NaturalDocs::Parser->OnComment(\@commentLines, $commentLineNumber, $isJavaDoc);
@commentLines = ( );
$isJavaDoc = undef;
};
# $lineIndex was incremented by the individual code paths above.
}; # while ($lineIndex < scalar @lines)
};
#
# Function: PreprocessFile
#
# An overridable function if you'd like to preprocess the file before it goes into <ParseForCommentsAndTokens()>.
#
# Parameters:
#
# lines - An arrayref to the file's lines. Each line has its line break stripped off, but is otherwise untouched.
#
sub PreprocessFile #(lines)
{
};
#
# Function: TokenizeLine
#
# Converts the passed line to tokens as described in <ParseForCommentsAndTokens> and adds them to <Tokens()>. Also
# adds a line break token after it.
#
sub TokenizeLine #(line)
{
my ($self, $line) = @_;
push @{$self->Tokens()}, $line =~ /(\w+|[ \t]+|.)/g, "\n";
};
#
# Function: TryToSkipString
#
# If the position is on a string delimiter, moves the position to the token following the closing delimiter, or past the end of the
# tokens if there is none. Assumes all other characters are allowed in the string, the delimiter itself is allowed if it's preceded by
# a backslash, and line breaks are allowed in the string.
#
# Parameters:
#
# indexRef - A reference to the position's index into <Tokens()>.
# lineNumberRef - A reference to the position's line number.
# openingDelimiter - The opening string delimiter, such as a quote or an apostrophe.
# closingDelimiter - The closing string delimiter, if different. If not defined, assumes the same as openingDelimiter.
# startContentIndexRef - A reference to a variable in which to store the index of the first token of the string's content.
# May be undef.
# endContentIndexRef - A reference to a variable in which to store the index of the end of the string's content, which is one
# past the last index of content. May be undef.
#
# Returns:
#
# Whether the position was on the passed delimiter or not. The index, line number, and content index ref variables will be
# updated only if true.
#
sub TryToSkipString #(indexRef, lineNumberRef, openingDelimiter, closingDelimiter, startContentIndexRef, endContentIndexRef)
{
my ($self, $index, $lineNumber, $openingDelimiter, $closingDelimiter, $startContentIndexRef, $endContentIndexRef) = @_;
my $tokens = $self->Tokens();
if (!defined $closingDelimiter)
{ $closingDelimiter = $openingDelimiter; };
if ($tokens->[$$index] ne $openingDelimiter)
{ return undef; };
$$index++;
if (defined $startContentIndexRef)
{ $$startContentIndexRef = $$index; };
while ($$index < scalar @$tokens)
{
if ($tokens->[$$index] eq "\\")
{
# Skip the token after it.
$$index += 2;
}
elsif ($tokens->[$$index] eq "\n")
{
$$lineNumber++;
$$index++;
}
elsif ($tokens->[$$index] eq $closingDelimiter)
{
if (defined $endContentIndexRef)
{ $$endContentIndexRef = $$index; };
$$index++;
last;
}
else
{
$$index++;
};
};
if ($$index >= scalar @$tokens && defined $endContentIndexRef)
{ $$endContentIndexRef = scalar @$tokens; };
return 1;
};
#
# Function: SkipRestOfLine
#
# Moves the position to the token following the next line break, or past the end of the tokens array if there is none. Useful for
# line comments.
#
# Note that it skips blindly. It assumes there cannot be anything of interest, such as a string delimiter, between the position
# and the end of the line.
#
# Parameters:
#
# indexRef - A reference to the position's index into <Tokens()>.
# lineNumberRef - A reference to the position's line number.
sub SkipRestOfLine #(indexRef, lineNumberRef)
{
my ($self, $index, $lineNumber) = @_;
my $tokens = $self->Tokens();
while ($$index < scalar @$tokens)
{
if ($tokens->[$$index] eq "\n")
{
$$lineNumber++;
$$index++;
last;
}
else
{
$$index++;
};
};
};
#
# Function: SkipUntilAfter
#
# Moves the position to the token following the next occurance of a particular token sequence, or past the end of the tokens
# array if it never occurs. Useful for multiline comments.
#
# Note that it skips blindly. It assumes there cannot be anything of interest, such as a string delimiter, between the position
# and the end of the line.
#
# Parameters:
#
# indexRef - A reference to the position's index.
# lineNumberRef - A reference to the position's line number.
# token - A token that must be matched. Can be specified multiple times to match a sequence of tokens.
#
sub SkipUntilAfter #(indexRef, lineNumberRef, token, token, ...)
{
my ($self, $index, $lineNumber, @target) = @_;
my $tokens = $self->Tokens();
while ($$index < scalar @$tokens)
{
if ($tokens->[$$index] eq $target[0] && ($$index + scalar @target) <= scalar @$tokens)
{
my $match = 1;
for (my $i = 1; $i < scalar @target; $i++)
{
if ($tokens->[$$index+$i] ne $target[$i])
{
$match = 0;
last;
};
};
if ($match)
{
$$index += scalar @target;
return;
};
};
if ($tokens->[$$index] eq "\n")
{
$$lineNumber++;
$$index++;
}
else
{
$$index++;
};
};
};
#
# Function: IsFirstLineToken
#
# Returns whether the position is at the first token of a line, not including whitespace.
#
# Parameters:
#
# index - The index of the position.
#
sub IsFirstLineToken #(index)
{
my ($self, $index) = @_;
my $tokens = $self->Tokens();
if ($index == 0)
{ return 1; };
$index--;
if ($tokens->[$index] =~ /^[ \t]/)
{ $index--; };
if ($index <= 0 || $tokens->[$index] eq "\n")
{ return 1; }
else
{ return undef; };
};
#
# Function: IsLastLineToken
#
# Returns whether the position is at the last token of a line, not including whitespace.
#
# Parameters:
#
# index - The index of the position.
#
sub IsLastLineToken #(index)
{
my ($self, $index) = @_;
my $tokens = $self->Tokens();
do
{ $index++; }
while ($index < scalar @$tokens && $tokens->[$index] =~ /^[ \t]/);
if ($index >= scalar @$tokens || $tokens->[$index] eq "\n")
{ return 1; }
else
{ return undef; };
};
#
# Function: IsAtSequence
#
# Returns whether the position is at a sequence of tokens.
#
# Parameters:
#
# index - The index of the position.
# token - A token to match. Specify multiple times to specify the sequence.
#
sub IsAtSequence #(index, token, token, token ...)
{
my ($self, $index, @target) = @_;
my $tokens = $self->Tokens();
if ($index + scalar @target > scalar @$tokens)
{ return undef; };
for (my $i = 0; $i < scalar @target; $i++)
{
if ($tokens->[$index + $i] ne $target[$i])
{ return undef; };
};
return 1;
};
#
# Function: IsBackslashed
#
# Returns whether the position is after a backslash.
#
# Parameters:
#
# index - The index of the postition.
#
sub IsBackslashed #(index)
{
my ($self, $index) = @_;
my $tokens = $self->Tokens();
if ($index > 0 && $tokens->[$index - 1] eq "\\")
{ return 1; }
else
{ return undef; };
};
###############################################################################
#
# Group: Scope Functions
#
# These functions provide a nice scope stack implementation for language-specific parsers to use. The default implementation
# makes the following assumptions.
#
# - Packages completely replace one another, rather than concatenating. You need to concatenate manually if that's the
# behavior.
#
# - Packages inherit, so if a scope level doesn't set its own, the package is the same as the parent scope's.
#
#
# Function: ClearScopeStack
#
# Clears the scope stack for a new file. Not necessary if you call <ParseForCommentsAndTokens()>.
#
sub ClearScopeStack
{
my ($self) = @_;
$self->[SCOPE_STACK] = [ NaturalDocs::Languages::Advanced::Scope->New(undef, undef) ];
$self->[SCOPE_RECORD] = [ NaturalDocs::Languages::Advanced::ScopeChange->New(undef, 1) ];
};
#
# Function: StartScope
#
# Records a new scope level.
#
# Parameters:
#
# closingSymbol - The closing symbol of the scope.
# lineNumber - The line number where the scope begins.
# package - The package <SymbolString> of the scope. Undef means no change.
#
sub StartScope #(closingSymbol, lineNumber, package)
{
my ($self, $closingSymbol, $lineNumber, $package) = @_;
push @{$self->[SCOPE_STACK]},
NaturalDocs::Languages::Advanced::Scope->New($closingSymbol, $package, $self->CurrentUsing());
$self->AddToScopeRecord($self->CurrentScope(), $lineNumber);
};
#
# Function: EndScope
#
# Records the end of the current scope level. Note that this is blind; you need to manually check <ClosingScopeSymbol()> if
# you need to determine if it is correct to do so.
#
# Parameters:
#
# lineNumber - The line number where the scope ends.
#
sub EndScope #(lineNumber)
{
my ($self, $lineNumber) = @_;
if (scalar @{$self->[SCOPE_STACK]} > 1)
{ pop @{$self->[SCOPE_STACK]}; };
$self->AddToScopeRecord($self->CurrentScope(), $lineNumber);
};
#
# Function: ClosingScopeSymbol
#
# Returns the symbol that ends the current scope level, or undef if we are at the top level.
#
sub ClosingScopeSymbol
{
my ($self) = @_;
return $self->[SCOPE_STACK]->[-1]->ClosingSymbol();
};
#
# Function: CurrentScope
#
# Returns the current calculated scope, or undef if global. The default implementation just returns <CurrentPackage()>. This
# is a separate function because C++ may need to track namespaces and classes separately, and so the current scope would
# be a concatenation of them.
#
sub CurrentScope
{
return $_[0]->CurrentPackage();
};
#
# Function: CurrentPackage
#
# Returns the current calculated package or class, or undef if none.
#
sub CurrentPackage
{
my ($self) = @_;
my $package;
for (my $index = scalar @{$self->[SCOPE_STACK]} - 1; $index >= 0 && !defined $package; $index--)
{
$package = $self->[SCOPE_STACK]->[$index]->Package();
};
return $package;
};
#
# Function: SetPackage
#
# Sets the package for the current scope level.
#
# Parameters:
#
# package - The new package <SymbolString>.
# lineNumber - The line number the new package starts on.
#
sub SetPackage #(package, lineNumber)
{
my ($self, $package, $lineNumber) = @_;
$self->[SCOPE_STACK]->[-1]->SetPackage($package);
$self->AddToScopeRecord($self->CurrentScope(), $lineNumber);
};
#
# Function: CurrentUsing
#
# Returns the current calculated arrayref of <SymbolStrings> from Using statements, or undef if none.
#
sub CurrentUsing
{
my ($self) = @_;
return $self->[SCOPE_STACK]->[-1]->Using();
};
#
# Function: AddUsing
#
# Adds a Using <SymbolString> to the current scope.
#
sub AddUsing #(using)
{
my ($self, $using) = @_;
$self->[SCOPE_STACK]->[-1]->AddUsing($using);
};
###############################################################################
# Group: Support Functions
#
# Function: AddToScopeRecord
#
# Adds a change to the scope record, condensing unnecessary entries.
#
# Parameters:
#
# newScope - What the scope <SymbolString> changed to.
# lineNumber - Where the scope changed.
#
sub AddToScopeRecord #(newScope, lineNumber)
{
my ($self, $scope, $lineNumber) = @_;
my $scopeRecord = $self->ScopeRecord();
if ($scope ne $scopeRecord->[-1]->Scope())
{
if ($scopeRecord->[-1]->LineNumber() == $lineNumber)
{ $scopeRecord->[-1]->SetScope($scope); }
else
{ push @$scopeRecord, NaturalDocs::Languages::Advanced::ScopeChange->New($scope, $lineNumber); };
};
};
#
# Function: CreateString
#
# Converts the specified tokens into a string and returns it.
#
# Parameters:
#
# startIndex - The starting index to convert.
# endIndex - The ending index, which is *not inclusive*.
#
# Returns:
#
# The string.
#
sub CreateString #(startIndex, endIndex)
{
my ($self, $startIndex, $endIndex) = @_;
my $tokens = $self->Tokens();
my $string;
while ($startIndex < $endIndex && $startIndex < scalar @$tokens)
{
$string .= $tokens->[$startIndex];
$startIndex++;
};
return $string;
};
1;

View File

@ -0,0 +1,96 @@
###############################################################################
#
# Class: NaturalDocs::Languages::Advanced::Scope
#
###############################################################################
#
# A class used to store a scope level.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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::Advanced::Scope;
#
# Constants: Implementation
#
# The object is implemented as a blessed arrayref. The constants below are used as indexes.
#
# CLOSING_SYMBOL - The closing symbol character of the scope.
# PACKAGE - The package <SymbolString> of the scope.
# USING - An arrayref of <SymbolStrings> for using statements, or undef if none.
#
use NaturalDocs::DefineMembers 'CLOSING_SYMBOL', 'PACKAGE', 'USING';
# Dependency: New() depends on the order of these constants as well as that there is no inherited members.
#
# Function: New
#
# Creates and returns a new object.
#
# Parameters:
#
# closingSymbol - The closing symbol character of the scope.
# package - The package <SymbolString> of the scope.
# using - An arrayref of using <SymbolStrings>, or undef if none. The contents of the array will be duplicated.
#
# If package is set to undef, it is assumed that it inherits the value of the previous scope on the stack.
#
sub New #(closingSymbol, package, using)
{
# Dependency: This depends on the order of the parameters matching the constants, and that there are no inherited
# members.
my $package = shift;
my $object = [ @_ ];
bless $object, $package;
if (defined $object->[USING])
{ $object->[USING] = [ @{$object->[USING]} ]; };
return $object;
};
# Function: ClosingSymbol
# Returns the closing symbol character of the scope.
sub ClosingSymbol
{ return $_[0]->[CLOSING_SYMBOL]; };
# Function: Package
# Returns the package <SymbolString> of the scope, or undef if none.
sub Package
{ return $_[0]->[PACKAGE]; };
# Function: SetPackage
# Sets the package <SymbolString> of the scope.
sub SetPackage #(package)
{ $_[0]->[PACKAGE] = $_[1]; };
# Function: Using
# Returns an arrayref of <SymbolStrings> for using statements, or undef if none
sub Using
{ return $_[0]->[USING]; };
# Function: AddUsing
# Adds a <SymbolString> to the <Using()> array.
sub AddUsing #(using)
{
my ($self, $using) = @_;
if (!defined $self->[USING])
{ $self->[USING] = [ ]; };
push @{$self->[USING]}, $using;
};
1;

View File

@ -0,0 +1,71 @@
###############################################################################
#
# Class: NaturalDocs::Languages::Advanced::ScopeChange
#
###############################################################################
#
# A class used to store a scope change.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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::Advanced::ScopeChange;
#
# Constants: Implementation
#
# The object is implemented as a blessed arrayref. The constants below are used as indexes.
#
# SCOPE - The new scope <SymbolString>.
# LINE_NUMBER - The line number of the change.
#
use NaturalDocs::DefineMembers 'SCOPE', 'LINE_NUMBER';
# Dependency: New() depends on the order of these constants as well as that there is no inherited members.
#
# Function: New
#
# Creates and returns a new object.
#
# Parameters:
#
# scope - The <SymbolString> the scope was changed to.
# lineNumber - What line it occurred on.
#
sub New #(scope, lineNumber)
{
# Dependency: This depends on the order of the parameters matching the constants, and that there are no inherited
# members.
my $self = shift;
my $object = [ @_ ];
bless $object, $self;
return $object;
};
# Function: Scope
# Returns the <SymbolString> the scope was changed to.
sub Scope
{ return $_[0]->[SCOPE]; };
# Function: SetScope
# Replaces the <SymbolString> the scope was changed to.
sub SetScope #(scope)
{ $_[0]->[SCOPE] = $_[1]; };
# Function: LineNumber
# Returns the line number of the change.
sub LineNumber
{ return $_[0]->[LINE_NUMBER]; };
1;

View File

@ -0,0 +1,833 @@
###############################################################################
#
# Class: NaturalDocs::Languages::Base
#
###############################################################################
#
# A base class for all programming language parsers.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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::Base;
use NaturalDocs::DefineMembers 'NAME', 'Name()',
'EXTENSIONS', 'Extensions()', 'SetExtensions() duparrayref',
'SHEBANG_STRINGS', 'ShebangStrings()', 'SetShebangStrings() duparrayref',
'IGNORED_PREFIXES',
'ENUM_VALUES';
use base 'Exporter';
our @EXPORT = ('ENUM_GLOBAL', 'ENUM_UNDER_TYPE', 'ENUM_UNDER_PARENT');
#
# Constants: EnumValuesType
#
# How enum values are handled in the language.
#
# ENUM_GLOBAL - Values are always global and thus 'value'.
# ENUM_UNDER_TYPE - Values are under the type in the hierarchy, and thus 'package.enum.value'.
# ENUM_UNDER_PARENT - Values are under the parent in the hierarchy, putting them on the same level as the enum itself. Thus
# 'package.value'.
#
use constant ENUM_GLOBAL => 1;
use constant ENUM_UNDER_TYPE => 2;
use constant ENUM_UNDER_PARENT => 3;
#
# Handle: SOURCEFILEHANDLE
#
# The handle of the source file currently being parsed.
#
#
# Function: New
#
# Creates and returns a new object.
#
# Parameters:
#
# name - The name of the language.
#
sub New #(name)
{
my ($selfPackage, $name) = @_;
my $object = [ ];
$object->[NAME] = $name;
bless $object, $selfPackage;
return $object;
};
#
# Functions: Members
#
# Name - Returns the language's name.
# Extensions - Returns an arrayref of the language's file extensions, or undef if none.
# SetExtensions - Replaces the arrayref of the language's file extensions.
# ShebangStrings - Returns an arrayref of the language's shebang strings, or undef if none.
# SetShebangStrings - Replaces the arrayref of the language's shebang strings.
#
#
# Function: PackageSeparator
# Returns the language's package separator string.
#
sub PackageSeparator
{ return '.'; };
#
# Function: PackageSeparatorWasSet
# Returns whether the language's package separator string was ever changed from the default.
#
sub PackageSeparatorWasSet
{ return 0; };
#
# Function: EnumValues
# Returns the <EnumValuesType> that describes how the language handles enums.
#
sub EnumValues
{ return ENUM_GLOBAL; };
#
# Function: IgnoredPrefixesFor
#
# Returns an arrayref of ignored prefixes for the passed <TopicType>, or undef if none. The array is sorted so that the longest
# prefixes are first.
#
sub IgnoredPrefixesFor #(type)
{
my ($self, $type) = @_;
if (defined $self->[IGNORED_PREFIXES])
{ return $self->[IGNORED_PREFIXES]->{$type}; }
else
{ return undef; };
};
#
# Function: SetIgnoredPrefixesFor
#
# Replaces the arrayref of ignored prefixes for the passed <TopicType>.
#
sub SetIgnoredPrefixesFor #(type, prefixes)
{
my ($self, $type, $prefixesRef) = @_;
if (!defined $self->[IGNORED_PREFIXES])
{ $self->[IGNORED_PREFIXES] = { }; };
if (!defined $prefixesRef)
{ delete $self->[IGNORED_PREFIXES]->{$type}; }
else
{
my $prefixes = [ @$prefixesRef ];
# Sort prefixes to be longest to shortest.
@$prefixes = sort { length $b <=> length $a } @$prefixes;
$self->[IGNORED_PREFIXES]->{$type} = $prefixes;
};
};
#
# Function: HasIgnoredPrefixes
#
# Returns whether the language has any ignored prefixes at all.
#
sub HasIgnoredPrefixes
{ return defined $_[0]->[IGNORED_PREFIXES]; };
#
# Function: CopyIgnoredPrefixesOf
#
# Copies all the ignored prefix settings of the passed <NaturalDocs::Languages::Base> object.
#
sub CopyIgnoredPrefixesOf #(language)
{
my ($self, $language) = @_;
if ($language->HasIgnoredPrefixes())
{
$self->[IGNORED_PREFIXES] = { };
while (my ($topicType, $prefixes) = each %{$language->[IGNORED_PREFIXES]})
{
$self->[IGNORED_PREFIXES]->{$topicType} = [ @$prefixes ];
};
};
};
###############################################################################
# Group: Parsing Functions
#
# Function: ParseFile
#
# Parses the passed source file, sending comments acceptable for documentation to <NaturalDocs::Parser->OnComment()>.
# This *must* be defined by a subclass.
#
# Parameters:
#
# sourceFile - The <FileName> of the source file to parse.
# topicList - A reference to the list of <NaturalDocs::Parser::ParsedTopics> being built by the file.
#
# Returns:
#
# The array ( autoTopics, scopeRecord ).
#
# autoTopics - An arrayref of automatically generated <NaturalDocs::Parser::ParsedTopics> from the file, or undef if none.
# scopeRecord - An arrayref of <NaturalDocs::Languages::Advanced::ScopeChanges>, or undef if none.
#
#
# Function: ParsePrototype
#
# Parses the prototype and returns it as a <NaturalDocs::Languages::Prototype> object.
#
# Parameters:
#
# type - The <TopicType>.
# prototype - The text prototype.
#
# Returns:
#
# A <NaturalDocs::Languages::Prototype> object.
#
sub ParsePrototype #(type, prototype)
{
my ($self, $type, $prototype) = @_;
my $isClass = NaturalDocs::Topics->TypeInfo($type)->ClassHierarchy();
if ($prototype !~ /\(.*[^ ].*\)/ && (!$isClass || $prototype !~ /\{.*[^ ].*\}/))
{
my $object = NaturalDocs::Languages::Prototype->New($prototype);
return $object;
};
# Parse the parameters out of the prototype.
my @tokens = $prototype =~ /([^\(\)\[\]\{\}\<\>\'\"\,\;]+|.)/g;
my $parameter;
my @parameterLines;
my @symbolStack;
my $finishedParameters;
my ($beforeParameters, $afterParameters);
foreach my $token (@tokens)
{
if ($finishedParameters)
{ $afterParameters .= $token; }
elsif ($symbolStack[-1] eq '\'' || $symbolStack[-1] eq '"')
{
if ($symbolStack[0] eq '(' || ($isClass && $symbolStack[0] eq '{'))
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
if ($token eq $symbolStack[-1])
{ pop @symbolStack; };
}
elsif ($token =~ /^[\(\[\{\<\'\"]$/)
{
if ($symbolStack[0] eq '(' || ($isClass && $symbolStack[0] eq '{'))
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
push @symbolStack, $token;
}
elsif ( ($token eq ')' && $symbolStack[-1] eq '(') ||
($token eq ']' && $symbolStack[-1] eq '[') ||
($token eq '}' && $symbolStack[-1] eq '{') ||
($token eq '>' && $symbolStack[-1] eq '<') )
{
if ($symbolStack[0] eq '(')
{
if ($token eq ')' && scalar @symbolStack == 1)
{
if ($parameter ne ' ')
{ push @parameterLines, $parameter; };
$finishedParameters = 1;
$afterParameters .= $token;
}
else
{ $parameter .= $token; };
}
elsif ($isClass && $symbolStack[0] eq '{')
{
if ($token eq '}' && scalar @symbolStack == 1)
{
if ($parameter ne ' ')
{ push @parameterLines, $parameter; };
$finishedParameters = 1;
$afterParameters .= $token;
}
else
{ $parameter .= $token; };
}
else
{
$beforeParameters .= $token;
};
pop @symbolStack;
}
elsif ($token eq ',' || $token eq ';')
{
if ($symbolStack[0] eq '(' || ($isClass && $symbolStack[0] eq '{'))
{
if (scalar @symbolStack == 1)
{
push @parameterLines, $parameter . $token;
$parameter = undef;
}
else
{
$parameter .= $token;
};
}
else
{
$beforeParameters .= $token;
};
}
else
{
if ($symbolStack[0] eq '(' || ($isClass && $symbolStack[0] eq '{'))
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
};
};
foreach my $part (\$beforeParameters, \$afterParameters)
{
$$part =~ s/^ //;
$$part =~ s/ $//;
};
my $prototypeObject = NaturalDocs::Languages::Prototype->New($beforeParameters, $afterParameters);
# Parse the actual parameters.
foreach my $parameterLine (@parameterLines)
{
$prototypeObject->AddParameter( $self->ParseParameterLine($parameterLine) );
};
return $prototypeObject;
};
#
# Function: ParseParameterLine
#
# Parses a prototype parameter line and returns it as a <NaturalDocs::Languages::Prototype::Parameter> object.
#
# This vesion assumes a C++ style line. If you need a Pascal style line, override this function to forward to
# <ParsePascalParameterLine()>.
#
# > Function(parameter, type parameter, type parameter = value);
#
sub ParseParameterLine #(line)
{
my ($self, $line) = @_;
$line =~ s/^ //;
$line =~ s/ $//;
my @tokens = $line =~ /([^ \(\)\{\}\[\]\<\>\'\"\=]+|.)/g;
my @symbolStack;
my @parameterWords = ( undef );
my ($defaultValue, $defaultValuePrefix, $inDefaultValue);
foreach my $token (@tokens)
{
if ($inDefaultValue)
{ $defaultValue .= $token; }
elsif ($symbolStack[-1] eq '\'' || $symbolStack[-1] eq '"')
{
$parameterWords[-1] .= $token;
if ($token eq $symbolStack[-1])
{ pop @symbolStack; };
}
elsif ($token =~ /^[\(\[\{\<\'\"]$/)
{
push @symbolStack, $token;
$parameterWords[-1] .= $token;
}
elsif ( ($token eq ')' && $symbolStack[-1] eq '(') ||
($token eq ']' && $symbolStack[-1] eq '[') ||
($token eq '}' && $symbolStack[-1] eq '{') ||
($token eq '>' && $symbolStack[-1] eq '<') )
{
pop @symbolStack;
$parameterWords[-1] .= $token;
}
elsif ($token eq ' ')
{
if (!scalar @symbolStack)
{ push @parameterWords, undef; }
else
{ $parameterWords[-1] .= $token; };
}
elsif ($token eq '=')
{
if (!scalar @symbolStack)
{
$defaultValuePrefix = $token;
$inDefaultValue = 1;
}
else
{ $parameterWords[-1] .= $token; };
}
else
{
$parameterWords[-1] .= $token;
};
};
my ($name, $namePrefix, $type, $typePrefix);
if (!$parameterWords[-1])
{ pop @parameterWords; };
$name = pop @parameterWords;
if ($parameterWords[-1]=~ /([\*\&]+)$/)
{
$namePrefix = $1;
$parameterWords[-1] = substr($parameterWords[-1], 0, 0 - length($namePrefix));
$parameterWords[-1] =~ s/ $//;
if (!$parameterWords[-1])
{ pop @parameterWords; };
}
elsif ($name =~ /^([\*\&]+)/)
{
$namePrefix = $1;
$name = substr($name, length($namePrefix));
$name =~ s/^ //;
};
$type = pop @parameterWords;
$typePrefix = join(' ', @parameterWords);
if ($typePrefix)
{ $typePrefix .= ' '; };
if ($type =~ /^([a-z0-9_\:\.]+(?:\.|\:\:))[a-z0-9_]/i)
{
my $attachedTypePrefix = $1;
$typePrefix .= $attachedTypePrefix;
$type = substr($type, length($attachedTypePrefix));
};
$defaultValue =~ s/ $//;
return NaturalDocs::Languages::Prototype::Parameter->New($type, $typePrefix, $name, $namePrefix,
$defaultValue, $defaultValuePrefix);
};
#
# Function: ParsePascalParameterLine
#
# Parses a Pascal-like prototype parameter line and returns it as a <NaturalDocs::Languages::Prototype::Parameter> object.
# Pascal lines are as follows:
#
# > Function (name: type; name, name: type := value)
#
# Also supports ActionScript lines
#
# > Function (name: type, name, name: type = value)
#
sub ParsePascalParameterLine #(line)
{
my ($self, $line) = @_;
$line =~ s/^ //;
$line =~ s/ $//;
my @tokens = $line =~ /([^\(\)\{\}\[\]\<\>\'\"\=\:]+|\:\=|.)/g;
my ($type, $name, $defaultValue, $defaultValuePrefix, $afterName, $afterDefaultValue);
my @symbolStack;
foreach my $token (@tokens)
{
if ($afterDefaultValue)
{ $defaultValue .= $token; }
elsif ($symbolStack[-1] eq '\'' || $symbolStack[-1] eq '"')
{
if ($afterName)
{ $type .= $token; }
else
{ $name .= $token; };
if ($token eq $symbolStack[-1])
{ pop @symbolStack; };
}
elsif ($token =~ /^[\(\[\{\<\'\"]$/)
{
push @symbolStack, $token;
if ($afterName)
{ $type .= $token; }
else
{ $name .= $token; };
}
elsif ( ($token eq ')' && $symbolStack[-1] eq '(') ||
($token eq ']' && $symbolStack[-1] eq '[') ||
($token eq '}' && $symbolStack[-1] eq '{') ||
($token eq '>' && $symbolStack[-1] eq '<') )
{
pop @symbolStack;
if ($afterName)
{ $type .= $token; }
else
{ $name .= $token; };
}
elsif ($afterName)
{
if (($token eq ':=' || $token eq '=') && !scalar @symbolStack)
{
$defaultValuePrefix = $token;
$afterDefaultValue = 1;
}
else
{ $type .= $token; };
}
elsif ($token eq ':' && !scalar @symbolStack)
{
$name .= $token;
$afterName = 1;
}
else
{ $name .= $token; };
};
foreach my $part (\$type, \$name, \$defaultValue)
{
$$part =~ s/^ //;
$$part =~ s/ $//;
};
return NaturalDocs::Languages::Prototype::Parameter->New($type, undef, $name, undef, $defaultValue, $defaultValuePrefix);
};
#
# Function: TypeBeforeParameter
#
# Returns whether the type appears before the parameter in prototypes.
#
# For example, it does in C++
# > void Function (int a, int b)
#
# but does not in Pascal
# > function Function (a: int; b, c: int)
#
sub TypeBeforeParameter
{
return 1;
};
#
# Function: IgnoredPrefixLength
#
# Returns the length of the prefix that should be ignored in the index, or zero if none.
#
# Parameters:
#
# name - The name of the symbol.
# type - The symbol's <TopicType>.
#
# Returns:
#
# The length of the prefix to ignore, or zero if none.
#
sub IgnoredPrefixLength #(name, type)
{
my ($self, $name, $type) = @_;
foreach my $prefixes ($self->IgnoredPrefixesFor($type), $self->IgnoredPrefixesFor(::TOPIC_GENERAL()))
{
if (defined $prefixes)
{
foreach my $prefix (@$prefixes)
{
if (substr($name, 0, length($prefix)) eq $prefix)
{ return length($prefix); };
};
};
};
return 0;
};
###############################################################################
# Group: Support Functions
#
# Function: StripOpeningSymbols
#
# Determines if the line starts with any of the passed symbols, and if so, replaces it with spaces. This only happens
# if the only thing before it on the line is whitespace.
#
# Parameters:
#
# lineRef - A reference to the line to check.
# symbols - An arrayref of the symbols to check for.
#
# Returns:
#
# If the line starts with any of the passed comment symbols, it will replace it in the line with spaces and return the symbol.
# If the line doesn't, it will leave the line alone and return undef.
#
sub StripOpeningSymbols #(lineRef, symbols)
{
my ($self, $lineRef, $symbols) = @_;
if (!defined $symbols)
{ return undef; };
my ($index, $symbol) = ::FindFirstSymbol($$lineRef, $symbols);
if ($index != -1 && substr($$lineRef, 0, $index) =~ /^[ \t]*$/)
{
return substr($$lineRef, $index, length($symbol), ' ' x length($symbol));
};
return undef;
};
#
# Function: StripOpeningJavaDocSymbols
#
# Determines if the line starts with any of the passed symbols, and if so, replaces it with spaces. This only happens
# if the only thing before it on the line is whitespace and the next character after it is whitespace or the end of the line.
#
# Parameters:
#
# lineRef - A reference to the line to check.
# symbols - An arrayref of the symbols to check for.
#
# Returns:
#
# If the line starts with any of the passed comment symbols, it will replace it in the line with spaces and return the symbol.
# If the line doesn't, it will leave the line alone and return undef.
#
sub StripOpeningJavaDocSymbols #(lineRef, symbols)
{
my ($self, $lineRef, $symbols) = @_;
if (!defined $symbols)
{ return undef; };
my ($index, $symbol) = ::FindFirstSymbol($$lineRef, $symbols);
if ($index != -1 && substr($$lineRef, 0, $index) =~ /^[ \t]*$/ && substr($$lineRef, $index + length($symbol), 1) =~ /^[ \t]?$/)
{
return substr($$lineRef, $index, length($symbol), ' ' x length($symbol));
};
return undef;
};
#
# Function: StripOpeningBlockSymbols
#
# Determines if the line starts with any of the opening symbols in the passed symbol pairs, and if so, replaces it with spaces.
# This only happens if the only thing before it on the line is whitespace.
#
# Parameters:
#
# lineRef - A reference to the line to check.
# symbolPairs - An arrayref of the symbol pairs to check for. Pairs are specified as two consecutive array entries, with the
# opening symbol first.
#
# Returns:
#
# If the line starts with any of the opening symbols, it will replace it in the line with spaces and return the closing symbol.
# If the line doesn't, it will leave the line alone and return undef.
#
sub StripOpeningBlockSymbols #(lineRef, symbolPairs)
{
my ($self, $lineRef, $symbolPairs) = @_;
if (!defined $symbolPairs)
{ return undef; };
for (my $i = 0; $i < scalar @$symbolPairs; $i += 2)
{
my $index = index($$lineRef, $symbolPairs->[$i]);
if ($index != -1 && substr($$lineRef, 0, $index) =~ /^[ \t]*$/)
{
substr($$lineRef, $index, length($symbolPairs->[$i]), ' ' x length($symbolPairs->[$i]));
return $symbolPairs->[$i + 1];
};
};
return undef;
};
#
# Function: StripOpeningJavaDocBlockSymbols
#
# Determines if the line starts with any of the opening symbols in the passed symbol pairs, and if so, replaces it with spaces.
# This only happens if the only thing before it on the line is whitespace and the next character is whitespace or the end of the line.
#
# Parameters:
#
# lineRef - A reference to the line to check.
# symbolPairs - An arrayref of the symbol pairs to check for. Pairs are specified as two consecutive array entries, with the
# opening symbol first.
#
# Returns:
#
# If the line starts with any of the opening symbols, it will replace it in the line with spaces and return the closing symbol.
# If the line doesn't, it will leave the line alone and return undef.
#
sub StripOpeningJavaDocBlockSymbols #(lineRef, symbolPairs)
{
my ($self, $lineRef, $symbolPairs) = @_;
if (!defined $symbolPairs)
{ return undef; };
for (my $i = 0; $i < scalar @$symbolPairs; $i += 2)
{
my $index = index($$lineRef, $symbolPairs->[$i]);
if ($index != -1 && substr($$lineRef, 0, $index) =~ /^[ \t]*$/ &&
substr($$lineRef, $index + length($symbolPairs->[$i]), 1) =~ /^[ \t]?$/)
{
substr($$lineRef, $index, length($symbolPairs->[$i]), ' ' x length($symbolPairs->[$i]));
return $symbolPairs->[$i + 1];
};
};
return undef;
};
#
# Function: StripClosingSymbol
#
# Determines if the line contains a symbol, and if so, truncates it just before the symbol.
#
# Parameters:
#
# lineRef - A reference to the line to check.
# symbol - The symbol to check for.
#
# Returns:
#
# The remainder of the line, or undef if the symbol was not found.
#
sub StripClosingSymbol #(lineRef, symbol)
{
my ($self, $lineRef, $symbol) = @_;
my $index = index($$lineRef, $symbol);
if ($index != -1)
{
my $lineRemainder = substr($$lineRef, $index + length($symbol));
$$lineRef = substr($$lineRef, 0, $index);
return $lineRemainder;
}
else
{ return undef; };
};
#
# Function: NormalizePrototype
#
# Normalizes a prototype. Specifically, condenses spaces, tabs, and line breaks into single spaces and removes leading and
# trailing ones.
#
# Parameters:
#
# prototype - The original prototype string.
#
# Returns:
#
# The normalized prototype.
#
sub NormalizePrototype #(prototype)
{
my ($self, $prototype) = @_;
$prototype =~ tr/ \t\r\n/ /s;
$prototype =~ s/^ //;
$prototype =~ s/ $//;
return $prototype;
};
1;

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,320 @@
###############################################################################
#
# Class: NaturalDocs::Languages::PLSQL
#
###############################################################################
#
# A subclass to handle the language variations of PL/SQL.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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::PLSQL;
use base 'NaturalDocs::Languages::Simple';
#
# Function: OnPrototypeEnd
#
# Microsoft's SQL specifies parameters as shown below.
#
# > CREATE PROCEDURE Test @as int, @foo int AS ...
#
# Having a parameter @is or @as is perfectly valid even though those words are also used to end the prototype. We need to
# ignore text-based enders preceded by an at sign. Also note that it does not have parenthesis for parameter lists. We need to
# skip all commas if the prototype doesn't have parenthesis but does have @ characters.
#
# Identifiers such as function names may contain the characters $, #, and _, so if "as" or "is" appears directly after one of them
# we need to ignore the ender there as well.
#
# > FUNCTION Something_is_something ...
#
# 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) = @_;
# _ should be handled already.
if ($ender =~ /^[a-z]+$/i && substr($$prototypeRef, -1) =~ /^[\@\$\#]$/)
{ return ::ENDER_IGNORE(); }
elsif ($type eq ::TOPIC_FUNCTION() && $ender eq ',')
{
if ($$prototypeRef =~ /^[^\(]*\@/)
{ return ::ENDER_IGNORE(); }
else
{ return ::ENDER_ACCEPT(); };
}
else
{ return ::ENDER_ACCEPT(); };
};
#
# Function: ParsePrototype
#
# Overridden to handle Microsoft's parenthesisless version. Otherwise just throws to the parent.
#
# Parameters:
#
# type - The <TopicType>.
# prototype - The text prototype.
#
# Returns:
#
# A <NaturalDocs::Languages::Prototype> object.
#
sub ParsePrototype #(type, prototype)
{
my ($self, $type, $prototype) = @_;
my $noParenthesisParameters = ($type eq ::TOPIC_FUNCTION() && $prototype =~ /^[^\(]*\@/);
if ($prototype !~ /\(.*[^ ].*\)/ && !$noParenthesisParameters)
{ return $self->SUPER::ParsePrototype($type, $prototype); };
my ($beforeParameters, $afterParameters, $isAfterParameters);
if ($noParenthesisParameters)
{
($beforeParameters, $prototype) = split(/\@/, $prototype, 2);
$prototype = '@' . $prototype;
};
my @tokens = $prototype =~ /([^\(\)\[\]\{\}\<\>\'\"\,]+|.)/g;
my $parameter;
my @parameterLines;
my @symbolStack;
foreach my $token (@tokens)
{
if ($isAfterParameters)
{ $afterParameters .= $token; }
elsif ($symbolStack[-1] eq '\'' || $symbolStack[-1] eq '"')
{
if ($noParenthesisParameters || $symbolStack[0] eq '(')
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
if ($token eq $symbolStack[-1])
{ pop @symbolStack; };
}
elsif ($token =~ /^[\(\[\{\<\'\"]$/)
{
if ($noParenthesisParameters || $symbolStack[0] eq '(')
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
push @symbolStack, $token;
}
elsif ( ($token eq ')' && $symbolStack[-1] eq '(') ||
($token eq ']' && $symbolStack[-1] eq '[') ||
($token eq '}' && $symbolStack[-1] eq '{') ||
($token eq '>' && $symbolStack[-1] eq '<') )
{
if (!$noParenthesisParameters && $token eq ')' && scalar @symbolStack == 1 && $symbolStack[0] eq '(')
{
$afterParameters .= $token;
$isAfterParameters = 1;
}
else
{ $parameter .= $token; };
pop @symbolStack;
}
elsif ($token eq ',')
{
if (!scalar @symbolStack)
{
if ($noParenthesisParameters)
{
push @parameterLines, $parameter . $token;
$parameter = undef;
}
else
{
$beforeParameters .= $token;
};
}
else
{
if (scalar @symbolStack == 1 && $symbolStack[0] eq '(' && !$noParenthesisParameters)
{
push @parameterLines, $parameter . $token;
$parameter = undef;
}
else
{
$parameter .= $token;
};
};
}
else
{
if ($noParenthesisParameters || $symbolStack[0] eq '(')
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
};
};
push @parameterLines, $parameter;
foreach my $item (\$beforeParameters, \$afterParameters)
{
$$item =~ s/^ //;
$$item =~ s/ $//;
}
my $prototypeObject = NaturalDocs::Languages::Prototype->New($beforeParameters, $afterParameters);
# Parse the actual parameters.
foreach my $parameterLine (@parameterLines)
{
$prototypeObject->AddParameter( $self->ParseParameterLine($parameterLine) );
};
return $prototypeObject;
};
#
# Function: ParseParameterLine
#
# Parses a prototype parameter line and returns it as a <NaturalDocs::Languages::Prototype::Parameter> object.
#
sub ParseParameterLine #(line)
{
my ($self, $line) = @_;
$line =~ s/^ //;
$line =~ s/ $//;
my @tokens = $line =~ /([^\(\)\[\]\{\}\<\>\'\"\:\=\ ]+|\:\=|.)/g;
my ($name, $type, $defaultValue, $defaultValuePrefix, $inType, $inDefaultValue);
my @symbolStack;
foreach my $token (@tokens)
{
if ($inDefaultValue)
{ $defaultValue .= $token; }
elsif ($symbolStack[-1] eq '\'' || $symbolStack[-1] eq '"')
{
if ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
if ($token eq $symbolStack[-1])
{ pop @symbolStack; };
}
elsif ($token =~ /^[\(\[\{\<\'\"]$/)
{
if ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
push @symbolStack, $token;
}
elsif ( ($token eq ')' && $symbolStack[-1] eq '(') ||
($token eq ']' && $symbolStack[-1] eq '[') ||
($token eq '}' && $symbolStack[-1] eq '{') ||
($token eq '>' && $symbolStack[-1] eq '<') )
{
if ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
pop @symbolStack;
}
elsif ($token eq ' ')
{
if ($inType)
{ $type .= $token; }
elsif (!scalar @symbolStack)
{ $inType = 1; }
else
{ $name .= $token; };
}
elsif ($token eq ':=' || $token eq '=')
{
if (!scalar @symbolStack)
{
$defaultValuePrefix = $token;
$inDefaultValue = 1;
}
elsif ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
}
else
{
if ($inType)
{ $type .= $token; }
else
{ $name .= $token; };
};
};
foreach my $part (\$type, \$defaultValue)
{
$$part =~ s/ $//;
};
return NaturalDocs::Languages::Prototype::Parameter->New($type, undef, $name, undef, $defaultValue, $defaultValuePrefix);
};
sub TypeBeforeParameter
{ return 0; };
1;

View File

@ -0,0 +1,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 <20> 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;

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,93 @@
###############################################################################
#
# Class: NaturalDocs::Languages::Prototype
#
###############################################################################
#
# A data class for storing parsed prototypes.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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;
use NaturalDocs::Languages::Prototype::Parameter;
package NaturalDocs::Languages::Prototype;
use NaturalDocs::DefineMembers 'BEFORE_PARAMETERS', 'BeforeParameters()', 'SetBeforeParameters()',
'AFTER_PARAMETERS', 'AfterParameters()', 'SetAfterParameters()',
'PARAMETERS', 'Parameters()';
# Dependency: New(), constant order, no parents.
#
# Function: New
#
# Creates and returns a new prototype object.
#
# Parameters:
#
# beforeParameters - The part of the prototype before the parameter list.
# afterParameters - The part of the prototype after the parameter list.
#
# You cannot set the parameters from here. Use <AddParameter()>.
#
sub New #(beforeParameters, afterParameters)
{
my ($package, @params) = @_;
# Dependency: Constant order, no parents.
my $object = [ @params ];
bless $object, $package;
return $object;
};
#
# Functions: Members
#
# BeforeParameters - Returns the part of the prototype before the parameter list. If there is no parameter list, this will be the
# only thing that returns content.
# SetBeforeParameters - Replaces the part of the prototype before the parameter list.
# AfterParameters - Returns the part of the prototype after the parameter list, if any.
# SetAfterParameters - Replaces the part of the prototype after the parameter list.
# Parameters - Returns the parameter list as an arrayref of <NaturalDocs::Languages::Prototype::Parameters>, or undef if none.
#
#
# Function: AddParameter
#
# Adds a <NaturalDocs::Languages::Prototype::Parameter> to the list.
#
sub AddParameter #(parameter)
{
my ($self, $parameter) = @_;
if (!defined $self->[PARAMETERS])
{ $self->[PARAMETERS] = [ ]; };
push @{$self->[PARAMETERS]}, $parameter;
};
#
# Function: OnlyBeforeParameters
#
# Returns whether <BeforeParameters()> is the only thing set.
#
sub OnlyBeforeParameters
{
my $self = shift;
return (!defined $self->[PARAMETERS] && !defined $self->[AFTER_PARAMETERS]);
};
1;

View File

@ -0,0 +1,88 @@
###############################################################################
#
# Class: NaturalDocs::Languages::Prototype::Parameter
#
###############################################################################
#
# A data class for storing parsed prototype parameters.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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::Prototype::Parameter;
use NaturalDocs::DefineMembers 'TYPE', 'Type()', 'SetType()',
'TYPE_PREFIX', 'TypePrefix()', 'SetTypePrefix()',
'NAME', 'Name()', 'SetName()',
'NAME_PREFIX', 'NamePrefix()', 'SetNamePrefix()',
'DEFAULT_VALUE', 'DefaultValue()', 'SetDefaultValue()',
'DEFAULT_VALUE_PREFIX', 'DefaultValuePrefix()', 'SetDefaultValuePrefix()';
# Dependency: New() depends on the order of these constants and that they don't inherit from another class.
#
# Constants: Members
#
# The object is implemented as a blessed arrayref, with the following constants as its indexes.
#
# TYPE - The parameter type, if any.
# TYPE_PREFIX - The parameter type prefix which should be aligned separately, if any.
# NAME - The parameter name.
# NAME_PREFIX - The parameter name prefix which should be aligned separately, if any.
# DEFAULT_VALUE - The default value expression, if any.
# DEFAULT_VALUE_PREFIX - The default value prefix which should be aligned separately, if any.
#
#
# Function: New
#
# Creates and returns a new prototype object.
#
# Parameters:
#
# type - The parameter type, if any.
# typePrefix - The parameter type prefix which should be aligned separately, if any.
# name - The parameter name.
# namePrefix - The parameter name prefix which should be aligned separately, if any.
# defaultValue - The default value expression, if any.
# defaultValuePrefix - The default value prefix which should be aligned separately, if any.
#
sub New #(type, typePrefix, name, namePrefix, defaultValue, defaultValuePrefix)
{
my ($package, @params) = @_;
# Dependency: This depends on the order of the parameters being the same as the order of the constants, and that the
# constants don't inherit from another class.
my $object = [ @params ];
bless $object, $package;
return $object;
};
#
# Functions: Members
#
# Type - The parameter type, if any.
# SetType - Replaces the parameter type.
# TypePrefix - The parameter type prefix, which should be aligned separately, if any.
# SetTypePrefix - Replaces the parameter type prefix.
# Name - The parameter name.
# SetName - Replaces the parameter name.
# NamePrefix - The parameter name prefix, which should be aligned separately, if any.
# SetNamePrefix - Replaces the parameter name prefix.
# DefaultValue - The default value expression, if any.
# SetDefaultValue - Replaces the default value expression.
# DefaultValuePrefix - The default value prefix, which should be aligned separately, if any.
# SetDefaultValuePrefix - Replaces the default value prefix.
#
1;

View File

@ -0,0 +1,487 @@
###############################################################################
#
# Class: NaturalDocs::Languages::Simple
#
###############################################################################
#
# A class containing the characteristics of a particular programming language for basic support within Natural Docs.
# Also serves as a base class for languages that break from general conventions, such as not having parameter lists use
# parenthesis and commas.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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::Simple;
use base 'NaturalDocs::Languages::Base';
use base 'Exporter';
our @EXPORT = ( 'ENDER_ACCEPT', 'ENDER_IGNORE', 'ENDER_ACCEPT_AND_CONTINUE', 'ENDER_REVERT_TO_ACCEPTED' );
use NaturalDocs::DefineMembers 'LINE_COMMENT_SYMBOLS', 'LineCommentSymbols()', 'SetLineCommentSymbols() duparrayref',
'BLOCK_COMMENT_SYMBOLS', 'BlockCommentSymbols()',
'SetBlockCommentSymbols() duparrayref',
'PROTOTYPE_ENDERS',
'LINE_EXTENDER', 'LineExtender()', 'SetLineExtender()',
'PACKAGE_SEPARATOR', 'PackageSeparator()',
'PACKAGE_SEPARATOR_WAS_SET', 'PackageSeparatorWasSet()',
'ENUM_VALUES', 'EnumValues()',
'ENUM_VALUES_WAS_SET', 'EnumValuesWasSet()';
#
# Function: New
#
# Creates and returns a new object.
#
# Parameters:
#
# name - The name of the language.
#
sub New #(name)
{
my ($selfPackage, $name) = @_;
my $object = $selfPackage->SUPER::New($name);
$object->[ENUM_VALUES] = ::ENUM_GLOBAL();
$object->[PACKAGE_SEPARATOR] = '.';
return $object;
};
#
# Functions: Members
#
# LineCommentSymbols - Returns an arrayref of symbols that start a line comment, or undef if none.
# SetLineCommentSymbols - Replaces the arrayref of symbols that start a line comment.
# BlockCommentSymbols - Returns an arrayref of start/end symbol pairs that specify a block comment, or undef if none. Pairs
# are specified with two consecutive array entries.
# SetBlockCommentSymbols - Replaces the arrayref of start/end symbol pairs that specify a block comment. Pairs are
# specified with two consecutive array entries.
# LineExtender - Returns the symbol to ignore a line break in languages where line breaks are significant.
# SetLineExtender - Replaces the symbol to ignore a line break in languages where line breaks are significant.
# PackageSeparator - Returns the package separator symbol.
# PackageSeparatorWasSet - Returns whether the package separator symbol was ever changed from the default.
#
#
# Function: SetPackageSeparator
# Replaces the language's package separator string.
#
sub SetPackageSeparator #(separator)
{
my ($self, $separator) = @_;
$self->[PACKAGE_SEPARATOR] = $separator;
$self->[PACKAGE_SEPARATOR_WAS_SET] = 1;
};
#
# Functions: Members
#
# EnumValues - Returns the <EnumValuesType> that describes how the language handles enums.
# EnumValuesWasSet - Returns whether <EnumValues> was ever changed from the default.
#
# Function: SetEnumValues
# Replaces the <EnumValuesType> that describes how the language handles enums.
#
sub SetEnumValues #(EnumValuesType newBehavior)
{
my ($self, $behavior) = @_;
$self->[ENUM_VALUES] = $behavior;
$self->[ENUM_VALUES_WAS_SET] = 1;
};
#
# Function: PrototypeEndersFor
#
# Returns an arrayref of prototype ender symbols for the passed <TopicType>, or undef if none.
#
sub PrototypeEndersFor #(type)
{
my ($self, $type) = @_;
if (defined $self->[PROTOTYPE_ENDERS])
{ return $self->[PROTOTYPE_ENDERS]->{$type}; }
else
{ return undef; };
};
#
# Function: SetPrototypeEndersFor
#
# Replaces the arrayref of prototype ender symbols for the passed <TopicType>.
#
sub SetPrototypeEndersFor #(type, enders)
{
my ($self, $type, $enders) = @_;
if (!defined $self->[PROTOTYPE_ENDERS])
{ $self->[PROTOTYPE_ENDERS] = { }; };
if (!defined $enders)
{ delete $self->[PROTOTYPE_ENDERS]->{$type}; }
else
{
$self->[PROTOTYPE_ENDERS]->{$type} = [ @$enders ];
};
};
###############################################################################
# Group: Parsing Functions
#
# Function: ParseFile
#
# Parses the passed source file, sending comments acceptable for documentation to <NaturalDocs::Parser->OnComment()>
# and all other sections to <OnCode()>.
#
# Parameters:
#
# sourceFile - The <FileName> of the source file to parse.
# topicList - A reference to the list of <NaturalDocs::Parser::ParsedTopics> being built by the file.
#
# Returns:
#
# Since this class cannot automatically document the code or generate a scope record, it always returns ( undef, undef ).
#
sub ParseFile #(sourceFile, topicsList)
{
my ($self, $sourceFile, $topicsList) = @_;
open(SOURCEFILEHANDLE, '<' . $sourceFile)
or die "Couldn't open input file " . $sourceFile . "\n";
my $lineReader = NaturalDocs::LineReader->New(\*SOURCEFILEHANDLE);
my @commentLines;
my @codeLines;
my $lastCommentTopicCount = 0;
if ($self->Name() eq 'Text File')
{
@commentLines = $lineReader->GetAll();
NaturalDocs::Parser->OnComment(\@commentLines, 1);
}
else
{
my $line = $lineReader->Get();
my $lineNumber = 1;
while (defined $line)
{
my $originalLine = $line;
# Retrieve multiline comments. This leaves $line at the next line.
# We check for multiline comments before single line comments because in Lua the symbols are --[[ and --.
if (my $closingSymbol = $self->StripOpeningBlockSymbols(\$line, $self->BlockCommentSymbols()))
{
# Note that it is possible for a multiline comment to start correctly but not end so. We want those comments to stay in
# the code. For example, look at this prototype with this splint annotation:
#
# int get_array(integer_t id,
# /*@out@*/ array_t array);
#
# The annotation starts correctly but doesn't end so because it is followed by code on the same line.
my $lineRemainder;
for (;;)
{
$lineRemainder = $self->StripClosingSymbol(\$line, $closingSymbol);
push @commentLines, $line;
# If we found an end comment symbol...
if (defined $lineRemainder)
{ last; };
$line = $lineReader->Get();
if (!defined $line)
{ last; };
};
if ($lineRemainder !~ /^[ \t]*$/)
{
# If there was something past the closing symbol this wasn't an acceptable comment, so move the lines to code.
push @codeLines, @commentLines;
@commentLines = ( );
};
$line = $lineReader->Get();
}
# Retrieve single line comments. This leaves $line at the next line.
elsif ($self->StripOpeningSymbols(\$line, $self->LineCommentSymbols()))
{
do
{
push @commentLines, $line;
$line = $lineReader->Get();
if (!defined $line)
{ goto EndDo; };
}
while ($self->StripOpeningSymbols(\$line, $self->LineCommentSymbols()));
EndDo: # I hate Perl sometimes.
}
# Otherwise just add it to the code.
else
{
push @codeLines, $line;
$line = $lineReader->Get();
};
# If there were comments, send them to Parser->OnComment().
if (scalar @commentLines)
{
# First process any code lines before the comment.
if (scalar @codeLines)
{
$self->OnCode(\@codeLines, $lineNumber, $topicsList, $lastCommentTopicCount);
$lineNumber += scalar @codeLines;
@codeLines = ( );
};
$lastCommentTopicCount = NaturalDocs::Parser->OnComment(\@commentLines, $lineNumber);
$lineNumber += scalar @commentLines;
@commentLines = ( );
};
}; # while (defined $line)
# Clean up any remaining code.
if (scalar @codeLines)
{
$self->OnCode(\@codeLines, $lineNumber, $topicsList, $lastCommentTopicCount);
@codeLines = ( );
};
};
close(SOURCEFILEHANDLE);
return ( undef, undef );
};
#
# Function: OnCode
#
# Called whenever a section of code is encountered by the parser. Is used to find the prototype of the last topic created.
#
# Parameters:
#
# codeLines - The source code as an arrayref of lines.
# codeLineNumber - The line number of the first line of code.
# topicList - A reference to the list of <NaturalDocs::Parser::ParsedTopics> being built by the file.
# lastCommentTopicCount - The number of Natural Docs topics that were created by the last comment.
#
sub OnCode #(codeLines, codeLineNumber, topicList, lastCommentTopicCount)
{
my ($self, $codeLines, $codeLineNumber, $topicList, $lastCommentTopicCount) = @_;
if ($lastCommentTopicCount && defined $self->PrototypeEndersFor($topicList->[-1]->Type()))
{
my $lineIndex = 0;
my $prototype;
# Skip all blank lines before a prototype.
while ($lineIndex < scalar @$codeLines && $codeLines->[$lineIndex] =~ /^[ \t]*$/)
{ $lineIndex++; };
my @tokens;
my $tokenIndex = 0;
my @brackets;
my $enders = $self->PrototypeEndersFor($topicList->[-1]->Type());
# Add prototype lines until we reach the end of the prototype or the end of the code lines.
while ($lineIndex < scalar @$codeLines)
{
my $line = $self->RemoveLineExtender($codeLines->[$lineIndex] . "\n");
push @tokens, $line =~ /([^\(\)\[\]\{\}\<\>]+|.)/g;
while ($tokenIndex < scalar @tokens)
{
# If we're not inside brackets, check for ender symbols.
if (!scalar @brackets)
{
my $startingIndex = 0;
my $testPrototype;
for (;;)
{
my ($enderIndex, $ender) = ::FindFirstSymbol($tokens[$tokenIndex], $enders, $startingIndex);
if ($enderIndex == -1)
{ last; }
else
{
# We do this here so we don't duplicate prototype for every single token. Just the first time an ender symbol
# is found in one.
if (!defined $testPrototype)
{ $testPrototype = $prototype; };
$testPrototype .= substr($tokens[$tokenIndex], $startingIndex, $enderIndex - $startingIndex);
my $enderResult;
# If the ender is all text and the character preceding or following it is as well, ignore it.
if ($ender =~ /^[a-z0-9]+$/i &&
( ($enderIndex > 0 && substr($tokens[$tokenIndex], $enderIndex - 1, 1) =~ /^[a-z0-9_]$/i) ||
substr($tokens[$tokenIndex], $enderIndex + length($ender), 1) =~ /^[a-z0-9_]$/i ) )
{ $enderResult = ENDER_IGNORE(); }
else
{ $enderResult = $self->OnPrototypeEnd($topicList->[-1]->Type(), \$testPrototype, $ender); }
if ($enderResult == ENDER_IGNORE())
{
$testPrototype .= $ender;
$startingIndex = $enderIndex + length($ender);
}
elsif ($enderResult == ENDER_REVERT_TO_ACCEPTED())
{
return;
}
else # ENDER_ACCEPT || ENDER_ACCEPT_AND_CONTINUE
{
my $titleInPrototype = $topicList->[-1]->Title();
# Strip parenthesis so Function(2) and Function(int, int) will still match Function(anything).
$titleInPrototype =~ s/[\t ]*\([^\(]*$//;
if (index($testPrototype, $titleInPrototype) != -1)
{
$topicList->[-1]->SetPrototype( $self->NormalizePrototype($testPrototype) );
};
if ($enderResult == ENDER_ACCEPT())
{ return; }
else # ENDER_ACCEPT_AND_CONTINUE
{
$testPrototype .= $ender;
$startingIndex = $enderIndex + length($ender);
};
};
};
};
}
# If we are inside brackets, check for closing symbols.
elsif ( ($tokens[$tokenIndex] eq ')' && $brackets[-1] eq '(') ||
($tokens[$tokenIndex] eq ']' && $brackets[-1] eq '[') ||
($tokens[$tokenIndex] eq '}' && $brackets[-1] eq '{') ||
($tokens[$tokenIndex] eq '>' && $brackets[-1] eq '<') )
{
pop @brackets;
};
# Check for opening brackets.
if ($tokens[$tokenIndex] =~ /^[\(\[\{]$/ ||
($tokens[$tokenIndex] eq "<" && $tokens[$tokenIndex-1] !~ /operator[ \t]*$/) )
{
push @brackets, $tokens[$tokenIndex];
};
$prototype .= $tokens[$tokenIndex];
$tokenIndex++;
};
$lineIndex++;
};
# If we got out of that while loop by running out of lines, there was no prototype.
};
};
use constant ENDER_ACCEPT => 1;
use constant ENDER_IGNORE => 2;
use constant ENDER_ACCEPT_AND_CONTINUE => 3;
use constant ENDER_REVERT_TO_ACCEPTED => 4;
#
# Function: OnPrototypeEnd
#
# Called whenever the end of a prototype is found so that there's a chance for derived classes to mark false positives.
#
# 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)
{
return ENDER_ACCEPT();
};
#
# Function: RemoveLineExtender
#
# If the passed line has a line extender, returns it without the extender or the line break that follows. If it doesn't, or there are
# no line extenders defined, returns the passed line unchanged.
#
sub RemoveLineExtender #(line)
{
my ($self, $line) = @_;
if (defined $self->LineExtender())
{
my $lineExtenderIndex = rindex($line, $self->LineExtender());
if ($lineExtenderIndex != -1 &&
substr($line, $lineExtenderIndex + length($self->LineExtender())) =~ /^[ \t]*\n$/)
{
$line = substr($line, 0, $lineExtenderIndex) . ' ';
};
};
return $line;
};
1;

View File

@ -0,0 +1,220 @@
###############################################################################
#
# Class: NaturalDocs::Languages::Tcl
#
###############################################################################
#
# A subclass to handle the language variations of Tcl.
#
###############################################################################
# This file is part of Natural Docs, which is Copyright <20> 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::Tcl;
use base 'NaturalDocs::Languages::Simple';
#
# bool: pastFirstBrace
#
# Whether we've past the first brace in a function prototype or not.
#
my $pastFirstBrace;
#
# Function: OnCode
#
# This is just overridden to reset <pastFirstBrace>.
#
sub OnCode #(...)
{
my ($self, @params) = @_;
$pastFirstBrace = 0;
return $self->SUPER::OnCode(@params);
};
#
# Function: OnPrototypeEnd
#
# Tcl's function syntax is shown below.
#
# > proc [name] { [params] } { [code] }
#
# The opening brace is one of the prototype enders. We need to allow the first opening brace because it contains the
# parameters.
#
# Also, the parameters may have braces within them. I've seen one that used { seconds 20 } as a parameter.
#
# 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 '{' && !$pastFirstBrace)
{
$pastFirstBrace = 1;
return ::ENDER_IGNORE();
}
else
{ return ::ENDER_ACCEPT(); };
};
#
# Function: ParsePrototype
#
# Parses the prototype and returns it as a <NaturalDocs::Languages::Prototype> object.
#
# Parameters:
#
# type - The <TopicType>.
# prototype - The text prototype.
#
# Returns:
#
# A <NaturalDocs::Languages::Prototype> object.
#
sub ParsePrototype #(type, prototype)
{
my ($self, $type, $prototype) = @_;
if ($type ne ::TOPIC_FUNCTION())
{
my $object = NaturalDocs::Languages::Prototype->New($prototype);
return $object;
};
# Parse the parameters out of the prototype.
my @tokens = $prototype =~ /([^\{\}\ ]+|.)/g;
my $parameter;
my @parameterLines;
my $braceLevel = 0;
my ($beforeParameters, $afterParameters, $finishedParameters);
foreach my $token (@tokens)
{
if ($finishedParameters)
{ $afterParameters .= $token; }
elsif ($token eq '{')
{
if ($braceLevel == 0)
{ $beforeParameters .= $token; }
else # braceLevel > 0
{ $parameter .= $token; };
$braceLevel++;
}
elsif ($token eq '}')
{
if ($braceLevel == 1)
{
if ($parameter && $parameter ne ' ')
{ push @parameterLines, $parameter; };
$finishedParameters = 1;
$afterParameters .= $token;
$braceLevel--;
}
elsif ($braceLevel > 1)
{
$parameter .= $token;
$braceLevel--;
};
}
elsif ($token eq ' ')
{
if ($braceLevel == 1)
{
if ($parameter)
{ push @parameterLines, $parameter; };
$parameter = undef;
}
elsif ($braceLevel > 1)
{
$parameter .= $token;
}
else
{
$beforeParameters .= $token;
};
}
else
{
if ($braceLevel > 0)
{ $parameter .= $token; }
else
{ $beforeParameters .= $token; };
};
};
foreach my $part (\$beforeParameters, \$afterParameters)
{
$$part =~ s/^ //;
$$part =~ s/ $//;
};
my $prototypeObject = NaturalDocs::Languages::Prototype->New($beforeParameters, $afterParameters);
# Parse the actual parameters.
foreach my $parameterLine (@parameterLines)
{
$prototypeObject->AddParameter( $self->ParseParameterLine($parameterLine) );
};
return $prototypeObject;
};
#
# Function: ParseParameterLine
#
# Parses a prototype parameter line and returns it as a <NaturalDocs::Languages::Prototype::Parameter> object.
#
sub ParseParameterLine #(line)
{
my ($self, $line) = @_;
return NaturalDocs::Languages::Prototype::Parameter->New(undef, undef, $line, undef, undef, undef);
};
1;