";
# print STDERR "FIRST (line = \"$line\")\n";
}
if ($line =~ s/^( +)//) {
my $spaces = $1;
my $count = ($spaces =~ tr/^ //);
while ($count--) { $line = " $line"; }
$newret .= "$first$line";
} else {
$newret .= "$first$line";
}
}
$retval = $newret;
$retval = "";
}
$self->{HTMLTREE} = $retval;
return $retval;
}
# /*!
# @abstract
# Recursively walks the descendants of this node (and their
# siblngs/descendants) and returns the first non-space node
# that is not in a comment.
# @param self
# The node whose children you want to search.
# @param soc
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param ilc
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param ilc_b
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# */
sub childpeeknc
{
my $self = shift;
my $soc = shift;
my $ilc = shift;
my $ilc_b = shift;
my $cache = $self->{CPNC};
if ($cache) { return $cache; }
my $node = $self->{FIRSTCHILD};
if (!$node) { return ""; }
bless($node, "HeaderDoc::ParseTree");
if (!$node->token()) { return $node->childpeeknc($soc, $ilc, $ilc_b) || return $node->nextpeeknc($soc, $ilc, $ilc_b); }
if ($node->token() =~ /\s/o) { return $node->childpeeknc($soc, $ilc, $ilc_b) || return $node->nextpeeknc($soc, $ilc, $ilc_b); }
if ($node->token() eq $soc) { return $node->childpeeknc($soc, $ilc, $ilc_b) || return $node->nextpeeknc($soc, $ilc, $ilc_b); }
if ($node->token() eq $ilc || $node->token() eq $ilc_b) { return $node->childpeeknc($soc, $ilc, $ilc_b) || return $node->nextpeeknc($soc, $ilc, $ilc_b); }
$cache = $node->token();
$self->{CPNC} = $cache;
return $cache;
}
# /*!
# @abstract
# Recursively walks the siblings of this node (and their
# descendants) and returns the first non-space node.
# @param self
# The node whose siblings you want to search.
# */
sub nextpeek
{
my $self = shift;
# This cache appears to be slowing things down.
# if ($self->{NPCACHE}) { return $self->{NPCACHE}; }
my $node = undef;
if ($self->firstchild()) {
$node = $self->firstchild();
$node = $node->next;
} else {
$node = $self->next();
}
if (!$node) {
# $self->{NPCACHE} = "";
return "";
}
my $token = $node->token();
if ($token =~ /\s/o && $token !~ /[\r\n]/o) {
my $ret = $node->nextpeek();
# $self->{NPCACHE} = $ret;
return $ret;
}
if ($node->hidden()) {
my $ret = $node->nextpeek();
# $self->{NPCACHE} = $ret;
return $ret;
}
# $self->{NPCACHE} = $node->token();
return $node->token();
}
# /*!
# @abstract
# Recursively walks the siblings of this node (and their
# descendants) and returns the first non-space node that
# is not in a comment.
# @param self
# The node whose siblings you want to search.
# @param soc
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param ilc
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param ilc_b
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# */
sub nextpeeknc
{
my $self = shift;
my $soc = shift;
my $ilc = shift;
my $ilc_b = shift;
my $node = $self->nextTokenNoComments($soc, $ilc, $ilc_b, 0, 0);
if (!$node) { return ""; }
return $node->token();
}
# /*!
# @abstract
# Recursively walks the siblings of this node (and their
# descendants) and returns the second non-space node that
# is not in a comment.
# @param self
# The node whose siblings you want to search.
# @param soc
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param ilc
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param ilc_b
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# */
sub nextnextpeeknc
{
my $self = shift;
my $soc = shift;
my $ilc = shift;
my $ilc_b = shift;
my $node = $self->nextTokenNoComments($soc, $ilc, $ilc_b, 0, 0);
if (!$node) { return ""; }
my $nodeafter = $node->nextTokenNoComments($soc, $ilc, $ilc_b, 0, 0);
if (!$nodeafter) { return ""; }
return $nodeafter->token();
}
# /*!
# @abstract
# Recursively walks the siblings of this node (and their
# descendants) and returns the first node (including spaces) that
# is not in a comment.
# @param self
# The node whose siblings you want to search.
# @param soc
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param ilc
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param ilc_b
# The start-of-comment token for the current programming language.
# Obtained by a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# */
sub nextTokenNoComments($$$$$)
{
my $self = shift;
my $soc = shift;
my $ilc = shift;
my $ilc_b = shift;
my $failOnHDComments = shift;
my $enable_javadoc_comments = shift;
my $localDebug = 0;
my $cache = $self->{NTNC};
if ($cache) { return $cache; }
my $node = $self->{NEXT};
if (!$node) { return undef }
bless($node, "HeaderDoc::ParseTree");
# print STDERR "SOC: $soc ILC: $ilc ILC_B: $ilc_b\n" if ($colorDebug);
# print STDERR "MAYBE ".$node->token()."\n";
if ($failOnHDComments) {
# print STDERR "FOHDC\n";
# print STDERR "FC: ".$node->firstchild()."\n";
if ($node->firstchild() && $node->firstchild()->next()) {
# print STDERR "POINT 1\n";
# first child always empty.
my $testnode = $node->firstchild()->next();
if (($node->token() eq $ilc) || ($node->token() eq $ilc_b)) {
# print STDERR "ILC\n";
if ($node->token() eq $ilc) {
my $ntoken = "";
if ($testnode->next()) { $ntoken = $testnode->next()->token(); }
if ($testnode->token() eq "!" || ($enable_javadoc_comments && $testnode->token eq "*" && $ntoken !~ /^\*/)) {
print STDERR "Unexpected HD Comment\n" if ($localDebug);
return undef;
}
} else {
if ($testnode->token() eq $ilc) {
my $nntoken = "";
if ($testnode->next() && $testnode->next()->next()) { $nntoken = $testnode->next()->next()->token(); }
if ($testnode->next() && (($testnode->next()->token() eq "!") || ($enable_javadoc_comments && $testnode->next()->token eq "*" && $nntoken !~ /^\*/))) {
print STDERR "Unexpected HD Comment\n" if ($localDebug);
return undef;
}
}
}
} elsif ($node->token() eq $soc) {
# print STDERR "SOC\n";
my $ntoken = "";
if ($testnode->next()) { $ntoken = $testnode->next()->token(); }
if (($testnode->token() eq "!") || ($enable_javadoc_comments && $testnode->token eq "*" && $ntoken !~ /^\*/)) {
print STDERR "Unexpected HD Comment\n" if ($localDebug);
return undef;
}
# } else {
# print STDERR "TOKEN: ".$node->token()."\n";
}
}
}
if (!$node->token()) { return $self->{NTNC} = $node->nextTokenNoComments($soc, $ilc, $ilc_b, $failOnHDComments, $enable_javadoc_comments); }
if ($node->token() =~ /\s/o) { return $self->{NTNC} = $node->nextTokenNoComments($soc, $ilc, $ilc_b, $failOnHDComments, $enable_javadoc_comments); }
if ($node->token() eq $soc) { return $self->{NTNC} = $node->nextTokenNoComments($soc, $ilc, $ilc_b, $failOnHDComments, $enable_javadoc_comments); }
if ($node->token() eq $ilc || $node->token() eq $ilc_b) { return $self->{NTNC} = $node->nextTokenNoComments($soc, $ilc, $ilc_b, $failOnHDComments, $enable_javadoc_comments); }
$self->{NTNC} = $node;
# weaken($self->{NTNC});
return $node;
}
# /*!
# @abstract
# Walks up the parent tree until it reaches a node
# that is a sibling of matchingnode, then returns
# the node after that one.
# @param self
# The starting node.
# @param matchingnode
# The node whose level you want ot match.
# @param fullpath
# The path of the file containing this parse
# tree (used for debugging messages).
# */
sub nextAtLevelOf
{
my $self = shift;
my $matchingnode = shift;
my $fullpath = shift;
my $nextnode = $self;
while ($nextnode && !$nextnode->isAfter($matchingnode)) {
$nextnode = $nextnode->parent();
}
if ($nextnode) {
$nextnode = $nextnode->next();
} else {
my $tt = $self;
while ($tt->parent()) { $tt = $tt->parent(); }
my $apio = $tt->apiOwner();
cluck("TT: $tt\n");
# my $fullpath = $apio->fullpath();
warn("$fullpath:0:Ran off top of stack looking for next node.\n");
# $nextnode = $matchingnode->next();
$nextnode = undef;
}
return $nextnode;
}
# /*!
# @abstract
# Trivially returns whether this token should be
# treated a the start of a macro.
# @param self
# This parse tree instance (unused).
# @param token
# The token to check.
# @param lang
# The current language.
# @param sublang
# The current language dialect (e.g. cpp for C++).
# */
sub isMacro
{
my $self = shift;
my $token = shift;
my $lang = shift;
my $sublang = shift;
if ($lang ne "C" && $lang ne "Csource") { return 0; }
if ($token =~ /^\#\w+/o) { return 1; }
return 0;
}
# /*!
# @abstract Prints the contents of a colorTreeSub state object.
# */
sub dumpCTState
{
my $ctstateref = shift;
my %ctstate = %{$ctstateref};
print STDERR "DUMPING CTSTATE:\n\n";
foreach my $key (keys %ctstate) {
print " $key => ".$ctstate{$key}."\n";
}
print "\n\n";
}
# /*!
# @abstract
# Returns an HTML or XML representation of a parse tree/subtree.
# @param self
# The top of the tree/subtree to print.
# @param ctstate
# The colortree state object. It should contain the parameters
# listed below.
# @param keep_whitespace
# Set to 1 if whitespace should be preserved in the
# output, else 0.
# @param apio
# The owner of the parse tree. This may be an API owner or
# may jut be an ordinary type class instance (e.g. Struct).
#
# This is mostly used for using methods in the HeaderElement
# class and obtaining filenames/line numbers for debugging.
# @param type
# Indicates information about what we're currently parsing.
# Possible values are:
#
#
# typedefstructrecordunionenumfuncptrhexnumberpastd - pascal type declarationpasvar - pascal variable declarationpasrec - pascal record declaration
# @param depth
# The nesting depth within the parse tree. Used for leading
# space calculations.
# @param inComment
# On initial call, 0. On recursion, possible values are:
#
# - 0 — Not in a comment.
# - 1 — In a multi-line (soc) comment.
# - 2 — In a single-line (ilc) comment.
#
#
# @param inQuote
# On initial call, 0. On recursion, possible values are:
#
# - 0 — Not in quote.
# - 1 — Inside double quotes.
# - 2 — Inside single quote.
# - 3 — In a Python triple-quote or a Ruby quote.
# See
inRubyQuote to determine which.
#
# @param inRubyQuote
# On initial call, 0. On recursion, possible values are:
#
# - 0 — Not in a Ruby quote.
# - 1 — Inside either
%{ or %/
# - 2 — Inside
<<. Prevents coloring
# of the initial token.
#
# @param inObjCMethod
# Pass in 1 if this is a parse tree for an Objective-C method,
# else pass in 0.
# @param lastBrace
# The last brace or parentheses character seen,
# or +/- in Objective-C methods), or special tokens
# that are treated like braces.
# @param parseTokensRef
# A reference to the parse tokens hash returned by
# a call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param prespace
# The leading spaces that should be inserted
# to the left of this token if it wraps to the start of
# a line.
# @param lang
# The current language.
# @param sublang
# The current language dialect (e.g. cpp for C++).
# @param xmlmode
# Set to 1 if you want XML output, 0 for HTML.
# @param newlen
# The length of the current line. Set to 0 on first call.
# @param breakable
# Indicates whether the formatter can break before this token.
#
# - 0 — Not a good spot to break.
# - 1 — Breakable before this token.
# - 2 — Breakable after this token.
# - 3 — This token must be at the start of a line.
#
# @param inMacro
# Set to 0 on first call. During tree walk, this goes high when
# the tree walk code enters a C preprocessor macro and remains high
# until the end of the macro.
# @param inEnum
# Set to 0 on first call. Goes high when inside an enumeration.
# @param seenEquals
# Set to 0 on first call. Goes high after the equals sign in a
# variable declaration.
# @param lastKeyword
# Contains the last keyword encountered. Set to an empty string
# on first call. Used for guessing types in generating link
# requests.
# @param lastnstoken
# The last non-space token encountered. Set to an empty string
# on first call.
# @param lastTreeNode
# The tree node at which output stops. This node and its
# descendants are included in output, but not this node's siblings.
# @param lastTokenType
# Contains the type of the last token emitted. One of:
# star, string, char,
# comment, preprocessor,
# number, keyword,
# function, var,
# template, type,
# param, or ignore.
#
# On initial call, an empty string.
# @param spaceSinceLastToken
# Indicates that whitespace has been seen since the last non-space
# token. This ensures that required space does not get deleted.
#
# On initial call, 0.
# @param inAttribute
# On initial call, 0. On recursion, set to 1 after
# the attribute keyword (or equivalent) is encountered.
#
# Causes the next word token to be interpreted as ordinary text.
#
# Also prevents the normal line break after the open parenthesis.
# @param inRaises
# On initial call, 0. On recursion, set to 1 after
# the raises keyword (or equivalent) is encountered.
#
# Causes the next word token to be interpreted as a variable (an
# exception) instead of a type.
#
# Also prevents the normal line break after the open parenthesis.
# @param inTypeOf
# On initial call, 0. On recursion, set to 1 after
# the typeof keyword (or equivalent) is encountered.
#
# Causes the next word token to be interpreted as a variable instead
# of a type.
#
# Also prevents the normal line break after the open parenthesis.
# @param drop_pdefine_contents
# Set to 1 if the contents of #define macros should be
# dropped from the output, else 0.
# @param ASinName
# On initial call, set to 0. During the recursive walk of the
# parse tree, this gets set to 1 when the current tree node in
# an AppleScript name.
#
# @var tokenType
# Contains the type of the last token emitted. One of:
# star, string, char,
# comment, preprocessor,
# number, keyword,
# function, var,
# template, type,
# param, or ignore.
#
# @discussion
# This is a helper function shared by {@link htmlTree} and
# {@link xmlTree}. You should not call this directly.
# */
sub colorTreeSub
{
my $self = shift;
my $ctstateref = shift;
my $localDebug = 0;
my $psDebug = 0;
my $treeDebug = 0;
my $dropDebug = 0;
my $tokenDebug = 0;
my $codePathDebug = 0;
my $rubyDebug = 0;
my $tokenPrintDebug = 0;
my $advisorySpaceDebug = 0;
my $continue = 1;
my %ctstate = %{$ctstateref};
my $token = $self->{TOKEN};
my $ntoken = $self->nextpeek();
my $tokenname = $token;
if ($token eq "\n") { $tokenname = "[NEWLINE]"; }
elsif ($token eq "\r") { $tokenname = "[CARRIAGE RETURN]"; }
elsif (!length($token)) { $tokenname = "[EMPTY STRING]"; }
else { $tokenname = "\"".$tokenname."\""; }
my $ntokenname = $ntoken;
if ($ntoken eq "\n") { $ntokenname = "[NEWLINE]"; }
elsif ($ntoken eq "\r") { $ntokenname = "[CARRIAGE RETURN]"; }
elsif (!length($ntoken)) { $ntokenname = "[EMPTY STRING]"; }
else { $ntokenname = "\"".$ntokenname."\""; }
my $lastnstokenname = $ctstate{lastnstoken};
if ($ctstate{lastnstoken} eq "\n") { $lastnstokenname = "[NEWLINE]"; }
elsif ($ctstate{lastnstoken} eq "\r") { $lastnstokenname = "[CARRIAGE RETURN]"; }
elsif (!length($ctstate{lastnstoken})) { $lastnstokenname = "[EMPTY STRING]"; }
else { $lastnstokenname = "\"".$lastnstokenname."\""; }
print STDERR "***** TOKEN: ".$tokenname." *****\n" if ($codePathDebug || $localDebug || $tokenDebug || $tokenPrintDebug);
# print STDERR "IN COLORTREESUB\n";
if ($self == $ctstate{lastTreeNode}) {
print STDERR "Node is last node in tree. Ending after this node.\n" if ($localDebug || $codePathDebug);
$continue = 0;
}
dumpCTState(\%ctstate) if ($localDebug);
print STDERR "NEWLEN: ".$ctstate{newlen}."\n" if ($localDebug);
my %parseTokens = %{$ctstate{parseTokensRef}};
my %macroList = %{$parseTokens{macronames}};
my $oldLastBrace = $ctstate{lastBrace};
my $oldDepth = $ctstate{depth};
my $oldInMacro = $ctstate{inMacro};
my $oldInQuote = $ctstate{inQuote};
my $oldLastKeyword = $ctstate{lastKeyword};
my $oldInComment = $ctstate{inComment} ;
my $oldInAttribute = $ctstate{inAttribute};
my $oldInRaises = $ctstate{inRaises};
my $oldInTypeOf = $ctstate{inTypeOf};
my $dropFP = 0;
# This cache slows things down now that it works....
# if ($self->{CTSUB}) { return (\$self->{CTSTRING}, $self->{CTSUB}); }
my $keep_all_newlines = 0;
print STDERR "DPC: ".$ctstate{drop_pdefine_contents}."\n" if ($localDebug);
if ($ctstate{lang} eq "shell" || $ctstate{sublang} eq "javascript") {
$keep_all_newlines = 1;
} elsif ($ctstate{lang} eq "python") {
$keep_all_newlines = 1;
$ctstate{keep_whitespace} = 1;
}
if ($ctstate{xmlmode} && $localDebug) {
print STDERR "XMLMODE.\n";
}
# foreach my $listitem (keys %macroList) { print STDERR "ML: $listitem\n"; }
print STDERR "IM: ".$ctstate{inMacro}."\n" if ($localDebug);
print STDERR "IAtt: ".$ctstate{inAttribute}."\n" if ($localDebug);
print STDERR "IRai: ".$ctstate{inRaises}."\n" if ($localDebug);
my $mustbreak = 0;
my $nextprespace = "";
my $string = "";
my $tailstring = "";
my $escapetoken = "";
my ($case_sensitive, $keywordhashref) = $ctstate{apio}->keywords();
my $tokennl = 0;
if ($token =~ /^[\r\n]/o) { $tokennl = 1; }
if (($token eq "\t" || $token =~ /^ +$/) && (!$ctstate{keep_whitespace})) { $token = " "; }
if ($ctstate{inQuote} == 3) {
$keep_all_newlines = 1;
$ctstate{keep_whitespace} = 1;
}
if ($ctstate{keep_whitespace}) {
$ctstate{prespace} = "";
$nextprespace = "";
}
if (length($token) && (!$tokennl)) {
if ($ctstate{afteradvisoryspace}) {
# Remove a single space if we're after a newline that
# got converted into a space
print STDERR "OLD AASTOKEN: \"$token\"\n" if ($localDebug || $advisorySpaceDebug || $codePathDebug);
$token =~ s/^ //;
$ctstate{afteradvisoryspace} = 0;
print STDERR "AASTOKEN NOW: \"$token\"\n" if ($localDebug || $advisorySpaceDebug || $codePathDebug);
print STDERR "AAS -> 0\n" if ($localDebug || $advisorySpaceDebug || $codePathDebug);
}
}
print "keep_all_newlines: $keep_all_newlines\n" if ($localDebug);
my $tokenIsKeyword = isKeyword($token, $keywordhashref, $case_sensitive);
print STDERR "TIK: $tokenIsKeyword\n" if ($localDebug);
# my $ctoken = $self->childpeek($soc, $parseTokens{ilc}, $parseTokens{ilc_b});
print STDERR "TK $token\n" if ($colorDebug || $rubyDebug || $colorDebug);
print STDERR "IRQ is ".$ctstate{inRubyQuote}."\n" if ($rubyDebug || $colorDebug);
print STDERR "IQ is ".$ctstate{inQuote}."\n" if ($rubyDebug || $colorDebug);
my $ctoken = $self->childpeeknc($parseTokens{soc}, $parseTokens{ilc}, $parseTokens{ilc_b});
my $ntokennc = $self->nextpeeknc($parseTokens{soc}, $parseTokens{ilc}, $parseTokens{ilc_b});
my $nntokennc = $self->nextnextpeeknc($parseTokens{soc}, $parseTokens{ilc}, $parseTokens{ilc_b});
my $tokenType = undef;
my $drop = 0;
my $firstCommentToken = 0;
my $leavingComment = 0;
my $hidden = ($self->hidden() && !$ctstate{xmlmode});
my $isTypeStar = 0;
my $begintr = "";
my $endtr = "";
my $newtd = "";
if (!$ctstate{xmlmode} && $HeaderDoc::align_columns) {
$begintr = "| ";
$endtr = " | ";
$newtd = " | ";
}
if ($ntoken eq "::" && $ctstate{lang} eq "perl") {
$ctstate{tokenAccum} .= $token.$ntoken;
$ctstate{skipToken} = 2;
# print STDERR "SKIPTOKEN -> 2 ($token $ntoken)\n";
} elsif ($ctstate{tokenAccum} && (!$ctstate{skipToken})) {
# print STDERR "ACCUM ($token prepended with ".$ctstate{tokenAccum}.")\n";
$token = $ctstate{tokenAccum}.$token;
$ctstate{tokenAccum} = "";
}
print STDERR "TOKEN: $tokenname NTOKEN: $ntokenname LASTNSTOKEN: $lastnstokenname IC: ".$ctstate{inComment}."\n" if ($treeDebug || $localDebug || $codePathDebug);
print STDERR "OCC: ".$ctstate{inObjCMethod}."\n" if ($colorDebug || $localDebug);
print STDERR "HIDDEN: $hidden\n" if ($localDebug);
# last one in each chain prior to a "," or at end of chain is "var"
# or "parm" (functions)
print STDERR "TK $token NT $ntoken NTNC $ntokennc NNTNC $nntokennc LB: ".$ctstate{lastBrace}." PS: ".length($ctstate{prespace})."\n" if ($colorDebug);
my $nospaceafter = 0;
my $nextbreakable = 0;
if ($ctstate{breakable} == 2) {
$ctstate{breakable} = 0;
$nextbreakable = 1;
} elsif ($ctstate{breakable} == 3) {
$mustbreak = 1;
$ctstate{breakable} = 1;
$nextbreakable = 0;
}
print STDERR "POST_CHECK MUSTBREAK: $mustbreak BREAKABLE: ".$ctstate{breakable}." NEXTBREAKABLE: $nextbreakable\n" if ($localDebug);
if (($ctstate{lang} eq "C" || $ctstate{lang} eq "Csource") && $token eq $parseTokens{enumname}) {
my $curname = $ctstate{apio}->name();
print STDERR "NAME: $curname\n" if ($localDebug);
print STDERR "NOW ENUM\n" if ($localDebug);
$ctstate{inEnum} = 1;
}
if ($parseTokens{propname} && $token eq $parseTokens{propname}) {
$ctstate{inObjCProperty} = 1;
}
## Enable for certain testing.
## if ($self->parserState()) {
## # reset for new declaration.
## $ctstate{lastBrace} = "";
## }
if ($ctstate{inObjCMethod} && $token =~ /^[+-]/o && ($ctstate{lastBrace} eq "")) {
$ctstate{lastBrace} = $token;
}
my $MIG = 0;
if ($ctstate{lang} eq "C" && $ctstate{sublang} eq "MIG") { $MIG = 1; }
my $splitre = "";
if ($ctstate{type} =~ /^(typedef|struct|record|union)/o) {
$splitre = ";";
} elsif ($ctstate{type} =~ /^(enum|funcptr)/o) {
$splitre = ",";
} elsif ($ctstate{lastBrace} eq "(") {
$splitre = ",";
if ($MIG) { $splitre = ";"; }
} elsif ($ctstate{lastBrace} eq $parseTokens{lbrace}) {
if ($ctstate{lang} eq "tcl") {
$splitre = '\s';
} elsif ($ctstate{inEnum}) {
$splitre = ",";
} else {
$splitre = ";";
}
} elsif (($ctstate{lastBrace} eq $parseTokens{structname}) && $parseTokens{structisbrace}) {
$splitre = ";";
}
print STDERR "SPLITRE IS $splitre\n" if ($localDebug);
if ($splitre && ($token =~ $splitre)) { # && ($ntoken !~ /^[\r\n]/o)) {
print STDERR "WILL SPLIT AFTER \"$token\" AND BEFORE \"$ntoken\".\n" if ($localDebug);
$nextbreakable = 3;
}
print STDERR "SOC: \"$parseTokens{soc}\"\nEOC: \"$parseTokens{eoc}\"\nILC: \"$parseTokens{ilc}\"\nILC_B: \"$parseTokens{ilc_b}\"\nLBRACE: \"$parseTokens{lbrace}\"\nRBRACE: \"$parseTokens{rbrace}\"\nSOPROC: \"$parseTokens{soprocedure}\"\nSOFUNC: \"$parseTokens{sofunction}\"\nVAR: \"$parseTokens{varname}\"\nSTRUCTNAME: \"$parseTokens{structname}\"\nTYPEDEFNAME: \"$parseTokens{typedefname}\"\n" if ($tokenDebug);
print STDERR "inQuote: ".$ctstate{inQuote}."\noldInQuote: $oldInQuote\ninComment: ".$ctstate{inComment}."\ninMacro: ".$ctstate{inMacro}."\ninEnum: ".$ctstate{inEnum}."\n" if ($localDebug);
print STDERR "oldInMacro: $oldInMacro\noldInComment: $oldInComment\n" if ($localDebug);
# print STDERR "TOKEN: $token\n" if ($localDebug);
print STDERR "TOKEN: $tokenname ASINNAME: ".$ctstate{ASinName}."\n" if ($localDebug);
if ($ctstate{inEnum}) {
# If we see this, anything nested below here is clearly not a union.
if (casecmp($token, $parseTokens{unionname}, $case_sensitive)) { $ctstate{inEnum} = 0; };
if (casecmp($token, $parseTokens{structname}, $case_sensitive)) { $ctstate{inEnum} = 0; };
if (casecmp($token, $parseTokens{typedefname}, $case_sensitive)) { $ctstate{inEnum} = 0; };
}
my $nonword = 0; my $pascal = 0; my $ruby = 0;
if ($token =~ /\W/) {
$nonword = 1;
if ($ctstate{ASinName} && (!$ctstate{inQuote}) && (!$ctstate{inComment}) && ($token !~ /\s/)) {
$ctstate{ASinName} = -1;
print STDERR "ASinName -> -1 [1]\n" if ($localDebug);
}
}
if ($ctstate{lang} eq "pascal") { $pascal = 1; }
if ($ctstate{lang} eq "ruby") { $ruby = 1; }
if ($ctstate{lang} eq "applescript" && $token =~ /(given|of|in)/) {
print STDERR "ASinName -> 3 [0a]\n" if ($localDebug);
$ctstate{ASinName} = 3;
print STDERR "AS lastBrace -> \"(\"\n" if ($localDebug);
$ctstate{lastBrace} = "(";
} elsif ($parseTokens{labelregexp} && $token =~ $parseTokens{labelregexp}) {
print STDERR "ASinName -> 3 [0b]\n" if ($localDebug);
$ctstate{ASinName} = 3;
print STDERR "AS lastBrace -> \"(\"\n" if ($localDebug);
$ctstate{lastBrace} = "(";
}
my $untypedLanguage = 0;
if ($ctstate{sublang} eq "javascript" ||
$ctstate{lang} eq "php" || $ctstate{lang} eq "perl" || $ctstate{lang} eq "python" ||
$ctstate{lang} eq "shell" || $ctstate{lang} eq "applescript") {
$untypedLanguage = 1;
} elsif ($ruby || $ctstate{lang} eq "tcl") {
$untypedLanguage = 2;
}
if ($ctstate{skipToken}) {
$ctstate{skipToken}--;
$drop = 1;
$token = "";
}
if ($ctstate{lang} eq "C" || $ctstate{lang} eq "java" || $pascal || $ctstate{sublang} eq "javascript" ||
$ctstate{lang} eq "php" || $ctstate{lang} eq "perl" || $ruby || $ctstate{lang} eq "python" ||
$ctstate{lang} eq "Csource" || $ctstate{lang} eq "shell" || $ctstate{lang} eq "applescript" ||
$ctstate{lang} eq "tcl") {
if ($ctstate{inQuote} == 1) {
print STDERR " STRING\n" if ($localDebug || $codePathDebug);
$tokenType = "string";
} elsif ($ctstate{inQuote} == 2) {
print STDERR " CHAR\n" if ($localDebug || $codePathDebug);
$tokenType = "char";
} elsif ($ctstate{inQuote} == 3 && $ctstate{inRubyQuote} != 2 && !$tokennl) {
# print STDERR "preserve newlines. TOKEN: \"$token\"\n" if ($rubyDebug || $colorDebug);
$tokenType = "string";
} elsif ($nonword && $token eq $parseTokens{soc} && $parseTokens{soc} ne "") {
if (!$hidden) {
$tokenType = "comment";
if ($ctstate{ASinName} == -1) {
$ctstate{ASinName} = 1;
print STDERR "ASinName -> 1 [2]\n" if ($localDebug);
}
print STDERR " COMMENT [1]\n" if ($localDebug || $codePathDebug);
if (!$ctstate{inComment}) {
$ctstate{inComment} = 1;
$firstCommentToken = 1;
if ($ctstate{xmlmode}) {
$string .= "";
} else {
$string .= "";
}
$leavingComment = 1;
$ctstate{inComment} = 0;
} elsif ($tokennl && ($ntoken !~ /^[\r\n]/o || $ctstate{keep_whitespace} || $keep_all_newlines)) {
my $ignored_newline = 1;
print STDERR " TOKENNL (KW: ".$ctstate{keep_whitespace}.", KAN: $keep_all_newlines)\n" if ($localDebug || $codePathDebug);
if ($ctstate{ASinName}) {
$ctstate{ASinName} = 0;
print STDERR "ASinName -> 0 [4]\n" if ($localDebug);
$ignored_newline = 0;
}
if ($ctstate{inComment} == 2) {
print STDERR " EOL INCOMMENT: END ILCOMMENT [1]\n" if ($localDebug || $codePathDebug);
$tokenType = "comment";
if ($ctstate{xmlmode}) {
$string .= "";
} else {
$string .= "";
}
$ctstate{inComment} = 0;
$ctstate{newlen} = 0;
$mustbreak = 1;
# $token = "";
$drop = 1;
$ignored_newline = 0;
} elsif ($ctstate{inMacro} || $keep_all_newlines) {
print STDERR " EOL INMACRO\n" if ($localDebug || $codePathDebug);
$mustbreak = 1;
$ctstate{newlen} = 0;
$ignored_newline = 0;
} elsif ($ctstate{inComment}) {
print STDERR " EOL INCOMMENT\n" if ($localDebug || $codePathDebug);
$mustbreak = 1;
$ctstate{newlen} = 0;
# $token = "";
$drop = 1;
$ignored_newline = 0;
}
if (!$ignored_newline) {
$ctstate{breakable} = 0;
$nextbreakable = 0;
# $nextprespace = nspaces(4 * $ctstate{depth});
$ctstate{newlen} = 0;
}
# } elsif ($ntoken =~ /^[\r\n]/o) {
# print STDERR " NEXT TOKEN IS NLCR\n" if ($localDebug || $codePathDebug);
# $ctstate{breakable} = 0;
# $nextbreakable = 0;
} elsif ($ctstate{inComment}) {
print STDERR " COMMENT [2:".$ctstate{inComment}."]\n" if ($localDebug || $codePathDebug);
$tokenType = "comment";
if ($ctstate{inComment} == 1) {
if (($token =~ /^\s/o && !$tokennl && $ntoken !~ /^\s/o) && (!$ctstate{keep_whitespace})) {
# Only allow wrapping of multi-line comments.
# Don't blow in extra newlines at existing ones.
$ctstate{breakable} = 1;
}
}
} elsif ($ctstate{inMacro}) {
print STDERR " MACRO [IN]\n" if ($localDebug || $codePathDebug);
$tokenType = "preprocessor";
} elsif ($token eq "=") {
print STDERR " EQUALS\n" if ($localDebug || $codePathDebug);
$nextbreakable = 1;
if ($ctstate{type} eq "pastd") {
$ctstate{type} = "";
print STDERR " END OF VAR\n" if ($localDebug || $codePathDebug);
}
if ($pascal) { $ctstate{seenEquals} = 1; }
} elsif ($token eq "-") {
print STDERR " MINUS\n" if ($localDebug || $codePathDebug);
if ($ntoken =~ /^\d/o) {
$tokenType = "number";
print STDERR " NUMBER [1]\n" if ($localDebug || $codePathDebug);
} else {
print STDERR " TEXT [1]\n" if ($localDebug || $codePathDebug);
$tokenType = "";
}
} elsif ($token =~ /^\d+$/o || $token =~ /^0x[\dabcdef]+$/io) {
$tokenType = "number";
$ctstate{type} = "hexnumber";
print STDERR " \nNUMBER [2]: $token\n" if ($localDebug || $codePathDebug);
} elsif (!$nonword && (casecmp($token, $parseTokens{sofunction}, $case_sensitive) || casecmp($token, $parseTokens{soprocedure}, $case_sensitive) || casecmp($token, $parseTokens{soconstructor}, $case_sensitive))) {
$tokenType = "keyword";
$ctstate{lastKeyword} = $token;
print STDERR " SOFUNC/SOPROC\n" if ($localDebug || $codePathDebug);
$ctstate{type} = "funcproc";
$ctstate{lastBrace} = "(";
$oldLastBrace = "(";
if ($ctstate{lang} eq "applescript") {
$ctstate{ASinName} = 1;
print STDERR "ASinName -> 1 [5]\n" if ($localDebug);
}
} elsif (!$nonword && $ctstate{type} eq "funcproc") {
if ($token =~ /^\;/o) {
$ctstate{type} = "";
$nextbreakable = 3;
}
print STDERR " FUNC/PROC NAME\n" if ($localDebug || $codePathDebug);
$tokenType = "function";
} elsif (!$nonword && casecmp($token, $parseTokens{constname}, $case_sensitive) && $ctstate{lang} eq "pascal") {
$tokenType = "keyword";
print STDERR " VAR\n" if ($localDebug || $codePathDebug);
$ctstate{type} = "pasvar";
} elsif (!$nonword && casecmp($token, $parseTokens{varname}, $case_sensitive)) {
$tokenType = "keyword";
print STDERR " VAR\n" if ($localDebug || $codePathDebug);
$ctstate{type} = "pasvar";
} elsif ($nonword && ($ctstate{type} eq "pasvar" || $ctstate{type} eq "pastd") &&
($token =~ /^[\;\:\=]/o)) {
# NOTE: '=' is handled elsewhere,
# but it is included above for clarity.
$ctstate{type} = "";
print STDERR " END OF VAR\n" if ($localDebug || $codePathDebug);
} elsif ($ctstate{type} eq "pasvar" || $ctstate{type} eq "pastd") {
print STDERR " VAR NAME\n" if ($localDebug || $codePathDebug);
$tokenType = "var";
} elsif (!$nonword && ($pascal) && casecmp($token, $parseTokens{typedefname}, $case_sensitive)) {
# TYPE: This is the start of a pascal type
print STDERR " TYPE\n" if ($localDebug || $codePathDebug);
$tokenType = "keyword";
$ctstate{type} = "pastd";
} elsif (!$nonword && ($pascal) && casecmp($token, $parseTokens{structname}, $case_sensitive)) {
# RECORD: This is the start of a pascal record
print STDERR " RECORD/STRUCT\n" if ($localDebug || $codePathDebug);
$ctstate{lastBrace} = $token;
$tokenType = "keyword";
$ctstate{type} = "pasrec";
} elsif (!$nonword && $tokenIsKeyword) {
# This is a keyword in any language.
$tokenType = "keyword";
if ($ctstate{ASinName} != 1 && $ctstate{ASinName} != 3) {
$ctstate{ASinName} = 0;
print STDERR "ASinName -> 0 [6]\n" if ($localDebug);
}
if ($tokenIsKeyword == 2) {
# This formatting change applies only to children of this node.
$ctstate{inAttribute} = 1;
} elsif ($tokenIsKeyword == 5) {
# This formatting change applies only to children of this node.
$ctstate{inRaises} = 1;
} elsif ($tokenIsKeyword == 6) {
$ctstate{inTypeOf} = 1;
}
# NOTE: If anybody ever wants "class" to show up colored
# as a keyword within a template, the next block should be
# made conditional on a command-line option. Personally,
# I find it distracting, hence the addition of these lines.
if ($ctstate{lastBrace} eq $parseTokens{sotemplate} && $parseTokens{sotemplate} ne "") {
$tokenType = "template";
}
print STDERR " KEYWORD\n" if ($localDebug || $codePathDebug);
# $ctstate{inMacro} = $self->isMacro($token, $ctstate{lang}, $ctstate{sublang});
# We could have keywords in a macro, so don't set this
# to zero. It will get zeroed when we pop a level
# anyway. Just set it to 1 if needed.
if ($case_sensitive) {
if ($macroList{$token}) {
print STDERR " IN MACRO\n" if ($localDebug || $codePathDebug);
$ctstate{inMacro} = 1;
}
} else {
foreach my $cmpToken (keys %macroList) {
if (casecmp($token, $cmpToken, $case_sensitive)) {
$ctstate{inMacro} = 1;
}
}
}
print STDERR " TOKEN IS $token, IM is now ".$ctstate{inMacro}."\n" if ($localDebug || $codePathDebug);
if (casecmp($token, $parseTokens{rbrace}, $case_sensitive)) {
print STDERR "PS: ".length($ctstate{prespace})." -> " if ($psDebug);
# $ctstate{prespace} = nspaces(4 * ($ctstate{depth}-1));
$mustbreak = 2;
print STDERR length($ctstate{prespace})."\n" if ($psDebug);
}
} elsif (!$ctstate{inQuote} && !$ctstate{inComment} && isKnownMacroToken($token, \%macroList, $case_sensitive)) {
# This is a preprocessor directive
print STDERR " IN MACRO\n" if ($localDebug || $codePathDebug);
$ctstate{inMacro} = 1;
} elsif (($token eq "*") && ($ctstate{depth} == 1) && ($ctstate{lastTokenType} eq "type" || $ctstate{lastTokenType} eq "star")) {
print STDERR " ASTERISK\n" if ($localDebug || $codePathDebug);
# spacing fix for '*' characters
if (!$ctstate{spaceSinceLastToken} && (!$ctstate{keep_whitespace}) && $ctstate{lastTokenType} ne "star") {
if ($ctstate{prespace} == "") { $ctstate{prespace} = " "; }
}
$tokenType = "type";
$isTypeStar = 1;
$nospaceafter = 1;
} elsif ($ntokennc eq ":" && $ctstate{inObjCMethod}) {
# Detecting of objective-C method separators
print STDERR " COLON (FUNCTION [1])\n" if ($localDebug || $codePathDebug);
$tokenType = "function";
} elsif ($token eq ":" && $ctstate{inObjCMethod}) {
# Detecting of objective-C method separators
print STDERR " COLON (FUNCTION [2])\n" if ($localDebug || $codePathDebug);
$tokenType = "function";
} elsif ($token eq ":" && $ctoken) {
# Don't indent Objective-C method parts so far.
print STDERR " COLON AND CTOKEN\n" if ($localDebug || $codePathDebug);
$ctstate{depth} = $ctstate{depth} - 1; # We'll change it back before the next token.
} elsif ($ntokennc eq "(" && !$ctstate{seenEquals} && !$ctstate{inAttribute} && !$ctstate{inRaises} && !$ctstate{inTypeOf}) {
# Upcoming parenthesis handling
$tokenType = "function";
print STDERR " LPAREN (FUNCTION [3])\n" if ($localDebug || $codePathDebug);
if ($nntokennc eq "(" && !$untypedLanguage) {
$tokenType = "type";
$ctstate{type} = "funcptr";
}
if ($ctstate{inObjCMethod}) {
$tokenType = ""; # shouldn't happen
}
if ($token eq "(") { $dropFP = 1; }
} elsif ((!$untypedLanguage) && $ntokennc eq $parseTokens{lbrace} && $parseTokens{lbrace} ne "") {
# Upcoming brace handling
$tokenType = "type";
print STDERR " LBRACE (TYPE [1])\n" if ($localDebug || $codePathDebug);
} elsif (($ctstate{inAttribute} || $ctstate{inRaises} || $ctstate{inTypeOf}) && $token eq "(") {
print STDERR " LPAREN (ATTRIBUTE)\n" if ($localDebug || $codePathDebug);
# Parenthesis handling for attributes
$nextbreakable = 0;
} elsif ($token eq "(") {
print STDERR " LPAREN (GENERAL)\n" if ($localDebug || $codePathDebug);
# Parenthesis handling
$ctstate{type} = "";
if ($ctstate{inObjCProperty}) {
$nextbreakable = 0;
$oldLastBrace = "";
} elsif ($ctstate{inObjCMethod} && $ctstate{lastBrace} =~ /^[+-]/o) {
$nextbreakable = 0;
$oldLastBrace = "";
} elsif ($ctoken ne ")") {
$nextbreakable = 3;
}
$ctstate{lastBrace} = $token;
#if (!$ctstate{depth}) {
#$nospaceafter = 2;
#}
} elsif ($token eq $parseTokens{sotemplate} && $parseTokens{sotemplate} ne "") {
print STDERR " TEMPLATE\n" if ($localDebug || $codePathDebug);
# This is the word "template" or similar.
$ctstate{lastBrace} = $token;
$nextbreakable = 0;
$ctstate{breakable} = 0;
} elsif (casecmp($token, $parseTokens{lbrace}, $case_sensitive)) {
print STDERR " LBRACE (GENERAL)\n" if ($localDebug || $codePathDebug);
# Brace handling.
$ctstate{type} = "";
$ctstate{lastBrace} = $token;
$nextbreakable = 3;
if (!casecmp($ctoken, $parseTokens{rbrace}, $case_sensitive)) {
$nextbreakable = 3;
}
} elsif (($ctstate{lang} eq "python") && ($token eq "\"\"\"")) {
print STDERR " IRQ STARTEND\n" if ($localDebug || $codePathDebug);
if ($ctstate{inQuote}) { $ctstate{inQuote} = 0; }
else { $ctstate{inQuote} = 3; }
} elsif ($ruby && ($token eq "%{" || $token eq "%Q{")) {
print STDERR " IRQ START[1]\n" if ($localDebug || $codePathDebug);
$ctstate{inQuote} = 3; $ctstate{inRubyQuote} = 1;
} elsif ($ruby && ($token eq "%/")) {
print STDERR " IRQ PERCENTSLASH\n" if ($localDebug || $codePathDebug);
$ctstate{inQuote} = 3; $ctstate{inRubyQuote} = 1;
} elsif ($ruby && ($token eq "<<")) {
print STDERR " IRQ START[2]\n" if ($localDebug || $codePathDebug);
$ctstate{inQuote} = 3;
$ctstate{inRubyQuote} = 2; # quote coloring starts after next token.
print STDERR "IRQ -> 2\n" if ($rubyDebug || $colorDebug);
} elsif ($ruby && ($ctstate{inRubyQuote} == 2)) {
print STDERR " IRQ\n" if ($localDebug || $codePathDebug);
$ctstate{inRubyQuote} = 1;
print STDERR "IRQ 2 -> 1\n" if ($rubyDebug || $colorDebug);
} elsif ($token =~ /^\"/o && !$ctstate{inRubyQuote}) {
print STDERR " DQUOTE\n" if ($localDebug || $codePathDebug);
# Double quote handling
$ctstate{inQuote} = 1;
} elsif ($token =~ /^\'/o && !$ctstate{inRubyQuote}) {
print STDERR " SQUOTE\n" if ($localDebug || $codePathDebug);
# Single quote handling
$ctstate{inQuote} = 2;
} elsif ($ntokennc =~ /^(\)|\,|\;)/o || casecmp($ntokennc, $parseTokens{rbrace}, $case_sensitive)) {
# Detection of the last token before the end of a part of a declaration.
# last token
print STDERR " LASTTOKEN\n" if ($localDebug || $codePathDebug);
if ($nextbreakable != 3) {
$nextbreakable = 2;
}
if ($ctstate{lastBrace} eq $parseTokens{sotemplate} && $parseTokens{sotemplate} ne "") {
$nextbreakable = 0;
}
if ($ctstate{lastBrace} eq "(" || ($ctstate{lastBrace} eq "{" && $parseTokens{parmswithcurlybraces})) {
if ($MIG || $pascal) {
$tokenType = "type";
print STDERR " TYPE [2]\n" if ($localDebug || $codePathDebug);
} else {
$tokenType = "param";
print STDERR " PARAM [1]\n" if ($localDebug || $codePathDebug);
}
} elsif ($ctstate{lastBrace} eq $parseTokens{sotemplate} && $parseTokens{sotemplate} ne "") {
print STDERR " TEMPLATE[1]\n" if ($localDebug || $codePathDebug);
$tokenType = "template";
} elsif ($ctstate{type} eq "funcptr") {
$tokenType = "function";
print STDERR " FUNCTION [1]\n" if ($localDebug || $codePathDebug);
$ctstate{breakable} = 0;
$nextbreakable = 0;
} else {
if ($MIG || $pascal) {
$tokenType = "type";
print STDERR " TYPE [2a]\n" if ($localDebug || $codePathDebug);
} else {
$tokenType = "var";
print STDERR " VAR [1] (LB: ".$ctstate{lastBrace}.")\n" if ($localDebug || $codePathDebug);
}
}
if (casecmp($ntokennc, $parseTokens{rbrace}, $case_sensitive) && $ctstate{type} eq "pasrec") {
$ctstate{type} = "";
}
if ($ntokennc eq ")") {
$nextbreakable = 0;
if ((!$untypedLanguage) && ($ctstate{inObjCMethod} || ($token eq "*"))) {
print STDERR " TYPE [3]\n" if ($localDebug || $codePathDebug);
$tokenType = "type";
}
}
} elsif ($ctstate{prespace} ne "" && ($token =~ /^\)/o || casecmp($token, $parseTokens{rbrace}, $case_sensitive))) {
print " CPAREN OR RBRACE\n" if ($codePathDebug);
print STDERR "PS: ".length($ctstate{prespace})." -> " if ($psDebug);
if (!$ctstate{keep_whitespace}) { $ctstate{prespace} = nspaces(4 * ($ctstate{depth}-1)); }
print STDERR length($ctstate{prespace})."\n" if ($psDebug);
$mustbreak = 2;
} elsif (casecmp($token, $parseTokens{rbrace}, $case_sensitive)) {
print " RBRACE\n" if ($codePathDebug);
if (!$ctstate{keep_whitespace}) { $ctstate{prespace} = nspaces(4 * ($ctstate{depth}-1)); }
print STDERR length($ctstate{prespace})."\n" if ($psDebug);
$mustbreak = 2;
} else {
if ($ctstate{inObjCMethod}) {
if ($ctstate{lastBrace} eq "(") {
print STDERR " TYPE [4]\n" if ($localDebug || $codePathDebug);
$tokenType = "type";
} else {
print STDERR " PARAM [2]\n" if ($localDebug || $codePathDebug);
$tokenType = "param";
}
} elsif ($MIG || $pascal) {
if ($ctstate{lastBrace} eq "(") {
print STDERR " PARAM [3]\n" if ($localDebug || $codePathDebug);
$tokenType = "param";
}
} else {
if ($ctstate{lastBrace} eq $parseTokens{sotemplate} && ($parseTokens{sotemplate} ne "")) {
print STDERR " TEMPLATE [5]\n" if ($localDebug || $codePathDebug);
$tokenType = "template";
} elsif ($ctstate{inEnum}) {
# Constants are a special case of variable
print STDERR " TYPE [5]\n" if ($localDebug || $codePathDebug);
$tokenType = "var";
} elsif ($untypedLanguage && $ctstate{lastBrace}) {
print STDERR " UNTYPED: PARAM [5]\n" if ($localDebug || $codePathDebug);
$tokenType = "param";
} elsif (($untypedLanguage == 1) ||
($untypedLanguage == 2 && $ctstate{lastnstoken} !~ $parseTokens{classregexp})) {
print STDERR " UNTYPED: VAR [5]\n" if ($localDebug || $codePathDebug);
$tokenType = "var";
} else {
print STDERR " TYPE [5]\n" if ($localDebug || $codePathDebug);
$tokenType = "type";
}
}
}
} else {
my $fullpath = $ctstate{apio}->fullpath;
my $linenum = $ctstate{apio}->linenum;
warn "$fullpath:$linenum: warning: Unknown language ".$ctstate{lang}.". Not coloring. Please file a bug.\n";
}
if ($ctstate{inRaises} && $tokenType && ($tokenType ne "keyword")) {
$tokenType = "type";
}
if ($ctstate{inTypeOf} && $tokenType && ($tokenType ne "keyword")) {
$tokenType = "param";
}
if ((!$hidden) && $self->isAvailabilityMacro()) {
if ($ctstate{xmlmode}) {
$string .= "";
$tailstring = "".$tailstring;
} else {
$string .= "";
$tailstring = "".$tailstring;
}
}
# print STDERR "TOKEN: $token TYPE: $tokenType\n";
if ($ctstate{ASinName} == 1) {
$ctstate{ASinName} = 2;
print STDERR "ASinName -> 2 [end]\n" if ($localDebug);
} elsif ($ctstate{ASinName} == 2) {
$tokenType = "function";
} elsif ($ctstate{ASinName} == 3) {
$ctstate{ASinName} = 4;
print STDERR "ASinName -> 4 [end]\n" if ($localDebug);
} elsif ($ctstate{ASinName} == 4) {
$tokenType = "param";
} elsif ($ctstate{ASinName} == -1) {
$ctstate{ASinName} = 0;
print STDERR "ASinName -> 0 [end]\n" if ($localDebug);
}
if ($hidden) {
$tokenType = "ignore";
if ($mustbreak) {
$nextbreakable = 3;
} else {
$nextbreakable = 0;
}
$mustbreak = 0;
$ctstate{breakable} = 0;
}
if (($ntoken =~ /[,;]/) && ($token =~ /[ \t]/) && !$ctstate{inComment} && !$ctstate{inMacro} && !$ctstate{inQuote}) {
# print STDERR "DROP\n";
$hidden = 1;
$tokenType = "ignore";
$nextbreakable = 0;
$mustbreak = 0;
$ctstate{breakable} = 0;
}
if ($MIG || $pascal) {
if ($ctstate{lastnstoken} =~ /:/ && $ctstate{lastTokenType} eq "var") {
$string .= $newtd;
}
} else {
if (($ctstate{lastTokenType} eq "type") && !$hidden && ($token =~ /[\w\*]/) &&
($tokenType eq "var" || $tokenType eq "param" ||
$tokenType eq "function" || $token eq "*") && ($ctstate{lastnstoken} =~ /\w/)) {
$string .= $newtd;
}
}
if (((($parseTokens{ilc} ne "") && ($ntoken eq $parseTokens{ilc})) || (($parseTokens{ilc_b} ne "") && ($ntoken eq $parseTokens{ilc_b}))) && !$ctstate{inComment}) {
$ctstate{breakable} = 0; $nextbreakable = 0;
} elsif (($parseTokens{soc} ne "") && $ntoken eq $parseTokens{soc} && !$ctstate{inComment}) {
$ctstate{breakable} = 0; $nextbreakable = 0;
}
print STDERR "NB: $nextbreakable\n" if ($localDebug);
print STDERR "TESTTYPE: $tokenType\n" if ($localDebug);
if ($ctstate{inObjCMethod}) {
print STDERR "OCC METHOD OVERRIDE: " if ($localDebug);
$nextbreakable = 0;
$ctstate{breakable} = 0;
$mustbreak = 0;
if ($ntoken eq ":" && $tokenType eq "function") {
$ctstate{breakable} = 1;
print STDERR "BREAKABLE\n" if ($localDebug);
} else {
print STDERR "NOT BREAKABLE\n" if ($localDebug);
}
}
if ($ctstate{type} eq "pasrec" && $tokenType eq "") {
print STDERR "PASREC VAR\n" if ($localDebug);
$tokenType = "var";
}
else { print STDERR "TYPE: ".$ctstate{type}." TT: ".$tokenType."\n" if ($localDebug); }
print STDERR "IM: ".$ctstate{inMacro}."\n" if ($localDebug);
if (!$ctstate{inComment} && $token =~ /^\s/o && !$tokennl && ($mustbreak || !$ctstate{newlen}) && (!$ctstate{keep_whitespace})) {
print STDERR "CASEA\n" if ($localDebug);
print STDERR "NL: ".$ctstate{newlen}." TOK: \"$token\" PS: \"".$ctstate{prespace}."\" NPS: \"$nextprespace\"\n" if ($localDebug);
print STDERR "dropping leading white space\n" if ($localDebug);
$drop = 1;
} elsif (!$ctstate{inComment} && $tokennl && (!$ctstate{keep_whitespace})) {
print STDERR "CASEB\n" if ($localDebug);
if ($ctstate{lastnstoken} ne $parseTokens{eoc}) {
# Insert a space instead.
print STDERR "dropping newline\n" if ($localDebug);
$drop = 1;
$string .= " ";
$ctstate{afteradvisoryspace} = 1;
print STDERR "AAS -> 1 [drop]\n" if ($localDebug || $advisorySpaceDebug || $codePathDebug);
} else {
$mustbreak = 1;
}
} elsif ($ctstate{inComment} || $token =~ /^\s/o || ($token =~ /^\W/o && $token ne "*") || !$tokenType) {
print STDERR "CASEC\n" if ($localDebug);
my $macroTail = "";
$escapetoken = $ctstate{apio}->textToXML($token);
print STDERR "OLDPS: \"".$ctstate{prespace}."\" ET=\"$escapetoken\" DROP=$drop\n" if ($localDebug);
if ($ctstate{inComment} && $ctstate{prespace} ne "" && !$hidden) {
if ($ctstate{xmlmode}) {
$string .= "\n".$ctstate{prespace}."";
} else {
$string .= "\n$endtr".$ctstate{prespace}."$begintr\n$ps$string";
} else {
$string = "$endtr\n$begintr$ps";
# } else {
# $string .= "";
# }
# }
if ($dropFP) { $ctstate{type} = $ctstate{apio}->class(); }
$node = $self->{NEXT};
if ($node && $continue) {
bless($node, "HeaderDoc::ParseTree");
if ($nospaceafter) {
while ($node && ($node->token =~ /[ \t]/)) {
print STDERR "SKIPPED NODE (\"".$node->token."\").\n" if ($localDebug);
$node = $node->next;
bless($node, "HeaderDoc::ParseTree");
}
print STDERR "STOPPED SKIPPING AT NODE \"".$node->token."\".\n" if ($localDebug);
}
print STDERR "CONTINUING TO NODE \"".$node->token."\".\n" if ($localDebug);
if ($node) {
my $nextctstate = newCTState(\%ctstate, breakable => $nextbreakable,
afteradvisoryspace => $ctstate{afteradvisoryspace});
($newstringref, $ctstate{newlen}, $nextbreakable, $ctstate{prespace}, $ctstate{lastnstoken}, $continue, $ctstate{lastTokenType}, $ctstate{spaceSinceLastToken}, $ctstate{afteradvisoryspace}) = $node->colorTreeSub($nextctstate);
$newstring = ${$newstringref};
}
}
$string .= $newstring;
print STDERR "SET STRING TO $string\n" if ($localDebug);
# $self->{CTSTRING} = $string;
# $self->{CTSUB} = ($ctstate{newlen}, $nextbreakable, $ctstate{prespace}, $ctstate{lastnstoken});
return (\$string, $ctstate{newlen}, $nextbreakable, $ctstate{prespace}, $ctstate{lastnstoken}, $continue, $ctstate{lastTokenType}, $ctstate{spaceSinceLastToken}, $ctstate{afteradvisoryspace});
}
# /*!
# @abstract
# The recursive part of {@link test_output_dump}.
# @param self
# The parse tree/subtree to dump.
# @param depth
# The number of nesting levels above this token.
# @param lastnode
# The last node to emit. This node and its children
# appear in the output, but not its siblings.
# */
sub test_output_dump_rec
{
my $self = shift;
my $depth = shift;
my $lastnode = shift;
my $ret = "";
my $parserState = $self->parserState();
if ($parserState && !$lastnode) {
$lastnode = $parserState->{lastTreeNode};
}
if ($self->token ne "") {
my $i = $depth-1;
while ($i > 0) {
$ret .= "| ";
$i--;
}
my $HYPHEN = "-";
my $psString = "";
if ($self->parserState()) {
$HYPHEN = "*";
$psString = " (HAS STATE)";
}
if ($depth) {
$ret .= "+-$HYPHEN-";
}
if ($self->token =~ /\n$/) {
$ret .= "[ NEWLINE ]$psString\n";
} else {
$ret .= $self->token()."$psString\n";
# if ($self->token !~ /\n$/) { $ret .= "\n"; }
}
}
if ($self == $lastnode) {
$ret .= "-=-=-=-=-=-=- EODEC -=-=-=-=-=-=-\n";
}
if ($self->firstchild()) {
$ret .= $self->firstchild()->test_output_dump_rec($depth+1, $lastnode);
}
if ($self->next()) {
$ret .= $self->next()->test_output_dump_rec($depth, $lastnode);
}
return $ret;
}
# /*!
# @abstract
# The recursive part of
# {@link //apple_ref/perl/instm/HeaderDoc::ParseTree/dbprint//() dbprint}.
# @param self
# The parse tree/subtree to dump.
# @param depth
# The number of nesting levels above this token.
# @param lastnode
# The last node to emit. This node and its children
# appear in the output, but not its siblings.
# */
sub dbprintrec
{
my $self = shift;
my $depth = shift;
my $lastnode = shift;
my $include_noise = shift;
# print STDERR "IN: $include_noise\n";
my $localDebug = 0;
# cluck("here\n");
my $parserState = $self->parserState();
if ($parserState && !$lastnode) {
$lastnode = $parserState->{lastTreeNode};
}
if ($self->token ne "") {
my $i = $depth-1;
while ($i > 0) {
print STDERR "| ";
$i--;
}
my $HYPHEN = "-";
my $psString = "";
my $reStateString = "";
if ($self->{RE_STATE}) { $reStateString = " ".$self->{RE_STATE}; }
if ($self->parserState()) {
$HYPHEN = "*";
$psString = " (TOKENID: ".$self.", PSID: ".$self->parserState().$reStateString.")";
} else {
$psString = " (TOKENID: ".$self.$reStateString.")";
}
if ($depth) {
print STDERR "+-$HYPHEN-";
}
if ($self->token =~ /\n$/) {
print STDERR "[ NEWLINE ]$psString\n";
} else {
print STDERR $self->token()."$psString\n";
# if ($self->token !~ /\n$/) { print STDERR "\n"; }
}
}
if ($include_noise) {
printHash(%{$self});
print STDERR "API OWNERS:\n";
foreach my $apio (@{$self->{APIOWNERS}} ) {
print " ".$apio."\n";
}
print STDERR "END OF API OWNERS\n";
}
if ($self == $lastnode) {
my $deb = "";
if ($localDebug || 1) { $deb = $lastnode; }
print STDERR "-=-=-=-=-=-=- EODEC $deb-=-=-=-=-=-=-\n";
}
if ($self->firstchild()) {
$self->firstchild()->dbprintrec($depth+1, $lastnode, $include_noise);
}
if ($self->next()) {
$self->next()->dbprintrec($depth, $lastnode, $include_noise);
}
}
# /*!
# @abstract
# Dumps a parse tree in a manner formatted for use by the
# {@link //apple_ref/perl/cl/HeaderDoc::Test Test} class
# (used for running HeaderDoc self tests).
# @param self
# The parse tree/subtree to dump.
# @param depth
# The number of nesting levels above this token.
# @param lastnode
# The last node to emit. This node and its children
# appear in the output, but not its siblings.
# @discussion
# This is similar to dbprint in many ways, but it
# omits object IDs that change from run to run.
# */
sub test_output_dump
{
my $self = shift;
return $self->test_output_dump_rec(1);
}
# /*!
# @abstract
# Prints a parse tree in a format designed for debugging.
# @param self
# The parse tree object to print.
# */
sub dbprint
{
my $self = shift;
my $enable_noise = shift;
$self->dbprintrec(1, undef, $enable_noise);
}
# /*!
# @abstract
# Gets/sets the filename associated with this tree node.
# @param self
# This tree node.
# @param FILENAME
# The new filename value to set. (Optional.)
# */
sub filename
{
my $self = shift;
if (@_) {
$self->{FILENAME} = shift;
}
return $self->{FILENAME};
}
# /*!
# @abstract
# Gets/sets the path associated with this tree node.
# @param self
# This tree node.
# @param FILENAME
# The new filename value to set. (Optional.)
# @discussion
# This contains the (relative or absolute) path
# for the owning header, as passed in on the
# command line.
# */
sub fullpath
{
my $self = shift;
if (@_) {
$self->{FULLPATH} = shift;
}
return $self->{FULLPATH};
}
# /*!
# @abstract
# Gets/sets the line number associated with this tree node.
# @param self
# This tree node.
# @param LINENUM
# The new line number value to set. (Optional.)
# @discussion
# This value indicates where this tree node came fron
# within the enclosing header.
# */
sub linenum
{
my $self = shift;
if (@_) {
$self->{LINENUM} = shift;
}
return $self->{LINENUM};
}
# /*!
# @abstract
# Prints this object for debugging purposes.
# @param self
# This object.
# */
sub printObject {
my $self = shift;
print STDERR "----- ParseTree Object ------\n";
print STDERR "token: $self->{TOKEN}\n";
print STDERR "next: $self->{NEXT}\n";
print STDERR "firstchild: $self->{FIRSTCHILD}\n";
print STDERR "\n";
}
# /*!
# @abstract
# Adds the parsed parameter strings from an
# array (reference) to this node's parsed
# parameters list.
# @param self
# This parse tree node.
# @param pplref
# A reference to a parsed parameter list.
# @seealso rawParsedParams rawParsedParams
# */
sub addRawParsedParams
{
my $self = shift;
my $pplref = shift;
my @array = @{$pplref};
foreach my $param (@array) {
push(@{$self->{RAWPARSEDPARAMETERS}}, $pplref);
}
return $self->{RAWPARSEDPARAMETERS};
}
# /*!
# @abstract
# Returns a reference to an array of parsed parameter
# strings associated with this node.
# @param self
# This parse tree node.
# @seealso addRawParsedParams
# */
sub rawParsedParams
{
my $self = shift;
return $self->{RAWPARSEDPARAMETERS};
}
# /*!
# @abstract
# Gets/sets the parser state object associated with
# this tree node.
# @param self
# This tree node.
# @param PARSERSTATE
# The new parser state value to set. (Optional.)
# @discussion
# Parser state objects are inserted into the parse
# tree to make it easier to interpret declarations
# within classes.
# */
sub parserState
{
my $self = shift;
my $localDebug = 0;
if (@_) {
my $state = shift;
print STDERR "Setting parser state for $self\n" if ($localDebug);
print STDERR "Last token (raw) is $state->{lastTreeNode}\n" if ($localDebug);
print STDERR "Last token (text) is ".$state->{lastTreeNode}->token()."\n" if ($localDebug);
$self->{PARSERSTATE} = $state;
}
return $self->{PARSERSTATE};
}
# /*!
# @abstract
# Uses gcc to calculate the value for a
# string containing a complex #define
# macro expression.
# @param self
# The parse tree object. (Unused.)
# @param rawvalue
# The expression to interpret.
# @discussion
# Used by {@link getPTvalue}.
#
# Although it should be possible for the
# new code in MacroFilter.pm to be easily
# adapted to do this job, at the time, that
# code did not exist.
# */
sub trygcc
{
my $self = shift;
my $rawvalue = shift;
my $success = 0;
my $value = 0;
my $timestamp = time();
my $localDebug = 0;
# print STDERR "RV: $rawvalue\n";
if (open(GCCFILE, ">/tmp/headerdoc-gcctemp-$timestamp.c")) {
print GCCFILE "#include \nmain(){printf(\"%d\\n\", $rawvalue);}\n";
close(GCCFILE);
if (open(GCCPIPE, $HeaderDoc::c_compiler." /tmp/headerdoc-gcctemp-$timestamp.c -o /tmp/headerdoc-gcctemp-$timestamp > /dev/null 2> /dev/null |")) {
my $junkstring = ;
close(GCCPIPE);
if ($?) {
$success = 0;
} else {
$success = 1;
}
if ($success) {
if (open(EXECPIPE, "/tmp/headerdoc-gcctemp-$timestamp |")) {
my $retstring = ;
$value = $retstring;
$value =~ s/\n//sg;
print STDERR "VALUE: $value\nSUCCESS: $success\n" if ($localDebug);
} else {
$success = 0;
}
}
}
unlink("/tmp/headerdoc-gcctemp-$timestamp.c");
unlink("/tmp/headerdoc-gcctemp-$timestamp");
}
print STDERR "RET $success, $value\n" if ($localDebug);
return ($success, $value);
}
# /*!
# @abstract
# Uses gcc to calculate the value for a
# parse tree containing a complex #define
# macro expression
# @param self
# The parse tree object.
# @discussion
# Although it should be possible for the
# new code in MacroFilter.pm to be easily
# adapted to do this job, at the time, that
# code did not exist.
# */
sub getPTvalue
{
my $self = shift;
my $success = 0;
my $value = 0;
my $localDebug = 0;
my $pos = $self;
while ($pos && ($pos->token() ne "#define")) {
$pos = $pos->next();
}
if (!$pos) {
return($success, $value);
}
$pos = $pos->firstchild();
while ($pos && ($pos->hidden != 3) && ($pos->{HIDEMACROLASTTOKEN} != 2)) {
$pos = $pos->next();
}
if ($pos) {
my $rawvalue = $pos->textTree();
print STDERR "getPTvalue: WE HAVE A WINNER.\n" if ($localDebug);
print STDERR "RAWVALUE IS: $rawvalue\n" if ($localDebug);
($success, $value) = $self->trygcc($rawvalue);
}
return($success, $value);
}
# /*!
# @abstract
# Releases references in an attempt to allow Perl to
# garbage collect this parse tree.
# @param self
# The root of the parse tree to release.
# */
sub dispose
{
my $self = shift;
# Decrement the reference count.
# cluck("Dispose called on parse tree\n");
if ($self->{REFCOUNT} > 0) {
if ($HeaderDoc::debugAllocations) {
print STDERR "Parse tree reference count is ".$self->{REFCOUNT}.". Not disposing.\n";
print STDERR "SELF: ".$self."\n";
print STDERR "FC: ".$self->{FIRSTCHILD}."\n";
print STDERR "NEXT: ".$self->{NEXT}."\n";
print STDERR "PARENT: ".$self->{PARENT}."\n";
print STDERR "APIOLIST: ".$self->{APIOWNERS}."\n";
foreach my $obj (@{$self->{APIOWNERS}}) {
print STDERR " OWNER: $obj\n";
}
print STDERR "END OF LIST\n";
}
return;
}
print STDERR "Disposing of tree\n" if ($HeaderDoc::debugAllocations);
$self->{PARENT} = undef;
if ($self->{FIRSTCHILD}) {
$self->{FIRSTCHILD}->dispose();
$self->{FIRSTCHILD} = undef;
}
if ($self->{NEXT}) {
$self->{NEXT}->dispose();
$self->{NEXT} = undef;
}
$self->{NTNC} = undef;
if ($self->{APIOWNERS}) { $self->{APIOWNERS} = (); }
if ($self->{PARSERSTATE}) { $self->{PARSERSTATE} = undef; }
$self->{PARSEDPARAMS} = ();
$self->{RAWPARSEDPARAMETERS} = ();
$self->{TOKEN} = undef;
$self->dbprint() if ($HeaderDoc::debugAllocations);
}
# /*!
# @abstract
# Called by Perl when a node is garbage collected.
# @param self
# The root of the parse tree to release.
# @discussion
# Used for debugging memory behavior.
# */
sub DESTROY
{
my $self = shift;
print STDERR "Destroying $self\n" if ($HeaderDoc::debugAllocations);
}
# /*!
# @abstract
# Counts the number of curly braces at this level in the parse tree.
# @param self
# This parse tree node.
# @param lbrace
# The left brace token to look for.
# @param last
# The last node to include.
# @discussion
# Because this function checks at a given level,
# it updates the last node to be the ancestor
# of the last node at the same level as the
# starting node. (Why doesn't this use
# {@link nextAtLevelOf}?)
# */
sub curlycount
{
my $self = shift;
my $lbrace = shift;
my $last = shift;
my $pos = $self;
my $count = 0;
while ($last && !$last->isAfter($self)) {
$last = $last->parent();
}
if ($last) { $last = $last->next(); } # first node after this declaration
while ($pos && $pos != $last) {
if ($pos->token eq "$lbrace") {
$count++;
}
$pos = $pos->next();
}
return $count;
}
# /*!
# @abstract
# Walks this parse tree node's sibling chain and
# returns the node after the nth left brace.
# @param self
# The starting parse tree node.
# @param lbrace
# The left brace token to look for.
# @param count
# The number of braces to skip past.
# */
sub skipcurly
{
my $self = shift;
my $lbrace = shift;
my $count = shift;
my $localDebug = 0;
my $pos = $self;
print STDERR "SKIPPING $count curly braces (lbrace = '$lbrace') at POS=$pos\n" if ($localDebug);
if (!$count) { return $self; }
while ($pos) {
my $tok = $pos->token();
print STDERR "TOKEN: '$tok'\n" if ($localDebug);
if ($tok eq "$lbrace") {
print STDERR "MATCH\n" if ($localDebug);
if (!--$count) {
my $next = $pos->next;
if ($localDebug) {
print STDERR "FOUND ONE. Next tree is:\n";
if ($next) {
$next->dbprint();
} else {
print STDERR "UNDEFINED!\n";
}
}
return $next;
}
}
$pos = $pos->next();
}
warn "Yikes! Ran out of open braces!\n";
return $pos;
}
# /*!
# @abstract
# Returns whether this token is a start token
# for a C preprocessor macro.
# @param token
# The token to check.
# @param macroListRef
# A reference to the macro hash returned by a
# call to
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/parseTokens//() parseTokens}.
# @param case_sensitive
# Set to 0/1 depending on whether the language uses
# case-sensitive token matching. This value is
# generally obtained with a call to
# {@link //apple_ref/perl/instm/HeaderDoc::HeaderElement/keywords//() keywords}.
# */
sub isKnownMacroToken
{
my $token = shift;
my $macroListRef = shift;
my $case_sensitive = shift;
my %macroList = %{$macroListRef};
if ($case_sensitive) {
if ($macroList{$token}) { return 1; }
return 0;
}
foreach my $cmpToken (keys %macroList) {
if (casecmp($token, $cmpToken, $case_sensitive)) {
return 1;
}
}
return 0;
}
# /*!
# @abstract
# Scrapes out the children of a new-style availability
# macro and returns a sanitized array.
# @param self
# The parse tree node, taken from
# {@link //apple_ref/perl/data/HeaderDoc::ParserState/availabilityNodesArray availabilityNodesArray}
# in the
# {@link //apple_ref/perl/cl/HeaderDoc::ParserState ParserState} object.
# @discussion
# Most of the hard work is done by
# {@link //apple_ref/perl/instm/HeaderDoc::Utilities/complexAvailabilityToArray//() complexAvailabilityToArray}.
#
# This function is exclusively used by
# {@link //apple_ref/perl/instm/HeaderDoc::BlockParse/mergeComplexAvailability//() mergeComplexAvailability}.
# */
sub parseComplexAvailability
{
my $self = shift;
my $localDebug = 0;
print STDERR "parseComplexAvailability: dumping tree for $self.\n" if ($localDebug);
$self->dbprint() if ($localDebug);
my $token = $self->token();
my $availstring = "";
my $pos = $self->firstchild();
while ($pos && ($pos->token() ne "(")) {
$pos = $pos->next();
}
if (!$pos) { my @arr = (); return \@arr; }
$pos = $pos->next();
while ($pos && ($pos->token() ne ")")) {
$availstring .= $pos->token();
$pos = $pos->next();
}
print STDERR "TOKEN: $token\nSTRING: $availstring\n" if ($localDebug);
return complexAvailabilityToArray($token, $availstring);
}
# /*!
# @abstract
# Gets/sets whether this token is an availability macro.
# @param self
# The parse tree node.
# @param newvalue
# The new value to set. (Optional.)
# */
sub isAvailabilityMacro
{
my $self = shift;
if (@_) {
$self->{ISAVAILABILITYMACRO} = shift;
}
if ($self->{ISAVAILABILITYMACRO}) {
return $self->{ISAVAILABILITYMACRO};
}
# my $parent = $self->parent();
# if ($parent) { return $parent->isAvailabilityMacro(); }
return 0;
}
# /*!
# @abstract
# Partially translates Perl code into C
# */
sub translateTree {
my $self = shift;
my %state = ();
$self->translateTreeRec(\%state);
}
# /*!
# @abstract
# Returns the parse tree node containing the
# next non-space token at the current level.
# @param self
# The initial parse tree node.
# */
sub nextNSToken
{
my $self = shift;
my $next = $self->{NEXT};
while ($next && $next->{TOKEN} !~ /\S/s) {
$next = $next->{NEXT};
}
return $next;
}
# /*! @abstract
# Does the real work of translating a Perl script (partially)
# to C.
# @param self
# The tree to translate.
# @param self
# A translation state object (initially empty).
# */
sub translateTreeRec {
my $self = shift;
my $stateref = shift;
my %state = %{$stateref};
my $localDebug = 0;
my $enteringComment = 0;
my $enteringString = 0;
my $enteringSingle = 0;
my $leavingHDComment = 0;
print STDERR "TOK: ".$self->{TOKEN}."\n" if ($localDebug);
if ((!$state{seenCode}) && $self->{TOKEN} && $self->{TOKEN} =~ /\S/s && $self->{TOKEN} ne "if" && $self->{TOKEN} ne "#" && $self->{TOKEN} ne "{" && $self->{TOKEN} ne "}") {
print STDERR "SEENCODE -> 1\n" if ($localDebug);
$state{seenCode} = 1;
$state{insertIfBeforeNode} = $self;
}
print STDERR "CHECK: INSTRING: ".$state{inString}." INCOMMENT: ".$state{inComment}." INREGEXP: ".$state{inRegExp}." INSINGLE: ".$state{inSingle}."\n" if ($localDebug);
if (!($state{inString} || $state{inComment} || $state{inRegExp} || $state{inSingle})) {
# Don't mess with the guts of these things, for the most part.
print STDERR "FIXUP OKAY\n" if ($localDebug);
if ($self->{TOKEN} eq "\"") {
$state{inString} = 1;
$enteringString = 1;
} elsif ($self->{TOKEN} eq "'") {
$state{inSingle} = 1;
$enteringSingle = 1;
} elsif ($self->{TOKEN} eq "#") {
print STDERR "ILC\n" if ($localDebug);
$state{inComment} = 1;
$enteringComment = 1;
$state{socNode} = $self;
if ($state{inHDComment}) {
$self->{TOKEN} = " ";
} else {
$self->{TOKEN} = "//";
}
if ($self->{FIRSTCHILD}->textTree() =~ /\*\//) {
$leavingHDComment = 1;
}
} elsif ($self->{TOKEN} eq "\$") { # Merge with next token.
my $next = $self->{NEXT};
if ($next) {
$self->{TOKEN} = "";
$self->{NEXT}->{TOKEN} = "\$".$self->{NEXT}->{TOKEN};
}
} elsif ($self->{TOKEN} eq ":") {
if ($self->{NEXT} && $self->{NEXT}->{TOKEN} eq ":") {
$self->{TOKEN} = "_";
$self->{NEXT}->{TOKEN} = "_";
}
} elsif ($self->{TOKEN} eq "elsif") {
$self->{TOKEN} = "else if";
} elsif ($self->{TOKEN} eq "STDERR") {
$self->{TOKEN} = "stderr";
} elsif ($self->{TOKEN} eq "STDOUT") {
$self->{TOKEN} = "stdout";
} elsif ($self->{TOKEN} eq "STDIN") {
$self->{TOKEN} = "stdin";
} elsif ($self->{TOKEN} eq "<" && $self->{FIRSTCHILD} &&
$self->{FIRSTCHILD}->{NEXT} &&
$self->{FIRSTCHILD}->{NEXT}->{TOKEN} =~ /^[a-zA-Z]+$/ &&
$self->{FIRSTCHILD}->{NEXT}->{NEXT} &&
$self->{FIRSTCHILD}->{NEXT}->{NEXT}->{TOKEN} eq ">") {
# print STDERR "FC: ".$self->{FIRSTCHILD}->{TOKEN}." NC ".$self->{FIRSTCHILD}->{NEXT}->{TOKEN}."\n";
print STDERR "Read from file.\n" if ($localDebug);
$self->{TOKEN} = "stringFromFP(";
$self->{FIRSTCHILD}->{NEXT}->{NEXT}->{TOKEN} = ")";
} elsif ($self->{TOKEN} eq "print" || $self->{TOKEN} eq "warn") {
my $nextnstoken = $self->nextNSToken();
if ($self->{TOKEN} eq "print") {
my $ns = $self->nextNSToken();
if ($ns && ($ns->{TOKEN} eq "\"" || $ns->{TOKEN} eq "\$")) {
$self->{TOKEN} = "printf";
} else {
$self->{TOKEN} = "fprintf";
if ($ns->{TOKEN} eq "STDERR") {
$ns->{TOKEN} = "stderr";
} elsif ($ns->{TOKEN} eq "STDOUT") {
$ns->{TOKEN} = "stdout";
}
$ns->{TOKEN} .= ",";
}
}
if ($nextnstoken->{TOKEN} ne "(") {
$self->{TOKEN} .= "(";
$state{addParenAtSemi} = 1;
$self->{NEXT} = $nextnstoken;
}
} elsif ($self->{TOKEN} eq "split") {
$self->{TOKEN} = "regexpSplit";
$state{inSplit} = 1;
print STDERR "inSplit -> 1\n" if ($localDebug);
} elsif ($self->{TOKEN} eq "(" && $state{inSplit}) {
$state{inSplit} = 2;
print STDERR "inSplit -> 1\n" if ($localDebug);
} elsif ($self->{TOKEN} eq "->") {
print STDERR "->" if ($localDebug);
my $pos = $self->{NEXT};
while ($pos && $pos->{TOKEN} !~ /\S/s) {
$pos = $pos->{NEXT};
}
if ($pos && $pos->{TOKEN} eq "{") {
my $posb = $pos->{FIRSTCHILD};
while ($posb && $posb->{TOKEN} ne "}") {
$posb = $posb->{NEXT};
}
if ($pos && $posb) {
$pos->{TOKEN} = "";
$posb->{TOKEN} = "";
}
}
} elsif ($self->{TOKEN} eq "eq" || $self->{TOKEN} eq "ne") {
my $prev = $self->slowprev();
while ($prev && ($prev->token !~ /\S/s)) {
$prev = $prev->slowprev();
}
while ($prev && $prev->{TOKEN} !~ /\&/ && $prev->{TOKEN} !~/\|/) {
print STDERR "PREV: $prev\n" if ($localDebug);
print STDERR "TOK: ".$prev->{TOKEN}."\n" if ($localDebug);
$prev = $prev->slowprev();
}
# })
# If we run off the beginning of the chain, we hit an open parenthesis,
# so we know we can always insert after the first (always-empty)
# child.
my $addspace = "";
if (!$prev) {
$prev = $self->parent()->firstchild();
} else {
# Add a space after || or &&
$addspace = " ";
}
my $next = $self->{NEXT};
while ($next && ($next->token !~ /\S/s)) {
$next = $next->{NEXT};
}
print STDERR "NEXT IS \"".$next->{TOKEN}."\"\n" if ($localDebug);
while ($next && $next->{NEXT} && $next->{NEXT}->{TOKEN} !~ /\&/ && $next->{NEXT}->{TOKEN} !~ /\|/ &&
$next->{NEXT}->{TOKEN} !~ /\)/) {
$next = $next->{NEXT};
print STDERR "INLOOP NEXT IS ".$next->{TOKEN}."\n" if ($localDebug);
}
if ($prev && $next) {
my $newnode = HeaderDoc::ParseTree->new();
if ($self->{TOKEN} eq "eq") {
$newnode->{TOKEN} = $addspace."!strcmp(";
} else {
$newnode->{TOKEN} = $addspace."strcmp(";
}
$newnode->{NEXT} = $prev->{NEXT};
$prev->{NEXT} = $newnode;
if ($next->{TOKEN} eq "\$") {
$next->{TOKEN} = "";
$next->{NEXT}->{TOKEN} = "\$".$next->{NEXT}->{TOKEN};
$next = $next->{NEXT};
}
$newnode = HeaderDoc::ParseTree->new();
$newnode->{TOKEN} = ")";
$newnode->{NEXT} = $next->{NEXT};
$next->{NEXT} = $newnode;
$self->{TOKEN} = ",";
$prev = $self->slowprev();
while ($prev && ($prev->{TOKEN} =~ /\s/s)) {
$prev->{TOKEN} = "";
$prev = $prev->slowprev();
}
} else {
warn("Could not fix \"eq\" because previous/next token not found (PREV: $prev NEXT: $next).\n");
}
} elsif ($state{seenCode} && ($self->{TOKEN} eq ";" || $self->{TOKEN} eq "{")) {
$state{seenCode} = 0;
if ($state{addParenAtSemi}) {
$state{addParenAtSemi} = 0;
$self->{TOKEN} = ")".$self->{TOKEN};
}
print STDERR "SEENCODE -> 0\n" if ($localDebug);
if ($state{captureIf}) {
my $lastcapture = $self->slowprev();
my $beforenode = $state{insertIfBeforeNode};
my $prev = $beforenode->slowprev();
if (!$prev) {
my $newnode = HeaderDoc::ParseTree->new();
$newnode->{TOKEN} = $beforenode->{TOKEN};
$newnode->{NEXT} = $beforenode->{NEXT};
$beforenode->{NEXT} = $newnode;
$beforenode->{TOKEN} = "";
$prev = $beforenode;
$beforenode = $newnode;
}
my $trailingspace = $self->slowprev();
if (!$trailingspace) {
$trailingspace = $self->parent();
}
while ($trailingspace &&
((!$trailingspace->{TOKEN}) ||
($trailingspace->{TOKEN} =~ /\s/s))) {
# print STDERR "TS: $trailingspace\n" if ($localDebug);
# print STDERR "PARENT: ".$trailingspace->parent()."\n" if ($localDebug);
$trailingspace->{TOKEN} = "";
my $temp = $trailingspace->slowprev();
if ($temp) { $trailingspace = $temp; }
else { $trailingspace = $trailingspace->parent(); }
}
my $copiedDataNode = HeaderDoc::ParseTree->new();
$copiedDataNode->{NEXT} = $prev->{NEXT};
$prev->{NEXT} = $copiedDataNode;
$copiedDataNode->{TOKEN} = $state{capturedText}." ";
print STDERR "ACCUM: ".$state{capturedText}."\n" if ($localDebug);
$state{captureIf} = 0;
print STDERR "captureIf -> 0\n" if ($localDebug);
}
} elsif ($self->{TOKEN} eq "if" && $state{seenCode}) {
$state{capturedText} = "";
$state{captureIf} = 1;
print STDERR "captureIf -> 1\n" if ($localDebug);
}
} elsif ($state{inComment} == 1 && ($self->{TOKEN} eq "/*!" || $self->{TOKEN} eq "/**")) {
$state{socNode}->{TOKEN} = " ";
$state{inHDComment} = 1;
} elsif ($state{inComment} && $self->{TOKEN} =~ /\S/) {
$state{inComment} = 2;
}
print STDERR "RE_STATE: ".$self->{RE_STATE}."\n" if ($localDebug);
if ($self->{RE_STATE} eq "RE_PREFIX") {
print STDERR "Regexp prefix found.\n" if ($localDebug);
if ($self->{TOKEN} eq "s") {
$state{inRegExp} = 3;
$state{rePrefix} = $self->{TOKEN};
$self->{TOKEN} = "";
} elsif ($self->{TOKEN} eq "tr") {
$state{inRegExp} = 4;
$state{rePrefix} = $self->{TOKEN};
$self->{TOKEN} = "";
} elsif ($self->{TOKEN} eq "m") {
$self->{TOKEN} = "";
print STDERR "Dropping prefix because 'm' is equivalent to no prefix.\n" if ($localDebug);
} else {
print STDERR "Unsupported prefix. Ignoring this expression.\n" if ($localDebug);
$state{inRegExp} = -1; # No 'tr' support yet.
}
} elsif ($self->{RE_STATE} eq "RE_PARTSEP") {
if ($self->{NEXT}->{RE_STATE} eq "RE_PARTSEP") {
$self->{NEXT}->{TOKEN} = "";
$self->{NEXT}->{RE_STATE} = "";
}
$self->{TOKEN} = "\", \"";
} elsif ($self->{RE_STATE} eq "RE_START" && ((!$state{inRegExp}) || $state{inRegExp} == 3 || $state{inRegExp} == 4)) {
print STDERR "Regexp start found. INSPLIT: ".$state{inSplit}."\n" if ($localDebug);
$state{regexpName} = $state{prevTokenNode}->{TOKEN};
print STDERR "PTN: ".$state{prevTokenNode}." (".$state{prevTokenNode}->{TOKEN}.") REGEXPNAME: ".$state{regexpName}."\n" if ($localDebug);
if ($state{inSplit}) {
$self->{TOKEN} = "\"";
$state{inRegExp} = 2;
} elsif ($state{regexpName} =~ /^\$[0-9A-Za-z_]+$/) {
if (!$state{inRegExp}) {
$state{inRegExp} = 1;
$state{prevTokenNode}->{TOKEN} = "regexpMatch(".$state{regexpName}.", ";
} elsif ($state{inRegExp} == 3) {
$state{prevTokenNode}->{TOKEN} = "regexpReplace(".$state{regexpName}.", \@\@\@DEST\@\@\@, ";
} elsif ($state{inRegExp} == 4) {
$state{prevTokenNode}->{TOKEN} = "regexptr(".$state{regexpName}.", \@\@\@DEST\@\@\@, ";
}
my $pos = $state{prevTokenNode}->{NEXT};
print STDERR "Deleting the =~ .\n" if ($localDebug);
while ($pos && !$pos->{RE_STATE}) {
print STDERR "Deleting \"".$pos->{TOKEN}."\" ($pos)\n" if ($localDebug);
# Nuke the "=~"
if ($pos->{TOKEN} eq "!") {
$state{prevTokenNode}->{TOKEN} = "!".$state{prevTokenNode}->{TOKEN};
}
$pos->{TOKEN} = "";
$pos = $pos->{NEXT}
}
if ($state{rePrefix} eq "s") {
$self->{TOKEN} = "\"";
# } elsif ($state{rePrefix} eq "tr") {
# $self->{TOKEN} = "\"[";
} else {
$self->{TOKEN} = "\"";
}
} else {
$state{inRegExp} = -1;
}
} elsif ($self->{RE_STATE} eq "RE_END") {
print STDERR "End of regexp found.\n" if ($localDebug);
# Defaults.
my $multiline = 0;
my $insensitive = 0;
my $global = 0;
my $complement = 0;
my $delete = 0;
my $nondestructive = 0;
my $squash = 0;
my $next = $self->{NEXT};
if ($next && $next->{TOKEN} =~ /^[siogmcdr]*$/) {
my $re_trailer = $next->{TOKEN};
if ($re_trailer =~ /s/) {
$multiline = 0; # for 's'
$squash = 1; # for 'tr'
} elsif ($re_trailer =~ /m/) {
$multiline = 1;
}
if ($re_trailer =~ /g/) {
$global = 1;
}
if ($re_trailer =~ /i/) {
$insensitive = 1;
}
if ($re_trailer =~ /c/) {
$complement = 1;
}
if ($re_trailer =~ /d/) {
$delete = 1;
}
if ($re_trailer =~ /r/) {
$nondestructive = 1;
}
$next->{TOKEN} = "";
}
if ($state{inRegExp} == 1) {
$self->{TOKEN} = "\", $multiline, $insensitive, NULL)";
} elsif ($state{inRegExp} == 2) {
# Leave parentheses open.
$self->{TOKEN} = "\"";
my $next = $self->nextNSToken();
print STDERR "THISNEXT: ".$next->{TOKEN}."\n" if ($localDebug);
if (!$next) {
die("Malformed split\n");
}
# $next should be the comma after the regular expression.
$next = $next->nextNSToken();
if ($next->{TOKEN} eq "\$") {
$next->{TOKEN} = "";
$next->{NEXT}->{TOKEN} = "\$".$next->{NEXT}->{TOKEN};
$next = $next->{NEXT};
}
# $next should be the data to split.
my $argNode = HeaderDoc::ParseTree->new();
$argNode->{NEXT} = $next->{NEXT};
$next->{NEXT} = $argNode;
$argNode->{TOKEN} = ", $multiline, $insensitive";
my $afternext = $argNode->nextNSToken();
print STDERR "AN: ".$afternext->{TOKEN}."\n" if ($localDebug);
if (!$afternext || ($afternext->{TOKEN} ne ",")) {
$argNode->{TOKEN} .= ", 0";
}
} elsif ($state{inRegExp} == 3) {
if ($state{rePrefix} eq "s") {
$self->{TOKEN} = "\", $multiline, $insensitive, $global)";
# } elsif ($state{rePrefix} eq "tr") {
# $self->{TOKEN} = "]\"";
} else {
die("Unknown RE prefix \"".$state{rePrefix}."\" [1]\n");
}
} elsif ($state{inRegExp} == 4) {
if ($state{rePrefix} eq "tr") {
# Allowed: "s", but not "m", not "i", not "g"
$self->{TOKEN} = "\", $squash, $complement, $delete)";
if ($nondestructive) {
$state{prevTokenNode}->{TOKEN} = "regexptr(".$state{regexpName}.", NULL, ";
}
} else {
die("Unknown RE prefix \"".$state{rePrefix}."\" [2]\n");
}
}
$state{inRegExp} = 0;
$state{rePrefix} = "";
} elsif ($state{inRegExp}) {
$self->{TOKEN} =~ s/\\/\\\\/g;
}
if ($state{inComment} && $self->{TOKEN} =~ /[\n\r]/) {
print STDERR "Leaving comment.\n" if ($localDebug);
$state{inComment} = 0;
}
print STDERR "Checking token.\n" if ($localDebug);
if ($self->{TOKEN} =~ /^\$[a-zA-Z0-9_]+$/) {
print STDERR "setting PTN\n" if ($localDebug);
$state{prevTokenNode} = $self;
}
if ($state{captureIf}) {
print STDERR "APPEND ".$self->{TOKEN}."\n" if ($localDebug);
$state{capturedText} .= $self->{TOKEN};
$self->{TOKEN} = "";
}
my $resetSplit = 0;
if ($state{inSplit} == 2) {
$resetSplit = 1;
$state{inSplit} = 3;
}
if ($self->{FIRSTCHILD}) {
print STDERR "Processing children.\n" if ($localDebug);
my $tempstateref = $self->{FIRSTCHILD}->translateTreeRec(\%state);
my %tempstate = %{$tempstateref};
if ($state{inComment} && $tempstate{inHDComment}) {
$state{inHDComment} = 1;
}
if ($state{captureIf}) {
$state{capturedText} = $tempstate{capturedText};
}
$state{seenCode} = $tempstate{seenCode};
$state{prevTokenNode} = $tempstate{prevtoken};
}
if ($resetSplit) { $state{inSplit} = 0; print STDERR "inSplit -> 0\n" if ($localDebug) };
if ($enteringComment) { $state{inComment} = 0; $state{seenCode} = 0; }
if ($enteringString) { $state{inString} = 0; }
if ($enteringSingle) { $state{inSingle} = 0; }
if ($leavingHDComment) { $state{inHDComment} = 0; $state{seenCode} = 0; }
if ($self->{NEXT}) {
print STDERR "Processing next.\n" if ($localDebug);
$stateref = $self->{NEXT}->translateTreeRec(\%state);
%state = %{$stateref};
}
print STDERR "Returning.\n" if ($localDebug);
return \%state;
}
# /*!
# @abstract Returns the first token inside the body of an AppleScript
# function.
# */
sub ASFunctionBodyStart
{
my $self = shift;
my $localDebug = 0;
while ($self &&
($self->token() ne "\n") &&
($self->token() ne "\r") &&
($self->token() ne "(")) {
print STDERR "SKIPPING ".$self->token()." (LOOP 1)\n" if ($localDebug);
$self = $self->next();
}
while ($self &&
($self->token() eq "\n") ||
($self->token() eq "\r") ||
($self->token() eq "(")) {
print STDERR "SKIPPING ".$self->token()." (LOOP 2)\n" if ($localDebug);
$self = $self->next();
}
print STDERR "RETURNING TREE.\n" if ($localDebug);
$self->dbprint() if ($localDebug);
return $self;
}
1;
|