#!/bin/sh
# -*- perl -*-
# This code allows us to start perl from our path or an environment variable
# rather than hardcoding a path into the #! line.  It works from sh or csh.
(exit $?0) && eval 'exec ${QPERLQ-perl} -x $0 ${1+"$@"}'
if (! $?QPERLQ) setenv QPERLQ perl
exec $QPERLQ -x $0 $argv:q

#!/usr/local/bin/perl -w
#
# $Id: lcgrep,v 1.2 1998/11/20 15:51:46 ejb Exp $
# $Source: /home/ejb/scripts/RCS/lcgrep,v $
# $Author: ejb $
#
# Crude version of grep that prints both line and column number information,
# making it suitable for use in M-x compile
#

require 5.002;
use strict;

my $whoami = ($0 =~ m,([^/\\]*)$,) ? $1 : $0;
#my $dirname = ($0 =~ m,(.*)[/\\][^/\\]+$,) ? $1 : ".";

my $tabwidth = 8;

my $expr = undef;
my @files = ();
my $wholeword = 0;
while (@ARGV)
{
    my $arg = shift(@ARGV);
    if ($arg eq "-n")
    {
	# ignore -- always give line and column number information
    }
    elsif ($arg eq "-w")
    {
	$wholeword = 1;
    }
    elsif ($arg eq "-t")
    {
	&usage() unless @ARGV;
	$tabwidth = shift(@ARGV);
    }
    elsif ($arg =~ m/^-/)
    {
	&usage();
    }
    elsif (! defined $expr)
    {
	$expr = $arg;
    }
    else
    {
	push(@files, $arg);
    }
}

&usage() unless defined $expr;
&usage() unless @files;

if ($wholeword)
{
    $expr = "\\b" . $expr . "\\b";
}

my $file;
foreach $file (@files)
{
    if (open(F, "<$file"))
    {
	while (<F>)
	{
	    while (m/$expr/g)
	    {
		my $col = &compute_col($`);
		print "File \"$file\", line $., character $col: $&\n";
	    }
	}
	close(F);
    }
    else
    {
	warn "$whoami: can't read $file: $!\n";
    }
}

sub compute_col
{
    my $str = shift;
    my $col = 0;
    do
    {
	while ($str =~ s/^([^\t]+)//)
	{
	    $col += length($1);
	}
	if ($str =~ s/^\t//)
	{
	    $col += $tabwidth;
	    $col -= ($col % $tabwidth);
	}
	while ($str =~ s/^\t+//)
	{
	    $col += ($tabwidth * length($&));
	}
    } while length($str);
    $col + 1;
}

sub usage
{
    die "Usage: lcgrep [ -w | -t tabwidth ] expr file [ file . . . ]\n";
}