diff --git a/ext/tk/sample/tkextlib/tile/repeater.tcl b/ext/tk/sample/tkextlib/tile/repeater.tcl new file mode 100644 index 0000000000..652ba8ab17 --- /dev/null +++ b/ext/tk/sample/tkextlib/tile/repeater.tcl @@ -0,0 +1,117 @@ +# +# $Id$ +# +# Demonstration of custom classes. +# +# The Tile button doesn't have built-in support for autorepeat. +# Instead of adding -repeatdelay and -repeatinterval options, +# and all the extra binding scripts required to deal with them, +# we create a custom widget class for autorepeating buttons. +# +# Usage: +# ttk::button .b -class Repeater [... other options ...] +# +# TODO: +# Use system settings for repeat interval and initial delay. +# +# Notes: +# Repeater buttons work more like scrollbar arrows than +# Tk repeating buttons: they fire once immediately when +# first pressed, and $State(delay) specifies the initial +# interval before the button starts autorepeating. +# + +namespace eval tile::Repeater { + variable State + set State(timer) {} ;# [after] id of repeat script + set State(interval) 100 ;# interval between repetitions + set State(delay) 300 ;# delay after initial invocation +} + +### Class bindings. +# + +bind Repeater { %W state active } +bind Repeater { %W state !active } + +bind Repeater { tile::Repeater::Activate %W } +bind Repeater <> { tile::Repeater::Activate %W } + +bind Repeater { tile::Repeater::Press %W } +bind Repeater { tile::Repeater::Release %W } +bind Repeater { tile::Repeater::Pause %W } +bind Repeater { tile::Repeater::Resume %W } ;# @@@ see below + +# @@@ Workaround for metacity-induced bug: +bind Repeater \ + { if {"%d" ne "NotifyUngrab"} { tile::Repeater::Resume %W } } + +### Binding procedures. +# + +## Activate -- Keyboard activation binding. +# Simulate clicking the button, and invoke the command once. +# +proc tile::Repeater::Activate {w} { + $w instate disabled { return } + set oldState [$w state pressed] + update idletasks; after 100 + $w state $oldState + after idle [list $w invoke] +} + +## Press -- ButtonPress-1 binding. +# Invoke the command once and start autorepeating after +# $State(delay) milliseconds. +# +proc tile::Repeater::Press {w} { + variable State + $w instate disabled { return } + $w state pressed + $w invoke + after cancel $State(timer) + set State(timer) [after $State(delay) [list tile::Repeater::Repeat $w]] +} + +## Release -- ButtonRelease binding. +# Stop repeating. +# +proc tile::Repeater::Release {w} { + variable State + $w state !pressed + after cancel $State(timer) +} + +## Pause -- B1-Leave binding +# Temporarily suspend autorepeat. +# +proc tile::Repeater::Pause {w} { + variable State + $w state !pressed + after cancel $State(timer) +} + +## Resume -- B1-Enter binding +# Resume autorepeat. +# +proc tile::Repeater::Resume {w} { + variable State + $w instate disabled { return } + $w state pressed + $w invoke + after cancel $State(timer) + set State(timer) [after $State(interval) [list tile::Repeater::Repeat $w]] +} + +## Repeat -- Timer script +# Invoke the command and reschedule another repetition +# after $State(interval) milliseconds. +# +proc tile::Repeater::Repeat {w} { + variable State + $w instate disabled { return } + $w invoke + set State(timer) [after $State(interval) [list tile::Repeater::Repeat $w]] +} + +#*EOF* diff --git a/ext/tk/stubs.h b/ext/tk/stubs.h new file mode 100644 index 0000000000..7c913fb393 --- /dev/null +++ b/ext/tk/stubs.h @@ -0,0 +1,33 @@ +#include + +extern int ruby_open_tcl_dll(char *); +extern int ruby_open_tk_dll(); +extern int ruby_open_tcltk_dll(char *); +extern int tcl_stubs_init_p(); +extern int tk_stubs_init_p(); +extern Tcl_Interp *ruby_tcl_create_ip_and_stubs_init(int*); +extern int ruby_tcl_stubs_init(); +extern int ruby_tk_stubs_init(Tcl_Interp*); +extern int ruby_tk_stubs_safeinit(Tcl_Interp*); +extern int ruby_tcltk_stubs(); + +/* no error */ +#define TCLTK_STUBS_OK (0) + +/* return value of ruby_open_tcl_dll() */ +#define NO_TCL_DLL (1) +#define NO_FindExecutable (2) + +/* return value of ruby_open_tk_dll() */ +#define NO_TK_DLL (-1) + +/* status value of ruby_tcl_create_ip_and_stubs_init(st) */ +#define NO_CreateInterp (3) +#define NO_DeleteInterp (4) +#define FAIL_CreateInterp (5) +#define FAIL_Tcl_InitStubs (6) + +/* return value of ruby_tk_stubs_init() */ +#define NO_Tk_Init (7) +#define FAIL_Tk_Init (8) +#define FAIL_Tk_InitStubs (9)