Fix conflict

[factor.git] / basis / ui / operations / operations.factor

diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor
index 8ba0e5dac7d532e57d3ebe63c139609aade285ea..aa81899462bbb79e620491d0a84906a5ace57789 100644 (file)
--- a/basis/ui/operations/operations.factor
+++ b/basis/ui/operations/operations.factor
@@ -1,19 +1,18 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel ui.commands
-ui.gestures sequences strings math words generic namespaces make
-hashtables help.markup quotations assocs fry linked-assocs ;
+ui.gestures sequences strings math words generic namespaces
+hashtables help.markup quotations assocs fry call linked-assocs ;
 IN: ui.operations
 
 SYMBOL: +keyboard+
 SYMBOL: +primary+
 SYMBOL: +secondary+
 
-TUPLE: operation predicate command translator hook listener? ;
+TUPLE: operation predicate command translator listener? ;
 
 : <operation> ( predicate command -- operation )
     operation new
-        [ ] >>hook
         [ ] >>translator
         swap >>command
         swap >>predicate ;
@@ -38,7 +37,10 @@ operations [ <linked-hash> ] initialize
 
 : object-operations ( obj -- operations )
     operations get values
-    [ predicate>> call ] with filter ;
+    [ predicate>> call( obj -- ? ) ] with filter ;
+
+: gesture>operation ( gesture object -- operation/f )
+    object-operations [ operation-gesture = ] with find nip ;
 
 : find-operation ( obj quot -- command )
     [ object-operations ] dip find-last nip ; inline
@@ -63,28 +65,23 @@ operations [ <linked-hash> ] initialize
     dupd define-command <operation>
     (define-operation) ;
 
-: modify-operation ( hook translator operation -- operation )
+: modify-operation ( translator operation -- operation )
     clone
         swap >>translator
-        swap >>hook
         t >>listener? ;
 
-: modify-operations ( operations hook translator -- operations )
-    '[ [ _ _ ] dip modify-operation ] map ;
+: modify-operations ( operations translator -- operations )
+    '[ [ _ ] dip modify-operation ] map ;
 
-: operations>commands ( object hook translator -- pairs )
-    [ object-operations ] 2dip modify-operations
+: operations>commands ( object translator -- pairs )
+    [ object-operations ] dip modify-operations
     [ [ operation-gesture ] keep ] { } map>assoc ;
 
-: define-operation-map ( class group blurb object hook translator -- )
+: define-operation-map ( class group blurb object translator -- )
     operations>commands define-command-map ;
 
 : operation-quot ( target command -- quot )
-    [
-        swap literalize ,
-        dup translator>> %
-        command>> ,
-    ] [ ] make ;
+    [ translator>> ] [ command>> ] bi '[ _ @ _ execute ] ;
 
 M: operation invoke-command ( target command -- )
-    [ hook>> call ] keep operation-quot call ;
+    operation-quot call( -- ) ;