From f5d850f39e2ebe8f8ff6d03caa14cb37447d5445 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 26 Jan 2009 17:58:23 -0600
Subject: [PATCH] Display gesture modifiers using Mac OS X Unicode characters

---
 basis/ui/gadgets/buttons/buttons.factor | 15 +++++++--------
 basis/ui/gestures/gestures.factor       | 25 ++++++++++++++++++++-----
 2 files changed, 27 insertions(+), 13 deletions(-)

diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index e264dd9aa8..660b7d1cb5 100644
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -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 )
diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor
index eea2320b1b..3ac793636e 100644
--- a/basis/ui/gestures/gestures.factor
+++ b/basis/ui/gestures/gestures.factor
@@ -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
     [