Simplify define-operation-map; it doesn't need the hook quotation at all
parent
ca9e04c086
commit
d871691342
basis/ui
operations
tools
listener
operations
|
@ -61,8 +61,8 @@ HELP: define-operation
|
|||
} ;
|
||||
|
||||
HELP: define-operation-map
|
||||
{ $values { "class" "a class word" } { "group" string } { "blurb" { $maybe string } } { "object" object } { "hook" { $quotation "( obj -- newobj )" } ", or " { $link f } } { "translator" { $quotation "( obj -- newobj )" } ", or " { $link f } } }
|
||||
{ $description "Defines a command map named " { $snippet "group" } " on " { $snippet "class" } " consisting of operations applicable to " { $snippet "object" } ". The hook quotation is applied to the target gadget; the translator quotation is applied to the result of the hook. Finally the result of the translator is passed to the operation. A distinction is drawn between the hook and the translator because for listener operations, the hook runs in the event loop and the translator runs in the listener. This avoids polluting the listener output with large prettyprinted gadgets and long quotations." } ;
|
||||
{ $values { "class" "a class word" } { "group" string } { "blurb" { $maybe string } } { "object" object } { "translator" { $quotation "( obj -- newobj )" } ", or " { $link f } } }
|
||||
{ $description "Defines a command map named " { $snippet "group" } " on " { $snippet "class" } " consisting of operations applicable to " { $snippet "object" } ". The translator quotation is applied to the target gadget, and the result of the translator is passed to the operation." } ;
|
||||
|
||||
HELP: $operations
|
||||
{ $values { "element" "a sequence" } }
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! 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
|
||||
ui.gestures sequences strings math words generic namespaces
|
||||
hashtables help.markup quotations assocs fry ;
|
||||
IN: ui.operations
|
||||
|
||||
|
@ -9,11 +9,10 @@ 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 ;
|
||||
|
@ -56,28 +55,23 @@ SYMBOL: operations
|
|||
dupd define-command <operation>
|
||||
operations get push ;
|
||||
|
||||
: 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 ;
|
||||
|
|
|
@ -257,7 +257,7 @@ M: listener-command invoke-command ( target command -- )
|
|||
command-quot call-listener ;
|
||||
|
||||
M: listener-operation invoke-command ( target command -- )
|
||||
[ hook>> call ] keep operation-quot call-listener ;
|
||||
operation-quot call-listener ;
|
||||
|
||||
: eval-listener ( string -- )
|
||||
get-listener input>> [ set-editor-string ] keep
|
||||
|
|
|
@ -181,7 +181,6 @@ source-editor
|
|||
"word"
|
||||
"These commands operate on the Factor word named by the token at the caret position."
|
||||
\ selected-word
|
||||
[ ]
|
||||
[ selected-word ]
|
||||
define-operation-map
|
||||
|
||||
|
@ -189,6 +188,5 @@ interactor
|
|||
"quotation"
|
||||
"These commands operate on the entire contents of the input area."
|
||||
[ ]
|
||||
[ quot-action ]
|
||||
[ [ parse-lines ] with-compilation-unit ]
|
||||
[ quot-action [ parse-lines ] with-compilation-unit ]
|
||||
define-operation-map
|
||||
|
|
Loading…
Reference in New Issue