Up to [Platon] / platos / _scripts

Platon SDG office

#! /usr/bin/perl -w

#
# colorgcc
#
# Version: 1.3.2
#
# $Id: colorgcc,v 1.1.1.1 2003/02/06 19:25:12 rajo Exp $
#
# A wrapper to colorize the output from compilers whose messages
# match the "gcc" format.
#
# Requires the ANSIColor module from CPAN.
#
# Usage:
#
# In a directory that occurs in your PATH _before_ the directory
# where the compiler lives, create a softlink to colorgcc for
# each compiler you want to colorize:
#
#    g++ -> colorgcc
#    gcc -> colorgcc
#    cc  -> colorgcc
#    etc.
#
# That's it. When "g++" is invoked, colorgcc is run instead.
# colorgcc looks at the program name to figure out which compiler to run.
#
# The default settings can be overridden with ~/.colorgccrc.
# See the comments in the sample .colorgccrc for more information.
#
# Note:
#
# colorgcc will only emit color codes if:
# 
#    (1) Its STDOUT is a tty and
#    (2) the value of $TERM is not listed in the "nocolor" option.
#
# If colorgcc colorizes the output, the compiler's STDERR will be
# combined with STDOUT. Otherwise, colorgcc just passes the output from
# the compiler through without modification.
# 
# Author: Jamie Moyers <jmoyers@geeks.com>
# Started: April 20, 1999
# Licence: GNU Public License
#
# Credits:
#
#    I got the idea for this from a script called "color_cvs":
#       color_cvs .03   Adrian Likins <adrian@gimp.org> <adrian@redhat.com>
#
#    <seh4@ix.netcom.com> (Scott Harrington)
#       Much improved handling of compiler command line arguments.
#       exec compiler when not colorizing to preserve STDOUT, STDERR.
#       Fixed my STDIN kludge.
#       
#    <ecarotti@athena.polito.it> (Elias S. G. Carotti)
#       Corrected handling of text like -DPACKAGE=\"Package\"
#       Spotted return code bug.
#
#    <erwin@erwin.andreasen.org> (Erwin S. Andreasen)
#    <schurchi@ucsd.edu> (Steve Churchill)
#       Return code bug fixes.
#
#    <rik@kde.org> (Rik Hemsley)
#       Found STDIN bug.
#
# Changes:
#
# 1.3.2 Better handling of command line arguments to compiler.
#
#       If we aren't colorizing output, we just exec the compiler which
#       preserves the original STDOUT and STDERR.
#
#       Removed STDIN kludge. STDIN being passed correctly now.
# 
# 1.3.1 Added kludge to copy STDIN to the compiler's STDIN.
#
# 1.3.0 Now correctly returns (I hope) the return code of the compiler
#       process as its own.
# 
# 1.2.1 Applied patch to handle text similar to -DPACKAGE=\"Package\".
#
# 1.2.0 Added tty check. If STDOUT is not a tty, don't do color.
#
# 1.1.0 Added the "nocolor" option to turn off the color if the terminal type
#       ($TERM) is listed.
#
# 1.0.0 Initial Version

use Term::ANSIColor;
use IPC::Open3;

