Fix drag gestures

db4
Slava Pestov 2008-11-22 01:42:16 -06:00
parent 17cb29e74e
commit 0b8cbc7d67
1 changed files with 4 additions and 1 deletions

View File

@ -103,13 +103,15 @@ world H{
{ T{ key-down f { C+ } "a" } [ T{ select-all-action } send-action ] }
{ T{ button-down f { C+ } 1 } [ drop T{ button-down f f 3 } button-gesture ] }
{ T{ button-down f { A+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
{ T{ button-down f { M+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
{ T{ button-up f { C+ } 1 } [ drop T{ button-up f f 3 } button-gesture ] }
{ T{ button-up f { A+ } 1 } [ drop T{ button-up f f 2 } button-gesture ] }
{ T{ button-up f { M+ } 1 } [ drop T{ button-up f f 2 } button-gesture ] }
} set-gestures
PREDICATE: specific-button-up < button-up #>> ;
PREDICATE: specific-button-down < button-down #>> ;
PREDICATE: specific-drag < drag #>> ;
: generalize-gesture ( gesture -- )
clone f >># button-gesture ;
@ -118,6 +120,7 @@ M: world handle-gesture ( gesture gadget -- ? )
{
{ [ over specific-button-up? ] [ drop generalize-gesture t ] }
{ [ over specific-button-down? ] [ drop generalize-gesture t ] }
{ [ over specific-drag? ] [ drop generalize-gesture t ] }
[ call-next-method ]
} cond ;