steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2009-10-05 17:56:43 -05:00
parent fbe810fc3b 317c3f82d5
commit b1d52517c5
14 changed files with 138 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/io/backend/windows/nt/nt.factor
View File

@ -91,6 +91,8 @@ ERROR: seek-before-start n ;
: set-seek-ptr ( n handle -- )
[ dup 0 < [ seek-before-start ] when ] dip (>>ptr) ;
M: winnt tell-handle ( handle -- n ) ptr>> ;
M: winnt seek-handle ( n seek-type handle -- )
swap {
{ seek-absolute [ set-seek-ptr ] }

7
basis/ui/backend/x11/x11.factor
View File

@ -7,7 +7,8 @@ namespaces sequences strings ui ui.backend ui.clipboards
ui.event-loop ui.gadgets ui.gadgets.private ui.gadgets.worlds
ui.gestures ui.pixel-formats ui.pixel-formats.private
ui.private x11 x11.clipboard x11.constants x11.events x11.glx
x11.io x11.windows x11.xim x11.xlib environment command-line ;
x11.io x11.windows x11.xim x11.xlib environment command-line
combinators.short-circuit ;
IN: ui.backend.x11
SINGLETON: x11-ui-backend
@ -107,9 +108,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 ;

26
basis/ui/gadgets/buttons/buttons.factor
View File

@ -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 -- 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>> ] }

