[PWE] 20060202 Since a pocketpc does't have a mouse, but only a stylus, there is no right mouse button. The context sensitive menu's usually bound to the right mouse button, are displayed on the pocket pc after a Tap&Hold, meaning to press the stylus for about a second, after which the menu appears. During the waiting time some balls are shown to indicate that a menu will appear. This is my attempt to do something similar in tcl: ---- namespace eval ::tapandhold { variable ballcount 0 variable afterid "" variable nrballs 8 variable balldistance 20 variable ballsize 10 variable PI [expr {atan(1.0) * 4.0}] proc showball {command w m x y} { variable ballcount variable nrballs variable balldistance variable ballsize variable afterid variable PI if { $ballcount < $nrballs } { set angle [expr {2.0*$PI*($ballcount+0)/$nrballs} ] set dx [expr {int($balldistance*sin($angle))}] set dy [expr {int(-$balldistance*cos($angle))}] toplevel .tapandholdball_$ballcount wm overrideredirect .tapandholdball_$ballcount true wm geometry .tapandholdball_$ballcount "${ballsize}x${ballsize}+[expr {$x+$dx}]+[expr {$y+$dy}]" pack [canvas .tapandholdball_$ballcount.c -bg blue -width $ballsize -height $ballsize] set afterid [after 100 "::tapandhold::showball $command $w $m $x $y"] incr ballcount } else { ::tapandhold::stopball update bell if { $command eq "popup" } { tk_popup $m $x $y 0 } else { $m $w $x $y } } } proc stopball { } { variable ballcount variable afterid catch { after cancel $afterid} for { set n 0 } { $n < $ballcount } { incr n } { destroy .tapandholdball_$n } set ballcount 0 } proc tapandhold_bind {command w m} { if { $command ne "popup" && $command ne "command" } { error "bad option $command must be popup or command" } bind $w " ::tapandhold::showball $command $w $m %X %Y " bind $w { ::tapandhold::stopball } bind $w { ::tapandhold::stopball } } } A little demonstration (must be little to fit the pocketpc). proc makemymenu { window x y } { menu .menu2 -tearoff false set now [clock format [clock seconds]] set comm [list .t1 insert end $now\n] .menu2 add command -command $comm -label $now puts [tk_popup .menu2 $x $y 0] update destroy .menu2 } menu .menu -tearoff false .menu add command -label {Item1} -command {.t insert end "Choosen 1\n"} .menu add command -label {Item2} -command {.t insert end "Choosen 2\n"} pack [text .t -height 10 -width 35] pack [text .t1 -height 10 -width 35] ::tapandhold::tapandhold_bind popup .t .menu ::tapandhold::tapandhold_bind command .t1 makemymenu ---- It's a bit tricky to use it on the pocketpc, since any movement of the stylus will abort the tap&hold. ----