# Perl script not to be run as stand_alone program, but in the context of PFE.
# From PFE define extra command (Options/Preferences/Execute Menu) like
#   Perl c:\Perl\Progs\Pfe\EvalPFE.pfe
# PFE will then call this script using Perl, and communicating via DDE links
#
# This particular script will delete a rectangular area from the current text file
# based on the current selection. The data cut will be put in a file
# %TEMP%\_columns.pfe for further rectangular paste operations.
#
# Script written by C.M. Moerman, April 2001 (c)
#   http://home.hccnet.nl/Kees.Moerman/perl_pfe.html  mailto:moerman@iaehv.nl
#
# PFE by Alan Phillips can be found on: http://www.lancs.ac.uk/people/cpaap/pfe/
# Win32::Editor::PFE by Jenda Krynicky can be found on http://jenda.krynicky.cz/
#
# Note: this script does not yet handle tabs!!


use Win32::Editor::PFE;                 # implicitly also loads Win32::DDE
use Win32::Clipboard;
use strict;                             # strict error checking


my $clip = Win32::Clipboard();          # get clipboard object
my $save_clipboard = $clip->Get();      # save contents for later

my $pfe = new Win32::Editor::PFE;       # get pfe object
message("Can't connect to PFE") if !defined $pfe;
$pfe->Connect();                        # get a connection to PFE


sub message                             # print message, wait for key, and die
{
    print "$_[0]\nScript halted\nPress key to continue.....";
    my $temp = <>;
    $clip->Set($save_clipboard);        # restore clipboard
    exit;
}

sub wait_ready                          # wait until link becomes available
{
    for (0..5)                          # with timeout at 6 seconds
    {
        return if ($pfe->Get('Status') eq 'Ready');
        sleep(1);
    }
    message "PFE does not respond" if ($pfe->Get('Status') ne 'Ready');
}


# Note: top of file: PFE pos (1,1), this script (0,0)
# Selecting a 2x2 character block (2 right, 1 down) makes this PFE(3,2), this(2,1)
wait_ready();
my $column2 = $pfe->Get('ColumnNumber') - 1;

wait_ready();
message "Could not cut" if !$pfe->EditCut(); # place selected text on clipboard

wait_ready();
my $column1 = $pfe->Get('ColumnNumber') - 1;
my $width = $column2 - $column1;

wait_ready();
my $text = $clip->Get();                   # retrieve selected text
my $result = "";
my ($temp, $status);

if(length($text))                       # if non-zero length
{
    my @lines = split (/\n/, $text);    # array of lines captured
    
    my $firstline = shift @lines;       # treat initial line differently
    $firstline =~ s/[\x0A\x0D]//g;      # due to cursor offset
    if(length($firstline) <= $width)    # short line (starting at $column1)
    {
            $temp = substr($firstline . (" " x $width), 0, $width) . "\n";
            $result .= "\x0D\x0A";      # add DOS style end-of-line
    }
    else                                # ling line (starting at $column1)
    {
            $temp = substr($firstline , 0, $width) . "\n";
            $result .= substr($firstline, $width) . "\x0D\x0A";
    }

    for (@lines)                        # treat remainder of lines
    {
        s/[\x0A\x0D]//g;                # remove end-of-line characters
        if(length($_) <= $column1)      # short line, return unmodified
        {
            $temp .= (" " x $width) . "\n";
            $result .= "$_\x0D\x0A";
        }
        elsif (length($_) <= $column2)  # (partly) within column
        {                               # substr( string, offset, length, newval)
            $temp .= substr($_ . (" " x $width), $column1, $width) . "\n";
            $result .= substr($_, 0, $column1) . "\x0D\x0A";
        }
        else                            # long line
        {
            $temp .= substr($_, $column1, $width) . "\n";
            substr($_, $column1, $width) = "";
            $result .= "$_\x0D\x0A";
        }
    }

    chop($result); chop($result);       # don't need last end-of-line (CR/LF)
    $clip->Set($result) if $result;

    for (1..10)                         # retry: might be busy or fail otherwise?
    {
        wait_ready();
        $status = $pfe->EditPaste();    # check if succeeded
        last if $status == 1; 
        print ".";                      # else retry
    }
    message "Could not paste" if ($status != 1);
}

    
my $dirname = $ENV{'TEMP'} || $ENV{'TMP'} || "C:";
open (FILENAME, ">$dirname/_columns.pfe")        # open file for output
|| message "Can't open file '$dirname/_columns.pfe' ($!)";
print FILENAME $temp;                   # save rectangle to file
close FILENAME;

undef $pfe;                             # free pfe
$clip->Set($save_clipboard);            # restore clipboard

# $temp = <>;                           # debugging only

# end of script