#!/pro/bin/perl

# ss2tk: show SpreadSheet file in Tk::TableMatrix::Spreadsheet (*)
#	  (m)'17 [2017-07-03] Copyright H.M.Brand 2005-2017

use strict;
use warnings;

our $VERSION = "2.8";

sub usage {
    my $err = shift and select STDERR;
    print
	"usage: ss2tk [options] [X11 options] file.xls [<pattern>]\n",
	"       -w <width> use <width> as column width\n",
	"       -L         Add spreadsheet tags to top (A, B, ..Z, AB, ...)\n",
	"                  and left (1, 2, ...)\n",
	"       --fs[=7]   Set font size (default 7 if no value)\n",
	"       --fn=name  Set font Face name (default is DejaVu Sans Mono\n",
	"                  if font size is given\n";
    exit $err;
    } # usage

use Getopt::Long qw(:config bundling passthrough);
my $opt_fs;
GetOptions (
    "help|?"		=> sub { usage (0); },
    "w|width=i"		=> \my $opt_w,
    "L|ss|labels!"	=> \my $opt_L,
    "a|align!"		=> \my $opt_a,

      "fn|font-name=s"	=> \my $opt_fn,
      "fs|font-size:7"	=> \   $opt_fs,
      "fs-4"		=> sub { $opt_fs = 4; },
      "fs-5"		=> sub { $opt_fs = 5; },
      "fs-6"		=> sub { $opt_fs = 6; },
      "fs-7"		=> sub { $opt_fs = 7; },
      "fs-8"		=> sub { $opt_fs = 8; },
      "fs-9"		=> sub { $opt_fs = 9; },

    # For restarts
    "G|geometry=s"	=> \my $geometry,
    "W|column-widths=s"	=> \my $col_widths,
    ) or usage (1);

use Data::Peek;
use Spreadsheet::Read;
use Tk;
use Tk::NoteBook;
use Tk::TableMatrix::Spreadsheet;

# This will allow ~/.Xdefaults to have lines like
#ss2tk*font:	-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-iso10646-1
Tk::CmdLine->LoadResources ();
# This will allow calls like # ss2tk -fg Blue4 blah.csv
Tk::CmdLine->SetArguments ();

@ARGV && -f $ARGV[0] or usage (1);
my $title = $ARGV[0];

my $sfn = shift;
my $ref = Spreadsheet::Read->new ($sfn)	or die "Cannot read $sfn\n";
$ref->[0]{sheets}			or die "No sheets in $title\n";

fork and exit;

$opt_fn || $opt_fs and $opt_fn = "{".($opt_fn|| "DejaVu Sans Mono")."} ".($opt_fs||7);

my $pat = @ARGV ? qr/$ARGV[0]/i : undef;

