#!/packages/bin/perl
#!/bin/sh -- # to start perl, if it is in the PATH
#eval 'exec perl -S $0 ${1+"$@"}'
#    if 0;
#
#  This is a perl 5 script used to invoke the 'nedit' editor as a server via
#  its client tool 'nc'. The script attempts to discover the type of file that
#  is being edited so that there is some context sensitive environment
#  variables that can be set for the editing session.

$nedit_file   = "$ENV{'HOME'}/.nedit";
$service_file = "$ENV{'EXPANDER_DIR'}/service";
$test_chars   = 200;  # of characters to examine for file type determination.
$pref_fields  = 5;    # of preference fields in service file record.
$svn          = $pref_fields-1; # position of service name

#---------------------------------------------------------
# reads .nedit and extracts language recognition criteria
#---------------------------------------------------------
sub get_language_hash 
{
        #---------------------------------
        # slurp in the nedit configuration 
        #---------------------------------
        open nedit_handle, $nedit_file;
        @nedit_config = <nedit_handle>;
        close nedit_handle;
        #-------------------------------
        # skip through to language modes
        #-------------------------------
        do 
        {
            $line = shift @nedit_config;
            
        } until $line =~ /nedit\.languageModes/;
        
        #-------------------------
        # snip off field specifier
        #-------------------------
        $line =~ s/nedit\.languageModes:\s*//;
        chop $line;
        push @language_mode, $line;
        
        #----------------------------------
        # go through list of language modes
        #----------------------------------
        do  
        {
            $line = shift @nedit_config;
            push @language_mode, $line;
            
        } while ($line =~ /.*\\[ \t]*$/);
        
        #------------------------------------------------
        # now get the important data from the definitions
        #------------------------------------------------
        foreach (@language_mode)  
        {
            #-----------------------------------
            # trim leading garbage from the name
            #-----------------------------------
            s/^\s*//;
            ($name, $ext, $regex) = split /:/;
            #---------------------------------------------
            # clean up regex quotes and double backslashes
            #---------------------------------------------
            if ($regex) 
            {
                $regex = substr($regex, 1, length($regex) - 2);
                $regex =~ s/\\\\/\\/g;
            }
            #--------------------------------------
            # create a hash of recognition criteria
            #--------------------------------------
            $language_hash{$name} = [$ext, $regex];
        }
        return %language_hash;
}

#-------------------------------------
# read language service hash from file
#-------------------------------------
sub get_service_hash 
{
    #-----------------------------------------------------
    # check if file exists, or generate empty service hash
    #-----------------------------------------------------
    (-e $service_file) or return &generate_service_hash;
    
    #-----------------------
    # read service hash file
    #-----------------------
    open(hash_handle, $service_file);
    @hash_line = <hash_handle>;
    close hash_handle;
    
    #--------------------------
    # process service hash data
    #--------------------------
    foreach $line (@hash_line) 
    {
        if( $line !~ /^!/ )   # Ignore comment lines.
        {
            ($lang, @prefs) = split(/:/, $line);
            if (@prefs == $pref_fields) 
            {
                $service_hash{$lang} = [@prefs];
                chop $service_hash{$lang}->[$svn];
            }
        }
    }
    return %service_hash;
}

#-----------------------------------------------------------------
# generate empty service hash based upon language recognition hash
#-----------------------------------------------------------------
sub generate_service_hash 
{
    $new_service = 1;
    #----------------------------------------
    # use keys from language recognition hash
    #----------------------------------------
    foreach $lang (keys %language) 
    {
        if ($lang) 
        {
            $service_hash{$lang} = ["", "", "", "", ""];
        }
    }
    return %service_hash;
}

