?? stlfilt.pl
字號:
{ # (just "/closewrap" means Y)
$close_wrap = "\u$1";
$close_wrap = 'Y' if $close_wrap eq "";
shift;
next;
}
if ($ARGV[0] =~ /^[\/-]meta:?([YN]?)[A-Z]*$/i) # meta:Y or N
{ # (just "/meta" means Y)
if ("\u$1" =~ /^N/)
{
$break_algorithm = 'P';
}
else
{
$break_algorithm = 'D';
$comma_wrap = $meta_y_cbreak;
$close_wrap = $meta_y_closewrap;
}
$output_width = 80 if $output_width == 0;
shift;
next;
}
if ($ARGV[0] =~ /^[\/-]lognative/i) # allow log native msgs option
{ # of form: /lognative
$lognative = 1;
shift;
next;
}
if ($ARGV[0] =~ /^[\/-]banner:?([YN]?)[a-zA-Z]*$/i) # banner:Y or N
{ # (just "/banner" means Y)
$banner = "\u$1";
$banner = 'Y' if $banner eq "";
shift;
next;
}
if ($ARGV[0] =~ /^[\/-]plg/i) # .PLG file mode
{
$plg = 1;
shift;
next;
}
if ($ARGV[0] =~ /^[\/-]/)
{
print "STLFilt.pl: Unrecognized option: $ARGV[0]\n";
shift;
next;
}
last;
}
break_and_print "$STLFilt_ID\n" if $banner eq 'Y';
#
# This sections builds the $t ("type") regex from the ground up.
# After it is built, the component variables (except for $id) are not used again.
#
$sid = '\b[a-zA-Z_]\w*'; # pattern for a simple identifier or keyword
$id = "(?:$sid\:\:)*$sid"; # simple id preceded by optional namespace qualifier(s)
$p = '(?: ?\*)*'; # suffix for "ptr", "ptr to ptr", "ptr to ptr to ptr", ad nauseum.
$idp = "(?:$id )*$id ?$p ?"; # one or more identifiers/keywords with perhaps some *'s after
# simple id or basic template spec
$cid = "(?:$idp(?: ?const ?\\*? ?)?|$id<$idp(?: ?const ?\\*? ?)?(?:,$idp(?: ?const ?\\*? ?)?)*>$p) ?";
# a cid or template type with 1+ cid's as parameters
$t = "(?:$cid|$id<$cid(?:,$cid)*>$p|$id<$id<$cid>$p(?:,$id<$cid>$p)* ?>$p)";
$dotNET = 0; # have we detected .NET-style messages yet? no
$justWith = 0; # did we see a line with just "with" on it? no, not yet
$long_id = 0; # was the previous message a long identifier warning? no
showkey $output_width if $pdbg;
lognative_header if $lognative;
#
# Data structures supporting the Dave Abrahams mode line break algorithm:
#
@open_delims = ('(', '{', '<');
@close_delims= (')', '}', '>');
for (@open_delims) # list of "open" delimiters
{
$open_delims{$_}++;
}
for (@close_delims) # list of "close" delimiters
{
$close_delims{$_}++;
}
# create "opposites" table, mapping each delimiter to its complement:
for ($i = 0; $i < @open_delims; $i++)
{
$opps{$open_delims[$i]} = $close_delims[$i];
$opps{$close_delims[$i]} = $open_delims[$i];
}
$improperly_broken_line = 0; # processing a line with inappropriate CRLF at the end?
$accumulated_line = ""; # if so, this holds all segments of that line seen so far.
#
# NOTE: We cannot use a main loop of the form
#
# while( <> )
#
# because of ActivePerl's way of handling input from Win32 pipes
# connected to STDIN. (EOF is treated like an ordinary character.
# In particular, it doesn't get read unless FOLLOWED by a newline.
# Yeah, great, EOF followed by a newline.)
#
MAIN_LOOP:
while ( 1 )
{
# Read the first char of the next line to see if it equals EOF.
# If we're the ones who write the code that writes to STDIN,
# we can guarantee that EOF is always preceded by a newline.
#
# We must do this in a loop, because if the next line is empty,
# then we have not read the first char of the next line, but
# the entire next line.
#
$newlines = "";
CHECK_FOR_EOF_LOOP:
while( 1 )
{
# Read one char.
$nextchar = "";
$numRead = read STDIN, $nextchar, 1;
# Normally, perl will return an undefined value from read if the next
# character was EOF. ActivePerl will simply read the EOF like any other
# character. Since we know that one of the newlines was ours, we print one
# less newline than we have seen. NOTE: It is possible that we have seen no
# newline at all. This happens if the CL output has no newline at the end.
# In that case, we have appended a newline, and that's good.
if (1 != $numRead or $nextchar eq "\032")
{
if ($newlines ne "")
{
chop $newlines;
print $newlines;
}
last MAIN_LOOP;
}
else # Else, if we have read a newline, we store it for later output and continue reading.
{
if ($nextchar eq "\n")
{
$newlines = $newlines . "\n";
}
# Else, if we have read something that's neither a newline nor EOF, we print
# the accumulated newlines and proceed to read and process the next line.
else
{
print $newlines;
last CHECK_FOR_EOF_LOOP;
}
}
}
# Read the next line, prepend the first char, which has already been read.
$_ = <STDIN>;
# If the read failed, the pipe must have broken.
if (!defined $_)
{
print "\nSTL Decryptor: Input stream terminated abnormally (broken pipe?)\n";
last MAIN_LOOP;
}
$_ = $nextchar . $_;
# Do these transformation immediately, so the `...' pairs don't appear as mismatched when looking
# for even numbers of single quotes:
s/`anonymous[- ]namespace'/anon_ns/g; # massage anonymous namespace specs to qualify as identifiers
s/``global namespace''/ \$global namespace\$/g; # massage this too so as to not confuse quote counters
s/`([^']*)'/$1/g; # change `anything' to anything (typical: operator`+' -> operator+)
# Check for long line wrapped by IDE with an improper CRLF:
if ($improperly_broken_line) # if processing line(s) with improper CRLF termination
{
chomp $accumulated_line;
$accumulated_line .= $_;
next if /^\S/; # if line does not begin with whitespace, "glue" to previous
$_ = $accumulated_line; # else done accumulating.
$accumulated_line = ""; # clear the accumulation buffer
$improperly_broken_line = 0; # and clear the flag to indicate we're no longer "accumulating".
}
elsif (tr/'// % 2 == 1) # if an odd number of single quotes
{
$improperly_broken_line = 1; # then go look for more pieces of the line to glue together
$accumulated_line = $_;
next;
}
$save_line_for_dbg = $_; # in case of a panic error
print LOGNATIVE $_ if $lognative; # log native message if requested
if ($plg) # If processing .PLG file
{
if ($doing_brackets)
{
$doing_brackets = 0 if /^]/; # Done "doing brackets" if we see a "]" line
next;
}
if (/^\[/) # A "[" line means we're about to start skipping until we see a "]" line
{
$doing_brackets = 1;
next;
}
if (/---Configuration/) # Pass through all "Configuration" lines as they are
{
print;
next;
}
if (!$plg_sawcompiling)
{
next if !/Compiling\.\.\.$/; # Skip everything until we see "Compiling..."
$plg_sawcompiling = 1; # Then mark that we did see it.
print "Compiling...\n"; # Spit it out without the HTML, thank you very much
next;
}
next if /^Creating [^l]/; # permit "Creating library", but not "Creating" anything else
next if /BD Software Proxy CL/;
next if /^</; # suppress all HTML
}
if (/^([^;]*\(\d+\)) ?\:/) # strip prefix of form:
{ # "pathname(n) : "
$oldprefix = "$1 :"; # and conditionally replace later with:
# "pathname(n):" (note how space goes away)
$prefix = ($keep_space_pre_colon ? $oldprefix : "$1:");
s/^\Q$oldprefix//; # remove the old prefix
}
elsif (/^(.*\.c(pp|xx))$/) # if line ends with ".cpp" or ".cxx",
{ # then assume it is just a filename and don't filter
print; # don't bother filtering the line with just
next; # the filename on it
}
else
{
$prefix = ""; # dummy prefix value
}
$prefix =~ s/^ /$tab/;
next if /was declared deprecated/ and $hide_deprecated_warns;
next if /compiler has generated/ and $hide_generated_warns;
s/\boperator`(\w[^']*)'/operator $1/g; # obscure case involving conversion operators and quote marks
##################################################################################################
# Do "with"-clause substitutions, to transform into old-style messages (native CL's /WL option required):
if ($with_policy eq 'S')
{
$justWith = 1 if /^ *with *$/; # so we can remind folks to use /WL when the dust settles...
while (/'(([^']*)( with \[([^']*)\]))/)
{
$dotNET = 1; # OK, now we know we're dealing with .NET messages...
$text = $2; # the original message text with placeholder names
$keyclause = $3; # the "with [...]" clause
$keylist = $4; # just the list of key/value mappings
%map = (); # clear the hash of key/value pairs
while($keylist =~ /(\w+)=/)
{
$key = $1;
$pos = $start = index($keylist, $key) + length($key) + 1;
$depth = 0; # count <'s and >'s
$previous = ' ';
while ($pos <= length($keylist))
{
$next = substr ($keylist, $pos++, 1);
last if $depth == 0 and ($next eq ',' or ($next eq ']' and $previous ne '[')); # ignore "[]"
$depth++ if $next =~ /[<\[\(]/;
$depth-- if $next =~ /[>\]\)]/;
}
$value = substr($keylist, $start, $pos - $start - 1);
$map{$key} = $value;
last if $pos > length($keylist);
$keylist = substr($keylist, $pos);
}
# Apply substitutions to the original text fragment:
$newtext = $text;
while(($key, $value) = each(%map))
{
$newtext =~ s/\b$key\b/$value/g;
}
# Replace the original message text with the expanded version:
s/\Q$text/$newtext/;
# Delete the key/value list from the message:
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -