From 61e5729cdbbe2ea87d0e842e74aa4fe399b01caa Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Sun, 31 Aug 2008 23:53:07 -0500
Subject: [PATCH] Update old accessors from 'ui.operations'
---
basis/ui/operations/operations-docs.factor | 12 ++++-----
basis/ui/operations/operations.factor | 30 +++++++++++-----------
basis/ui/tools/listener/listener.factor | 2 +-
3 files changed, 22 insertions(+), 22 deletions(-)
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