sub initDefaults
{
    $compilerPaths{"gcc"}   = "/usr/bin/gcc-2.96";
    $compilerPaths{"g++"}   = "/usr/bin/g++-2.96";
    $compilerPaths{"cc"}    = "/usr/bin/gcc-2.96";
    $compilerPaths{"c++"}   = "/usr/bin/g++-2.96";
    $compilerPaths{"make"}  = "/usr/bin/make";
    $compilerPaths{"latex"} = "/usr/bin/latex";

    $nocolor{"dumb"} = "true";

    $colors{"srcColor"}              = color("cyan");
    $colors{"introColor"}            = color("blue");

    $colors{"warningFileNameColor"}  = color("yellow");
    $colors{"warningNumberColor"}    = color("yellow");
    $colors{"warningMessageColor"}   = color("yellow");

    $colors{"errorFileNameColor"}    = color("bold red");
    $colors{"errorNumberColor"}      = color("bold red");
    $colors{"errorMessageColor"}     = color("bold red");

    $colors{"makeColor"}             = color("cyan");
    $colors{"makeSrcColor"}          = color("cyan");
    $colors{"makeEnterDirColor"}     = color("bold green");
    $colors{"makeLeaveDirColor"}     = color("green");
    $colors{"makeErrorMessageColor"} = color("bold red");

    $color{"latexWarningColor"}      = color("yellow");
    $color{"latexOverfullColor"}     = color("bold yellow");
    $color{"latexUnderfullColor"}    = color("bold yellow");

    # defined OK:
    $character{"e1"} = "á"; # 225 0xE1
    $character{"e9"} = "é"; # 233 0xE9
    $character{"ed"} = "í"; # 237 0xED
    $character{"a9"} = "ľ"; # 181 0xB5
    $character{"f3"} = "ó"; # 243 0xF3
    $character{"b2"} = "š"; # 185 0xB9
    $character{"b9"} = "š"; # changed from ź 0Xbc
    $character{"fa"} = "ú"; # 250 0xFA
    $character{"fd"} = "ý"; # 253 0xFD
    $character{"ba"} = "ž"; # 190 0xBE
    $character{"91"} = "Ś"; # 166 0xA6
    $character{"92"} = "Š"; # 169 0xA9
    $character{"94"} = "Ť"; # 171 0xAB
    $character{"e4"} = "ä"; # 228 0xE4
    $character{"f4"} = "ô"; # 244 0xF4
    $character{"9a"} = "Ž"; # 174 0xAE
    $character{"af"} = "ŕ"; # 224 0xE0
    $character{"b1"} = "ś"; # 182 0xB6
    $character{"a8"} = "ĺ"; # 229 0xE5
    $character{"a2"} = "ć"; # 230 0xE6
    $character{"a3"} = "č"; # 232 0xE8
    $character{"a4"} = "ď"; # 239 0xEF
    $character{"a5"} = "ě"; # 236 0xEC
    $character{"ab"} = "ń"; # ń 0Xf1
    $character{"ac"} = "ň"; # ň 0Xf2
    $character{"f6"} = "ö"; # ö 0Xf6
    $character{"b0"} = "ř"; # ř 0Xf8
    $character{"b4"} = "ť"; # ť 0Xbb
    $character{"fc"} = "ü"; # ü 0Xfc
    $character{"c1"} = "Á"; # Á 0Xc1
    $character{"c4"} = "Ä"; # Ä 0Xc4
    $character{"82"} = "Ć"; # Ć 0Xc6
    $character{"83"} = "Č"; # Č 0Xc8
    $character{"84"} = "Ď"; # Ď 0Xcf
    $character{"c9"} = "É"; # É 0Xc9
    $character{"85"} = "Ě"; # Ě 0Xcc
    $character{"cd"} = "Í"; # Í 0Xcd
    $character{"88"} = "Ĺ"; # Ĺ 0Xc5
    $character{"89"} = "Ľ"; # Ľ 0Xa5
    $character{"8b"} = "Ń"; # Ń 0Xd1
    $character{"8c"} = "Ň"; # Ň 0Xd2
    $character{"d3"} = "Ó"; # Ó 0Xd3
    $character{"d4"} = "Ô"; # Ô 0Xd4
    $character{"8f"} = "Ŕ"; # Ŕ 0Xc0
    $character{"90"} = "Ř"; # Ř 0Xd8
    $character{"da"} = "Ú"; # Ú 0Xda
    $character{"dc"} = "Ü"; # Ü 0Xdc
    $character{"dd"} = "Ý"; # Ý 0Xdd
    $character{"99"} = "Ź"; # Ź 0Xac
}

