diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor index 56bc3364ac..656826344c 100755 --- a/basis/ui/backend/x11/x11.factor +++ b/basis/ui/backend/x11/x11.factor @@ -107,9 +107,9 @@ CONSTANT: key-codes : valid-input? ( string gesture -- ? ) over empty? [ 2drop f ] [ mods>> { f { S+ } } member? [ - [ [ 127 = not ] [ CHAR: \s >= ] bi and ] all? + [ { [ 127 = not ] [ CHAR: \s >= ] } 1&& ] all? ] [ - [ [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] tri and and ] all? + [ { [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] } 1&& ] all? ] if ] if ; diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index dee5d7425a..d5e8dff3b1 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -1,12 +1,13 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays kernel math models namespaces sequences -strings quotations assocs combinators classes colors colors.constants -classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets -ui.gadgets.borders ui.gadgets.labels ui.gadgets.tracks -ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.pens ui.pens.solid -ui.pens.image ui.pens.tile math.rectangles locals fry -combinators.smart ; +USING: accessors arrays assocs classes classes.tuple colors +colors.constants combinators combinators.short-circuit +combinators.smart fry kernel locals math math.rectangles +math.vectors models namespaces opengl opengl.gl quotations +sequences strings ui.commands ui.gadgets ui.gadgets.borders +ui.gadgets.labels ui.gadgets.packs ui.gadgets.tracks +ui.gadgets.worlds ui.gestures ui.pens ui.pens.image +ui.pens.solid ui.pens.tile ; FROM: models => change-model ; IN: ui.gadgets.buttons @@ -30,7 +31,7 @@ PRIVATE> : button-update ( button -- ) dup - [ mouse-clicked? ] [ button-rollover? ] bi and + { [ mouse-clicked? ] [ button-rollover? ] } 1&& buttons-down? and >>pressed? relayout-1 ; @@ -42,8 +43,9 @@ PRIVATE> dup "" swap show-status button-update ; : button-clicked ( button -- ) - dup button-update - dup button-rollover? + [ ] + [ button-update ] + [ button-rollover? ] tri [ dup quot>> call( button -- ) ] [ drop ] if ; button H{ @@ -67,7 +69,9 @@ C: button-pen : button-pen ( button pen -- button pen ) over find-button { - { [ dup [ pressed?>> ] [ selected?>> ] bi and ] [ drop pressed-selected>> ] } + { [ dup { [ pressed?>> ] [ selected?>> ] } 1&& ] + [ drop pressed-selected>> + ] } { [ dup pressed?>> ] [ drop pressed>> ] } { [ dup selected?>> ] [ drop selected>> ] } { [ dup button-rollover? ] [ drop rollover>> ] } diff --git a/basis/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor index 168fb4bb11..884813916f 100644 --- a/basis/ui/gadgets/frames/frames.factor +++ b/basis/ui/gadgets/frames/frames.factor @@ -26,7 +26,8 @@ M: glue pref-dim* drop { 0 0 } ; length 1 + * [-] ; inline : -center) ( pref-dim gap filled-cell dims -- ) - [ nip available-space ] 2keep [ remove-nth sum [-] ] 2keep set-nth ; inline + [ nip available-space ] + [ [ remove-nth sum [-] ] [ set-nth ] 2bi ] 2bi ; inline : (fill-center) ( frame grid-layout quot1 quot2 -- ) (fill- -center) ; inline @@ -35,7 +36,7 @@ M: glue pref-dim* drop { 0 0 } ; [ [ second ] [ row-heights>> ] (fill-center) ] 2bi ; : ( frame -- grid-layout ) - dup [ fill-center ] keep ; + dup [ fill-center ] [ ] bi ; PRIVATE> diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index 26d0fee2e3..a6d9028a46 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -85,7 +85,7 @@ M: gadget contains-point? ( loc gadget -- ? ) : pick-up ( point gadget -- child/f ) 2dup [ dup point>rect ] dip children-on [ contains-point? ] with find-last nip - [ [ loc>> v- ] keep pick-up ] [ nip ] ?if ; + [ [ loc>> v- ] [ pick-up ] bi ] [ nip ] ?if ; : max-dim ( dims -- dim ) { 0 0 } [ vmax ] reduce ; @@ -115,7 +115,7 @@ M: gadget gadget-text-separator gadget-text-separator '[ _ % ] [ gadget-text* ] interleave ; M: gadget gadget-text* - [ children>> ] keep gadget-seq-text ; + [ children>> ] [ gadget-seq-text ] bi ; M: array gadget-text* [ gadget-text* ] each ; @@ -183,7 +183,7 @@ GENERIC: pref-dim* ( gadget -- dim ) : pref-dim ( gadget -- dim ) dup pref-dim>> [ ] [ - [ pref-dim* ] keep dup layout-state>> + [ pref-dim* ] [ dup layout-state>> ] bi [ drop ] [ dupd (>>pref-dim) ] if ] ?if ; @@ -267,7 +267,7 @@ M: gadget ungraft* drop ; : notify ( gadget -- ) dup graft-state>> - [ first { f f } { t t } ? >>graft-state ] keep + [ first { f f } { t t } ? >>graft-state ] [ ] bi { { { f t } [ dup activate-control graft* ] } { { t f } [ dup deactivate-control ungraft* ] } @@ -388,7 +388,7 @@ M: gadget request-focus-on parent>> request-focus-on ; M: f request-focus-on 2drop ; : request-focus ( gadget -- ) - [ focusable-child ] keep request-focus-on ; + [ focusable-child ] [ request-focus-on ] bi ; : focus-path ( gadget -- seq ) [ focus>> ] follow ; diff --git a/basis/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor index ddcfa1465d..9b5b737406 100644 --- a/basis/ui/gadgets/grids/grids.factor +++ b/basis/ui/gadgets/grids/grids.factor @@ -27,7 +27,9 @@ PRIVATE> : grid-child ( grid pair -- gadget ) grid@ nth ; : grid-add ( grid child pair -- grid ) - [ nip grid-child unparent ] [ drop add-gadget ] [ swapd grid@ set-nth ] 3tri ; + [ nip grid-child unparent ] + [ drop add-gadget ] + [ swapd grid@ set-nth ] 3tri ; : grid-remove ( grid pair -- grid ) [ ] dip grid-add ; @@ -114,8 +116,7 @@ M: grid layout* [ grid>> ] [ ] bi grid-layout ; M: grid children-on ( rect gadget -- seq ) dup children>> empty? [ 2drop f ] [ [ { 0 1 } ] dip grid>> - [ 0 fast-children-on ] keep - concat + [ 0 fast-children-on ] [ concat ] bi ] if ; M: grid gadget-text* @@ -123,4 +124,4 @@ M: grid gadget-text* [ [ gadget-text ] map ] map format-table [ CHAR: \n , ] [ % ] interleave ; -PRIVATE> \ No newline at end of file +PRIVATE> diff --git a/basis/ui/gadgets/line-support/line-support.factor b/basis/ui/gadgets/line-support/line-support.factor index 3292e3e6c5..c229c8c075 100644 --- a/basis/ui/gadgets/line-support/line-support.factor +++ b/basis/ui/gadgets/line-support/line-support.factor @@ -79,7 +79,7 @@ PRIVATE> [ second ] [ [ line-height ] [ min-rows>> ] [ max-rows>> ] tri ] bi* clamp ; M: line-gadget pref-viewport-dim - [ pref-dim ] keep + [ pref-dim ] [ ] bi [ line-gadget-width ] [ line-gadget-height ] 2bi 2array ; diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor index ccc5550adb..c907e90673 100644 --- a/basis/ui/gadgets/tables/tables.factor +++ b/basis/ui/gadgets/tables/tables.factor @@ -307,7 +307,7 @@ PRIVATE> '[ _ row-value eq? ] with find drop ; : (update-selected-indices) ( table -- set ) - [ selection>> value>> dup [ array? not ] [ ] bi and [ 1array ] when ] keep + [ selection>> value>> dup { [ array? not ] [ ] } 1&& [ 1array ] when ] keep '[ _ find-row-index ] map sift unique f assoc-like ; : initial-selected-indices ( table -- set ) diff --git a/basis/ui/gadgets/tracks/tracks.factor b/basis/ui/gadgets/tracks/tracks.factor index 92268690ac..4bccab8c98 100644 --- a/basis/ui/gadgets/tracks/tracks.factor +++ b/basis/ui/gadgets/tracks/tracks.factor @@ -61,6 +61,7 @@ PRIVATE> pick sizes>> push add-gadget ; M: track remove-gadget - [ [ children>> index ] keep sizes>> delete-nth ] [ call-next-method ] 2bi ; + [ [ children>> index ] [ sizes>> ] bi delete-nth ] + [ call-next-method ] 2bi ; : clear-track ( track -- ) [ sizes>> delete-all ] [ clear-gadget ] bi ; diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor index a502707ee6..48ff20837e 100755 --- a/basis/ui/operations/operations.factor +++ b/basis/ui/operations/operations.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays definitions kernel ui.commands -ui.gestures sequences strings math words generic namespaces -hashtables quotations assocs fry linked-assocs ; +USING: accessors arrays assocs combinators.short-circuit fry +kernel linked-assocs namespaces sequences ui.commands words ; IN: ui.operations SYMBOL: +keyboard+ @@ -18,7 +17,7 @@ TUPLE: operation predicate command translator listener? ; swap >>predicate ; PREDICATE: listener-operation < operation - [ command>> listener-command? ] [ listener?>> ] bi or ; + { [ command>> listener-command? ] [ listener?>> ] } 1|| ; M: operation command-name command>> command-name ; diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index 3d590feb58..173e1c0595 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -1,14 +1,14 @@ ! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: debugger classes help help.topics help.crossref help.home -kernel models compiler.units assocs words vocabs accessors fry arrays -combinators.short-circuit namespaces sequences help.apropos -combinators ui 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 ui.gadgets.glass ui.gadgets.borders -ui.gadgets.viewports ui.tools.common ui.tools.browser.popups -ui.tools.browser.history ; +USING: accessors arrays assocs classes combinators +combinators.short-circuit compiler.units debugger fry help +help.apropos help.crossref help.home help.topics kernel models +sequences ui ui.commands ui.gadgets ui.gadgets.borders +ui.gadgets.buttons ui.gadgets.editors ui.gadgets.glass +ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers +ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.viewports +ui.gestures ui.tools.browser.history ui.tools.browser.popups +ui.tools.common vocabs ; IN: ui.tools.browser TUPLE: browser-gadget < tool history scroller search-field popup ; @@ -95,8 +95,10 @@ M: browser-gadget focusable-child* search-field>> ; "help.home" (browser-window) ; : error-help-window ( error -- ) - [ error-help ] - [ dup tuple? [ class ] [ drop "errors" ] if ] bi or (browser-window) ; + { + [ error-help ] + [ dup tuple? [ class ] [ drop "errors" ] if ] + } 1|| (browser-window) ; \ browser-window H{ { +nullary+ t } } define-command @@ -162,4 +164,4 @@ browser-gadget "scrolling" { T{ key-down f f "PAGE_DOWN" } com-page-down } } define-command-map -MAIN: browser-window \ No newline at end of file +MAIN: browser-window diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor index c3fbdb88cd..bb23bc0692 100644 --- a/basis/ui/tools/profiler/profiler.factor +++ b/basis/ui/tools/profiler/profiler.factor @@ -1,14 +1,15 @@ ! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel quotations accessors fry assocs present math.order -math.vectors arrays locals models.search models.sort models sequences -vocabs tools.profiler words prettyprint combinators.smart -definitions.icons see ui ui.commands ui.gadgets ui.gadgets.panes -ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons -ui.gadgets.tables ui.gadgets.search-tables ui.gadgets.labeled -ui.gadgets.packs ui.gadgets.labels ui.gadgets.tabbed -ui.gadgets.status-bar ui.gadgets.borders ui.tools.browser -ui.tools.common ui.baseline-alignment ui.operations ui.images ; +USING: accessors arrays assocs combinators.short-circuit +combinators.smart definitions.icons fry kernel locals +math.order models models.search models.sort present see +sequences tools.profiler ui.baseline-alignment ui.commands +ui.gadgets ui.gadgets.borders ui.gadgets.buttons +ui.gadgets.labeled ui.gadgets.labels ui.gadgets.packs +ui.gadgets.search-tables ui.gadgets.status-bar +ui.gadgets.tabbed ui.gadgets.tables ui.gadgets.tracks +ui.gestures ui.images ui.operations ui.tools.browser +ui.tools.common vocabs words ; FROM: models.arrow => ; FROM: models.arrow.smart => ; FROM: models.product => ; @@ -105,9 +106,10 @@ M: method-renderer column-titles drop { "" "Method" "Count" } ; : method-matches? ( method generic class -- ? ) [ first ] 2dip - [ drop dup [ subwords memq? ] [ 2drop t ] if ] - [ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ] - 3bi and ; + { + [ drop dup [ subwords memq? ] [ 2drop t ] if ] + [ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ] + } 3&& ; : ( profiler -- model ) [