#!/usr/bin/perl -w

# pkxed - Simple editor

use strict;

use Tkx;
use File::Basename qw(basename);

Tkx::package_require("BWidget");

Tkx::package_require("style");
Tkx::style__use("lobster", -priority => 70);

# state
my $file = "";

# set up main window
my $mw = Tkx::widget->new(".");
my $sw = $mw->new_ScrolledWindow(
    -managed => 0,
    -background => "white",
);
$sw->g_pack(
    -fill => "both",
    -expand => 1,
);
my $t = $sw->new_text(
    -padx => 5,
    -pady => 5,
    -background => "white",
);
$sw->setwidget($t);

$t->g_bind("<Button-3>", [\&post_menu, Tkx::Ev("%X", "%Y"), mk_menu($t)]);

if (@ARGV) {
    Tkx::after_idle([\&load, $ARGV[0]])
}
else {
    new();
}

Tkx::MainLoop();
exit;

sub mk_menu {
    my $t = shift;
    my $m = $t->new_menu(
        -tearoff => 0,
    );
    $m->add_command(
        -label => "New",
        -command => \&new,
    );
    $m->add_command(
        -label => "Open...",
        -command => \&my_open,
    );
    $m->add_command(
        -label => "Save",
        -command => \&save,
    );
    $m->add_command(
        -label => "Save As...",
        -command => \&save_as,
    );
    $m->add_command(
        -label => "Exit",
        -underline => 1,
        -command => [\&Tkx::destroy, $mw],
    );

    return $m;
}


sub post_menu {
    my($x, $y, $menu) = @_;
    Tkx::tk___popup($menu, $x, $y);
}

sub new {
    $t->delete("1.0", "end");
    set_file("");
}

sub my_open {
    my $f = Tkx::tk___getOpenFile(
        -parent => $mw,
    );
    load($f) if length $f;
}

sub load {
    my $f = shift;
    open(my $fh, "<:utf8", $f) || die "Can't open '$file': $!";
    $t->delete("1.0", "end");
    $t->insert("end", scalar do { local $/; <$fh> });
    set_file($f);
}

sub set_file {
    $file = shift;
    update_title();
}

sub save {
    return save_as() unless length $file;
    _save($file);
}

sub save_as {
    my $f = Tkx::tk___getSaveFile(
        -parent => $mw,
    );
    if (length $f) {
        _save($f);
        set_file($f);
    }
}

sub _save {
    my $f = shift;
    open(my $fh, ">", $f) || die "Can't open '$file': $!";
    print $fh $t->get("1.0", "end - 1 char");
    close($fh) || die "Can't write '$file': $!";
}

sub update_title {
    my $title;
    if (length $file) {
	$title = basename($file);
    }
    else {
	$title = "<no name>";
    }
    $title .= " - " . basename($0);
    $mw->g_wm_title($title);
}

__END__

=head1 NAME

tkxed - Simple editor

=head1 SYNOPSIS

 tkxed [<file>]

=head1 DESCRIPTION

The F<tkxed> program is a simple editor implemented with the C<Tkx>
toolkit.  Its main purpose is to show how this kind of application is
written, so please take a look at its source code.

Right click in the editor window to bring up the menu.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

Copyright 2005 ActiveState.  All rights reserved.

=head1 SEE ALSO

L<Tkx>
