Changelog
[Spreadsheet-Read.git] / examples / ss2tk
1 #!/pro/bin/perl
2
3 # ss2tk: show SpreadSheet file in Tk::TableMatrix::Spreadsheet (*)
4 #         (m)'07 [26-06-2007] Copyright H.M.Brand 2005-2014
5
6 use strict;
7 use warnings;
8
9 our $VERSION = "2.1";
10
11 sub usage
12 {
13     my $err = shift and select STDERR;
14     print
15         "usage: ss2tk [-w <width>] [X11 options] file.xls [<pattern>]\n",
16         "       -w <width> use <width> as default column width (4)\n";
17     exit $err;
18     } # usage
19
20 use Getopt::Long qw(:config bundling nopermute passthrough);
21 my $wdt = 4;    # Default minimal column width
22 my $unq = 0;    # Uniq columns only
23
24 GetOptions (
25     "help|?"    => sub { usage (0); },
26     "w=i"       => \$wdt,
27     "u"         => \$unq,
28     ) or usage (1);
29
30 use Tk;
31 use Tk::NoteBook;
32 use Tk::TableMatrix::Spreadsheet;
33
34 # This will allow ~/.Xdefaults to have lines like
35 #ss2tk*font:    -misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-iso10646-1
36 Tk::CmdLine->LoadResources ();
37 # This will allow calls like # ss2tk -fg Blue4 blah.csv
38 Tk::CmdLine->SetArguments ();
39
40 @ARGV && -f $ARGV[0] or usage (1);
41 my $title = $ARGV[0];
42 my %unq;
43
44 use Spreadsheet::Read;
45 my $ref = ReadData (shift)      or die "Cannot read $title\n";
46 $ref->[0]{sheets}               or die "No sheets in $title\n";
47
48 my $mw = MainWindow->new (-title => $title);
49 my $nb = $mw->NoteBook ()->pack (qw(-side top -expand 1 -fill both ));
50 my @nb;
51 foreach my $sht (1 .. $ref->[0]{sheets}) {
52     my $s = $ref->[$sht];
53     $title .= " [ " . $s->{label} . " ]";
54
55     my $pat = @ARGV ? qr/$ARGV[0]/i : undef;
56
57     my ($data, @data);
58     my @c = (1, $s->{maxcol});
59     my ($h, $w, @w) = (0, 1, 0, (0) x $c[1]); # data height, -width, and default column widths
60     foreach my $r (1 .. $s->{maxrow}) {
61         my @row = map {
62             defined $s->{cell}[$_][$r] ? $s->{cell}[$_][$r] : "";
63             } 1 .. $s->{maxcol};
64         $pat and "@row" =~ $pat || next;
65         foreach my $c (0 .. $#row) {
66             $row[$c] or next;
67             $c >= $w and $w = $c + 1;
68             $data->{"$h,$c"} = $row[$c];
69             push @data, "$h,$c";
70             my $l = length $row[$c];
71             $l > $w[$c] and $w[$c] = $l;
72             }
73         ++$h % 100 or printf STDERR "%6d x %6d\r", $w, $h;
74         }
75     printf STDERR "%6d x %6d\n", $w, $h;
76
77     $nb[$sht] = $nb->add ($sht,
78         -label  => $s->{label},
79         -state  => "normal",
80         -anchor => "nw");
81     my $ss = $nb[$sht]->Scrolled ('Spreadsheet',
82         -rows           => $h,  -cols           => $w,
83         -width          => 10,  -height         => 20,
84         -titlerows      =>  1,  -titlecols      =>  0,
85
86         -selectmode     => "extended",
87         -resizeborders  => "both",
88
89         -justify        => "left",
90         -anchor         => "w",
91
92         -variable               => $data,
93         )->pack (-expand => 1, -fill => "both", -side => "top", -anchor => "nw");
94     $ss->Subwidget ("${_}scrollbar")->configure (-width => 6) for qw( x y );
95     $ss->tagConfigure ("title",  -bg => "#ffffe0", -justify => "left");
96     $ss->tagConfigure ("active", -bg => "#ffff40", -justify => "left");
97     $ss->tagConfigure ("sel",    -bg => "gray95",  -justify => "left");
98
99     my ($pv, $sv, $si) = ("", "", 0);
100     sub search
101     {
102         $sv or return;
103         $sv eq $pv && !$_[0] and return;
104         $ss->selectionClear ("all");
105         foreach my $i ($_[0] .. $#data, 0 .. ($_[0] - 1)) {
106             $data->{$data[$i]} =~ m/$sv/i or next;
107             $si = $i;
108             $ss->activate     ($data[$si = $i]);
109             $ss->selectionSet ($data[$si]);
110             $ss->see          ($data[$si]);
111             $pv = $sv;
112             last;
113             }
114         } # search
115
116     # Search frame
117     my $sf = $nb[$sht]->Frame ()->pack (-side => "left", -expand => 1, -fill => "both");
118     my $sl = $sf->Label (
119         -text     => "Search",
120         )->pack (-side => "left", -anchor => "sw");
121     my $sb = $sf->Entry (
122         -textvariable => \$sv,
123         )->pack (-side => "left", -anchor => "sw");
124     $sb->bind ("<Return>" => sub { search ($si = 0); });
125     my $sn = $sf->Button (
126         -text     => "Next",
127         -command  => sub { search (++$si) },
128         )->pack (-side => "left", -anchor => "sw");
129
130     # Control frame
131     my $cf = $nb[$sht]->Frame ()->pack (-side => "right", -expand => 1, -fill => "both");
132     my $ce = $cf->Button (
133         -text     => "Exit",
134         -command  => \&exit,
135         )->pack (-side => "right", -anchor => "se");
136
137     # autosize columns on data (not on headers)
138     $ss->colWidth (map { $_ => $w[$_] } 0 .. $#w);
139     }
140
141 MainLoop;