Improved UI completion
slava
parent
5dd0182d73
commit
3abfe244aa
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
: (apropos) ( str words -- )
|
||||
completions [
|
||||
: completion. ( completions -- )
|
||||
first3 dup presented associate [
|
||||
dup word-vocabulary write bl word-name fuzzy.
|
||||
" (score: " swap >fixnum number>string ")" append3
|
||||
write
|
||||
] with-nesting terpri
|
||||
] each ;
|
||||
] with-nesting ;
|
||||
|
||||
: (apropos) ( str words -- )
|
||||
completions [ completion. terpri ] each ;
|
||||
|
||||
: apropos ( str -- ) all-words (apropos) ;
|
||||
|
|
|
|||
|
|
@ -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 <pile> 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 <pile> 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
|
||||
|
|
|
|||
|
|
@ -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{
|
|||
<presentation-mouse-help> ,
|
||||
] { } make make-pile 1 over set-pack-fill ;
|
||||
|
||||
: <listener-button> ( gadget quot -- button )
|
||||
[ call-listener ] curry <roll-button> ;
|
||||
|
||||
! Character styles
|
||||
|
||||
: apply-style ( style gadget key quot -- style gadget )
|
||||
|
|
@ -116,12 +122,16 @@ presentation H{
|
|||
: apply-presentation-style ( style gadget -- style gadget )
|
||||
presented [ <object-presentation> ] apply-style ;
|
||||
|
||||
: apply-quotation-style ( style gadget -- style gadget )
|
||||
quotation [ <listener-button> ] apply-style ;
|
||||
|
||||
: <styled-label> ( style text -- gadget )
|
||||
<label>
|
||||
apply-foreground-style
|
||||
apply-background-style
|
||||
apply-font-style
|
||||
apply-presentation-style
|
||||
apply-quotation-style
|
||||
nip ;
|
||||
|
||||
! Paragraph styles
|
||||
|
|
@ -154,6 +164,7 @@ presentation H{
|
|||
apply-border-color-style
|
||||
apply-page-color-style
|
||||
apply-presentation-style
|
||||
apply-quotation-style
|
||||
apply-outliner-style
|
||||
nip ;
|
||||
|
||||
|
|
|
|||
|
|
@ -65,6 +65,11 @@ USING: gadgets kernel models namespaces sequences ;
|
|||
|
||||
: editor-doc-end ( editor -- ) T{ doc-elt } editor-next ;
|
||||
|
||||
: selected-word ( editor -- string )
|
||||
dup gadget-selection?
|
||||
[ dup T{ word-elt } select-elt ] unless
|
||||
gadget-selection ;
|
||||
|
||||
editor "Editing commands" {
|
||||
{ "Insert newline" T{ key-down f f "RETURN" } [ "\n" swap user-input ] }
|
||||
{ "Insert newline" T{ key-down f { S+ } "RETURN" } [ "\n" swap user-input ] }
|
||||
|
|
|
|||
|
|
@ -2,14 +2,16 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets-listener
|
||||
USING: compiler arrays gadgets gadgets-frames gadgets-labels
|
||||
gadgets-panes gadgets-scrolling gadgets-text gadgets-theme
|
||||
gadgets-tracks gadgets-workspace generic hashtables tools io
|
||||
kernel listener math models namespaces parser prettyprint
|
||||
sequences shells strings styles threads words memory ;
|
||||
gadgets-panes gadgets-scrolling gadgets-text gadgets-lists
|
||||
gadgets-theme gadgets-tracks gadgets-workspace generic
|
||||
hashtables tools io kernel listener math models namespaces
|
||||
parser prettyprint sequences shells strings styles threads words
|
||||
memory ;
|
||||
|
||||
TUPLE: listener-gadget input output stack ;
|
||||
TUPLE: listener-gadget input output stack minibuffer use ;
|
||||
|
||||
: ui-listener-hook ( listener -- )
|
||||
use get over set-listener-gadget-use
|
||||
>r datastack r> listener-gadget-stack set-model ;
|
||||
|
||||
: listener-stream ( listener -- stream )
|
||||
|
|
@ -72,16 +74,6 @@ M: listener-gadget tool-help
|
|||
: listener-eof ( listener -- )
|
||||
listener-gadget-input f swap interactor-eval ;
|
||||
|
||||
: (listener-history) ( listener -- )
|
||||
dup listener-gadget-output [
|
||||
listener-gadget-input interactor-history
|
||||
[ dup print-input ] each
|
||||
] with-stream* ;
|
||||
|
||||
: listener-history ( listener -- )
|
||||
[ [ (listener-history) ] curry ] keep
|
||||
call-listener ;
|
||||
|
||||
: clear-listener-output ( listener -- )
|
||||
[ listener-gadget-output [ pane-clear ] curry ] keep
|
||||
call-listener ;
|
||||
|
|
@ -89,10 +81,79 @@ M: listener-gadget tool-help
|
|||
: clear-listener-stack ( listener -- )
|
||||
[ clear ] swap call-listener ;
|
||||
|
||||
: hide-minibuffer ( listener -- )
|
||||
dup listener-gadget-minibuffer dup
|
||||
[ over track-remove ] [ drop ] if
|
||||
dup listener-gadget-input request-focus
|
||||
f swap set-listener-gadget-minibuffer ;
|
||||
|
||||
: show-minibuffer ( gadget listener -- )
|
||||
[ hide-minibuffer ] keep
|
||||
[ set-listener-gadget-minibuffer ] 2keep
|
||||
dupd track-add request-focus ;
|
||||
|
||||
: show-list ( seq presenter action listener -- )
|
||||
>r >r >r <model> r> r> <list> <scroller> r>
|
||||
show-minibuffer ;
|
||||
|
||||
: show-history ( listener -- )
|
||||
[
|
||||
listener-gadget-input interactor-history <reversed>
|
||||
[ [ dup print-input ] make-pane ]
|
||||
[
|
||||
find-listener
|
||||
[ listener-gadget-input set-editor-text ] keep
|
||||
hide-minibuffer
|
||||
]
|
||||
] keep show-list ;
|
||||
|
||||
: insert-completion ( completion -- )
|
||||
find-listener [
|
||||
>r peek word-name r> listener-gadget-input user-input
|
||||
] keep hide-minibuffer ;
|
||||
|
||||
: show-completions ( listener words -- )
|
||||
over listener-gadget-input selected-word swap completions
|
||||
over
|
||||
>r [ [ completion. ] make-pane ] [ insert-completion ] r>
|
||||
show-list ;
|
||||
|
||||
: used-words ( listener -- seq )
|
||||
listener-gadget-use
|
||||
[ [ hash-values [ dup set ] each ] each ] make-hash
|
||||
hash-values natural-sort ;
|
||||
|
||||
listener-gadget "Listener commands" {
|
||||
{ "Restart" T{ key-down f { C+ } "r" } [ start-listener ] }
|
||||
{ "Send EOF" T{ key-down f { C+ } "d" } [ listener-eof ] }
|
||||
{ "History" T{ key-down f { C+ } "h" } [ listener-history ] }
|
||||
{ "Clear output" T{ key-down f f "CLEAR" } [ clear-listener-output ] }
|
||||
{ "Clear stack" T{ key-down f { C+ } "CLEAR" } [ clear-listener-stack ] }
|
||||
{
|
||||
"History"
|
||||
T{ key-down f "UP" }
|
||||
[ show-history ]
|
||||
}
|
||||
{
|
||||
"Clear output"
|
||||
T{ key-down f f "CLEAR" }
|
||||
[ clear-listener-output ]
|
||||
}
|
||||
{
|
||||
"Clear stack"
|
||||
T{ key-down f { C+ } "CLEAR" }
|
||||
[ clear-listener-stack ]
|
||||
}
|
||||
{
|
||||
"Complete word (used vocabs)"
|
||||
T{ key-down f f "TAB" }
|
||||
[ dup used-words show-completions ]
|
||||
}
|
||||
{
|
||||
"Complete word (all vocabs)"
|
||||
T{ key-down f f "TAB" }
|
||||
[ all-words show-completions ]
|
||||
}
|
||||
{
|
||||
"Hide minibuffer"
|
||||
T{ key-down f f "ESCAPE" }
|
||||
[ hide-minibuffer ]
|
||||
}
|
||||
} define-commands
|
||||
|
|
|
|||
|
|
@ -143,26 +143,6 @@ M: operation invoke-command ( target operation -- )
|
|||
{ +quot+ [ link-name browser call-tool ] }
|
||||
} define-operation
|
||||
|
||||
! Strings
|
||||
[ string? ] H{
|
||||
{ +name+ "Apropos (all)" }
|
||||
{ +keyboard+ T{ key-down f { A+ } "a" } }
|
||||
{ +quot+ [ apropos ] }
|
||||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
: usable-words ( -- seq )
|
||||
[
|
||||
use get [ hash-values [ dup set ] each ] each
|
||||
] make-hash hash-values natural-sort ;
|
||||
|
||||
[ string? ] H{
|
||||
{ +name+ "Apropos (used)" }
|
||||
{ +keyboard+ T{ key-down f f "TAB" } }
|
||||
{ +quot+ [ usable-words (apropos) ] }
|
||||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
! Quotations
|
||||
[ quotation? ] H{
|
||||
{ +name+ "Infer" }
|
||||
|
|
@ -216,13 +196,6 @@ tile "Word commands"
|
|||
define-commands
|
||||
|
||||
! Interactor commands
|
||||
|
||||
! Listener commands
|
||||
: selected-word ( editor -- string )
|
||||
dup gadget-selection?
|
||||
[ dup T{ word-elt } select-elt ] unless
|
||||
gadget-selection ;
|
||||
|
||||
: word-action ( target -- quot )
|
||||
selected-word search ;
|
||||
|
||||
|
|
@ -234,16 +207,12 @@ interactor "Word commands"
|
|||
[ word-action ] modify-listener-operations
|
||||
define-commands
|
||||
|
||||
interactor "Word search commands"
|
||||
string class-operations
|
||||
[ selected-word ] modify-listener-operations
|
||||
define-commands
|
||||
|
||||
interactor "Quotation commands"
|
||||
quotation class-operations
|
||||
[ quot-action ] modify-listener-operations
|
||||
define-commands
|
||||
|
||||
! Help commands
|
||||
help-gadget "Link commands"
|
||||
link class-operations [ help-action ] modify-operations
|
||||
[ command-name "Follow" = not ] subset
|
||||
|
|
|
|||
Loading…
Reference in New Issue