-- 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
- 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
#! 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
[ 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) ;
! 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
+ 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
] [
- 2drop
+ dup list-index swap control-value nth
] if ;
-M: list focusable-child* drop t ;
+: scroll>selected ( list -- )
+ dup selected-rect swap scroll>rect ;
: select-index ( n list -- )
dup control-value empty? [
] [
[ control-value length rem ] keep
[ set-list-index ] keep
- relayout-1
+ [ relayout-1 ] keep
+ scroll>selected
] if ;
: select-prev ( list -- )
: 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
! 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
<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 )
: 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
apply-border-color-style
apply-page-color-style
apply-presentation-style
+ apply-quotation-style
apply-outliner-style
nip ;
: 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 ] }
! 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 )
: 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 ;
: 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
{ +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" }
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 ;
[ 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
projects / factor.git / commitdiff