--- deliantra/Deliantra-Client/DC.pm 2006/05/31 12:44:17 1.84 +++ deliantra/Deliantra-Client/DC.pm 2006/06/18 17:13:10 1.93 @@ -26,6 +26,92 @@ use Carp (); use AnyEvent (); use BerkeleyDB; +use Pod::POM (); +use Scalar::Util (); +use Storable (); # finally + +package CFClient::PodToPango; + +use base Pod::POM::View::Text; + +our $VERSION = 1; # bump if resultant formatting changes + +our $indent = 0; + +*view_seq_code = +*view_seq_bold = sub { "$_[1]" }; +*view_seq_italic = sub { "$_[1]" }; +*view_seq_space = +*view_seq_link = +*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) }; + +sub view_seq_text { + my $text = $_[1]; + $text =~ s/\s+/ /g; + CFClient::UI::Label::escape ($text) +} + +sub view_item { + ("\t" x ($indent / 4)) + . $_[1]->title->present ($_[0]) + . "\n\n" + . $_[1]->content->present ($_[0]) +} + +sub view_verbatim { + (join "", + map +("\t" x ($indent / 2)) . "$_\n", + split /\n/, CFClient::UI::Label::escape ($_[1])) + . "\n" +} + +sub view_textblock { + ("\t" x ($indent / 2)) . "$_[1]\n\n" +} + +sub view_head1 { + "\n\n" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; + +sub view_head2 { + "\n" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; + +sub view_head3 { + "\n" . $_[1]->title->present ($_[0]) . "\n\n" + . $_[1]->content->present ($_[0]) +}; + +sub view_over { + local $indent = $indent + $_[1]->indent; + $_[1]->content->present ($_[0]) +} + +package CFClient::Database; + +our @ISA = BerkeleyDB::Btree::; + +sub get($$) { + my $data; + + $_[0]->db_get ($_[1], $data) == 0 + ? $data + : () +} + +my %DB_SYNC; + +sub put($$$) { + my ($db, $key, $data) = @_; + + $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); + + $db->db_put ($key => $data) +} + +package CFClient; sub find_rcfile($) { my $path; @@ -70,13 +156,12 @@ close CFG; } -mkdir "$Crossfire::VARDIR/cfplus", 0777; - our $DB_ENV; { use strict; + mkdir "$Crossfire::VARDIR/cfplus", 0777; my $recover = $BerkeleyDB::db_version >= 4.4 ? eval "DB_REGISTER | DB_RECOVER" : 0; @@ -107,98 +192,49 @@ or die "unable to create/open database table $_[0]: $BerkeleyDB::Error" } -sub pod_to_pango($) { - my ($pom) = @_; - - $pom->present ("CFClient::PodToPango") -} - -sub pod_to_pango_list($) { - my ($pom) = @_; +my $pod_cache = db_table "pod_cache"; - [ - map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "], - split /\n/, $pom->present ("CFClient::PodToPango") - ] -} +sub load_pod($$$$) { + my ($path, $filtertype, $filterversion, $filtercb) = @_; -package CFClient::PodToPango; - -use base Pod::POM::View::Text; - -our $indent = 0; - -*view_seq_code = -*view_seq_bold = sub { "$_[1]" }; -*view_seq_italic = sub { "$_[1]" }; -*view_seq_space = -*view_seq_link = -*view_seq_index = sub { CFClient::UI::Label::escape ($_[1]) }; + stat $path + or die "$path: $!"; -sub view_seq_text { - my $text = $_[1]; - $text =~ s/\s+/ /g; - CFClient::UI::Label::escape ($text) -} + my $phash = join ",", $filterversion, $CFClient::PodToPango::VERSION, (stat _)[7,9]; -sub view_item { - ("\t" x ($indent / 4)) - . $_[1]->title->present ($_[0]) - . "\n" - . $_[1]->content->present ($_[0]) -} + my ($chash, $pom) = eval { @{ Storable::thaw $pod_cache->get ("$path/$filtertype") } }; -sub view_verbatim { - (join "", - map +("\t" x ($indent / 2)) . "$_\n", - split /\n/, CFClient::UI::Label::escape ($_[1])) - . "\n" -} + return $pom if $chash eq $phash; -sub view_textblock { - ("\t" x ($indent / 2)) . "$_[1]\n\n" -} + my $pod = do { + local $/; + open my $pod, "<:utf8", $_[0] + or die "$_[0]: $!"; + <$pod> + }; -sub view_head1 { - "\n\n" . $_[1]->title->present ($_[0]) . "\n\n" - . $_[1]->content->present ($_[0]) -}; + #utf8::downgrade $pod; -sub view_head2 { - "\n" . $_[1]->title->present ($_[0]) . "\n\n" - . $_[1]->content->present ($_[0]) -}; + $pom = $filtercb-> (Pod::POM->new->parse_text ($pod)); -sub view_head3 { - "\n" . $_[1]->title->present ($_[0]) . "\n\n" - . $_[1]->content->present ($_[0]) -}; + $pod_cache->put ("$path/$filtertype" => Storable::nfreeze [$phash, $pom]); -sub view_over { - local $indent = $indent + $_[1]->indent; - $_[1]->content->present ($_[0]) + $pom } -package CFClient::Database; - -our @ISA = BerkeleyDB::Btree::; - -sub get($$) { - my $data; +sub pod_to_pango($) { + my ($pom) = @_; - $_[0]->db_get ($_[1], $data) == 0 - ? $data - : () + $pom->present ("CFClient::PodToPango") } -my %DB_SYNC; - -sub put($$$) { - my ($db, $key, $data) = @_; - - $DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync }); +sub pod_to_pango_list($) { + my ($pom) = @_; - $db->db_put ($key => $data) + [ + map s/^(\s*)// && [40 * length $1, length $_ ? $_ : " "], + split /\n/, $pom->present ("CFClient::PodToPango") + ] } package CFClient::Item; @@ -258,7 +294,7 @@ $w = undef; } ); - $entry->focus_in; + $entry->grab_focus; $w->show; } @@ -266,6 +302,9 @@ sub update_widgets { my ($self) = @_; + # necessary to avoid cyclic references + Scalar::Util::weaken $self; + my $button_cb = sub { my (undef, $ev, $x, $y) = @_; @@ -278,6 +317,10 @@ if (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 1) { $::CONN->send ("move $targ $self->{tag} 0") if $targ || !($self->{flags} & F_LOCKED); + } elsif (($ev->{mod} & CFClient::KMOD_SHIFT) && $ev->{button} == 2) { + $self->{flags} & F_LOCKED + ? $::CONN->send ("lock " . pack "CN", 0, $self->{tag}) + : $::CONN->send ("lock " . pack "CN", 1, $self->{tag}) } elsif ($ev->{button} == 1) { $::CONN->send ("examine $self->{tag}"); } elsif ($ev->{button} == 2) { @@ -314,6 +357,7 @@ . "Left click - examine item\n" . "Shift-Left click - " . ($self->{container} ? "move or drop" : "take") . " item\n" . "Middle click - apply\n" + . "Shift-Middle click - lock/unlock\n" . "Right click - further options" . "\n"; @@ -365,27 +409,27 @@ package CFClient::Binder; my @ALLOWED_MODIFIER_KEYS = ( - (CFClient::SDLK_LSHIFT), - (CFClient::SDLK_LCTRL ), - (CFClient::SDLK_LALT ), - (CFClient::SDLK_LMETA ), - - (CFClient::SDLK_RSHIFT), - (CFClient::SDLK_RCTRL ), - (CFClient::SDLK_RALT ), - (CFClient::SDLK_RMETA ), + CFClient::SDLK_LSHIFT, + CFClient::SDLK_LCTRL , + CFClient::SDLK_LALT , + CFClient::SDLK_LMETA , + + CFClient::SDLK_RSHIFT, + CFClient::SDLK_RCTRL , + CFClient::SDLK_RALT , + CFClient::SDLK_RMETA , ); my %ALLOWED_MODIFIERS = ( - (CFClient::KMOD_LSHIFT) => "LSHIFT", - (CFClient::KMOD_LCTRL ) => "LCTRL", - (CFClient::KMOD_LALT ) => "LALT", - (CFClient::KMOD_LMETA ) => "LMETA", - - (CFClient::KMOD_RSHIFT) => "RSHIFT", - (CFClient::KMOD_RCTRL ) => "RCTRL", - (CFClient::KMOD_RALT ) => "RALT", - (CFClient::KMOD_RMETA ) => "RMETA", + CFClient::KMOD_LSHIFT => "LSHIFT", + CFClient::KMOD_LCTRL => "LCTRL", + CFClient::KMOD_LALT => "LALT", + CFClient::KMOD_LMETA => "LMETA", + + CFClient::KMOD_RSHIFT => "RSHIFT", + CFClient::KMOD_RCTRL => "RCTRL", + CFClient::KMOD_RALT => "RALT", + CFClient::KMOD_RMETA => "RMETA", ); my %DIRECT_BIND_CHARS = map { $_ => 1 } qw/0 1 2 3 4 5 6 7 8 9/; @@ -446,14 +490,14 @@ return; } - $entry->focus_out; + $entry->grab_focus; $cb->($mod, $sym); $w->destroy }); - $entry->focus_in; + $entry->grab_focus; $w->show; }