From b979addffcc9f44933c8912b8131b745e33ea7e8 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Fri, 1 Sep 2006 05:20:38 +0000
Subject: [PATCH] More slight operations fixes

---
 library/ui/commands.factor              | 22 ++++++++------
 library/ui/gadgets/presentations.factor |  2 +-
 library/ui/tools/workspace.factor       | 38 ++++++++++++++-----------
 3 files changed, 36 insertions(+), 26 deletions(-)

diff --git a/library/ui/commands.factor b/library/ui/commands.factor
index c78ba995d7..9cc5a1c999 100644
--- a/library/ui/commands.factor
+++ b/library/ui/commands.factor
@@ -89,32 +89,36 @@ SYMBOL: +quot+
 SYMBOL: +listener+
 SYMBOL: +gesture+
 
-TUPLE: operation class tags gesture listener? ;
+TUPLE: operation predicate tags gesture listener? ;
 
 : (operation) ( -- command )
     f +name+ get +gesture+ get +quot+ get <command> ;
 
 : (tags) ( -- seq ) +button+ get +group+ get 2array ;
 
-C: operation ( class hash -- operation )
+C: operation ( predicate hash -- operation )
     swap [
         (operation) over set-delegate
         (tags) over set-operation-tags
         +listener+ get over set-operation-listener?
     ] bind
-    [ set-operation-class ] keep ;
+    [ set-operation-predicate ] keep ;
 
 SYMBOL: operations
 
-: class-operations ( class -- operations )
-    operations get [ operation-class class< ] subset-with ;
+: object-operations ( obj -- operations )
+    operations get [ operation-predicate call ] subset-with ;
 
-: tagged-operations ( class tag -- commands )
-    swap class-operations
+: class-operations ( class -- operations )
+    "predicate" word-prop
+    operations get [ operation-predicate = ] subset-with ;
+
+: tagged-operations ( obj tag -- commands )
+    swap object-operations
     [ operation-tags member? ] subset-with ;
 
-: mouse-operation ( class button# -- command )
+: mouse-operation ( obj button# -- command )
     tagged-operations dup empty? [ drop f ] [ peek ] if ;
 
-: mouse-operations ( class -- seq )
+: mouse-operations ( obj -- seq )
     3 [ 1+ mouse-operation ] map-with ;
diff --git a/library/ui/gadgets/presentations.factor b/library/ui/gadgets/presentations.factor
index 34985ad564..d132da88c5 100644
--- a/library/ui/gadgets/presentations.factor
+++ b/library/ui/gadgets/presentations.factor
@@ -17,7 +17,7 @@ C: presentation ( button object commands -- button )
 
 : <object-presentation> ( gadget object -- button )
     >r f <roll-button> r>
-    dup class mouse-operations <presentation> ;
+    dup mouse-operations <presentation> ;
 
 : <command-presentation> ( target command -- button )
     dup command-name f <bevel-button> -rot { f f } swap add*
diff --git a/library/ui/tools/workspace.factor b/library/ui/tools/workspace.factor
index 60c8f74582..09039b1b76 100644
--- a/library/ui/tools/workspace.factor
+++ b/library/ui/tools/workspace.factor
@@ -155,7 +155,7 @@ M: operation invoke-command ( target operation -- )
     [ modify-listener-operation ] map-with ;
 
 ! Objects
-object H{
+[ drop t ] H{
     { +button+ 1 }
     { +name+ "Inspect" }
     { +quot+ [ inspect ] }
@@ -163,76 +163,82 @@ object H{
 } define-operation
 
 ! Input
-input H{
+[ input? ] H{
     { +button+ 1 }
     { +name+ "Input" }
     { +quot+ [ listener-gadget call-tool ] }
 } define-operation
 
 ! Words
-\ word H{
+[ word? ] H{
     { +button+ 1 }
     { +name+ "Browse" }
     { +gesture+ T{ key-down f { A+ } "b" } }
     { +quot+ [ browser call-tool ] }
 } define-operation
 
-\ word H{
+[ word? ] H{
     { +button+ 2 }
     { +name+ "Edit" }
     { +gesture+ T{ key-down f { A+ } "e" } }
     { +quot+ [ edit ] }
 } define-operation
 
-\ word H{
+[ word? ] H{
     { +button+ 3 }
     { +name+ "Documentation" }
     { +gesture+ T{ key-down f { A+ } "h" } }
     { +quot+ [ help-gadget call-tool ] }
 } define-operation
 
-\ word H{
+[ word? ] H{
     { +name+ "Usage" }
     { +gesture+ T{ key-down f { A+ } "u" } }
     { +quot+ [ usage. ] }
     { +listener+ t }
 } define-operation
 
-\ word H{
+[ word? ] H{
     { +name+ "Reload" }
     { +gesture+ T{ key-down f { A+ } "r" } }
     { +quot+ [ reload ] }
     { +listener+ t }
 } define-operation
 
-\ word H{
+[ word? ] H{
     { +name+ "Watch" }
     { +quot+ [ watch ] }
     { +listener+ t }
 } define-operation
 
 ! Vocabularies
-vocab-link H{
+[ vocab-link? ] H{
     { +button+ 1 }
     { +name+ "Browse" }
     { +quot+ [ browser call-tool ] }
 } define-operation
 
 ! Link
-link H{
+[ link? ] H{
     { +button+ 1 }
     { +name+ "Follow" }
     { +quot+ [ help-gadget call-tool ] }
 } define-operation
 
-link H{
+[ link? ] H{
     { +button+ 2 }
     { +name+ "Edit" }
     { +quot+ [ edit ] }
 } define-operation
 
+[ word-link? ] H{
+    { +button+ 2 }
+    { +name+ "Definition" }
+    { +quot+ [ link-name browser call-tool ] }
+} define-operation
+
 ! Strings
-string H{
+[ string? ] H{
     { +name+ "Apropos (all)" }
     { +gesture+ T{ key-down f { A+ } "a" } }
     { +quot+ [ apropos ] }
@@ -244,7 +250,7 @@ string H{
         use get [ hash-values [ dup set ] each ] each
     ] make-hash hash-values natural-sort ;
 
-string H{
+[ string? ] H{
     { +name+ "Apropos (used)" }
     { +gesture+ T{ key-down f f "TAB" } }
     { +quot+ [ usable-words (apropos) ] }
@@ -252,21 +258,21 @@ string H{
 } define-operation
 
 ! Quotations
-quotation H{
+[ quotation? ] H{
     { +name+ "Infer" }
     { +gesture+ T{ key-down f { C+ A+ } "i" } }
     { +quot+ [ infer . ] }
     { +listener+ t }
 } define-operation
 
-quotation H{
+[ quotation? ] H{
     { +name+ "Walk" }
     { +gesture+ T{ key-down f { C+ A+ } "w" } }
     { +quot+ [ walk ] }
     { +listener+ t }
 } define-operation
 
-quotation H{
+[ quotation? ] H{
     { +name+ "Time" }
     { +gesture+ T{ key-down f { C+ A+ } "t" } }
     { +quot+ [ time ] }