Display gesture modifiers using Mac OS X Unicode characters

db4
Slava Pestov 2009-01-26 17:58:23 -06:00
parent 9bf2675fa3
commit f5d850f39e
2 changed files with 27 additions and 13 deletions

View File

@ -218,12 +218,10 @@ TUPLE: radio-control < button value ;
align-left ; inline
M: radio-control model-changed
swap value>>
over value>> = >>selected?
relayout-1 ;
2dup [ value>> ] bi@ = >>selected? relayout-1 drop ;
: <radio-controls> ( assoc model parent quot: ( value model label -- gadget ) -- parent )
'[ _ swap @ add-gadget ] assoc-each ; inline
:: <radio-controls> ( parent model assoc quot: ( value model label -- gadget ) -- parent )
assoc model [ parent swap quot call add-gadget ] assoc-each ; inline
: radio-button-theme ( gadget -- gadget )
{ 5 5 } >>gap
@ -234,7 +232,7 @@ M: radio-control model-changed
: <radio-buttons> ( model assoc -- gadget )
<filled-pile>
spin [ <radio-button> ] <radio-controls>
[ <radio-button> ] <radio-controls>
{ 5 5 } >>gap ;
: <toggle-button> ( value model label -- gadget )
@ -242,7 +240,7 @@ M: radio-control model-changed
: <toggle-buttons> ( model assoc -- gadget )
<shelf>
spin [ <toggle-button> ] <radio-controls> ;
[ <toggle-button> ] <radio-controls> ;
: command-button-quot ( target command -- quot )
'[ _ _ invoke-command drop ] ;
@ -252,8 +250,9 @@ M: radio-control model-changed
: <toolbar> ( target -- toolbar )
<shelf>
1 >>fill
swap
"toolbar" over class command-map commands>> swap
[ [ "toolbar" ] dip class command-map commands>> ] keep
'[ [ _ ] 2dip <command-button> add-gadget ] assoc-each ;
: add-toolbar ( track -- track )

View File

@ -3,7 +3,8 @@
USING: accessors arrays assocs kernel math math.order models
namespaces make sequences words strings system hashtables
math.parser math.vectors classes.tuple classes boxes calendar
alarms combinators sets columns fry deques ui.gadgets ;
alarms combinators sets columns fry deques ui.gadgets
unicode.case combinators.short-circuit ;
IN: ui.gestures
GENERIC: handle-gesture ( gesture gadget -- ? )
@ -280,12 +281,26 @@ SYMBOL: drag-timer
GENERIC: gesture>string ( gesture -- string/f )
: modifiers>string ( modifiers -- string )
[ name>> ] map concat >string ;
HOOK: modifiers>string os ( modifiers -- string )
M: macosx modifiers>string
[
{
{ A+ [ "⌘" ] }
{ M+ [ "⎇" ] }
{ S+ [ "⇧" ] }
{ C+ [ "⌃" ] }
} case
] map "" join ;
M: object modifiers>string
[ name>> ] map "" join ;
M: key-down gesture>string
dup mods>> modifiers>string
swap sym>> append ;
[ mods>> ] [ sym>> ] bi
dup { [ length 1 = ] [ upper? ] } 1&&
[ [ S+ prefix ] dip ] [ >upper ] if
[ modifiers>string ] dip append ;
M: button-up gesture>string
[