Removing last remnants of 'workspace' tool
Slava Pestov
parent
d9018d40c7
commit
d7358b5ef3
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: debugger help help.topics kernel models compiler.units
|
||||
assocs words vocabs accessors fry combinators.short-circuit
|
||||
models models.history tools.apropos ui.tools.workspace
|
||||
models models.history tools.apropos
|
||||
ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
|
||||
ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.packs
|
||||
ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar
|
||||
|
|
@ -71,9 +71,6 @@ M: browser-gadget focusable-child* search-field>> ;
|
|||
[ [ raise-window ] [ gadget-child show-help ] bi ]
|
||||
[ <browser-gadget> "Browser" open-status-window ] if* ;
|
||||
|
||||
: browser-window ( -- )
|
||||
"handbook" com-follow ;
|
||||
|
||||
: com-back ( browser -- ) model>> go-back ;
|
||||
|
||||
: com-forward ( browser -- ) model>> go-forward ;
|
||||
|
|
@ -103,4 +100,9 @@ browser-gadget "scrolling"
|
|||
{ T{ key-down f f "DOWN" } com-scroll-down }
|
||||
{ T{ key-down f f "PAGE_UP" } com-page-up }
|
||||
{ T{ key-down f f "PAGE_DOWN" } com-page-down }
|
||||
} define-command-map
|
||||
} define-command-map
|
||||
|
||||
: browser-window ( -- )
|
||||
[ "handbook" com-follow ] with-ui ;
|
||||
|
||||
MAIN: browser-window
|
||||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors inspector namespaces kernel models
|
||||
models.filter prettyprint sequences mirrors assocs classes
|
||||
io io.styles arrays
|
||||
io io.styles arrays hashtables math.order sorting
|
||||
ui.tools.browser ui.commands ui.gadgets ui.gadgets.panes
|
||||
ui.gadgets.scrollers ui.gadgets.slots ui.gadgets.tracks
|
||||
ui.gestures ui.gadgets.buttons ui.gadgets.tables
|
||||
|
|
@ -50,9 +50,14 @@ M: inspector-renderer row-value
|
|||
|
||||
DEFER: inspector
|
||||
|
||||
: make-slot-descriptions ( obj -- seq )
|
||||
GENERIC: make-slot-descriptions ( obj -- seq )
|
||||
|
||||
M: object make-slot-descriptions
|
||||
make-mirror [ <slot-description> ] { } assoc>map ;
|
||||
|
||||
M: hashtable make-slot-descriptions
|
||||
call-next-method [ [ key-string>> ] compare ] sort ;
|
||||
|
||||
: <inspector-table> ( model -- table )
|
||||
[ make-slot-descriptions ] <filter> <table>
|
||||
[ inspector ] >>action
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
USING: ui.gadgets ui.gadgets.editors listener io help.syntax
|
||||
help.markup ;
|
||||
IN: ui.tools.interactor
|
||||
|
||||
HELP: interactor
|
||||
{ $class-description "An interactor is an " { $link editor } " intended to be used as the input component of a " { $link "ui-listener" } "."
|
||||
$nl
|
||||
"Interactors are created by calling " { $link <interactor> } "."
|
||||
$nl
|
||||
"Interactors implement the " { $link stream-readln } ", " { $link stream-read } " and " { $link read-quot } " generic words." } ;
|
||||
|
|
@ -1,87 +0,0 @@
|
|||
IN: ui.tools.interactor.tests
|
||||
USING: ui.tools.interactor ui.gadgets.panes namespaces
|
||||
ui.gadgets.editors concurrency.promises threads listener
|
||||
tools.test kernel calendar parser accessors calendar io ;
|
||||
|
||||
\ <interactor> must-infer
|
||||
|
||||
[
|
||||
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||
|
||||
[ ] [ "interactor" get register-self ] unit-test
|
||||
|
||||
[ ] [ "[ 1 2 3" "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ <promise> "promise" set ] unit-test
|
||||
|
||||
[
|
||||
self "interactor" get (>>thread)
|
||||
"interactor" get stream-read-quot "promise" get fulfill
|
||||
] "Interactor test" spawn drop
|
||||
|
||||
! This should not throw an exception
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
|
||||
|
||||
[ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ [ [ 1 2 3 ] ] ] [ "promise" get 5 seconds ?promise-timeout ] unit-test
|
||||
] with-interactive-vocabs
|
||||
|
||||
! Hang
|
||||
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||
|
||||
[ ] [ [ "interactor" get stream-read-quot drop ] "A" spawn drop ] unit-test
|
||||
|
||||
[ ] [ [ "interactor" get stream-read-quot drop ] "B" spawn drop ] unit-test
|
||||
|
||||
[ ] [ 1 seconds sleep ] unit-test
|
||||
|
||||
[ ] [ "interactor" get interactor-eof ] unit-test
|
||||
|
||||
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||
|
||||
: text "Hello world.\nThis is a test." ;
|
||||
|
||||
[ ] [ text "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ <promise> "promise" set ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
"interactor" get register-self
|
||||
"interactor" get contents "promise" get fulfill
|
||||
] in-thread
|
||||
] unit-test
|
||||
|
||||
[ ] [ 100 milliseconds sleep ] unit-test
|
||||
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ ] [ 100 milliseconds sleep ] unit-test
|
||||
|
||||
[ ] [ "interactor" get interactor-eof ] unit-test
|
||||
|
||||
[ t ] [ "promise" get 2 seconds ?promise-timeout text = ] unit-test
|
||||
|
||||
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||
|
||||
[ ] [ text "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ <promise> "promise" set ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
"interactor" get register-self
|
||||
"interactor" get stream-read1 "promise" get fulfill
|
||||
] in-thread
|
||||
] unit-test
|
||||
|
||||
[ ] [ 100 milliseconds sleep ] unit-test
|
||||
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ CHAR: H ] [ "promise" get 2 seconds ?promise-timeout ] unit-test
|
||||
|
|
@ -1,181 +0,0 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays assocs combinators continuations documents
|
||||
hashtables io io.styles kernel math math.order math.vectors
|
||||
models models.delay namespaces parser lexer prettyprint
|
||||
quotations sequences strings threads listener classes.tuple
|
||||
ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.status-bar
|
||||
ui.gadgets.presentations ui.gadgets.worlds ui.gestures
|
||||
definitions calendar concurrency.flags concurrency.mailboxes
|
||||
ui.tools.workspace accessors sets destructors fry vocabs.parser ;
|
||||
IN: ui.tools.interactor
|
||||
|
||||
! If waiting is t, we're waiting for user input, and invoking
|
||||
! evaluate-input resumes the thread.
|
||||
TUPLE: interactor < source-editor
|
||||
output history flag mailbox thread waiting help ;
|
||||
|
||||
: register-self ( interactor -- )
|
||||
<mailbox> >>mailbox
|
||||
self >>thread
|
||||
drop ;
|
||||
|
||||
: interactor-continuation ( interactor -- continuation )
|
||||
thread>> continuation>> value>> ;
|
||||
|
||||
: interactor-busy? ( interactor -- ? )
|
||||
#! We're busy if there's no thread to resume.
|
||||
[ waiting>> ]
|
||||
[ thread>> dup [ thread-registered? ] when ]
|
||||
bi and not ;
|
||||
|
||||
: interactor-use ( interactor -- seq )
|
||||
dup interactor-busy? [ drop f ] [
|
||||
use swap
|
||||
interactor-continuation name>>
|
||||
assoc-stack
|
||||
] if ;
|
||||
|
||||
: <help-model> ( interactor -- model ) caret>> 1/3 seconds <delay> ;
|
||||
|
||||
: <interactor> ( output -- gadget )
|
||||
interactor new-editor
|
||||
V{ } clone >>history
|
||||
<flag> >>flag
|
||||
dup <help-model> >>help
|
||||
swap >>output ;
|
||||
|
||||
M: interactor graft*
|
||||
[ call-next-method ] [ dup help>> add-connection ] bi ;
|
||||
|
||||
M: interactor ungraft*
|
||||
[ 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
|
||||
2dup help>> eq? [
|
||||
swap value>> over word-at-loc swap show-summary
|
||||
] [
|
||||
call-next-method
|
||||
] if ;
|
||||
|
||||
: write-input ( string input -- )
|
||||
<input> presented associate
|
||||
[ H{ { font-style bold } } format ] with-nesting ;
|
||||
|
||||
: interactor-input. ( string interactor -- )
|
||||
output>> [
|
||||
dup string? [ dup write-input nl ] [ short. ] if
|
||||
] with-output-stream* ;
|
||||
|
||||
: add-interactor-history ( str interactor -- )
|
||||
over empty? [ 2drop ] [ history>> adjoin ] if ;
|
||||
|
||||
: interactor-continue ( obj interactor -- )
|
||||
mailbox>> mailbox-put ;
|
||||
|
||||
: interactor-finish ( interactor -- )
|
||||
[ editor-string ] keep
|
||||
[ interactor-input. ] 2keep
|
||||
[ add-interactor-history ] keep
|
||||
clear-editor ;
|
||||
|
||||
: interactor-eof ( interactor -- )
|
||||
dup interactor-busy? [
|
||||
f over interactor-continue
|
||||
] unless drop ;
|
||||
|
||||
: evaluate-input ( interactor -- )
|
||||
dup interactor-busy? [
|
||||
dup control-value over interactor-continue
|
||||
] unless drop ;
|
||||
|
||||
: interactor-yield ( interactor -- obj )
|
||||
dup thread>> self eq? [
|
||||
{
|
||||
[ t >>waiting drop ]
|
||||
[ flag>> raise-flag ]
|
||||
[ mailbox>> mailbox-get ]
|
||||
[ f >>waiting drop ]
|
||||
} cleave
|
||||
] [ drop f ] if ;
|
||||
|
||||
: interactor-read ( interactor -- lines )
|
||||
[ interactor-yield ] [ interactor-finish ] bi ;
|
||||
|
||||
M: interactor stream-readln
|
||||
interactor-read dup [ first ] when ;
|
||||
|
||||
: interactor-call ( quot interactor -- )
|
||||
dup interactor-busy? [
|
||||
2dup interactor-input.
|
||||
2dup interactor-continue
|
||||
] unless 2drop ;
|
||||
|
||||
M: interactor stream-read
|
||||
swap dup zero? [
|
||||
2drop ""
|
||||
] [
|
||||
[ interactor-read dup [ "\n" join ] when ] dip short head
|
||||
] if ;
|
||||
|
||||
M: interactor stream-read-partial
|
||||
stream-read ;
|
||||
|
||||
M: interactor stream-read1
|
||||
dup interactor-read {
|
||||
{ [ dup not ] [ 2drop f ] }
|
||||
{ [ dup empty? ] [ drop stream-read1 ] }
|
||||
{ [ dup first empty? ] [ 2drop CHAR: \n ] }
|
||||
[ nip first first ]
|
||||
} cond ;
|
||||
|
||||
M: interactor dispose drop ;
|
||||
|
||||
: go-to-error ( interactor error -- )
|
||||
[ line>> 1- ] [ column>> ] bi 2array
|
||||
over set-caret
|
||||
mark>caret ;
|
||||
|
||||
: handle-parse-error ( interactor error -- )
|
||||
dup lexer-error? [ 2dup go-to-error error>> ] when
|
||||
swap find-workspace debugger-popup ;
|
||||
|
||||
: try-parse ( lines interactor -- quot/error/f )
|
||||
[
|
||||
drop parse-lines-interactive
|
||||
] [
|
||||
2nip
|
||||
dup lexer-error? [
|
||||
dup error>> unexpected-eof? [ drop f ] when
|
||||
] when
|
||||
] recover ;
|
||||
|
||||
: handle-interactive ( lines interactor -- quot/f ? )
|
||||
tuck try-parse {
|
||||
{ [ dup quotation? ] [ nip t ] }
|
||||
{ [ dup not ] [ drop "\n" swap user-input* drop f f ] }
|
||||
[ handle-parse-error f f ]
|
||||
} cond ;
|
||||
|
||||
M: interactor stream-read-quot
|
||||
[ interactor-yield ] keep {
|
||||
{ [ over not ] [ drop ] }
|
||||
{ [ over callable? ] [ drop ] }
|
||||
[
|
||||
[ handle-interactive ] keep swap
|
||||
[ interactor-finish ] [ nip stream-read-quot ] if
|
||||
]
|
||||
} cond ;
|
||||
|
||||
interactor "interactor" f {
|
||||
{ T{ key-down f f "RET" } evaluate-input }
|
||||
{ T{ key-down f { C+ } "k" } clear-editor }
|
||||
} define-command-map
|
||||
|
|
@ -1 +0,0 @@
|
|||
Interactors are used to input Factor code
|
||||
|
|
@ -1,7 +1,14 @@
|
|||
USING: help.markup help.syntax ui.commands ui.tools.interactor
|
||||
ui.gadgets.editors ui.gadgets.panes ;
|
||||
USING: help.markup help.syntax ui.commands
|
||||
ui.gadgets.editors ui.gadgets.panes listener io ;
|
||||
IN: ui.tools.listener
|
||||
|
||||
HELP: interactor
|
||||
{ $class-description "An interactor is an " { $link editor } " intended to be used as the input component of a " { $link "ui-listener" } "."
|
||||
$nl
|
||||
"Interactors are created by calling " { $link <interactor> } "."
|
||||
$nl
|
||||
"Interactors implement the " { $link stream-readln } ", " { $link stream-read } " and " { $link read-quot } " generic words." } ;
|
||||
|
||||
ARTICLE: "ui-listener" "UI listener"
|
||||
"The graphical listener is based around the terminal listener (" { $link "listener" } ") and adds the following features:"
|
||||
{ $list
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: continuations documents ui.tools.interactor
|
||||
USING: continuations documents
|
||||
ui.tools.listener hashtables kernel namespaces parser sequences
|
||||
tools.test ui.commands ui.gadgets ui.gadgets.editors
|
||||
ui.gadgets.panes vocabs words tools.test.ui slots.private
|
||||
|
|
@ -6,6 +6,89 @@ threads arrays generic threads accessors listener math
|
|||
calendar ;
|
||||
IN: ui.tools.listener.tests
|
||||
|
||||
\ <interactor> must-infer
|
||||
|
||||
[
|
||||
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||
|
||||
[ ] [ "interactor" get register-self ] unit-test
|
||||
|
||||
[ ] [ "[ 1 2 3" "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ <promise> "promise" set ] unit-test
|
||||
|
||||
[
|
||||
self "interactor" get (>>thread)
|
||||
"interactor" get stream-read-quot "promise" get fulfill
|
||||
] "Interactor test" spawn drop
|
||||
|
||||
! This should not throw an exception
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
|
||||
|
||||
[ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ [ [ 1 2 3 ] ] ] [ "promise" get 5 seconds ?promise-timeout ] unit-test
|
||||
] with-interactive-vocabs
|
||||
|
||||
! Hang
|
||||
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||
|
||||
[ ] [ [ "interactor" get stream-read-quot drop ] "A" spawn drop ] unit-test
|
||||
|
||||
[ ] [ [ "interactor" get stream-read-quot drop ] "B" spawn drop ] unit-test
|
||||
|
||||
[ ] [ 1 seconds sleep ] unit-test
|
||||
|
||||
[ ] [ "interactor" get interactor-eof ] unit-test
|
||||
|
||||
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||
|
||||
: text "Hello world.\nThis is a test." ;
|
||||
|
||||
[ ] [ text "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ <promise> "promise" set ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
"interactor" get register-self
|
||||
"interactor" get contents "promise" get fulfill
|
||||
] in-thread
|
||||
] unit-test
|
||||
|
||||
[ ] [ 100 milliseconds sleep ] unit-test
|
||||
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ ] [ 100 milliseconds sleep ] unit-test
|
||||
|
||||
[ ] [ "interactor" get interactor-eof ] unit-test
|
||||
|
||||
[ t ] [ "promise" get 2 seconds ?promise-timeout text = ] unit-test
|
||||
|
||||
[ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
|
||||
|
||||
[ ] [ text "interactor" get set-editor-string ] unit-test
|
||||
|
||||
[ ] [ <promise> "promise" set ] unit-test
|
||||
|
||||
[ ] [
|
||||
[
|
||||
"interactor" get register-self
|
||||
"interactor" get stream-read1 "promise" get fulfill
|
||||
] in-thread
|
||||
] unit-test
|
||||
|
||||
[ ] [ 100 milliseconds sleep ] unit-test
|
||||
|
||||
[ ] [ "interactor" get evaluate-input ] unit-test
|
||||
|
||||
[ CHAR: H ] [ "promise" get 2 seconds ?promise-timeout ] unit-test
|
||||
|
||||
[ f ] [ "word" source-editor command-map commands>> empty? ] unit-test
|
||||
|
||||
[ ] [ <listener-gadget> [ ] with-grafted-gadget ] unit-test
|
||||
|
|
|
|||
|
|
@ -1,18 +1,158 @@
|
|||
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: inspector help help.markup io io.styles kernel models strings
|
||||
namespaces parser quotations sequences vocabs words prettyprint
|
||||
listener debugger threads boxes concurrency.flags math arrays
|
||||
generic accessors combinators assocs fry generic.standard.engines.tuple
|
||||
USING: inspector help help.markup io io.styles kernel models
|
||||
strings namespaces parser quotations sequences vocabs words
|
||||
continuations prettyprint listener debugger threads boxes
|
||||
concurrency.flags math arrays generic accessors combinators
|
||||
assocs fry generic.standard.engines.tuple combinators.short-circuit
|
||||
tools.vocabs concurrency.mailboxes vocabs.parser calendar
|
||||
models.delay documents hashtables sets destructors lexer
|
||||
ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.labelled
|
||||
ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers ui.gadgets.packs
|
||||
ui.gadgets.tracks ui.gadgets.borders ui.gadgets.frames
|
||||
ui.gadgets.grids ui.gestures ui.operations ui.tools.browser
|
||||
ui.tools.interactor ui.tools.inspector ui.tools.workspace
|
||||
ui.tools.common ;
|
||||
ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
|
||||
ui.gadgets.packs ui.gadgets.tracks ui.gadgets.borders
|
||||
ui.gadgets.frames ui.gadgets.grids ui.gadgets.status-bar
|
||||
ui.gestures ui.operations ui.tools.browser
|
||||
ui.tools.debugger ui.tools.inspector ui.tools.common ui ;
|
||||
IN: ui.tools.listener
|
||||
|
||||
TUPLE: listener-gadget < track input output scroller ;
|
||||
! If waiting is t, we're waiting for user input, and invoking
|
||||
! evaluate-input resumes the thread.
|
||||
TUPLE: interactor < source-editor
|
||||
output history flag mailbox thread waiting help ;
|
||||
|
||||
: register-self ( interactor -- )
|
||||
<mailbox> >>mailbox
|
||||
self >>thread
|
||||
drop ;
|
||||
|
||||
: interactor-continuation ( interactor -- continuation )
|
||||
thread>> continuation>> value>> ;
|
||||
|
||||
: interactor-busy? ( interactor -- ? )
|
||||
#! We're busy if there's no thread to resume.
|
||||
[ waiting>> ]
|
||||
[ thread>> dup [ thread-registered? ] when ]
|
||||
bi and not ;
|
||||
|
||||
: interactor-use ( interactor -- seq )
|
||||
dup interactor-busy? [ drop f ] [
|
||||
use swap
|
||||
interactor-continuation name>>
|
||||
assoc-stack
|
||||
] if ;
|
||||
|
||||
: <help-model> ( interactor -- model ) caret>> 1/3 seconds <delay> ;
|
||||
|
||||
: <interactor> ( output -- gadget )
|
||||
interactor new-editor
|
||||
V{ } clone >>history
|
||||
<flag> >>flag
|
||||
dup <help-model> >>help
|
||||
swap >>output ;
|
||||
|
||||
M: interactor graft*
|
||||
[ call-next-method ] [ dup help>> add-connection ] bi ;
|
||||
|
||||
M: interactor ungraft*
|
||||
[ 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
|
||||
2dup help>> eq? [
|
||||
swap value>> over word-at-loc swap show-summary
|
||||
] [
|
||||
call-next-method
|
||||
] if ;
|
||||
|
||||
: write-input ( string input -- )
|
||||
<input> presented associate
|
||||
[ H{ { font-style bold } } format ] with-nesting ;
|
||||
|
||||
: interactor-input. ( string interactor -- )
|
||||
output>> [
|
||||
dup string? [ dup write-input nl ] [ short. ] if
|
||||
] with-output-stream* ;
|
||||
|
||||
: add-interactor-history ( str interactor -- )
|
||||
over empty? [ 2drop ] [ history>> adjoin ] if ;
|
||||
|
||||
: interactor-continue ( obj interactor -- )
|
||||
mailbox>> mailbox-put ;
|
||||
|
||||
: interactor-finish ( interactor -- )
|
||||
[ editor-string ] keep
|
||||
[ interactor-input. ] 2keep
|
||||
[ add-interactor-history ] keep
|
||||
clear-editor ;
|
||||
|
||||
: interactor-eof ( interactor -- )
|
||||
dup interactor-busy? [
|
||||
f over interactor-continue
|
||||
] unless drop ;
|
||||
|
||||
: evaluate-input ( interactor -- )
|
||||
dup interactor-busy? [
|
||||
dup control-value over interactor-continue
|
||||
] unless drop ;
|
||||
|
||||
: interactor-yield ( interactor -- obj )
|
||||
dup thread>> self eq? [
|
||||
{
|
||||
[ t >>waiting drop ]
|
||||
[ flag>> raise-flag ]
|
||||
[ mailbox>> mailbox-get ]
|
||||
[ f >>waiting drop ]
|
||||
} cleave
|
||||
] [ drop f ] if ;
|
||||
|
||||
: interactor-read ( interactor -- lines )
|
||||
[ interactor-yield ] [ interactor-finish ] bi ;
|
||||
|
||||
M: interactor stream-readln
|
||||
interactor-read dup [ first ] when ;
|
||||
|
||||
: interactor-call ( quot interactor -- )
|
||||
dup interactor-busy? [
|
||||
2dup interactor-input.
|
||||
2dup interactor-continue
|
||||
] unless 2drop ;
|
||||
|
||||
M: interactor stream-read
|
||||
swap dup zero? [
|
||||
2drop ""
|
||||
] [
|
||||
[ interactor-read dup [ "\n" join ] when ] dip short head
|
||||
] if ;
|
||||
|
||||
M: interactor stream-read-partial
|
||||
stream-read ;
|
||||
|
||||
M: interactor stream-read1
|
||||
dup interactor-read {
|
||||
{ [ dup not ] [ 2drop f ] }
|
||||
{ [ dup empty? ] [ drop stream-read1 ] }
|
||||
{ [ dup first empty? ] [ 2drop CHAR: \n ] }
|
||||
[ nip first first ]
|
||||
} cond ;
|
||||
|
||||
M: interactor dispose drop ;
|
||||
|
||||
: go-to-error ( interactor error -- )
|
||||
[ line>> 1- ] [ column>> ] bi 2array
|
||||
over set-caret
|
||||
mark>caret ;
|
||||
|
||||
TUPLE: listener-gadget < track input output scroller popup ;
|
||||
|
||||
: find-listener ( gadget -- listener )
|
||||
[ listener-gadget? ] find-parent ;
|
||||
|
||||
: listener-streams ( listener -- input output )
|
||||
[ input>> ] [ output>> ] bi <pane-stream> ;
|
||||
|
|
@ -20,34 +160,68 @@ TUPLE: listener-gadget < track input output scroller ;
|
|||
: <listener-input> ( listener -- gadget )
|
||||
output>> <pane-stream> <interactor> ;
|
||||
|
||||
: welcome. ( -- )
|
||||
"If this is your first time with Factor, please read the " print
|
||||
"handbook" ($link) ". To see a list of keyboard shortcuts," print
|
||||
"press F1." print nl ;
|
||||
: init-listener ( listener -- listener )
|
||||
<scrolling-pane> >>output
|
||||
dup <listener-input> >>input ;
|
||||
|
||||
: <listener-scroller> ( listener -- scroller )
|
||||
<frame>
|
||||
over output>> @top grid-add
|
||||
swap input>> @center grid-add
|
||||
<scroller> ;
|
||||
|
||||
: <listener-gadget> ( -- gadget )
|
||||
{ 0 1 } listener-gadget new-track
|
||||
add-toolbar
|
||||
init-listener
|
||||
dup <listener-scroller> >>scroller
|
||||
dup scroller>> 1 track-add ;
|
||||
|
||||
M: listener-gadget focusable-child*
|
||||
input>> ;
|
||||
[ popup>> ] [ input>> ] bi or ;
|
||||
|
||||
: wait-for-listener ( listener -- )
|
||||
#! Wait for the listener to start.
|
||||
input>> flag>> wait-for-flag ;
|
||||
|
||||
: workspace-busy? ( workspace -- ? )
|
||||
listener>> input>> interactor-busy? ;
|
||||
: listener-busy? ( listener -- ? )
|
||||
input>> interactor-busy? ;
|
||||
|
||||
: listener-window* ( -- listener )
|
||||
<listener-gadget>
|
||||
dup "Listener" open-status-window ;
|
||||
|
||||
: listener-window ( -- )
|
||||
listener-window* drop ;
|
||||
|
||||
: (get-listener) ( quot -- listener )
|
||||
find-window
|
||||
[ gadget-child ] [ listener-window* ] if* ; inline
|
||||
|
||||
: get-listener ( -- listener )
|
||||
[ listener-gadget? ] (get-listener) ;
|
||||
|
||||
: get-ready-listener ( -- listener )
|
||||
[
|
||||
{
|
||||
[ listener-gadget? ]
|
||||
[ listener-busy? not ]
|
||||
} 1&&
|
||||
] (get-listener) ;
|
||||
|
||||
GENERIC: listener-input ( obj -- )
|
||||
|
||||
M: input listener-input string>> listener-input ;
|
||||
|
||||
M: string listener-input
|
||||
get-workspace listener>> input>>
|
||||
get-listener input>>
|
||||
[ set-editor-string ] [ request-focus ] bi ;
|
||||
|
||||
: (call-listener) ( quot listener -- )
|
||||
input>> interactor-call ;
|
||||
|
||||
: call-listener ( quot -- )
|
||||
[ workspace-busy? not ] get-workspace* listener>>
|
||||
get-ready-listener
|
||||
'[ _ _ dup wait-for-listener (call-listener) ]
|
||||
"Listener call" spawn drop ;
|
||||
|
||||
|
|
@ -58,8 +232,7 @@ M: listener-operation invoke-command ( target command -- )
|
|||
[ hook>> call ] keep operation-quot call-listener ;
|
||||
|
||||
: eval-listener ( string -- )
|
||||
get-workspace
|
||||
listener>> input>> [ set-editor-string ] keep
|
||||
get-listener input>> [ set-editor-string ] keep
|
||||
evaluate-input ;
|
||||
|
||||
: listener-run-files ( seq -- )
|
||||
|
|
@ -90,14 +263,14 @@ M: method-body word-completion-string method-completion-string ;
|
|||
M: engine-word word-completion-string method-completion-string ;
|
||||
|
||||
: use-if-necessary ( word seq -- )
|
||||
over vocabulary>> over and [
|
||||
2dup [ vocabulary>> ] dip and [
|
||||
2dup [ assoc-stack ] keep = [ 2drop ] [
|
||||
[ vocabulary>> vocab-words ] dip push
|
||||
] if
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: insert-word ( word -- )
|
||||
get-workspace listener>> input>>
|
||||
get-listener input>>
|
||||
[ [ word-completion-string ] dip user-input* drop ]
|
||||
[ interactor-use use-if-necessary ]
|
||||
2bi ;
|
||||
|
|
@ -108,13 +281,69 @@ M: engine-word word-completion-string method-completion-string ;
|
|||
[ select-all ]
|
||||
2bi ;
|
||||
|
||||
: ui-error-hook ( error listener -- )
|
||||
find-workspace debugger-popup ;
|
||||
: hide-popup ( listener -- )
|
||||
dup popup>> track-remove
|
||||
f >>popup
|
||||
request-focus ;
|
||||
|
||||
: show-popup ( gadget listener -- )
|
||||
dup hide-popup
|
||||
over >>popup
|
||||
over f track-add drop
|
||||
request-focus ;
|
||||
|
||||
: show-titled-popup ( listener gadget title -- )
|
||||
[ find-listener hide-popup ] <closable-gadget>
|
||||
swap show-popup ;
|
||||
|
||||
: debugger-popup ( error listener -- )
|
||||
swap dup compute-restarts
|
||||
[ find-listener hide-popup ] <debugger>
|
||||
"Error" show-titled-popup ;
|
||||
|
||||
: handle-parse-error ( interactor error -- )
|
||||
dup lexer-error? [ 2dup go-to-error error>> ] when
|
||||
swap find-listener debugger-popup ;
|
||||
|
||||
: try-parse ( lines interactor -- quot/error/f )
|
||||
[ drop parse-lines-interactive ] [
|
||||
2nip
|
||||
dup lexer-error? [
|
||||
dup error>> unexpected-eof? [ drop f ] when
|
||||
] when
|
||||
] recover ;
|
||||
|
||||
: handle-interactive ( lines interactor -- quot/f ? )
|
||||
tuck try-parse {
|
||||
{ [ dup quotation? ] [ nip t ] }
|
||||
{ [ dup not ] [ drop "\n" swap user-input* drop f f ] }
|
||||
[ handle-parse-error f f ]
|
||||
} cond ;
|
||||
|
||||
M: interactor stream-read-quot
|
||||
[ interactor-yield ] keep {
|
||||
{ [ over not ] [ drop ] }
|
||||
{ [ over callable? ] [ drop ] }
|
||||
[
|
||||
[ handle-interactive ] keep swap
|
||||
[ interactor-finish ] [ nip stream-read-quot ] if
|
||||
]
|
||||
} cond ;
|
||||
|
||||
interactor "interactor" f {
|
||||
{ T{ key-down f f "RET" } evaluate-input }
|
||||
{ T{ key-down f { C+ } "k" } clear-editor }
|
||||
} define-command-map
|
||||
|
||||
: welcome. ( -- )
|
||||
"If this is your first time with Factor, please read the " print
|
||||
"handbook" ($link) ". To see a list of keyboard shortcuts," print
|
||||
"press F1." print nl ;
|
||||
|
||||
: listener-thread ( listener -- )
|
||||
dup listener-streams [
|
||||
[ com-follow ] help-hook set
|
||||
'[ _ ui-error-hook ] error-hook set
|
||||
'[ _ debugger-popup ] error-hook set
|
||||
welcome.
|
||||
listener
|
||||
] with-streams* ;
|
||||
|
|
@ -137,23 +366,6 @@ M: engine-word word-completion-string method-completion-string ;
|
|||
[ wait-for-listener ]
|
||||
} cleave ;
|
||||
|
||||
: init-listener ( listener -- listener )
|
||||
<scrolling-pane> >>output
|
||||
dup <listener-input> >>input ;
|
||||
|
||||
: <listener-scroller> ( listener -- scroller )
|
||||
<frame>
|
||||
over output>> @top grid-add
|
||||
swap input>> @center grid-add
|
||||
<scroller> ;
|
||||
|
||||
: <listener-gadget> ( -- gadget )
|
||||
{ 0 1 } listener-gadget new-track
|
||||
add-toolbar
|
||||
init-listener
|
||||
dup <listener-scroller> >>scroller
|
||||
dup scroller>> 1 track-add ;
|
||||
|
||||
: listener-help ( -- ) "ui-listener" com-follow ;
|
||||
|
||||
\ listener-help H{ { +nullary+ t } } define-command
|
||||
|
|
@ -184,8 +396,23 @@ listener-gadget "scrolling"
|
|||
{ T{ key-down f { A+ } "PAGE_DOWN" } com-page-down }
|
||||
} define-command-map
|
||||
|
||||
\ refresh-all
|
||||
H{ { +nullary+ t } { +listener+ t } } define-command
|
||||
|
||||
listener-gadget "multi-touch" f {
|
||||
{ T{ up-action } refresh-all }
|
||||
} define-command-map
|
||||
|
||||
listener-gadget "workflow" f {
|
||||
{ T{ key-down f f "ESC" } hide-popup }
|
||||
{ T{ key-down f f "F2" } refresh-all }
|
||||
} define-command-map
|
||||
|
||||
M: listener-gadget graft*
|
||||
[ call-next-method ] [ restart-listener ] bi ;
|
||||
|
||||
M: listener-gadget ungraft*
|
||||
[ com-end ] [ call-next-method ] bi ;
|
||||
|
||||
M: listener-gadget pref-dim*
|
||||
drop { 550 700 } ;
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: continuations definitions ui.tools.browser
|
||||
ui.tools.interactor ui.tools.listener ui.tools.profiler
|
||||
ui.tools.listener ui.tools.profiler
|
||||
ui.tools.inspector ui.tools.search ui.tools.traceback
|
||||
ui.tools.workspace generic help.topics stack-checker
|
||||
generic help.topics stack-checker
|
||||
summary io.pathnames io.styles kernel namespaces parser
|
||||
prettyprint quotations tools.annotations editors
|
||||
tools.profiler tools.test tools.time tools.walker
|
||||
|
|
@ -90,12 +90,12 @@ UNION: definition word method-spec link vocab vocab-link ;
|
|||
{ +primary+ t }
|
||||
} define-operation
|
||||
|
||||
: com-usage ( word -- )
|
||||
get-workspace swap show-word-usage ;
|
||||
! : com-usage ( word -- )
|
||||
! get-workspace swap show-word-usage ;
|
||||
|
||||
[ word? ] \ com-usage H{
|
||||
{ +keyboard+ T{ key-down f { C+ } "U" } }
|
||||
} define-operation
|
||||
! [ word? ] \ com-usage H{
|
||||
! { +keyboard+ T{ key-down f { C+ } "U" } }
|
||||
! } define-operation
|
||||
|
||||
[ word? ] \ fix H{
|
||||
{ +keyboard+ T{ key-down f { C+ } "F" } }
|
||||
|
|
@ -117,13 +117,13 @@ M: word com-stack-effect def>> com-stack-effect ;
|
|||
} define-operation
|
||||
|
||||
! Vocabularies
|
||||
: com-vocab-words ( vocab -- )
|
||||
get-workspace swap show-vocab-words ;
|
||||
! : com-vocab-words ( vocab -- )
|
||||
! get-workspace swap show-vocab-words ;
|
||||
|
||||
[ vocab? ] \ com-vocab-words H{
|
||||
{ +secondary+ t }
|
||||
{ +keyboard+ T{ key-down f { C+ } "B" } }
|
||||
} define-operation
|
||||
! [ vocab? ] \ com-vocab-words H{
|
||||
! { +secondary+ t }
|
||||
! { +keyboard+ T{ key-down f { C+ } "B" } }
|
||||
! } define-operation
|
||||
|
||||
: com-enter-in ( vocab -- ) vocab-name set-in ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1,56 +0,0 @@
|
|||
USING: assocs ui.tools.search help.topics io.pathnames io.styles
|
||||
kernel namespaces sequences source-files threads
|
||||
tools.test ui.gadgets ui.gestures vocabs accessors
|
||||
vocabs.loader words tools.test.ui debugger calendar ;
|
||||
IN: ui.tools.search.tests
|
||||
|
||||
[ f ] [
|
||||
"no such word with this name exists, certainly"
|
||||
f f <definition-search>
|
||||
T{ key-down f { C+ } "x" } swap search-gesture
|
||||
] unit-test
|
||||
|
||||
: assert-non-empty ( obj -- ) empty? f assert= ;
|
||||
|
||||
: update-live-search ( search -- seq )
|
||||
dup [
|
||||
300 milliseconds sleep
|
||||
list>> control-value
|
||||
] with-grafted-gadget ;
|
||||
|
||||
: test-live-search ( gadget quot -- ? )
|
||||
[ update-live-search dup assert-non-empty ] dip all? ;
|
||||
|
||||
[ t ] [
|
||||
"swp" all-words f <definition-search>
|
||||
[ word? ] test-live-search
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"" all-words t <definition-search>
|
||||
dup [
|
||||
{ "set-word-prop" } over field>> set-control-value
|
||||
300 milliseconds sleep
|
||||
search-value \ set-word-prop eq?
|
||||
] with-grafted-gadget
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"quot" <help-search>
|
||||
[ link? ] test-live-search
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"factor" source-files get keys <source-file-search>
|
||||
[ pathname? ] test-live-search
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"kern" <vocab-search>
|
||||
[ vocab-spec? ] test-live-search
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
"a" { "a" "b" "aa" } <history-search>
|
||||
[ input? ] test-live-search
|
||||
] unit-test
|
||||
|
|
@ -1,160 +0,0 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs help help.topics io.pathnames io.styles
|
||||
kernel models models.delay models.filter namespaces prettyprint
|
||||
quotations sequences sorting source-files definitions strings
|
||||
tools.completion tools.apropos tools.crossref classes.tuple
|
||||
vocabs words vocabs.loader tools.vocabs unicode.case calendar
|
||||
locals fry ui.tools.interactor ui.tools.listener
|
||||
ui.tools.workspace ui.commands ui.gadgets ui.gadgets.editors
|
||||
ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
|
||||
ui.gadgets.borders ui.gestures ui.operations ui ;
|
||||
IN: ui.tools.search
|
||||
|
||||
TUPLE: live-search < track field list ;
|
||||
|
||||
: search-value ( live-search -- value )
|
||||
list>> list-value ;
|
||||
|
||||
: search-gesture ( gesture live-search -- operation/f )
|
||||
search-value object-operations
|
||||
[ operation-gesture = ] with find nip ;
|
||||
|
||||
M: live-search handle-gesture ( gesture live-search -- ? )
|
||||
tuck search-gesture dup [
|
||||
over find-workspace hide-popup
|
||||
[ search-value ] dip invoke-command f
|
||||
] [
|
||||
2drop t
|
||||
] if ;
|
||||
|
||||
: find-live-search ( gadget -- search )
|
||||
[ live-search? ] find-parent ;
|
||||
|
||||
: find-search-list ( gadget -- list )
|
||||
find-live-search list>> ;
|
||||
|
||||
TUPLE: search-field < editor ;
|
||||
|
||||
: <search-field> ( -- gadget )
|
||||
search-field new-editor ;
|
||||
|
||||
search-field H{
|
||||
{ T{ key-down f f "UP" } [ find-search-list select-previous ] }
|
||||
{ T{ key-down f f "DOWN" } [ find-search-list select-next ] }
|
||||
{ T{ key-down f f "PAGE_UP" } [ find-search-list list-page-up ] }
|
||||
{ T{ key-down f f "PAGE_DOWN" } [ find-search-list list-page-down ] }
|
||||
{ T{ key-down f f "RET" } [ find-search-list invoke-value-action ] }
|
||||
} set-gestures
|
||||
|
||||
: <search-model> ( live-search producer -- filter )
|
||||
[
|
||||
field>> model>>
|
||||
ui-running? [ 1/5 seconds <delay> ] when
|
||||
] dip [ "\n" join ] prepend <filter> ;
|
||||
|
||||
: init-search-model ( live-search seq limited? -- live-search )
|
||||
[ 2drop ]
|
||||
[
|
||||
[ limited-completions ] [ completions ] ?
|
||||
'[ _ @ [ first ] map ] <search-model>
|
||||
] 3bi
|
||||
>>model ; inline
|
||||
|
||||
: <search-list> ( presenter live-search -- list )
|
||||
[ [ find-workspace hide-popup ] ] [ ] [ model>> ] tri* <list> ;
|
||||
|
||||
:: <live-search> ( string seq limited? presenter -- gadget )
|
||||
{ 0 1 } live-search new-track
|
||||
<search-field> >>field
|
||||
seq limited? init-search-model
|
||||
presenter over <search-list> >>list
|
||||
dup field>> 1 <border> { 1 1 } >>fill f track-add
|
||||
dup list>> <scroller> 1 track-add
|
||||
string over field>> set-editor-string
|
||||
dup field>> end-of-document ;
|
||||
|
||||
M: live-search focusable-child* field>> ;
|
||||
|
||||
M: live-search pref-dim* drop { 400 200 } ;
|
||||
|
||||
: current-word ( workspace -- string )
|
||||
listener>> input>> selected-word ;
|
||||
|
||||
: definition-candidates ( words -- candidates )
|
||||
[ dup synopsis >lower ] { } map>assoc sort-values ;
|
||||
|
||||
: <definition-search> ( string words limited? -- gadget )
|
||||
[ definition-candidates ] dip [ synopsis ] <live-search> ;
|
||||
|
||||
: <word-search> ( string words limited? -- gadget )
|
||||
[ word-candidates ] dip [ synopsis ] <live-search> ;
|
||||
|
||||
: com-words ( workspace -- )
|
||||
dup current-word all-words t <word-search>
|
||||
"Word search" show-titled-popup ;
|
||||
|
||||
: show-vocab-words ( workspace vocab -- )
|
||||
[ "" swap words natural-sort f <word-search> ]
|
||||
[ "Words in " swap vocab-name append ]
|
||||
bi show-titled-popup ;
|
||||
|
||||
: show-word-usage ( workspace word -- )
|
||||
[ "" swap smart-usage f <definition-search> ]
|
||||
[ "Words and methods using " swap name>> append ]
|
||||
bi show-titled-popup ;
|
||||
|
||||
: <help-search> ( string -- gadget )
|
||||
all-articles help-candidates
|
||||
f [ article-title ] <live-search> ;
|
||||
|
||||
: com-search ( workspace -- )
|
||||
"" <help-search> "Help search" show-titled-popup ;
|
||||
|
||||
: source-file-candidates ( seq -- candidates )
|
||||
[ dup <pathname> swap >lower ] { } map>assoc ;
|
||||
|
||||
: <source-file-search> ( string files -- gadget )
|
||||
source-file-candidates
|
||||
f [ string>> ] <live-search> ;
|
||||
|
||||
: all-source-files ( -- seq )
|
||||
source-files get keys natural-sort ;
|
||||
|
||||
: com-sources ( workspace -- )
|
||||
"" all-source-files <source-file-search>
|
||||
"Source file search" show-titled-popup ;
|
||||
|
||||
: show-vocab-files ( workspace vocab -- )
|
||||
[ "" swap vocab-files <source-file-search> ]
|
||||
[ "Source files in " swap vocab-name append ]
|
||||
bi show-titled-popup ;
|
||||
|
||||
: <vocab-search> ( string -- gadget )
|
||||
vocab-candidates f [ vocab-name ] <live-search> ;
|
||||
|
||||
: com-vocabs ( workspace -- )
|
||||
dup current-word <vocab-search>
|
||||
"Vocabulary search" show-titled-popup ;
|
||||
|
||||
: history-candidates ( seq -- candidates )
|
||||
[ [ <input> ] [ >lower ] bi ] { } map>assoc ;
|
||||
|
||||
: <history-search> ( string seq -- gadget )
|
||||
history-candidates
|
||||
f [ string>> ] <live-search> ;
|
||||
|
||||
: listener-history ( listener -- seq )
|
||||
input>> history>> <reversed> ;
|
||||
|
||||
: com-history ( workspace -- )
|
||||
"" over listener>> listener-history <history-search>
|
||||
"History search" show-titled-popup ;
|
||||
|
||||
workspace "toolbar" f {
|
||||
{ T{ key-down f { C+ } "p" } com-history }
|
||||
{ T{ key-down f f "TAB" } com-words }
|
||||
{ T{ key-down f { C+ } "u" } com-vocabs }
|
||||
{ T{ key-down f { C+ } "e" } com-sources }
|
||||
{ T{ key-down f { C+ } "h" } com-search }
|
||||
} define-command-map
|
||||
|
|
@ -1 +0,0 @@
|
|||
Support for graphical completion popups
|
||||
|
|
@ -2,9 +2,9 @@ USING: editors help.markup help.syntax summary inspector io
|
|||
io.styles listener parser prettyprint tools.profiler
|
||||
tools.walker ui.commands ui.gadgets.editors ui.gadgets.panes
|
||||
ui.gadgets.presentations ui.gadgets.slots ui.operations
|
||||
ui.tools.browser ui.tools.interactor ui.tools.inspector
|
||||
ui.tools.browser ui.tools.inspector
|
||||
ui.tools.listener ui.tools.operations ui.tools.profiler
|
||||
ui.tools.walker ui.tools.workspace vocabs ;
|
||||
ui.tools.walker vocabs ;
|
||||
IN: ui.tools
|
||||
|
||||
ARTICLE: "ui-presentations" "Presentations in the UI"
|
||||
|
|
@ -39,49 +39,15 @@ $nl
|
|||
|
||||
;
|
||||
|
||||
ARTICLE: "ui-completion-words" "Word completion popup"
|
||||
"Clicking a word in the word completion popup displays the word definition in the " { $link "ui-browser" } ". Pressing " { $snippet "RET" } " with a word selected inserts the word name in the listener, along with a " { $link POSTPONE: USE: } " declaration (if necessary)."
|
||||
{ $operations \ $operations } ;
|
||||
|
||||
ARTICLE: "ui-completion-vocabs" "Vocabulary completion popup"
|
||||
"Clicking a vocabulary in the vocabulary completion popup displays a list of words in the vocabulary in another " { $link "ui-completion-words" } ". Pressing " { $snippet "RET" } " adds the vocabulary to the current search path, just as if you invoked " { $link POSTPONE: USE: } "."
|
||||
{ $operations "kernel" vocab } ;
|
||||
|
||||
ARTICLE: "ui-completion-sources" "Source file completion popup"
|
||||
"The source file completion popup lists all source files which have been previously loaded by " { $link run-file } ". Clicking a source file or pressing " { $snippet "RET" } " opens the source file in your editor with " { $link edit } "."
|
||||
{ $operations P" " } ;
|
||||
|
||||
ARTICLE: "ui-completion" "UI completion popups"
|
||||
"Completion popups allow fast access to aspects of the environment. Completion popups can be invoked by clicking the row of buttons along the bottom of the workspace, or via keyboard commands:"
|
||||
{ $command-map workspace "toolbar" }
|
||||
"A completion popup instantly updates the list of completions as keys are typed. The list of completions can be navigated from the keyboard with the " { $snippet "UP" } " and " { $snippet "DOWN" } " arrow keys. Every completion has a " { $emphasis "primary action" } " and " { $emphasis "secondary action" } ". The primary action is invoked when clicking a completion, and the secondary action is invoked on the currently-selected completion when pressing " { $snippet "RET" } "."
|
||||
$nl
|
||||
"The primary and secondary actions, along with additional keyboard shortcuts, are documented for some completion popups in the below sections."
|
||||
{ $subsection "ui-completion-words" }
|
||||
{ $subsection "ui-completion-vocabs" }
|
||||
{ $subsection "ui-completion-sources" } ;
|
||||
|
||||
ARTICLE: "ui-workspace-keys" "UI keyboard shortcuts"
|
||||
"See " { $link "gesture-differences" } " to find out how your platform's modifier keys map to modifiers in the Factor UI."
|
||||
{ $command-map workspace "tool-switching" }
|
||||
{ $command-map workspace "scrolling" }
|
||||
{ $command-map workspace "workflow" }
|
||||
{ $command-map workspace "multi-touch" } ;
|
||||
|
||||
ARTICLE: "ui-tools" "UI developer tools"
|
||||
"The Factor development environment can seem rather different from what you are used to, because it is very simple and powerful.."
|
||||
$nl
|
||||
"To take full advantage of the UI, you should be using a supported text editor. See " { $link "editor" } "."
|
||||
{ $subsection "ui-workspace-keys" }
|
||||
{ $subsection "ui-presentations" }
|
||||
{ $subsection "ui-completion" }
|
||||
{ $heading "Tools" }
|
||||
"A single-window " { $emphasis "workspace" } " contains the most frequently-used tools:"
|
||||
{ $subsection "ui-listener" }
|
||||
{ $subsection "ui-browser" }
|
||||
{ $subsection "ui-inspector" }
|
||||
{ $subsection "ui-profiler" }
|
||||
"Additional tools:"
|
||||
{ $subsection "ui-walker" }
|
||||
{ $subsection "ui.tools.deploy" }
|
||||
"Platform-specific features:"
|
||||
|
|
|
|||
|
|
@ -1,8 +1,9 @@
|
|||
USING: ui.tools ui.tools.interactor ui.tools.listener
|
||||
ui.tools.search ui.tools.workspace kernel models namespaces
|
||||
ui.tools.search kernel models namespaces
|
||||
sequences tools.test ui.gadgets ui.gadgets.buttons
|
||||
ui.gadgets.labelled ui.gadgets.presentations
|
||||
ui.gadgets.menus ui.gadgets.scrollers vocabs tools.test.ui ui accessors ;
|
||||
ui.gadgets.menus ui.gadgets.scrollers vocabs
|
||||
tools.test.ui ui accessors ;
|
||||
IN: ui.tools.tests
|
||||
|
||||
[ f ]
|
||||
|
|
|
|||
|
|
@ -1,49 +1,6 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs debugger ui.tools.workspace
|
||||
ui.tools.operations ui.tools.traceback ui.tools.browser
|
||||
ui.tools.inspector ui.tools.listener
|
||||
ui.tools.operations ui ui.commands ui.gadgets
|
||||
ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
|
||||
ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
|
||||
ui.gadgets.presentations ui.gestures words vocabs.loader
|
||||
tools.test tools.vocabs ui.gadgets.buttons ui.gadgets.status-bar
|
||||
mirrors fry inspector io kernel math models namespaces
|
||||
prettyprint quotations sequences ;
|
||||
USING: ui.tools.operations ui.tools.listener ui namespaces ;
|
||||
IN: ui.tools
|
||||
|
||||
: <workspace> ( -- workspace )
|
||||
{ 0 1 } workspace new-track
|
||||
<listener-gadget> >>listener
|
||||
dup listener>> 1 track-add
|
||||
add-toolbar ;
|
||||
|
||||
[ workspace-window ] ui-hook set-global
|
||||
|
||||
workspace "multi-touch" f {
|
||||
{ T{ up-action } refresh-all }
|
||||
} define-command-map
|
||||
|
||||
\ workspace-window
|
||||
H{ { +nullary+ t } } define-command
|
||||
|
||||
\ refresh-all
|
||||
H{ { +nullary+ t } { +listener+ t } } define-command
|
||||
|
||||
workspace "workflow" f {
|
||||
{ T{ key-down f { C+ } "n" } workspace-window }
|
||||
{ T{ key-down f f "ESC" } hide-popup }
|
||||
{ T{ key-down f f "F2" } refresh-all }
|
||||
} define-command-map
|
||||
|
||||
[
|
||||
<workspace> dup "Factor workspace" open-status-window
|
||||
] workspace-window-hook set-global
|
||||
|
||||
: inspect-continuation ( traceback -- )
|
||||
control-value '[ _ inspect ] call-listener ;
|
||||
|
||||
traceback-gadget "toolbar" f {
|
||||
{ T{ key-down f f "v" } variables }
|
||||
{ T{ key-down f f "n" } inspect-continuation }
|
||||
} define-command-map
|
||||
[ listener-window ] ui-hook set-global
|
||||
|
|
@ -1,11 +1,10 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors continuations kernel models namespaces
|
||||
prettyprint ui ui.commands ui.gadgets ui.gadgets.labelled assocs
|
||||
ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
|
||||
ui.gadgets.status-bar ui.gadgets.scrollers ui.gestures sequences
|
||||
hashtables inspector ;
|
||||
|
||||
prettyprint ui ui.commands ui.gadgets ui.gadgets.labelled assocs
|
||||
ui.gadgets.tracks ui.gadgets.buttons ui.gadgets.panes
|
||||
ui.gadgets.status-bar ui.gadgets.scrollers ui.tools.inspector
|
||||
ui.gestures sequences hashtables inspector ;
|
||||
IN: ui.tools.traceback
|
||||
|
||||
: <callstack-display> ( model -- gadget )
|
||||
|
|
@ -54,3 +53,11 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
|
|||
|
||||
: traceback-window ( continuation -- )
|
||||
<model> <traceback-gadget> "Traceback" open-status-window ;
|
||||
|
||||
: inspect-continuation ( traceback -- )
|
||||
control-value inspector ;
|
||||
|
||||
traceback-gadget "toolbar" f {
|
||||
{ T{ key-down f f "v" } variables }
|
||||
{ T{ key-down f f "n" } inspect-continuation }
|
||||
} define-command-map
|
||||
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
||||
|
|
@ -1 +0,0 @@
|
|||
Graphical development environment
|
||||
|
|
@ -1 +0,0 @@
|
|||
tools
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
IN: ui.tools.workspace.tests
|
||||
USING: tools.test ui.tools ;
|
||||
|
||||
\ <workspace> must-infer
|
||||
|
|
@ -1,58 +0,0 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: classes continuations help help.topics kernel models
|
||||
sequences assocs arrays namespaces accessors math.vectors fry ui
|
||||
ui.backend ui.tools.debugger ui.gadgets ui.gadgets.books
|
||||
ui.gadgets.buttons ui.gadgets.labelled ui.gadgets.panes
|
||||
ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
|
||||
ui.gadgets.presentations ui.gadgets.status-bar ui.commands
|
||||
ui.gestures ;
|
||||
IN: ui.tools.workspace
|
||||
|
||||
TUPLE: workspace < track listener popup ;
|
||||
|
||||
: find-workspace ( gadget -- workspace ) [ workspace? ] find-parent ;
|
||||
|
||||
SYMBOL: workspace-window-hook
|
||||
|
||||
: workspace-window* ( -- workspace ) workspace-window-hook get call ;
|
||||
|
||||
: workspace-window ( -- ) workspace-window* drop ;
|
||||
|
||||
: get-workspace* ( quot -- workspace )
|
||||
'[ dup workspace? _ [ drop f ] if ] find-window
|
||||
[ dup raise-window gadget-child ]
|
||||
[ workspace-window* ] if* ; inline
|
||||
|
||||
: get-workspace ( -- workspace ) [ drop t ] get-workspace* ;
|
||||
|
||||
: hide-popup ( workspace -- )
|
||||
dup popup>> track-remove
|
||||
f >>popup
|
||||
request-focus ;
|
||||
|
||||
: show-popup ( gadget workspace -- )
|
||||
dup hide-popup
|
||||
over >>popup
|
||||
over f track-add drop
|
||||
request-focus ;
|
||||
|
||||
: show-titled-popup ( workspace gadget title -- )
|
||||
[ find-workspace hide-popup ] <closable-gadget>
|
||||
swap show-popup ;
|
||||
|
||||
: debugger-popup ( error workspace -- )
|
||||
swap dup compute-restarts
|
||||
[ find-workspace hide-popup ] <debugger>
|
||||
"Error" show-titled-popup ;
|
||||
|
||||
SYMBOL: workspace-dim
|
||||
|
||||
{ 600 700 } workspace-dim set-global
|
||||
|
||||
M: workspace pref-dim* call-next-method workspace-dim get vmax ;
|
||||
|
||||
M: workspace focusable-child*
|
||||
[ popup>> ] [ listener>> ] bi or ;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue