diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index d177a9d54d..b6840985b1 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,17 +1,20 @@ -- print-quot -- present commands directly - auto-invoke code gc - fix alien-callback/SEH bug on win32 - -+ ui: - +- list mouse gestures +- search gadget should use list +- maybe simplify list into displaying list a sequence of strings - control delegating to a pane is wrong - the mouse button overload sucks, use popup menus instead - nested presentation mouse over is not right - ui quick start doc - x11: scroll up/down wiggles caret - slider needs to be modelized -- [ ] write in the UI breaks stuff - some way of intercepting all gestures +- better help result ranking + ++ ui: + +- [ ] write in the UI breaks stuff - pane output in UI should use less memory - variable width word wrap - needs layout tricks @@ -23,12 +26,9 @@ - modules can be (re)loaded - keyboard navigation - ui browser: show currently selected vocab & words - - keyboard-navigatable list gadget of some kind - auto-update browser and help when sources reload - how do we refer to command shortcuts in the docs? - figure out if we need both set-model and set-model* -- full-height nodes should really be full height -- better help result ranking - roundoff is still not quite right with tracks - fix top level window positioning - x11.app has a problem with A+ keys diff --git a/library/tools/word-tools.factor b/library/tools/word-tools.factor index 57cb099909..35bdb25b20 100644 --- a/library/tools/word-tools.factor +++ b/library/tools/word-tools.factor @@ -94,8 +94,7 @@ generic ; #! triple is { score indices word } [ word-name [ swap fuzzy ] keep swap [ score ] keep - ] keep - 3array ; + ] keep 3array ; : completions ( str words -- seq ) [ completion ] map-with [ first zero? not ] subset @@ -107,13 +106,14 @@ generic ; [ hilite-style >r ch>string r> format ] [ write1 ] if ] 2each drop ; +: completion. ( completions -- ) + first3 dup presented associate [ + dup word-vocabulary write bl word-name fuzzy. + " (score: " swap >fixnum number>string ")" append3 + write + ] with-nesting ; + : (apropos) ( str words -- ) - completions [ - first3 dup presented associate [ - dup word-vocabulary write bl word-name fuzzy. - " (score: " swap >fixnum number>string ")" append3 - write - ] with-nesting terpri - ] each ; + completions [ completion. terpri ] each ; : apropos ( str -- ) all-words (apropos) ; diff --git a/library/ui/gadgets/lists.factor b/library/ui/gadgets/lists.factor index c5b788fcca..2516066794 100644 --- a/library/ui/gadgets/lists.factor +++ b/library/ui/gadgets/lists.factor @@ -1,38 +1,56 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-lists -USING: gadgets kernel sequences models opengl math ; +USING: gadgets gadgets-scrolling kernel sequences models opengl +math ; -TUPLE: list index quot color ; +TUPLE: list index presenter action color ; -C: list ( model quot -- gadget ) - [ set-list-quot ] keep +: list-theme ( list -- ) + { 0.8 0.8 1.0 1.0 } swap set-list-color ; + +C: list ( model presenter action -- gadget ) + [ set-list-action ] keep + [ set-list-presenter ] keep + dup rot 1 over set-pack-fill delegate>control 0 over set-list-index - { 0.8 0.8 1.0 1.0 } over set-list-color - dup rot 1 over set-pack-fill delegate>control ; + dup list-theme ; M: list model-changed dup clear-gadget - dup control-value over list-quot map + dup control-value over list-presenter map swap add-gadgets ; +: selected-rect ( list -- rect ) + dup list-index swap gadget-children 2dup bounds-check? + [ nth ] [ 2drop f ] if ; + M: list draw-gadget* dup list-color gl-color - dup list-index swap gadget-children 2dup bounds-check? [ - nth rect-bounds swap [ gl-fill-rect ] with-translation - ] [ - 2drop - ] if ; + selected-rect [ + rect-bounds swap [ gl-fill-rect ] with-translation + ] when* ; M: list focusable-child* drop t ; +: list-value ( list -- object ) + dup control-value empty? [ + drop f + ] [ + dup list-index swap control-value nth + ] if ; + +: scroll>selected ( list -- ) + dup selected-rect swap scroll>rect ; + : select-index ( n list -- ) dup control-value empty? [ 2drop ] [ [ control-value length rem ] keep [ set-list-index ] keep - relayout-1 + [ relayout-1 ] keep + scroll>selected ] if ; : select-prev ( list -- ) @@ -41,8 +59,12 @@ M: list focusable-child* drop t ; : select-next ( list -- ) dup list-index 1+ swap select-index ; +: call-action ( list -- ) + dup list-value swap list-action call ; + \ list H{ { T{ button-down } [ request-focus ] } { T{ key-down f f "UP" } [ select-prev ] } { T{ key-down f f "DOWN" } [ select-next ] } + { T{ key-down f f "RETURN" } [ call-action ] } } set-gestures diff --git a/library/ui/gadgets/presentations.factor b/library/ui/gadgets/presentations.factor index 676ef4729a..48c97e4bcf 100644 --- a/library/ui/gadgets/presentations.factor +++ b/library/ui/gadgets/presentations.factor @@ -1,5 +1,8 @@ ! Copyright (C) 2005, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +IN: gadgets-listener +DEFER: call-listener + IN: gadgets-presentations USING: arrays definitions gadgets gadgets-borders gadgets-buttons gadgets-grids gadgets-labels gadgets-outliner @@ -94,6 +97,9 @@ presentation H{ , ] { } make make-pile 1 over set-pack-fill ; +: ( gadget quot -- button ) + [ call-listener ] curry ; + ! Character styles : apply-style ( style gadget key quot -- style gadget ) @@ -116,12 +122,16 @@ presentation H{ : apply-presentation-style ( style gadget -- style gadget ) presented [ ] apply-style ; +: apply-quotation-style ( style gadget -- style gadget ) + quotation [ ] apply-style ; + : ( style text -- gadget )