diff --git a/basis/ui/operations/operations-docs.factor b/basis/ui/operations/operations-docs.factor index 5f7ed60f38..ebdf3eee1f 100644 --- a/basis/ui/operations/operations-docs.factor +++ b/basis/ui/operations/operations-docs.factor @@ -22,11 +22,11 @@ HELP: operation $nl "Operations have the following slots:" { $list - { { $link operation-predicate } " - a quotation with stack effect " { $snippet "( obj -- ? )" } } - { { $link operation-command } " - a " { $link word } } - { { $link operation-translator } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } } - { { $link operation-hook } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } } - { { $link operation-listener? } " - a boolean" } + { { $snippet "predicate" } " - a quotation with stack effect " { $snippet "( obj -- ? )" } } + { { $snippet "command" } " - a " { $link word } } + { { $snippet "translator" } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } } + { { $snippet "hook" } " - a quotation with stack effect " { $snippet "( obj -- newobj )" } ", or " { $link f } } + { { $snippet "listener?" } " - a boolean" } } } ; HELP: operation-gesture @@ -38,7 +38,7 @@ HELP: operations HELP: object-operations { $values { "obj" object } { "operations" "a sequence of " { $link operation } " instances" } } -{ $description "Outputs a sequence of operations applicable to the given object, by testing each defined operation's " { $link operation-predicate } " quotation in turn." } ; +{ $description "Outputs a sequence of operations applicable to the given object, by testing each defined operation's " { $snippet "predicate" } " quotation in turn." } ; HELP: primary-operation { $values { "obj" object } { "operation" "an " { $link operation } " or " { $link f } } } diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor index 5a47f9e80b..8b4817dcac 100755 --- a/basis/ui/operations/operations.factor +++ b/basis/ui/operations/operations.factor @@ -19,34 +19,34 @@ TUPLE: operation predicate command translator hook listener? ; swap >>predicate ; PREDICATE: listener-operation < operation - dup operation-command listener-command? - swap operation-listener? or ; + dup command>> listener-command? + swap listener?>> or ; M: operation command-name - operation-command command-name ; + command>> command-name ; M: operation command-description - operation-command command-description ; + command>> command-description ; -M: operation command-word operation-command command-word ; +M: operation command-word command>> command-word ; : operation-gesture ( operation -- gesture ) - operation-command +keyboard+ word-prop ; + command>> +keyboard+ word-prop ; SYMBOL: operations : object-operations ( obj -- operations ) - operations get [ operation-predicate call ] with filter ; + operations get [ predicate>> call ] with filter ; : find-operation ( obj quot -- command ) >r object-operations r> find-last nip ; inline : primary-operation ( obj -- operation ) - [ operation-command +primary+ word-prop ] find-operation ; + [ command>> +primary+ word-prop ] find-operation ; : secondary-operation ( obj -- operation ) dup - [ operation-command +secondary+ word-prop ] find-operation + [ command>> +secondary+ word-prop ] find-operation [ ] [ primary-operation ] ?if ; : default-flags ( -- assoc ) @@ -59,9 +59,9 @@ SYMBOL: operations : modify-operation ( hook translator operation -- operation ) clone - tuck set-operation-translator - tuck set-operation-hook - t over set-operation-listener? ; + tuck (>>translator) + tuck (>>hook) + t over (>>listener?) ; : modify-operations ( operations hook translator -- operations ) rot [ >r 2dup r> modify-operation ] map 2nip ; @@ -76,9 +76,9 @@ SYMBOL: operations : operation-quot ( target command -- quot ) [ swap literalize , - dup operation-translator % - operation-command , + dup translator>> % + command>> , ] [ ] make ; M: operation invoke-command ( target command -- ) - [ operation-hook call ] keep operation-quot call ; + [ hook>> call ] keep operation-quot call ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 1ae99b800d..2dee1ba4a9 100755 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -64,7 +64,7 @@ M: listener-command invoke-command ( target command -- ) command-quot call-listener ; M: listener-operation invoke-command ( target command -- ) - [ operation-hook call ] keep operation-quot call-listener ; + [ hook>> call ] keep operation-quot call-listener ; : eval-listener ( string -- ) get-workspace