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

Cleaner display of stack effect of word at caret, using models

db4
Slava Pestov 2009-01-09 14:14:19 -06:00
parent a1c3b9b26b
commit 63c0e5470b
2 changed files with 17 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays documents kernel math models namespaces USING: accessors arrays documents kernel math models models.filter
locals fry make opengl opengl.gl sequences strings io.styles namespaces locals fry make opengl opengl.gl sequences strings io.styles
math.vectors sorting colors combinators assocs math.order fry math.vectors sorting colors combinators assocs math.order fry
calendar alarms continuations ui.clipboards ui.commands calendar alarms continuations ui.clipboards ui.commands
ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets ui.gadgets.borders ui.gadgets.buttons
@ -541,6 +541,11 @@ TUPLE: source-editor < multiline-editor ;
: <source-editor> ( -- editor ) : <source-editor> ( -- editor )
source-editor new-editor ; source-editor new-editor ;
! A useful model
: <element-model> ( editor element -- model )
[ [ caret>> ] [ model>> ] bi ] dip
'[ _ _ elt-string ] <filter> ;
! Fields wrap an editor ! Fields wrap an editor
TUPLE: field < wrapper editor min-width max-width ; TUPLE: field < wrapper editor min-width max-width ;

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

@ -6,7 +6,7 @@ continuations prettyprint listener debugger threads boxes
concurrency.flags math arrays generic accessors combinators concurrency.flags math arrays generic accessors combinators
assocs fry generic.standard.engines.tuple combinators.short-circuit assocs fry generic.standard.engines.tuple combinators.short-circuit
tools.vocabs concurrency.mailboxes vocabs.parser calendar 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.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled
ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
ui.gadgets.packs ui.gadgets.tracks ui.gadgets.borders ui.gadgets.packs ui.gadgets.tracks ui.gadgets.borders
@ -41,13 +41,15 @@ output history flag mailbox thread waiting help ;
assoc-stack assoc-stack
] if ; ] if ;
: <help-model> ( interactor -- model ) caret>> 1/3 seconds <delay> ; : <word-model> ( interactor -- model )
[ one-word-elt <element-model> 1/3 seconds <delay> ] keep
'[ _ interactor-use assoc-stack ] <filter> ;
: <interactor> ( output -- gadget ) : <interactor> ( output -- gadget )
interactor new-editor interactor new-editor
V{ } clone >>history V{ } clone >>history
<flag> >>flag <flag> >>flag
dup <help-model> >>help dup <word-model> >>help
swap >>output ; swap >>output ;
M: interactor graft* M: interactor graft*
@ -56,20 +58,11 @@ M: interactor graft*
M: interactor ungraft* M: interactor ungraft*
[ dup help>> remove-connection ] [ call-next-method ] bi ; [ 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 M: interactor model-changed
2dup help>> eq? [ 2dup help>> eq?
swap value>> over word-at-loc swap show-summary [ [ value>> ] dip show-summary ]
] [ [ call-next-method ]
call-next-method if ;
] if ;
: write-input ( string input -- ) : write-input ( string input -- )
<input> presented associate <input> presented associate