diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor index bcfca946dd..8ba0e5dac7 100644 --- a/basis/ui/operations/operations.factor +++ b/basis/ui/operations/operations.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! 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 ; +hashtables help.markup quotations assocs fry linked-assocs ; IN: ui.operations SYMBOL: +keyboard+ @@ -34,8 +34,11 @@ M: operation command-word command>> command-word ; SYMBOL: operations +operations [ ] initialize + : object-operations ( obj -- operations ) - operations get [ predicate>> call ] with filter ; + operations get values + [ predicate>> call ] with filter ; : find-operation ( obj quot -- command ) [ object-operations ] dip find-last nip ; inline @@ -51,10 +54,14 @@ SYMBOL: operations : default-flags ( -- assoc ) H{ { +keyboard+ f } { +primary+ f } { +secondary+ f } } ; +: (define-operation) ( operation -- ) + dup [ command>> ] [ predicate>> ] bi + 2array operations get set-at ; + : define-operation ( pred command flags -- ) default-flags swap assoc-union dupd define-command - operations get push ; + (define-operation) ; : modify-operation ( hook translator operation -- operation ) clone diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor index a9405424dc..d8802d66c9 100644 --- a/basis/ui/tools/operations/operations.factor +++ b/basis/ui/tools/operations/operations.factor @@ -12,8 +12,6 @@ sequences tools.vocabs classes compiler.units accessors vocabs.parser ; IN: ui.tools.operations -V{ } clone operations set-global - ! Objects [ drop t ] \ inspect H{ { +primary+ t }