[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 <ButtonPress-1> "
       ::tapandhold::showball $command $w $m %X %Y
     "
     bind $w <ButtonRelease-1> {
       ::tapandhold::stopball 
     } 
     bind $w <Motion> {
       ::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. 
[SRIV] Neat! I've been thinking of adding something like this into [Whim window manager] 
for use on the N770. 
Would it be less tricky if you took out the <Motion> handler, or is that needed?

[RS]: Very cool indeed! I tried it under [eTcl] on my [HTC Magician], and it works. And of course I couldn't resist to make it [simple]r :)
   * The balls are of course square, as they are tiny [toplevel]s. But to [pack] a [canvas] on each is redundant - just give the toplevels -bg blue (lightblue seems to be more similar to what CE does)
   * PI can be calculated simpler as [[expr atan(-1)]] - and braces are really not needed here. They are not some special [expr] syntax, but just say: "group, but don't substitute". As there's nothing to substitute in atan(-1), the effect is the same without braces
   * The [update] in ''showball'' can be taken out without noticeable effect. However, in ''makemymenu'' it's needed, otherwise the action (inserting the time/date string) is not done
   * The <Motion> handler is important so you can still mark text, without the "balls" getting in the way - but <B1-Motion> should be enough
I compared with the "real thing" in Pocket IE, and the time for full circle seems to be more like 0.5 sec. My current settings are: ballsize=4, balldistance=16, after=60
----
Another idea: As "tap and hold" is to emulate right-click, why not let it generate a <3> event? Here's this variation by [RS]:

 namespace eval ::tapandhold {
     variable ballcount -3  nrballs 8  distance 16  size 5
		
     proc showball {w x y} {
        variable ballcount; variable nrballs
        variable distance;  variable size
        if { $ballcount < $nrballs } {
            if {$ballcount > -1} {
                set angle [expr {2.0*acos(-1)*$ballcount/$nrballs} ]
                set dx [expr {int($distance*sin($angle))}]
                set dy [expr {int(-$distance*cos($angle))}]
                toplevel .tapandholdball_$ballcount -bg lightblue
                wm overrideredirect .tapandholdball_$ballcount 1
                wm geometry .tapandholdball_$ballcount \
                    ${size}x${size}+[expr {$x+$dx}]+[expr {$y+$dy}]
            }
            variable afterid [after 50 "::tapandhold::showball $w $x $y"]
            incr ballcount
        } else {
            stopball
            bell
            event generate $w <3> -x [expr {$x-[winfo rootx $w]}]\
                 -y [expr {$y-[winfo rooty $w]}]
        }
    }
    proc stopball {} {
        variable ballcount; variable afterid
        catch {after cancel $afterid}
        for {set n  0} {$n < $ballcount} {incr n} {
            destroy .tapandholdball_$n
        }
        set ballcount -3
    }
 }
 proc tapandhold::init w {
    bind $w <1>         [list ::tapandhold::showball $w %x %y]
    bind $w <ButtonRelease-1> ::tapandhold::stopball
    bind $w <B1-Motion>       ::tapandhold::stopball 
 }
#----------- Demo
 menu .m -tearoff false
 .m add command -label Foo -command {.t insert end foo\n}
 .m add command -label Bar -command {.t insert end bar\n}

 pack [text .t -height 20 -width 35]
 tapandhold::init .t
 bind .t <3> {tk_popup .m %X %Y}

DISCLAIMER: The above worked fine on my W95 box at hime, but on XP at work geometry is wrong again... Will check... ([RS])
----
[Category GUI]