diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 1c87a4fe0f..a6550f0a3a 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -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 documents kernel math models namespaces -locals fry make opengl opengl.gl sequences strings io.styles +USING: accessors arrays documents kernel math models models.filter +namespaces locals fry make opengl opengl.gl sequences strings io.styles math.vectors sorting colors combinators assocs math.order fry calendar alarms continuations ui.clipboards ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.buttons @@ -541,6 +541,11 @@ TUPLE: source-editor < multiline-editor ; : ( -- editor ) source-editor new-editor ; +! A useful model +: ( editor element -- model ) + [ [ caret>> ] [ model>> ] bi ] dip + '[ _ _ elt-string ] ; + ! Fields wrap an editor TUPLE: field < wrapper editor min-width max-width ; diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index 0f169faf47..a030fa5311 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -6,7 +6,7 @@ continuations prettyprint listener debugger threads boxes concurrency.flags math arrays generic accessors combinators assocs fry generic.standard.engines.tuple combinators.short-circuit tools.vocabs concurrency.mailboxes vocabs.parser calendar -models.delay documents hashtables sets destructors lexer +models.delay models.filter documents hashtables sets destructors lexer ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.packs ui.gadgets.tracks ui.gadgets.borders @@ -41,13 +41,15 @@ output history flag mailbox thread waiting help ; assoc-stack ] if ; -: ( interactor -- model ) caret>> 1/3 seconds ; +: ( interactor -- model ) + [ one-word-elt 1/3 seconds ] keep + '[ _ interactor-use assoc-stack ] ; : ( output -- gadget ) interactor new-editor V{ } clone >>history >>flag - dup >>help + dup >>help swap >>output ; M: interactor graft* @@ -56,20 +58,11 @@ M: interactor graft* M: interactor ungraft* [ dup help>> remove-connection ] [ call-next-method ] bi ; -: word-at-loc ( loc interactor -- word ) - over [ - [ model>> one-word-elt elt-string ] keep - interactor-use assoc-stack - ] [ - 2drop f - ] if ; - M: interactor model-changed - 2dup help>> eq? [ - swap value>> over word-at-loc swap show-summary - ] [ - call-next-method - ] if ; + 2dup help>> eq? + [ [ value>> ] dip show-summary ] + [ call-next-method ] + if ; : write-input ( string input -- ) presented associate