my $mw = MainWindow->new (-title => $title);
$geometry and $mw->geometry ($geometry);
my $nb = $mw->NoteBook ()->pack (qw(-side top -expand 1 -fill both ));
my @nb;
foreach my $sht (1 .. $ref->[0]{sheets}) {
    my $s = $ref->[$sht];
    $title .= " [ " . $s->{label} . " ]";

    my ($data, @data) = ({});
    my ($h, $w, @w) = get_data ($data, $s, \@data);

    $nb[$sht] = $nb->add ($sht,
	-label	=> $s->{label},
	-state	=> "normal",
	-anchor	=> "nw");
    my @ff = $opt_fn ? (-font => $opt_fn) : ();
    my $ss = $nb[$sht]->Scrolled ('Spreadsheet',
	-rows		=> $h,	-cols		=> $w,
	-width		=> 10,	-height		=> 20,
	-titlecols	=> $opt_L ? 1 : 0,
	-titlerows	=> $opt_L ? 2 : 1,

	-selectmode	=> "extended",
	-resizeborders	=> "both",

	-justify	=> "left",
	-anchor		=> "w",

	-variable	=> $data,
	@ff,
	)->pack (-expand => 1, -fill => "both", -side => "top", -anchor => "nw");
    $ss->Subwidget ("${_}scrollbar")->configure (-width => 6) for qw( x y );
    $ss->tagConfigure ("title",  -bg => "#ffffe0", -justify => "left");
    $ss->tagConfigure ("active", -bg => "#ffff40", -justify => "left");
    $ss->tagConfigure ("sel",    -bg => "gray95",  -justify => "left");

    my ($pv, $sv, $si) = ("", "", 0);
    sub search {
	$sv or return;
	$sv eq $pv && !$_[0] and return;
	$ss->selectionClear ("all");
	foreach my $i ($_[0] .. $#data, 0 .. ($_[0] - 1)) {
	    $data->{$data[$i]} =~ m/$sv/i or next;
	    $si = $i;
	    $ss->activate     ($data[$si = $i]);
	    $ss->selectionSet ($data[$si]);
	    $ss->see          ($data[$si]);
	    $pv = $sv;
	    last;
	    }
	} # search

    my $reload = sub {
	$ss->clearCache;
	$data->{$_} = "" for @data;
	@data = ();
	$ref = Spreadsheet::Read->new ($sfn) or die "Cannot read $sfn\n";
	$s = $ref->[$sht];
	get_data ($data, $s, \@data);
	}; # reload

    # Search frame
    my $sf = $nb[$sht]->Frame ()->pack (-side => "left", -expand => 1, -fill => "both");
    my $sl = $sf->Label (
	-text     => "Search",
	)->pack (-side => "left", -anchor => "sw");
    my $sb = $sf->Entry (
	-textvariable => \$sv,
	)->pack (-side => "left", -anchor => "sw");
    $sb->bind ("<Return>" => sub { search ($si = 0); });
    my $sn = $sf->Button (
	-text     => "Next",
	-command  => sub { search (++$si) },
	)->pack (-side => "left", -anchor => "sw");

    # Control frame
    my $cf = $nb[$sht]->Frame ()->pack (-side => "right", -expand => 1, -fill => "both");
    $cf->Button (
	-text       => "\x{2718}",
	-foreground => "#8b0000",
	-command    => \&exit,
	)->pack (-side => "right", -anchor => "se");
    $cf->Button (
	-text       => "\x{21f5}",
	-foreground => "#ffa500",
	-command    => sub {
	    my $geo = $mw->geometry;
	    # Add column widths here
	    exec $0, "--geometry=$geo";
	    },
	)->pack (-side => "right", -anchor => "se");
    $cf->Button (
	-text       => "\x{21bb}",
	-foreground => "#008b00",
	-command    => $reload,
	)->pack (-side => "right", -anchor => "se");

    my $swss = $ss->Subwidget ("spreadsheet");

    # autosize columns on data (not on headers)
    $swss->colWidth (map { $_ => ($opt_w || $w[$_] || 4) } 0 .. $#w);

    $opt_a or next;
    $swss->tagConfigure ("numeric", -justify => "right");
    foreach my $rc (keys %$data) {
	$data->{$rc} && $data->{$rc} =~ m/^\d+$/ or next;
	$swss->tagCell ("numeric", $rc);
	}
    DDumper $swss;
    }

sub get_data {
    my ($dta, $s, $adta) = @_;

    my @c = (1, $s->{maxcol});
    my ($h, $w, @w) = (0, 1, 0, (0) x $c[1]); # data height, -width, and default column widths
    if ($opt_L) {
	foreach my $c (0 .. $s->{maxcol}) {
	    $dta->{"$h,$c"} = $c ? $ref->col2label ($c) : "";
	    push @$adta, "$h,$c";
	    }
	$h++;
	}
    foreach my $r (1 .. $s->{maxrow}) {
	my @row = map {
	    defined $s->{cell}[$_][$r] ? $s->{cell}[$_][$r] : "";
	    } 1 .. $s->{maxcol};
	$pat and "@row" =~ $pat || next;
	$opt_L and unshift @row, $r;
	foreach my $c (0 .. $#row) {
	    length $row[$c] or next;
	    $c >= $w and $w = $c + 1;
	    $dta->{"$h,$c"} = $row[$c];
	    push @$adta, "$h,$c";
	    my $l = length $row[$c];
	    $l > $w[$c] and $w[$c] = $l;
	    }
	++$h % 100 or printf STDERR "%6d x %6d\r", $w, $h;
	}
    printf STDERR "%6d x %6d\n", $w, $h;
    #use DP;DDumper { S => $dta, A => $adta };
    ($h, $w, @w);
    } # get_data

MainLoop;