Tk-DoubleClick-0.04/0000755000175000017500000000000012630774615012646 5ustar domidomiTk-DoubleClick-0.04/Makefile.PL0000644000175000017500000000115412630774417014621 0ustar domidomiuse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Tk::DoubleClick', AUTHOR => q{John C. Norton }, VERSION_FROM => 'lib/Tk/DoubleClick.pm', ABSTRACT_FROM => 'lib/Tk/DoubleClick.pm', ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'perl') : ()), PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, Tk => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Tk-DoubleClick-*' }, ); Tk-DoubleClick-0.04/META.yml0000644000175000017500000000112712630774615014120 0ustar domidomi--- abstract: 'Correctly handle single-click vs double-click events,' author: - 'John C. Norton ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Tk-DoubleClick no_index: directory: - t - inc requires: Test::More: '0' Tk: '0' version: '0.04' x_serialization_backend: 'CPAN::Meta::YAML version 0.016' Tk-DoubleClick-0.04/lib/0000755000175000017500000000000012630774615013414 5ustar domidomiTk-DoubleClick-0.04/lib/Tk/0000755000175000017500000000000012630774615013772 5ustar domidomiTk-DoubleClick-0.04/lib/Tk/DoubleClick.pm0000644000175000017500000001530012630774512016503 0ustar domidomi package Tk::DoubleClick; our $VERSION = '0.04'; use strict; use warnings; =head1 NAME Tk::DoubleClick - Correctly handle single-click vs double-click events, =head1 VERSION Version 0.04 =head1 SYNOPSIS use Tk::Doubleclick; bind_clicks( $widget, [ \&single_callback, @args ], # Single callback with args \&double_callback, # Double callback without args -delay => 500, -button => 'right', ); =head1 DESCRIPTION Tk::DoubleClick module correctly handle single-click vs double-click events, calling only the appropriate callback for the given event. This module always exports C. =head1 FUNCTIONS =head2 bind_clicks() Required parameters: =over 5 =item $widget Widget to bind to mousebuttons. Typically a Tk::Button object, but could actually be almost any widget. =item [ \&single_click_callback, @single_click_args ], The callback subroutine to invoke when the event is a single-click, along with the arguments to pass. When no arguments are passed, the brackets can be omitted. =item [ \&double_click_callback, @double_click_args ], The callback subroutine to invoke when the event is a double-click, along with the arguments to pass. When no arguments are passed, the brackets can be omitted. =back Options: =over 5 =item -delay Maximum delay time detween clicks in milliseconds. Default is 300. If the second click of a two proximate mouse clicks occurs within the given delay time, the event is considered a double-click. If not, the two clicks are considered two separate (albeit nearly simultaneous) single-clicks. =item -button Mouse button to bind. Options are 1, 2, 3, or the corresponding synonyms 'left', 'middle', or 'right'. The default is 1 ('left'). =back =head1 EXAMPLE # Libraries use strict; use warnings; use Tk; use Tk::DoubleClick; # User-defined my $a_colors = [ [ '#8800FF', '#88FF88', '#88FFFF' ], [ '#FF0000', '#FF0088', '#FF00FF' ], [ '#FF8800', '#FF8888', '#FF88FF' ], [ '#FFFF00', '#FFFF88', '#FFFFFF' ], ]; # Main program my $nsingle = my $ndouble = 0; my $mw = new MainWindow(-title => "Double-click example"); my $f1 = $mw->Frame->pack(-expand => 1, -fill => 'both'); my @args = qw( -width 12 -height 2 -relief groove -borderwidth 4 ); my @pack = qw( -side left -expand 1 -fill both ); # Display single/double click counts my $lb1 = $f1->Label(-text => "Single Clicks", @args); my $lb2 = $f1->Label(-textvar => \$nsingle, @args); my $lb3 = $f1->Label(-text => "Double Clicks", @args); my $lb4 = $f1->Label(-textvar => \$ndouble, @args); $lb1->pack($lb2, $lb3, $lb4, @pack); # Create button for each color, and bind single/double clicks to it foreach my $a_color (@$a_colors) { my $fr = $mw->Frame->pack(-expand => 1, -fill => 'both'); foreach my $bg (@$a_color) { my $b = $fr->Button(-bg => $bg, -text => $bg, @args); $b->pack(@pack); bind_clicks($b, [\&single, $lb2, $bg], [\&double, $lb4, $bg]); } } # Make 'Escape' quit the program $mw->bind("" => sub { exit }); MainLoop; # Callbacks sub single { my ($lbl, $color) = @_; $lbl->configure(-bg => $color); ++$nsingle; } sub double { my ($lbl, $color) = @_; $lbl->configure(-bg => $color); ++$ndouble; } =head1 ACKNOWLEDGEMENTS Thanks to Mark Freeman for numerous great suggestions and documentation help. =head1 AUTHOR John C. Norton, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Tk::DoubleClick You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =back =head1 ACKNOWLEDGEMENTS Thanks to Mark Freeman for numerous great suggestions and documentation help. =head1 COPYRIGHT & LICENSE Copyright 2009 John C. Norton. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(bind_clicks); # Track last-clicked mouse number, widget, "after" event id and callback. my $h_pend = { 'mn' => 0, 'wi' => 0, 'id' => 0, 'cb' => 0 }; sub bind_clicks { my ($widget, $a_single, $a_double, %args) = @_; my $delay = delete $args{-delay} || 300; my $button = delete $args{-button} || 'left'; my $h_button = { left => 1, middle => 2, right => 3 }; my $mousenum = $h_button->{$button} || $button; ($mousenum =~ /^[123]$/) or $mousenum = 1; my $c_single = $a_single; if (ref $a_single eq 'ARRAY') { my $c_cmd = shift @$a_single; $c_single = sub { $c_cmd->(@$a_single) }; } my $c_double = $a_double; if (ref $a_double eq 'ARRAY') { my $c_cmd = shift @$a_double; $c_double = sub { $c_cmd->(@$a_double) }; } my $button_name = ""; my $c_pending = sub { my ($mousenum, $widget, $id) = @_; $h_pend->{'mn'} = $mousenum; $h_pend->{'wi'} = $widget; $h_pend->{'id'} = $id; $h_pend->{'cb'} = $c_single; }; my $c_cmd = sub { my $b_sched = 0; # Schedule new single-click? if (!$h_pend->{'id'}) { # No click is pending -- schedule a new one $b_sched = 1; } else { # Cancel pending single-click event $h_pend->{'wi'}->afterCancel($h_pend->{'id'}); $h_pend->{'id'} = 0; if ($h_pend->{'mn'} == $mousenum and $h_pend->{'wi'} eq $widget) { # Invoke double-click callback and reset pending event $c_double->(); $c_pending->(0, 0, 0); } else { # Invoke previous single-click, and schedule a new one $h_pend->{'cb'}->(); $b_sched = 1; } } # Schedule new single-click subroutine when $delay expires if ($b_sched) { my $c_after = sub { $c_pending->(0, 0, 0); $c_single->() }; my $id = $widget->after($delay => $c_after); $c_pending->($mousenum, $widget, $id); } }; $widget->bind($button_name => $c_cmd); } 1; Tk-DoubleClick-0.04/MANIFEST0000644000175000017500000000040212630774615013773 0ustar domidomiChanges MANIFEST Makefile.PL README lib/Tk/DoubleClick.pm t/00-load.t t/pod-coverage.t t/pod.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Tk-DoubleClick-0.04/Changes0000644000175000017500000000046112630774546014145 0ustar domidomiRevision history for Tk-DoubleClick 0.04 2015/12/06 * Added missing Tk dependency 0.03 2015/12/05 * Moved pod-coverage test to xt/ (Closes: RT 108422) (dddumont) * Fixed pod doc to fix pod-coverage tests (ddumont) 0.01 Date/time First version, released on an unsuspecting world. Tk-DoubleClick-0.04/t/0000755000175000017500000000000012630774615013111 5ustar domidomiTk-DoubleClick-0.04/t/00-load.t0000644000175000017500000000023612630525026014421 0ustar domidomi#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Tk::DoubleClick' ); } diag( "Testing Tk::DoubleClick $Tk::DoubleClick::VERSION, Perl $], $^X" ); Tk-DoubleClick-0.04/t/pod.t0000644000175000017500000000035012630525026014044 0ustar domidomi#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Tk-DoubleClick-0.04/META.json0000644000175000017500000000174012630774615014271 0ustar domidomi{ "abstract" : "Correctly handle single-click vs double-click events,", "author" : [ "John C. Norton " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Tk-DoubleClick", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Test::More" : "0", "Tk" : "0" } } }, "release_status" : "stable", "version" : "0.04", "x_serialization_backend" : "JSON::PP version 2.27300" } Tk-DoubleClick-0.04/README0000644000175000017500000000303212630525026013512 0ustar domidomiTk-DoubleClick The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it to get an idea of the module's uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Tk::DoubleClick You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tk-DoubleClick AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Tk-DoubleClick CPAN Ratings http://cpanratings.perl.org/d/Tk-DoubleClick Search CPAN http://search.cpan.org/dist/Tk-DoubleClick/ COPYRIGHT AND LICENCE Copyright (C) 2009 John C. Norton This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information.