Commands/operations cleanup
slava
parent
b9524ae656
commit
d5c1eba09a
|
|
@ -14,8 +14,6 @@
|
|||
- signal 4 on datastack underflow on mac intel??
|
||||
- new section in cookbook: philosophy
|
||||
- help gadget should not re-render every time it is grafted
|
||||
- clean up interactor and listener commands -- there is a lot of
|
||||
duplication
|
||||
- keyboard help persists after clicking on a link
|
||||
- apropos and help search
|
||||
|
||||
|
|
@ -49,12 +47,6 @@
|
|||
- fonts/ should go inside the .app -- we need multi-tier resource-path
|
||||
- should be possible to drop an image file on the .app to run it
|
||||
- add-gadget, model-changed, set-model should compile
|
||||
- shortcuts:
|
||||
- find a listener
|
||||
- find a browser
|
||||
- find a help window
|
||||
- they'll either focus such a window, or if the current window is of
|
||||
that type, cycle
|
||||
- support x11's large selections, if needed
|
||||
- own-selection violates ICCCM
|
||||
- cocoa: windows are not updated while resizing
|
||||
|
|
|
|||
|
|
@ -30,3 +30,9 @@ M: byte-array resize resize-array ;
|
|||
3 swap <array>
|
||||
[ 1 swap set-array-nth ] keep
|
||||
[ 0 swap set-array-nth ] keep ;
|
||||
|
||||
: 4array ( x y z t -- array )
|
||||
4 swap <array>
|
||||
[ 2 swap set-array-nth ] keep
|
||||
[ 1 swap set-array-nth ] keep
|
||||
[ 0 swap set-array-nth ] keep ;
|
||||
|
|
|
|||
|
|
@ -71,9 +71,6 @@ world H{
|
|||
|
||||
SYMBOL: operations
|
||||
|
||||
: define-operation ( pred button# name quot -- )
|
||||
>r >r f r> f r> <command> 3array operations get push-new ;
|
||||
|
||||
: object-operation ( obj button# -- command )
|
||||
swap operations get
|
||||
[ >r class r> first class< ] subset-with
|
||||
|
|
@ -82,3 +79,6 @@ SYMBOL: operations
|
|||
|
||||
: object-operations ( object -- seq )
|
||||
3 [ 1+ object-operation ] map-with ;
|
||||
|
||||
: <operation> ( name quot -- command )
|
||||
>r >r f r> f r> <command> ;
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets-text
|
||||
USING: definitions gadgets gadgets-controls gadgets-panes
|
||||
USING: arrays definitions gadgets gadgets-controls gadgets-panes
|
||||
generic hashtables help io kernel namespaces prettyprint styles
|
||||
threads sequences vectors definitions parser words ;
|
||||
|
||||
|
|
@ -60,33 +60,48 @@ SYMBOL: structured-input
|
|||
swap interactor-eval
|
||||
] if ;
|
||||
|
||||
: interactor-history. ( interactor -- )
|
||||
dup interactor-output [
|
||||
interactor-history [ dup print-input ] each
|
||||
: interactor-history. ( -- )
|
||||
stdio get dup duplex-stream-out [
|
||||
duplex-stream-in interactor-history
|
||||
[ dup print-input ] each
|
||||
] with-stream* ;
|
||||
|
||||
: word-action ( interactor word -- )
|
||||
: token-action ( interactor quot -- )
|
||||
over gadget-selection?
|
||||
[ over T{ word-elt } select-elt ] unless
|
||||
over gadget-selection add* swap interactor-call ;
|
||||
|
||||
: word-action ( interactor quot -- )
|
||||
search token-action ;
|
||||
|
||||
: usable-words ( -- seq )
|
||||
use get [ hash-values natural-sort ] map concat prune ;
|
||||
|
||||
interactor {
|
||||
{ f "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] }
|
||||
{ f "History" T{ key-down f { C+ } "h" } [ dup [ interactor-history. ] curry swap interactor-call ] }
|
||||
{ f "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] }
|
||||
{ f "Stack effect" T{ key-down f { C+ A+ } "i" } [ "infer ." quot-action ] }
|
||||
{ f "Single step" T{ key-down f { C+ A+ } "w" } [ "walk" quot-action ] }
|
||||
{ f "See" T{ key-down f { A+ } "s" } [ [ search see ] word-action ] }
|
||||
{ f "Help" T{ key-down f { A+ } "h" } [ [ search help ] word-action ] }
|
||||
{ f "Callers" T{ key-down f { A+ } "u" } [ [ search usage. ] word-action ] }
|
||||
{ f "Edit" T{ key-down f { A+ } "e" } [ [ search edit ] word-action ] }
|
||||
{ f "Reload" T{ key-down f { A+ } "r" } [ [ search reload ] word-action ] }
|
||||
{ f "Apropos (all)" T{ key-down f { A+ } "a" } [ [ apropos ] word-action ] }
|
||||
{ f "Apropos (used)" T{ key-down f f "TAB" } [ [ usable-words (apropos) ] word-action ] }
|
||||
} define-commands
|
||||
interactor [
|
||||
{ f "Evaluate" T{ key-down f f "RETURN" } [ interactor-commit ] } ,
|
||||
{ f "History" T{ key-down f { C+ } "h" } [ [ interactor-history. ] swap interactor-call ] } ,
|
||||
{ f "Send EOF" T{ key-down f { C+ } "d" } [ f swap interactor-eval ] } ,
|
||||
|
||||
{
|
||||
{ f "Stack effect" T{ key-down f { C+ A+ } "i" } "infer ." }
|
||||
{ f "Single step" T{ key-down f { C+ A+ } "w" } "walk" }
|
||||
{ f "Single step" T{ key-down f { C+ A+ } "t" } "time" }
|
||||
} [ first4 [ quot-action ] curry 4array ] map %
|
||||
|
||||
{
|
||||
{ f "See" T{ key-down f { A+ } "s" } [ see ] }
|
||||
{ f "Help" T{ key-down f { A+ } "h" } [ help ] }
|
||||
{ f "Callers" T{ key-down f { A+ } "u" } [ usage. ] }
|
||||
{ f "Edit" T{ key-down f { A+ } "e" } [ edit ] }
|
||||
{ f "Reload" T{ key-down f { A+ } "r" } [ reload ] }
|
||||
{ f "Reload" T{ key-down f { A+ } "w" } [ watch ] }
|
||||
} [ first4 [ word-action ] curry 4array ] map %
|
||||
|
||||
{
|
||||
{ f "Apropos (all)" T{ key-down f { A+ } "a" } [ apropos ] }
|
||||
{ f "Apropos (used)" T{ key-down f f "TAB" } [ usable-words (apropos) ] }
|
||||
} [ first4 [ token-action ] curry 4array ] map %
|
||||
] { } make define-commands
|
||||
|
||||
M: interactor stream-readln
|
||||
dup interactor-queue empty? [
|
||||
|
|
|
|||
|
|
@ -2,11 +2,10 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets-listener
|
||||
USING: arrays gadgets gadgets-frames gadgets-labels
|
||||
gadgets-panes gadgets-scrolling
|
||||
gadgets-text gadgets-theme gadgets-tiles gadgets-tracks generic
|
||||
hashtables inspector io kernel listener math models
|
||||
namespaces parser prettyprint sequences shells styles threads
|
||||
words memory ;
|
||||
gadgets-panes gadgets-scrolling gadgets-text gadgets-theme
|
||||
gadgets-tiles gadgets-tracks generic hashtables inspector io
|
||||
kernel listener math models namespaces parser prettyprint
|
||||
sequences shells styles threads words memory ;
|
||||
|
||||
TUPLE: listener-gadget input output stack ;
|
||||
|
||||
|
|
@ -60,5 +59,5 @@ M: listener-gadget gadget-title drop "Listener" <model> ;
|
|||
drop f
|
||||
] if ;
|
||||
|
||||
: clear-listener ( listener -- )
|
||||
listener-gadget-output pane-clear ;
|
||||
: clear-listener ( -- )
|
||||
stdio get duplex-stream-out pane-clear ;
|
||||
|
|
|
|||
|
|
@ -82,12 +82,17 @@ workspace {
|
|||
{ f "Walker" T{ key-down f f "F3" } [ walker-gadget select-tool ] }
|
||||
{ f "Dictionary" T{ key-down f f "F4" } [ browser select-tool ] }
|
||||
{ f "Documentation" T{ key-down f f "F5" } [ help-gadget select-tool ] }
|
||||
{ f "New workspace" T{ key-down f { C+ } "n" } [ workspace-window drop ] }
|
||||
} define-commands
|
||||
|
||||
V{ } clone operations set-global
|
||||
|
||||
\ word 2 "Edit" [ edit ] define-operation
|
||||
link 2 "Edit" [ edit ] define-operation
|
||||
: define-operation ( pred button# name tool quot -- )
|
||||
[ % , \ call-tool , ] [ ] make <operation> 3array
|
||||
operations get push-new ;
|
||||
|
||||
\ word 2 "Edit" [ [ edit ] curry ] listener-gadget define-operation
|
||||
link 2 "Edit" [ [ edit ] curry ] listener-gadget define-operation
|
||||
|
||||
! Listener tool
|
||||
M: listener-gadget call-tool* ( quot/string listener -- )
|
||||
|
|
@ -102,14 +107,16 @@ M: listener-gadget call-tool* ( quot/string listener -- )
|
|||
] if ;
|
||||
|
||||
listener-gadget {
|
||||
{ f "Clear" T{ key-down f f "CLEAR" } [ dup [ clear-listener ] curry listener-gadget call-tool ] }
|
||||
{ f "Globals" f [ [ global inspect ] listener-gadget call-tool ] }
|
||||
{ f "Memory" f [ [ heap-stats. room. ] listener-gadget call-tool ] }
|
||||
} define-commands
|
||||
{ f "Clear" T{ key-down f f "CLEAR" } [ clear-listener ] }
|
||||
{ f "Globals" f [ global inspect ] }
|
||||
{ f "Memory" f [ heap-stats. room. ] }
|
||||
}
|
||||
[ first4 [ listener-gadget call-tool ] curry 4array ] map
|
||||
define-commands
|
||||
|
||||
object 1 "Inspect" [ [ inspect ] curry listener-gadget call-tool ] define-operation
|
||||
object 3 "Inspect" [ [ inspect ] curry listener-gadget call-tool ] define-operation
|
||||
input 1 "Input" [ input-string listener-gadget call-tool ] define-operation
|
||||
object 1 "Inspect" [ [ inspect ] curry ] listener-gadget define-operation
|
||||
object 3 "Inspect" [ [ inspect ] curry ] listener-gadget define-operation
|
||||
input 1 "Input" [ input-string ] listener-gadget define-operation
|
||||
|
||||
! Browser tool
|
||||
M: browser call-tool*
|
||||
|
|
@ -119,13 +126,13 @@ M: browser call-tool*
|
|||
show-word
|
||||
] if ;
|
||||
|
||||
\ word 1 "Browse" [ browser call-tool ] define-operation
|
||||
vocab-link 1 "Browse" [ browser call-tool ] define-operation
|
||||
\ word 1 "Browse" [ ] browser define-operation
|
||||
vocab-link 1 "Browse" [ ] browser define-operation
|
||||
|
||||
! Help tool
|
||||
M: help-gadget call-tool* show-help ;
|
||||
|
||||
link 1 "Follow link" [ help-gadget call-tool ] define-operation
|
||||
link 1 "Follow link" [ ] help-gadget define-operation
|
||||
|
||||
! Walker tool
|
||||
M: walker-gadget call-tool* ( arg tool -- )
|
||||
|
|
|
|||
Loading…
Reference in New Issue