134
basis/ui/gadgets/editors/editors.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2006, 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays documents documents.elements kernel math
math.ranges models models.arrow namespaces locals fry make opengl
opengl.gl sequences strings math.vectors math.functions sorting colors
colors.constants combinators assocs math.order calendar alarms
continuations ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
ui.gadgets.menus ui.gadgets.wrappers ui.render ui.pens.solid
ui.gadgets.line-support ui.text ui.gestures ui.baseline-alignment
math.rectangles splitting unicode.categories grouping ;
USING: accessors alarms arrays assocs calendar colors.constants
combinators combinators.short-circuit documents
documents.elements fry grouping kernel locals make math
math.functions math.order math.ranges math.rectangles
math.vectors models models.arrow namespaces opengl sequences
sorting splitting ui.baseline-alignment ui.clipboards
ui.commands ui.gadgets ui.gadgets.borders
ui.gadgets.line-support ui.gadgets.menus ui.gadgets.scrollers
ui.gestures ui.pens.solid ui.render ui.text unicode.categories ;
EXCLUDE: fonts => selection ;
IN: ui.gadgets.editors
@ -37,14 +37,14 @@ focused? blink blink-alarm ;
editor new-editor ;
: activate-editor-model ( editor model -- )
2dup add-connection
dup activate-model
swap model>> add-loc ;
[ add-connection ]
[ nip activate-model ]
[ swap model>> add-loc ] 2tri ;
: deactivate-editor-model ( editor model -- )
2dup remove-connection
dup deactivate-model
swap model>> remove-loc ;
[ remove-connection ]
[ nip deactivate-model ]
[ swap model>> remove-loc ] 2tri ;
: blink-caret ( editor -- )
[ not ] change-blink relayout-1 ;
@ -71,23 +71,20 @@ SYMBOL: blink-interval
] [ drop ] if ;
M: editor graft*
dup
dup caret>> activate-editor-model
dup mark>> activate-editor-model ;
[ dup caret>> activate-editor-model ]
[ dup mark>> activate-editor-model ] bi ;
M: editor ungraft*
dup
dup stop-blinking
dup caret>> deactivate-editor-model
dup mark>> deactivate-editor-model ;
[ stop-blinking ]
[ dup caret>> deactivate-editor-model ]
[ dup mark>> deactivate-editor-model ] tri ;
: editor-caret ( editor -- loc ) caret>> value>> ;
: editor-mark ( editor -- loc ) mark>> value>> ;
: set-caret ( loc editor -- )
[ model>> validate-loc ] keep
caret>> set-model ;
[ model>> validate-loc ] [ caret>> ] bi set-model ;
: change-caret ( editor quot -- )
[ [ [ editor-caret ] [ model>> ] bi ] dip call ] [ drop ] 2bi
@ -115,7 +112,7 @@ M: editor ungraft*
} cond ;
: clicked-loc ( editor -- loc )
[ hand-rel ] keep point>loc ;
[ hand-rel ] [ point>loc ] bi ;
: click-loc ( editor model -- )
[ clicked-loc ] dip set-model ;
@ -133,20 +130,20 @@ M: editor ungraft*
[ loc>x ] [ [ first ] dip line>y ceiling ] 2bi 2array ;
: caret-loc ( editor -- loc )
[ editor-caret ] keep loc>point ;
[ editor-caret ] [ loc>point ] bi ;
: caret-dim ( editor -- dim )
line-height 0 swap 2array ;
[ 0 ] dip line-height 2array ;
: scroll>caret ( editor -- )
dup graft-state>> second [
[
[ caret-loc ] [ caret-dim { 2 1 } v+ ] bi <rect>
] keep scroll>rect
] [ scroll>rect ] bi
] [ drop ] if ;
: draw-caret? ( editor -- ? )
[ focused?>> ] [ blink>> ] bi and ;
{ [ focused?>> ] [ blink>> ] } 1&& ;
: draw-caret ( editor -- )
dup draw-caret? [
@ -166,8 +163,9 @@ TUPLE: selected-line start end first? last? ;
: compute-selection ( editor -- assoc )
dup gadget-selection? [
[ selection-start/end [ [ first ] bi@ [a,b] ] 2keep ] keep model>>
'[ [ _ _ ] keep _ start/end-on-line 2array ] H{ } map>assoc
[ selection-start/end [ [ first ] bi@ [a,b] ] [ ] 2bi ]
[ model>> ] bi
'[ [ _ _ ] [ _ start/end-on-line ] bi 2array ] H{ } map>assoc
] [ drop f ] if ;
:: draw-selection ( line pair editor -- )
@ -186,8 +184,8 @@ TUPLE: selected-line start end first? last? ;
] [
[ draw-selection ]
[
[ [ first2 ] [ selection-color>> ] bi* <selection> ] keep
draw-unselected-line
[ [ first2 ] [ selection-color>> ] bi* <selection> ]
[ draw-unselected-line ] bi
] 3bi
] if ;
@ -209,32 +207,31 @@ M: editor baseline font>> font-metrics ascent>> ;
M: editor cap-height font>> font-metrics cap-height>> ;
: contents-changed ( model editor -- )
swap
over caret>> [ over validate-loc ] (change-model)
over mark>> [ over validate-loc ] (change-model)
drop relayout ;
[ [ nip caret>> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ]
[ [ nip mark>> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ]
[ nip relayout ] 2tri ;
: caret/mark-changed ( model editor -- )
nip [ restart-blinking ] [ scroll>caret ] bi ;
: caret/mark-changed ( editor -- )
[ restart-blinking ] [ scroll>caret ] bi ;
M: editor model-changed
{
{ [ 2dup model>> eq? ] [ contents-changed ] }
{ [ 2dup caret>> eq? ] [ caret/mark-changed ] }
{ [ 2dup mark>> eq? ] [ caret/mark-changed ] }
{ [ 2dup caret>> eq? ] [ nip caret/mark-changed ] }
{ [ 2dup mark>> eq? ] [ nip caret/mark-changed ] }
} cond ;
M: editor gadget-selection?
selection-start/end = not ;
M: editor gadget-selection
[ selection-start/end ] keep model>> doc-range ;
[ selection-start/end ] [ model>> ] bi doc-range ;
: remove-selection ( editor -- )
[ selection-start/end ] keep model>> remove-doc-range ;
[ selection-start/end ] [ model>> ] bi remove-doc-range ;
M: editor user-input*
[ selection-start/end ] keep model>> set-doc-range t ;
[ selection-start/end ] [ model>> ] bi set-doc-range t ;
: editor-string ( editor -- string )
model>> doc-string ;
@ -245,9 +242,9 @@ M: editor user-input*
M: editor gadget-text* editor-string % ;
: extend-selection ( editor -- )
dup request-focus
dup restart-blinking
dup caret>> click-loc ;
[ request-focus ]
[ restart-blinking ]
[ dup caret>> click-loc ] tri ;
: mouse-elt ( -- element )
hand-click# get {
@ -260,24 +257,25 @@ M: editor gadget-text* editor-string % ;
: drag-selection-caret ( loc editor element -- loc )
[
[ drag-direction? ] 2keep model>>
[ drag-direction? ] [ model>> ] 2bi
] dip prev/next-elt ? ;
: drag-selection-mark ( loc editor element -- loc )
[
[ drag-direction? not ] keep
[ editor-mark ] [ model>> ] bi
[ drag-direction? not ]
[ editor-mark ]
[ model>> ] tri
] dip prev/next-elt ? ;
: drag-caret&mark ( editor -- caret mark )
dup clicked-loc swap mouse-elt
[ drag-selection-caret ] 3keep
drag-selection-mark ;
[ clicked-loc ] [ mouse-elt ] bi
[ drag-selection-caret ]
[ drag-selection-mark ] 3bi ;
: drag-selection ( editor -- )
dup drag-caret&mark
pick mark>> set-model
swap caret>> set-model ;
[ drag-caret&mark ]
[ mark>> set-model ]
[ caret>> set-model ] tri ;
: editor-cut ( editor clipboard -- )
[ gadget-copy ] [ drop remove-selection ] 2bi ;
@ -343,11 +341,9 @@ M: editor gadget-text* editor-string % ;
: delete-to-end-of-line ( editor -- )
one-line-elt editor-backspace ;
: com-undo ( editor -- )
model>> undo ;
: com-undo ( editor -- ) model>> undo ;
: com-redo ( editor -- )
model>> redo ;
: com-redo ( editor -- ) model>> redo ;
editor "editing" f {
{ undo-action com-undo }
@ -515,7 +511,7 @@ PRIVATE>
"\n" swap user-input* drop ;
: change-selection ( editor quot -- )
'[ gadget-selection @ ] keep user-input* drop ; inline
'[ gadget-selection @ ] [ user-input* drop ] bi ; inline
: join-lines ( string -- string' )
"\n" split
@ -526,7 +522,7 @@ PRIVATE>
: this-line-and-next ( document line -- start end )
[ nip 0 swap 2array ]
[ [ nip 1 + ] [ 1 + swap doc-line length ] 2bi 2array ]
[ 1 + [ nip ] [ swap doc-line length ] 2bi 2array ]
2bi ;
: last-line? ( document line -- ? )
@ -589,15 +585,16 @@ TUPLE: field < border editor min-cols max-cols ;
M: field font>> editor>> font>> ;
M: field pref-dim*
dup
[ editor>> pref-dim ] keep
[ line-gadget-width ] [ drop second ] 2bi 2array
border-pref-dim ;
[ ]
[ editor>> pref-dim ]
[ [ line-gadget-width ] [ drop second ] 2bi 2array ]
tri border-pref-dim ;
TUPLE: model-field < field field-model ;
: <model-field> ( model -- gadget )
model-field new-field swap >>field-model ;
model-field new-field
swap >>field-model ;
M: model-field graft*
[ [ field-model>> value>> ] [ editor>> ] bi set-editor-string ]
@ -613,7 +610,8 @@ M: model-field model-changed
TUPLE: action-field < field quot ;
: <action-field> ( quot -- gadget )
action-field new-field swap >>quot ;
action-field new-field
swap >>quot ;
: invoke-action-field ( field -- )
[ editor>> editor-string ]

5
basis/ui/gadgets/frames/frames.factor
View File

@ -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-layout> ( frame -- grid-layout )
dup <grid-layout> [ fill-center ] keep ;
dup <grid-layout> [ fill-center ] [ ] bi ;
PRIVATE>

10
basis/ui/gadgets/gadgets.factor
View File

@ -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 ;

9
basis/ui/gadgets/grids/grids.factor
View File

@ -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 ) [ <gadget> ] dip grid-add ;
@ -114,8 +116,7 @@ M: grid layout* [ grid>> ] [ <grid-layout> ] bi grid-layout ;
M: grid children-on ( rect gadget -- seq )
dup children>> empty? [ 2drop f ] [
[ { 0 1 } ] dip grid>>
[ 0 <column> fast-children-on ] keep
<slice> concat
[ 0 <column> fast-children-on ] [ <slice> 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>
PRIVATE>

2
basis/ui/gadgets/line-support/line-support.factor
View File

@ -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 ;

2
basis/ui/gadgets/tables/tables.factor
View File

@ -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 )

3
basis/ui/gadgets/tracks/tracks.factor
View File

@ -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 ;

7
basis/ui/operations/operations.factor
View File

@ -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 ;

26
basis/ui/tools/browser/browser.factor
View File

@ -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
MAIN: browser-window

6
basis/ui/tools/listener/listener.factor
View File

@ -150,11 +150,11 @@ M: interactor stream-readln
] if ;
M: interactor stream-read
swap dup zero? [
2drop ""
swap [
drop ""
] [
[ interactor-read dup [ "\n" join ] when ] dip short head
] if ;
] if-zero ;
M: interactor stream-read-partial
stream-read ;

26
basis/ui/tools/profiler/profiler.factor
View File

@ -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 => <arrow> ;
FROM: models.arrow.smart => <smart-arrow> ;
FROM: models.product => <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&& ;
: <methods-model> ( profiler -- model )
[