steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use singletons instead of empty tuples, add undo/redo to editor gadgets

db4
Slava Pestov 2009-01-28 00:30:57 -06:00
parent 33c955775b
commit af744e4511
16 changed files with 110 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
basis/ui/backend/cocoa/views/views.factor
View File

@ -197,24 +197,32 @@ CLASS: {
[ nip send-key-up-event ]
}
{ "undo:" "id" { "id" "SEL" "id" }
[ nip undo-action send-action$ ]
}
{ "redo:" "id" { "id" "SEL" "id" }
[ nip redo-action send-action$ ]
}
{ "cut:" "id" { "id" "SEL" "id" }
[ nip T{ cut-action } send-action$ ]
[ nip cut-action send-action$ ]
}
{ "copy:" "id" { "id" "SEL" "id" }
[ nip T{ copy-action } send-action$ ]
[ nip copy-action send-action$ ]
}
{ "paste:" "id" { "id" "SEL" "id" }
[ nip T{ paste-action } send-action$ ]
[ nip paste-action send-action$ ]
}
{ "delete:" "id" { "id" "SEL" "id" }
[ nip T{ delete-action } send-action$ ]
[ nip delete-action send-action$ ]
}
{ "selectAll:" "id" { "id" "SEL" "id" }
[ nip T{ select-all-action } send-action$ ]
[ nip select-all-action send-action$ ]
}
! Multi-touch gestures: this is undocumented.
@ -223,8 +231,8 @@ CLASS: {
[
nip
dup -> deltaZ sgn {
{ 1 [ T{ zoom-in-action } send-action$ ] }
{ -1 [ T{ zoom-out-action } send-action$ ] }
{ 1 [ zoom-in-action send-action$ ] }
{ -1 [ zoom-out-action send-action$ ] }
{ 0 [ 2drop ] }
} case
]
@ -234,13 +242,13 @@ CLASS: {
[
nip
dup -> deltaX sgn {
{ 1 [ T{ left-action } send-action$ ] }
{ -1 [ T{ right-action } send-action$ ] }
{ 1 [ left-action send-action$ ] }
{ -1 [ right-action send-action$ ] }
{ 0
[
dup -> deltaY sgn {
{ 1 [ T{ up-action } send-action$ ] }
{ -1 [ T{ down-action } send-action$ ] }
{ 1 [ up-action send-action$ ] }
{ -1 [ down-action send-action$ ] }
{ 0 [ 2drop ] }
} case
]

4
basis/ui/gadgets/buttons/buttons.factor
View File

@ -35,8 +35,8 @@ TUPLE: button < border pressed? selected? quot ;
button H{
{ T{ button-up } [ button-clicked ] }
{ T{ button-down } [ button-update ] }
{ T{ mouse-leave } [ button-update ] }
{ T{ mouse-enter } [ button-update ] }
{ mouse-leave [ button-update ] }
{ mouse-enter [ button-update ] }
} set-gestures
: new-button ( label quot class -- button )

2
basis/ui/gadgets/editors/editors-tests.factor
View File

@ -1,7 +1,7 @@
USING: accessors ui.gadgets.editors tools.test kernel io
io.streams.plain definitions namespaces ui.gadgets
ui.gadgets.grids prettyprint documents ui.gestures tools.test.ui
models ;
models documents.elements ;
IN: ui.gadgets.editors.tests
[ "foo bar" ] [

40
basis/ui/gadgets/editors/editors.factor
View File

@ -1,13 +1,13 @@
! Copyright (C) 2006, 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays documents kernel math models models.filter
namespaces locals fry make opengl opengl.gl sequences strings
math.vectors sorting colors combinators assocs math.order fry
calendar alarms continuations ui.clipboards ui.commands
ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.theme
ui.gadgets.menus ui.gadgets.wrappers ui.render ui.text
ui.gestures math.geometry.rect splitting unicode.categories ;
USING: accessors arrays documents documents.elements kernel math
models models.filter namespaces locals fry make opengl opengl.gl
sequences strings math.vectors sorting colors combinators assocs
math.order fry calendar alarms continuations ui.clipboards ui.commands
ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.menus
ui.gadgets.wrappers ui.render ui.text ui.gestures math.geometry.rect
splitting unicode.categories ;
IN: ui.gadgets.editors
TUPLE: editor < gadget
@ -377,7 +377,15 @@ M: editor gadget-text* editor-string % ;
: delete-to-end-of-line ( editor -- )
one-line-elt editor-backspace ;
editor "general" f {
: com-undo ( editor -- )
model>> undo ;
: com-redo ( editor -- )
model>> redo ;
editor "editing" f {
{ undo-action com-undo }
{ redo-action com-redo }
{ T{ key-down f f "DELETE" } delete-next-character }
{ T{ key-down f { S+ } "DELETE" } delete-next-character }
{ T{ key-down f f "BACKSPACE" } delete-previous-character }
@ -395,11 +403,11 @@ editor "general" f {
: cut ( editor -- ) clipboard get editor-cut ;
editor "clipboard" f {
{ T{ paste-action } paste }
{ paste-action paste }
{ copy-action com-copy }
{ cut-action cut }
{ T{ button-up f f 2 } paste-selection }
{ T{ copy-action } com-copy }
{ T{ button-up } com-copy-selection }
{ T{ cut-action } cut }
} define-command-map
: previous-character ( editor -- )
@ -480,10 +488,10 @@ editor "caret-motion" f {
editor "selection" f {
{ T{ button-down f { S+ } 1 } extend-selection }
{ T{ drag } drag-selection }
{ T{ gain-focus } focus-editor }
{ T{ lose-focus } unfocus-editor }
{ T{ delete-action } remove-selection }
{ T{ select-all-action } select-all }
{ gain-focus focus-editor }
{ lose-focus unfocus-editor }
{ delete-action remove-selection }
{ select-all-action select-all }
{ T{ key-down f { C+ } "l" } select-line }
{ T{ key-down f { S+ } "LEFT" } select-previous-character }
{ T{ key-down f { S+ } "RIGHT" } select-next-character }

2
basis/ui/gadgets/panes/panes.factor
View File

@ -414,6 +414,6 @@ pane H{
{ T{ button-up f { S+ } 1 } [ end-selection ] }
{ T{ button-up } [ end-selection ] }
{ T{ drag } [ extend-selection ] }
{ T{ copy-action } [ com-copy ] }
{ copy-action [ com-copy ] }
{ T{ button-down f f 3 } [ pane-menu ] }
} set-gestures

6
basis/ui/gadgets/presentations/presentations.factor
View File

@ -40,11 +40,11 @@ M: presentation ungraft*
presentation H{
{ T{ button-down f f 3 } [ show-presentation-menu ] }
{ T{ mouse-leave } [ [ hide-status ] [ button-update ] bi ] }
{ T{ mouse-enter } [ show-mouse-help ] }
{ mouse-leave [ [ hide-status ] [ button-update ] bi ] }
{ mouse-enter [ show-mouse-help ] }
! Responding to motion too allows nested presentations to
! display status help properly, when the mouse leaves a
! nested presentation and is still inside the parent, the
! parent doesn't receive a mouse-enter
{ T{ motion } [ show-mouse-help ] }
{ motion [ show-mouse-help ] }
} set-gestures

2
basis/ui/gadgets/scrollers/scrollers.factor
View File

@ -27,7 +27,7 @@ TUPLE: scroller < frame viewport x y follows ;
2bi ;
scroller H{
{ T{ mouse-scroll } [ do-mouse-scroll ] }
{ mouse-scroll [ do-mouse-scroll ] }
} set-gestures
: <scroller-model> ( -- model )

10
basis/ui/gadgets/tables/tables.factor
View File

@ -300,14 +300,14 @@ PRIVATE>
] [ drop ] if-mouse-row ;
table H{
{ T{ mouse-enter } [ show-mouse-help ] }
{ T{ mouse-leave } [ hide-mouse-help ] }
{ T{ motion } [ show-mouse-help ] }
{ mouse-enter [ show-mouse-help ] }
{ mouse-leave [ hide-mouse-help ] }
{ motion [ show-mouse-help ] }
{ T{ button-down } [ table-button-down ] }
{ T{ button-down f f 3 } [ show-table-menu ] }
{ T{ button-up } [ table-button-up ] }
{ T{ gain-focus } [ t >>focused? drop ] }
{ T{ lose-focus } [ f >>focused? drop ] }
{ gain-focus [ t >>focused? drop ] }
{ lose-focus [ f >>focused? drop ] }
{ T{ drag } [ table-button-down ] }
{ T{ key-down f f "RET" } [ row-action ] }
{ T{ key-down f f "UP" } [ prev-row ] }

10
basis/ui/gadgets/worlds/worlds.factor
View File

@ -92,10 +92,12 @@ ui-error-hook global [ [ rethrow ] or ] change-at
] [ drop ] if ;
world H{
{ T{ key-down f { C+ } "x" } [ T{ cut-action } send-action ] }
{ T{ key-down f { C+ } "c" } [ T{ copy-action } send-action ] }
{ T{ key-down f { C+ } "v" } [ T{ paste-action } send-action ] }
{ T{ key-down f { C+ } "a" } [ T{ select-all-action } send-action ] }
{ T{ key-down f { C+ } "z" } [ undo-action send-action ] }
{ T{ key-down f { C+ } "Z" } [ redo-action send-action ] }
{ T{ key-down f { C+ } "x" } [ cut-action send-action ] }
{ T{ key-down f { C+ } "c" } [ copy-action send-action ] }
{ T{ key-down f { C+ } "v" } [ paste-action send-action ] }
{ T{ key-down f { C+ } "a" } [ select-all-action send-action ] }
{ T{ button-down f { C+ } 1 } [ drop T{ button-down f f 3 } button-gesture ] }
{ T{ button-down f { A+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }
{ T{ button-down f { M+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] }

32
basis/ui/gestures/gestures-docs.factor
View File

@ -23,7 +23,7 @@ HELP: propagate-gesture
HELP: motion
{ $class-description "Mouse motion gesture." }
{ $examples { $code "T{ motion }" } } ;
{ $examples { $code "motion" } } ;
HELP: drag
{ $class-description "Mouse drag gesture. The " { $snippet "#" } " slot is either set to a mouse button number, or " { $link f } " indicating no specific button is expected." } ;
@ -48,43 +48,43 @@ HELP: button-down
HELP: mouse-scroll
{ $class-description "Scroll wheel motion gesture. When this gesture is sent, the " { $link scroll-direction } " global variable is set to a direction vector." }
{ $examples { $code "T{ mouse-scroll }" } } ;
{ $examples { $code "mouse-scroll" } } ;
HELP: mouse-enter
{ $class-description "Gesture sent when the mouse enters the bounds of a gadget." }
{ $examples { $code "T{ mouse-enter }" } } ;
{ $examples { $code "mouse-enter" } } ;
HELP: mouse-leave
{ $class-description "Gesture sent when the mouse leaves the bounds of a gadget." }
{ $examples { $code "T{ mouse-leave }" } } ;
{ $examples { $code "mouse-leave" } } ;
HELP: gain-focus
{ $class-description "Gesture sent when a gadget gains keyboard focus." }
{ $examples { $code "T{ gain-focus }" } } ;
{ $examples { $code "gain-focus" } } ;
HELP: lose-focus
{ $class-description "Gesture sent when a gadget loses keyboard focus." }
{ $examples { $code "T{ lose-focus }" } } ;
{ $examples { $code "lose-focus" } } ;
HELP: cut-action
{ $class-description "Gesture sent when the " { $emphasis "cut" } " standard window system action is invoked." }
{ $examples { $code "T{ cut-action }" } } ;
{ $examples { $code "cut-action" } } ;
HELP: copy-action
{ $class-description "Gesture sent when the " { $emphasis "copy" } " standard window system action is invoked." }
{ $examples { $code "T{ copy-action }" } } ;
{ $examples { $code "copy-action" } } ;
HELP: paste-action
{ $class-description "Gesture sent when the " { $emphasis "paste" } " standard window system action is invoked." }
{ $examples { $code "T{ paste-action }" } } ;
{ $examples { $code "paste-action" } } ;
HELP: delete-action
{ $class-description "Gesture sent when the " { $emphasis "delete" } " standard window system action is invoked." }
{ $examples { $code "T{ delete-action }" } } ;
{ $examples { $code "delete-action" } } ;
HELP: select-all-action
{ $class-description "Gesture sent when the " { $emphasis "select all" } " standard window system action is invoked." }
{ $examples { $code "T{ select-all-action }" } } ;
{ $examples { $code "select-all-action" } } ;
HELP: C+
{ $description "Control key modifier." } ;
@ -359,10 +359,12 @@ ARTICLE: "action-gestures" "Action gestures"
"The following keyboard gestures, if not handled directly, send action gestures:"
{ $table
{ { $strong "Keyboard gesture" } { $strong "Action gesture" } }
{ { $snippet "T{ key-down f { C+ } \"x\" }" } { $snippet "T{ cut-action }" } }
{ { $snippet "T{ key-down f { C+ } \"c\" }" } { $snippet "T{ copy-action }" } }
{ { $snippet "T{ key-down f { C+ } \"v\" }" } { $snippet "T{ paste-action }" } }
{ { $snippet "T{ key-down f { C+ } \"a\" }" } { $snippet "T{ select-all }" } }
{ { $snippet "T{ key-down f { C+ } \"z\" }" } { $snippet "undo-action" } }
{ { $snippet "T{ key-down f { C+ } \"Z\" }" } { $snippet "redo-action" } }
{ { $snippet "T{ key-down f { C+ } \"x\" }" } { $snippet "cut-action" } }
{ { $snippet "T{ key-down f { C+ } \"c\" }" } { $snippet "copy-action" } }
{ { $snippet "T{ key-down f { C+ } \"v\" }" } { $snippet "paste-action" } }
{ { $snippet "T{ key-down f { C+ } \"a\" }" } { $snippet "select-all-action" } }
}
"Action gestures should be used in place of the above keyboard gestures if possible. For example, on Mac OS X, the standard " { $strong "Edit" } " menu items send action gestures." ;

43
basis/ui/gestures/gestures.factor
View File

@ -66,30 +66,23 @@ M: user-input send-queued-gesture
'[ _ \ user-input queue-gesture ] unless-empty ;
! Gesture objects
TUPLE: motion ; C: <motion> motion
TUPLE: drag # ; C: <drag> drag
TUPLE: button-up mods # ; C: <button-up> button-up
TUPLE: button-down mods # ; C: <button-down> button-down
TUPLE: mouse-scroll ; C: <mouse-scroll> mouse-scroll
TUPLE: mouse-enter ; C: <mouse-enter> mouse-enter
TUPLE: mouse-leave ; C: <mouse-leave> mouse-leave
TUPLE: lose-focus ; C: <lose-focus> lose-focus
TUPLE: gain-focus ; C: <gain-focus> gain-focus
SYMBOLS:
motion
mouse-scroll
mouse-enter mouse-leave
lose-focus gain-focus ;
! Higher-level actions
TUPLE: cut-action ; C: <cut-action> cut-action
TUPLE: copy-action ; C: <copy-action> copy-action
TUPLE: paste-action ; C: <paste-action> paste-action
TUPLE: delete-action ; C: <delete-action> delete-action
TUPLE: select-all-action ; C: <select-all-action> select-all-action
TUPLE: left-action ; C: <left-action> left-action
TUPLE: right-action ; C: <right-action> right-action
TUPLE: up-action ; C: <up-action> up-action
TUPLE: down-action ; C: <down-action> down-action
TUPLE: zoom-in-action ; C: <zoom-in-action> zoom-in-action
TUPLE: zoom-out-action ; C: <zoom-out-action> zoom-out-action
SYMBOLS:
undo-action redo-action
cut-action copy-action paste-action
delete-action select-all-action
left-action right-action up-action down-action
zoom-in-action zoom-out-action ;
! Modifiers
SYMBOLS: C+ A+ M+ S+ ;
@ -165,15 +158,15 @@ SYMBOL: drag-timer
: fire-motion ( -- )
hand-buttons get-global empty? [
T{ motion } hand-gadget get-global propagate-gesture
motion hand-gadget get-global propagate-gesture
] [
drag-gesture
] if ;
: hand-gestures ( new old -- )
drop-prefix <reversed>
T{ mouse-leave } swap each-gesture
T{ mouse-enter } swap each-gesture ;
mouse-leave swap each-gesture
mouse-enter swap each-gesture ;
: forget-rollover ( -- )
f hand-world set-global
@ -182,10 +175,10 @@ SYMBOL: drag-timer
parents hand-gestures ;
: send-lose-focus ( gadget -- )
T{ lose-focus } swap send-gesture ;
lose-focus swap send-gesture ;
: send-gain-focus ( gadget -- )
T{ gain-focus } swap send-gesture ;
gain-focus swap send-gesture ;
: focus-child ( child gadget ? -- )
[
@ -274,7 +267,7 @@ SYMBOL: drag-timer
: send-wheel ( direction loc world -- )
move-hand
scroll-direction set-global
T{ mouse-scroll } hand-gadget get-global propagate-gesture ;
mouse-scroll hand-gadget get-global propagate-gesture ;
: send-action ( world gesture -- )
swap world-focus propagate-gesture ;

4
basis/ui/tools/browser/browser.factor
View File

@ -116,8 +116,8 @@ browser-gadget "navigation" "Commands for navigating in the article hierarchy" {
} define-command-map
browser-gadget "multi-touch" f {
{ T{ left-action } com-back }
{ T{ right-action } com-forward }
{ left-action com-back }
{ right-action com-forward }
} define-command-map
browser-gadget "scrolling"

2
basis/ui/tools/inspector/inspector.factor
View File

@ -109,7 +109,7 @@ inspector-gadget "toolbar" f {
} define-command-map
inspector-gadget "multi-touch" f {
{ T{ up-action } com-refresh }
{ up-action com-refresh }
} define-command-map
: inspector ( obj -- )

12
basis/ui/tools/listener/completion/completion.factor
View File

@ -1,13 +1,13 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs calendar colors documents fry kernel
words sets splitting math math.vectors models.delay models.filter
combinators.short-circuit parser present sequences tools.completion
generic generic.standard.engines.tuple
USING: accessors arrays assocs calendar colors documents
documents.elements fry kernel words sets splitting math math.vectors
models.delay models.filter combinators.short-circuit parser present
sequences tools.completion generic generic.standard.engines.tuple
ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.glass
ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.theme
ui.gadgets.worlds ui.gadgets.wrappers ui.gestures
ui.render ui.tools.listener.history ;
ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.render
ui.tools.listener.history ;
IN: ui.tools.listener.completion
: complete-IN:/USE:? ( tokens -- ? )

4
basis/ui/tools/listener/listener.factor
View File

@ -3,7 +3,7 @@
USING: accessors arrays assocs calendar combinators
combinators.short-circuit compiler.units concurrency.flags
concurrency.mailboxes continuations destructors documents
fry hashtables help help.markup io
documents.elements fry hashtables help help.markup io
io.styles kernel lexer listener math models models.delay models.filter
namespaces parser prettyprint quotations sequences strings threads
tools.vocabs ui ui.commands ui.gadgets ui.gadgets.buttons
@ -406,7 +406,7 @@ listener-gadget "scrolling"
} define-command-map
listener-gadget "multi-touch" f {
{ T{ up-action } refresh-all }
{ up-action refresh-all }
} define-command-map
listener-gadget "other" f {

4
basis/ui/ui.factor
View File

@ -35,8 +35,8 @@ SYMBOL: windows
: focus-gestures ( new old -- )
drop-prefix <reversed>
T{ lose-focus } swap each-gesture
T{ gain-focus } swap each-gesture ;
lose-focus swap each-gesture
gain-focus swap each-gesture ;
: focus-world ( world -- )
t >>focused?