#-------------------------------------------
# determine the language of a specified file
#-------------------------------------------
sub determine_language 
{
    $_ = shift;
    $language_result = "";
    
    #-------------------------
    # check if the file exists
    #-------------------------
    if (-e) 
    {
        #-------------------------------
        # yes, read in first $test_chars
        #-------------------------------
        open tmp_handle, $_;
        read tmp_handle, $data, $test_chars;
        close tmp_handle;
    }
    
    $keyCount = keys %language;  # resets 'each' mechanism on %language hash
                                 # (otherwise it extracts from last value seen)
    
    #-------------------------------------
    # loop over languages until recognized
    #-------------------------------------
    while ($language_result eq "" and  ($lang, $specs) = each(%language)) 
    {
        #----------------------------
        # if regex specified, test it
        #----------------------------
        if (($specs->[1]) and ($data =~ /$specs->[1]/)) 
        {
            $language_result = $lang; 
        }
        else
        {
            #-------------------------------
            # otherwize, test for extensions
            #-------------------------------
            @extensions = split /\s/, $specs->[0];
            foreach $ext (@extensions) 
            {
                $len = length() - length($ext);
                if ((index($_, $ext) == $len) && ($len >= 0)) 
                {
                    $language_result = $lang;
                    last;
                }
            }
        }
    }

    return ($language_result eq "") ? $default_language : $language_result;
}

#-------------------------------------------------------------------------------

if( $ARGV[0] ne "" )
{
    %language = get_language_hash();
    %service  = get_service_hash();
}

$default_language = "C";  # when file type determination fails.

$name = "[a-zA-Z0-9_]+";
$options = "-openwait";
$server = "";
$server_specified = 0;
$file_given = 0;
$error_file = "$ENV{'HOME'}/.nediterr";

open( STDERR, ">$error_file" ); # Helps hide the messages from 'nc'

while( $ARGV[0] ne "" )
{
    #--------------------------------------
    # Are we encountering an 'nc' option?
    # (read, create, line n (or +n), 
    # do command, svrname (or sn), [no]ask)
    #--------------------------------------
    if( $ARGV[0] =~ /^[-+]($name)/o )
    {
        $option = $1;
        
        #----------------------------------
        # Specific nedit service requested?
        #----------------------------------
        if( $option =~ /sn/ || $option =~ /svrname/ )
        {
            shift @ARGV;
            $serviceName = "$ARGV[0]";
            $server      = service_language( $serviceName );
            $server_specified  = 1;
        }
        
        #---------------------------------------------
        # These are options with a following argument.
        #---------------------------------------------
        elsif( $option =~ /line/ || $option =~ /do/ || $option =~ /display/ )
        {
            shift @ARGV;
            $options = "$options -$option $ARGV[0]";
        }

        #--------------------
        # Replace -n with +n.
        #--------------------
        elsif( $option =~ /[0-9]+/o )
        {
            $options = "$options +$option";
        }
        else
        {
            $options = "$options -$option";
        }
        
        shift @ARGV;
        next;
    }
    
    #-------------------------------------------
    # Otherwise, assume we have a file and want
    # to decide which server should be used.
    # (As long as the server was not explicitly 
    # specified by the user on the command line.
    #-------------------------------------------
    elsif( not $server_specified )
    {
        $server = service_language( determine_language( $ARGV[0] ));
    }

    $file_given = 1;

    system "nc $server $options $ARGV[0]";
    &handle_any_errors( $error_file );
    
    #----------------------------------------
    # Wait a bit so that a particular server
    # does not get so overwelmed that another
    # server is used in its place.
    #----------------------------------------
    #sleep( 5 );
    shift @ARGV;
}

#-----------------------------------
# When no file is specified, invoke 
# 'nedit' client with what we have.
#-----------------------------------
if( $file_given eq 0 )
{
    system "nc $server $options";
    &handle_any_errors( $error_file );
}

# End of 'main'
#-------------------------------------------------------------------------------

sub handle_any_errors
{
    #------------------------------------
    # Check for user invocation problems.
    #------------------------------------
    $usage = `egrep "nc:|Usage" $_[0]`;
    
    if( $usage ne "" )
    {
        print $usage;
        exit;
    }
}

#-------------------------------------------------------------------------------

sub service_language
{
    my $language    = shift;
    my $server_name = $language;
    
    if( exists $service_hash{ $language } )
    {
        $server_name = $service_hash{ $language }->[ $svn ];
        
        if( $server_name eq "" )
        {
            ($server_name, @junk) = split / /, $language;
        }
    }
    
    $ENV{ 'EXP_LANGUAGE' } = $server_name;
        
    return "-svrname $server_name";
}