sub loadPreferences
{
# Usage: loadPreferences("filename");

    my($filename) = @_;

    open(PREFS, "<$filename") || return;

    while(<PREFS>) {
        next if (m/^\#.*/);          # It's a comment.
        next if (!m/(.*):\s*(.*)/);  # It's not of the form "foo: bar".

        $option = $1;
        $value = $2;

        if ($option =~ m/cc|c\+\+|gcc|g\+\+|make|latex/) {
            $compilerPaths{$option} = $value;
        }
        elsif ($option eq "nocolor") {
            # The nocolor option lists terminal types, separated by
            # spaces, not to do color on.
            foreach $termtype (split(/\s+/, $value)) {
                $nocolor{$termtype} = "true";
            }
        }
        else {
            $colors{$option} = color($value);
        }
    }
    close(PREFS);
}

sub srcscan
{
# Usage: srcscan($text, $normalColor)
#    $text -- the text to colorize
#    $normalColor -- The escape sequence to use for non-source text.

# Looks for text between ` and ', and colors it srcColor.

    my($line, $normalColor) = @_;

    my($srcon) = color("reset") . $colors{"srcColor"};
    my($srcoff) = color("reset") . $normalColor;

    $line = $normalColor . $line;

    # This substitute replaces `foo' with `AfooB' where A is the escape
    # sequence that turns on the the desired source color, and B is the
    # escape sequence that returns to $normalColor.
    $line =~ s/\`(.*?)\'/\`$srcon$1$srcoff\'/g;

    print($line, color("reset"));
}

#
# Main program
#

# Set up default values for colors and compilers.
initDefaults();

# Read the configuration file, if there is one.
$configFile = $ENV{"HOME"} . "/.colorgccrc";
#$default_configFile = "/etc/colorgccrc";
$default_configFile = $ENV{"HOME"} . "/.colorgccrc";
if (-f $configFile) {
    loadPreferences($configFile);
} elsif (-f $default_configFile ) {
    loadPreferences($default_configFile)
}

# Figure out which compiler to invoke based on our program name.
$0 =~ m%.*/(.*)$%;
$progName = $1 || $0;

$compiler = $compilerPaths{$progName} || $compilerPaths{"gcc"};

# Get the terminal type. 
$terminal = $ENV{"TERM"} || "dumb";

# If it's in the list of terminal types not to color, or if
# we're writing to something that's not a tty, don't do color.
if (! -t STDOUT || $nocolor{$terminal}) {
    exec $compiler, @ARGV
        or die("Couldn't exec");
}

# Keep the pid of the compiler process so we can get its return
# code and use that as our return code.
$compiler_pid = open3('<&STDIN', \*COMPILEROUT, \*COMPILEROUT, $compiler, @ARGV);

sub diacritics_output($)
{
    my ($line) = @_;
    my $str = "";
    #printf("line = '$line'\n");

    while ($line =~ m/\^\^([0-9a-f][0-9a-f])/) {
        $field = $1 || "";
        $str = $character{"$field"} || sprintf "%c", hex("0x$field");
        #print ("pred substit. line = '$line'\nsubst = 's/\^\^$field/$str/g;'\n");
        $line =~ s/\^\^$field/$str/g;
        #print ("po substit. line = '$line'\n");
    }
    print("$line");
}

sub diacritics($)
{
    my ($line) = @_;
    $_ = <COMPILEROUT>;
    while (length($_) == 80) {
        s/[\r\n]$//g;
        $line = $line . $_;
        $_ = <COMPILEROUT>;
    }
    $line = $line . $_;

    diacritics_output($line);    
}

# Colorize the output from the compiler.
while(<COMPILEROUT>)
{
    if (m/^LaTeX Warning:.*/) { # output from LaTeX
        print($color{"latexWarningColor"}, $_, color("reset"));
    }
    elsif (m/^! Missing number.*/) {
        print($color{"latexWarningColor"}, $_, color("reset"));
    }
    elsif (m/Overfull \\[hv]box.*/) {
        print($color{"latexOverfullColor"}, $_, color("reset"));
        diacritics("");
    }
    elsif (m/^Underfull \\[hv]box.*/) {
        print($color{"latexUnderfullColor"}, $_, color("reset"));
        diacritics("");
    }
    elsif (m/^l\.([0-9]+)( .*)/) {
        $field1 = $1 || "";
        $field2 = $2 || "";
        diacritics_output("l." . $colors{"errorNumberColor"} . "$field1" . color("reset") . "$field2\n");
    }
    elsif (m/\.\.\.$/) {
        diacritics_output($_);
    }
    elsif (m/^(make[^:]*):(.*)$/) { # output from 'make'
        $field1 = $1 || "";
        $field2 = $2 || "";
        print($colors{"makeColor"}, "$field1:", color("reset"));
        if ($field2 =~ m/Entering directory/) {
            print($colors{"makeEnterDirColor"}, "$field2\n", color("reset")); 
        }
        elsif ($field2 =~ m/Leaving directory/) {
            print($colors{"makeLeaveDirColor"}, "$field2\n", color("reset")); 
        }
        elsif ($field2 =~ m/^[ \t]*\*\*\*|Entering an unknown directory|Leaving an unknown directory/) {
            print($colors{"makeErrorMessageColor"}, "$field2\n", color("reset")); 
        }
        elsif ($field2 =~ m/^([ \t]*\[.*\]) (Error [^ ]*) (\(.*\))$/) {
            print($colors{"makeErrorMessageColor"}, "$1 $2 ",
                $colors{"makeSrcColor"}, "$3\n", color("reset")); 
        }
        else {
            print("$field2\n", color("reset"));
        }
    }
    elsif (m/^(.*?):([0-9]+):(.*)$/) { # filename:lineno:message
        $field1 = $1 || "";
        $field2 = $2 || "";
        $field3 = $3 || "";

        if ($field3 =~ m/\s+warning:.*/) {
            # Warning
            print($colors{"warningFileNameColor"}, "$field1:", color("reset"));
            print($colors{"warningNumberColor"}, "$field2:", color("reset"));
            srcscan($field3, $colors{"warningMessageColor"});
        }
        else {
            # Error
            print($colors{"errorFileNameColor"}, "$field1:", color("reset"));
            print($colors{"errorNumberColor"}, "$field2:", color("reset"));
            srcscan($field3, $colors{"errorMessageColor"});
        }
        print("\n");
    }
    elsif (m/^(.*?):(.+):$/) { # filename:message:
        # No line number, treat as an "introductory" line of text.
        srcscan($_, $colors{"introColor"});
    }
    else { # Anything else.        
        # Doesn't seem to be a warning or an error. Print normally.
        print(color("reset"), $_);
    }
}

# Get the return code of the compiler and exit with that.
waitpid($compiler_pid, 0);
exit ($? >> 8);