From d7358b5ef3ef78e5aca693955e3b1452cfd4a994 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 7 Jan 2009 15:06:43 -0600 Subject: [PATCH] Removing last remnants of 'workspace' tool --- basis/ui/tools/browser/browser.factor | 12 +- basis/ui/tools/inspector/inspector.factor | 9 +- basis/ui/tools/interactor/authors.txt | 1 - .../tools/interactor/interactor-docs.factor | 10 - .../tools/interactor/interactor-tests.factor | 87 ----- basis/ui/tools/interactor/interactor.factor | 181 ---------- basis/ui/tools/interactor/summary.txt | 1 - basis/ui/tools/listener/listener-docs.factor | 11 +- basis/ui/tools/listener/listener-tests.factor | 85 ++++- basis/ui/tools/listener/listener.factor | 313 +++++++++++++++--- basis/ui/tools/operations/operations.factor | 26 +- basis/ui/tools/search/authors.txt | 1 - basis/ui/tools/search/search-tests.factor | 56 ---- basis/ui/tools/search/search.factor | 160 --------- basis/ui/tools/search/summary.txt | 1 - basis/ui/tools/tools-docs.factor | 38 +-- basis/ui/tools/tools-tests.factor | 5 +- basis/ui/tools/tools.factor | 47 +-- basis/ui/tools/traceback/traceback.factor | 19 +- basis/ui/tools/workspace/authors.txt | 1 - basis/ui/tools/workspace/summary.txt | 1 - basis/ui/tools/workspace/tags.txt | 1 - .../ui/tools/workspace/workspace-tests.factor | 4 - basis/ui/tools/workspace/workspace.factor | 58 ---- 24 files changed, 410 insertions(+), 718 deletions(-) delete mode 100644 basis/ui/tools/interactor/authors.txt delete mode 100644 basis/ui/tools/interactor/interactor-docs.factor delete mode 100644 basis/ui/tools/interactor/interactor-tests.factor delete mode 100644 basis/ui/tools/interactor/interactor.factor delete mode 100644 basis/ui/tools/interactor/summary.txt delete mode 100644 basis/ui/tools/search/authors.txt delete mode 100644 basis/ui/tools/search/search-tests.factor delete mode 100644 basis/ui/tools/search/search.factor delete mode 100644 basis/ui/tools/search/summary.txt delete mode 100644 basis/ui/tools/workspace/authors.txt delete mode 100644 basis/ui/tools/workspace/summary.txt delete mode 100644 basis/ui/tools/workspace/tags.txt delete mode 100644 basis/ui/tools/workspace/workspace-tests.factor delete mode 100644 basis/ui/tools/workspace/workspace.factor diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index 1f82b7fc26..8a0cdb0c4a 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -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" 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 \ No newline at end of file +} define-command-map + +: browser-window ( -- ) + [ "handbook" com-follow ] with-ui ; + +MAIN: browser-window \ No newline at end of file diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor index 9dbde4209c..a41001a46a 100644 --- a/basis/ui/tools/inspector/inspector.factor +++ b/basis/ui/tools/inspector/inspector.factor @@ -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 [ ] { } assoc>map ; +M: hashtable make-slot-descriptions + call-next-method [ [ key-string>> ] compare ] sort ; + : ( model -- table ) [ make-slot-descriptions ] [ inspector ] >>action diff --git a/basis/ui/tools/interactor/authors.txt b/basis/ui/tools/interactor/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/basis/ui/tools/interactor/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/ui/tools/interactor/interactor-docs.factor b/basis/ui/tools/interactor/interactor-docs.factor deleted file mode 100644 index 338a9be85e..0000000000 --- a/basis/ui/tools/interactor/interactor-docs.factor +++ /dev/null @@ -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 } "." -$nl -"Interactors implement the " { $link stream-readln } ", " { $link stream-read } " and " { $link read-quot } " generic words." } ; diff --git a/basis/ui/tools/interactor/interactor-tests.factor b/basis/ui/tools/interactor/interactor-tests.factor deleted file mode 100644 index 628570c3e3..0000000000 --- a/basis/ui/tools/interactor/interactor-tests.factor +++ /dev/null @@ -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 ; - -\ must-infer - -[ - [ ] [ "interactor" set ] unit-test - - [ ] [ "interactor" get register-self ] unit-test - - [ ] [ "[ 1 2 3" "interactor" get set-editor-string ] unit-test - - [ ] [ "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 -[ ] [ "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 - -[ ] [ "interactor" set ] unit-test - -: text "Hello world.\nThis is a test." ; - -[ ] [ text "interactor" get set-editor-string ] unit-test - -[ ] [ "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 - -[ ] [ "interactor" set ] unit-test - -[ ] [ text "interactor" get set-editor-string ] unit-test - -[ ] [ "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 diff --git a/basis/ui/tools/interactor/interactor.factor b/basis/ui/tools/interactor/interactor.factor deleted file mode 100644 index 85d270a0e1..0000000000 --- a/basis/ui/tools/interactor/interactor.factor +++ /dev/null @@ -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 - 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 ; - -: ( interactor -- model ) caret>> 1/3 seconds ; - -: ( output -- gadget ) - interactor new-editor - V{ } clone >>history - >>flag - dup >>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 -- ) - 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 diff --git a/basis/ui/tools/interactor/summary.txt b/basis/ui/tools/interactor/summary.txt deleted file mode 100644 index 6929b200a9..0000000000 --- a/basis/ui/tools/interactor/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Interactors are used to input Factor code diff --git a/basis/ui/tools/listener/listener-docs.factor b/basis/ui/tools/listener/listener-docs.factor index c7f8cfe99d..380f599227 100644 --- a/basis/ui/tools/listener/listener-docs.factor +++ b/basis/ui/tools/listener/listener-docs.factor @@ -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 } "." +$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 diff --git a/basis/ui/tools/listener/listener-tests.factor b/basis/ui/tools/listener/listener-tests.factor index 28fdef6cb7..f912952893 100644 --- a/basis/ui/tools/listener/listener-tests.factor +++ b/basis/ui/tools/listener/listener-tests.factor @@ -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 +\ must-infer + +[ + [ ] [ "interactor" set ] unit-test + + [ ] [ "interactor" get register-self ] unit-test + + [ ] [ "[ 1 2 3" "interactor" get set-editor-string ] unit-test + + [ ] [ "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 +[ ] [ "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 + +[ ] [ "interactor" set ] unit-test + +: text "Hello world.\nThis is a test." ; + +[ ] [ text "interactor" get set-editor-string ] unit-test + +[ ] [ "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 + +[ ] [ "interactor" set ] unit-test + +[ ] [ text "interactor" get set-editor-string ] unit-test + +[ ] [ "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 [ ] [ [ ] with-grafted-gadget ] unit-test diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor index f1b04e1000..ae294869f2 100644 --- a/basis/ui/tools/listener/listener.factor +++ b/basis/ui/tools/listener/listener.factor @@ -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 + 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 ; + +: ( interactor -- model ) caret>> 1/3 seconds ; + +: ( output -- gadget ) + interactor new-editor + V{ } clone >>history + >>flag + dup >>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 -- ) + 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 ; @@ -20,34 +160,68 @@ TUPLE: listener-gadget < track input output scroller ; : ( listener -- gadget ) output>> ; -: 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 ) + >>output + dup >>input ; + +: ( listener -- scroller ) + + over output>> @top grid-add + swap input>> @center grid-add + ; + +: ( -- gadget ) + { 0 1 } listener-gadget new-track + add-toolbar + init-listener + dup >>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 ) + + 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 ] + swap show-popup ; + +: debugger-popup ( error listener -- ) + swap dup compute-restarts + [ find-listener hide-popup ] + "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 ) - >>output - dup >>input ; - -: ( listener -- scroller ) - - over output>> @top grid-add - swap input>> @center grid-add - ; - -: ( -- gadget ) - { 0 1 } listener-gadget new-track - add-toolbar - init-listener - dup >>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 } ; \ No newline at end of file diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor index 2d471cdd4c..e50bd0052a 100644 --- a/basis/ui/tools/operations/operations.factor +++ b/basis/ui/tools/operations/operations.factor @@ -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 ; diff --git a/basis/ui/tools/search/authors.txt b/basis/ui/tools/search/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/basis/ui/tools/search/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/ui/tools/search/search-tests.factor b/basis/ui/tools/search/search-tests.factor deleted file mode 100644 index 4f239ba6e9..0000000000 --- a/basis/ui/tools/search/search-tests.factor +++ /dev/null @@ -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 - 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 - [ word? ] test-live-search -] unit-test - -[ t ] [ - "" all-words t - 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" - [ link? ] test-live-search -] unit-test - -[ t ] [ - "factor" source-files get keys - [ pathname? ] test-live-search -] unit-test - -[ t ] [ - "kern" - [ vocab-spec? ] test-live-search -] unit-test - -[ t ] [ - "a" { "a" "b" "aa" } - [ input? ] test-live-search -] unit-test diff --git a/basis/ui/tools/search/search.factor b/basis/ui/tools/search/search.factor deleted file mode 100644 index a8f70cf76d..0000000000 --- a/basis/ui/tools/search/search.factor +++ /dev/null @@ -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 ; - -: ( -- 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 - -: ( live-search producer -- filter ) - [ - field>> model>> - ui-running? [ 1/5 seconds ] when - ] dip [ "\n" join ] prepend ; - -: init-search-model ( live-search seq limited? -- live-search ) - [ 2drop ] - [ - [ limited-completions ] [ completions ] ? - '[ _ @ [ first ] map ] - ] 3bi - >>model ; inline - -: ( presenter live-search -- list ) - [ [ find-workspace hide-popup ] ] [ ] [ model>> ] tri* ; - -:: ( string seq limited? presenter -- gadget ) - { 0 1 } live-search new-track - >>field - seq limited? init-search-model - presenter over >>list - dup field>> 1 { 1 1 } >>fill f track-add - dup list>> 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 ; - -: ( string words limited? -- gadget ) - [ definition-candidates ] dip [ synopsis ] ; - -: ( string words limited? -- gadget ) - [ word-candidates ] dip [ synopsis ] ; - -: com-words ( workspace -- ) - dup current-word all-words t - "Word search" show-titled-popup ; - -: show-vocab-words ( workspace vocab -- ) - [ "" swap words natural-sort f ] - [ "Words in " swap vocab-name append ] - bi show-titled-popup ; - -: show-word-usage ( workspace word -- ) - [ "" swap smart-usage f ] - [ "Words and methods using " swap name>> append ] - bi show-titled-popup ; - -: ( string -- gadget ) - all-articles help-candidates - f [ article-title ] ; - -: com-search ( workspace -- ) - "" "Help search" show-titled-popup ; - -: source-file-candidates ( seq -- candidates ) - [ dup swap >lower ] { } map>assoc ; - -: ( string files -- gadget ) - source-file-candidates - f [ string>> ] ; - -: all-source-files ( -- seq ) - source-files get keys natural-sort ; - -: com-sources ( workspace -- ) - "" all-source-files - "Source file search" show-titled-popup ; - -: show-vocab-files ( workspace vocab -- ) - [ "" swap vocab-files ] - [ "Source files in " swap vocab-name append ] - bi show-titled-popup ; - -: ( string -- gadget ) - vocab-candidates f [ vocab-name ] ; - -: com-vocabs ( workspace -- ) - dup current-word - "Vocabulary search" show-titled-popup ; - -: history-candidates ( seq -- candidates ) - [ [ ] [ >lower ] bi ] { } map>assoc ; - -: ( string seq -- gadget ) - history-candidates - f [ string>> ] ; - -: listener-history ( listener -- seq ) - input>> history>> ; - -: com-history ( workspace -- ) - "" over listener>> listener-history - "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 diff --git a/basis/ui/tools/search/summary.txt b/basis/ui/tools/search/summary.txt deleted file mode 100644 index af5dcefcd4..0000000000 --- a/basis/ui/tools/search/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Support for graphical completion popups diff --git a/basis/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor index 1b74112bab..b224871c4c 100644 --- a/basis/ui/tools/tools-docs.factor +++ b/basis/ui/tools/tools-docs.factor @@ -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:" diff --git a/basis/ui/tools/tools-tests.factor b/basis/ui/tools/tools-tests.factor index 5ce9e4c4a2..3362bb7f5e 100644 --- a/basis/ui/tools/tools-tests.factor +++ b/basis/ui/tools/tools-tests.factor @@ -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 ] diff --git a/basis/ui/tools/tools.factor b/basis/ui/tools/tools.factor index 480f38c466..ffa5635856 100644 --- a/basis/ui/tools/tools.factor +++ b/basis/ui/tools/tools.factor @@ -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 ) - { 0 1 } workspace new-track - >>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 - -[ - 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 \ No newline at end of file diff --git a/basis/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor index 90f1e601c7..e98787e101 100644 --- a/basis/ui/tools/traceback/traceback.factor +++ b/basis/ui/tools/traceback/traceback.factor @@ -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 : ( model -- gadget ) @@ -54,3 +53,11 @@ M: traceback-gadget pref-dim* drop { 550 600 } ; : traceback-window ( continuation -- ) "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 \ No newline at end of file diff --git a/basis/ui/tools/workspace/authors.txt b/basis/ui/tools/workspace/authors.txt deleted file mode 100644 index 1901f27a24..0000000000 --- a/basis/ui/tools/workspace/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/basis/ui/tools/workspace/summary.txt b/basis/ui/tools/workspace/summary.txt deleted file mode 100644 index f7e3245adb..0000000000 --- a/basis/ui/tools/workspace/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Graphical development environment diff --git a/basis/ui/tools/workspace/tags.txt b/basis/ui/tools/workspace/tags.txt deleted file mode 100644 index ef1aab0d0e..0000000000 --- a/basis/ui/tools/workspace/tags.txt +++ /dev/null @@ -1 +0,0 @@ -tools diff --git a/basis/ui/tools/workspace/workspace-tests.factor b/basis/ui/tools/workspace/workspace-tests.factor deleted file mode 100644 index 49b14cda77..0000000000 --- a/basis/ui/tools/workspace/workspace-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -IN: ui.tools.workspace.tests -USING: tools.test ui.tools ; - -\ must-infer diff --git a/basis/ui/tools/workspace/workspace.factor b/basis/ui/tools/workspace/workspace.factor deleted file mode 100644 index a4d175e451..0000000000 --- a/basis/ui/tools/workspace/workspace.factor +++ /dev/null @@ -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 ] - swap show-popup ; - -: debugger-popup ( error workspace -- ) - swap dup compute-restarts - [ find-workspace hide-popup ] - "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 ; - -