Merge branch 'master' of git://github.com/bogiebro/factor into bogie
commit
805b0b2430
|
@ -6,4 +6,4 @@ IN: editors.textmate
|
|||
[ "mate" , "-a" , "-l" , number>string , , ] { } make
|
||||
run-detached drop ;
|
||||
|
||||
[ textmate ] edit-hook set-global
|
||||
[ textmate ] edit-hook set-global
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays classes.mixin classes.parser classes.singleton
|
||||
classes.tuple classes.tuple.parser combinators effects effects.parser
|
||||
fry generic generic.parser generic.standard interpolate
|
||||
io.streams.string kernel lexer locals.parser locals.rewrite.closures
|
||||
locals.types make namespaces parser quotations sequences vocabs.parser
|
||||
words words.symbol ;
|
||||
USING: accessors arrays classes.mixin classes.parser
|
||||
classes.singleton classes.tuple classes.tuple.parser
|
||||
combinators effects.parser fry generic generic.parser
|
||||
generic.standard interpolate io.streams.string kernel lexer
|
||||
locals.parser locals.types macros make namespaces parser
|
||||
quotations sequences vocabs.parser words words.symbol ;
|
||||
IN: functors
|
||||
|
||||
! This is a hack
|
||||
|
@ -117,6 +117,11 @@ SYNTAX: `GENERIC:
|
|||
complete-effect parsed
|
||||
\ define-simple-generic* parsed ;
|
||||
|
||||
SYNTAX: `MACRO:
|
||||
scan-param parsed
|
||||
parse-declared*
|
||||
\ define-macro parsed ;
|
||||
|
||||
SYNTAX: `inline [ word make-inline ] over push-all ;
|
||||
|
||||
SYNTAX: `call-next-method T{ fake-call-next-method } parsed ;
|
||||
|
@ -152,6 +157,7 @@ DEFER: ;FUNCTOR delimiter
|
|||
{ "SYNTAX:" POSTPONE: `SYNTAX: }
|
||||
{ "SYMBOL:" POSTPONE: `SYMBOL: }
|
||||
{ "inline" POSTPONE: `inline }
|
||||
{ "MACRO:" POSTPONE: `MACRO: }
|
||||
{ "call-next-method" POSTPONE: `call-next-method }
|
||||
} ;
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007, 2009 Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel words summary slots quotations
|
||||
USING: accessors kernel locals words summary slots quotations
|
||||
sequences assocs math arrays stack-checker effects
|
||||
continuations debugger classes.tuple namespaces make vectors
|
||||
bit-arrays byte-arrays strings sbufs math.functions macros
|
||||
|
@ -231,6 +231,18 @@ DEFER: __
|
|||
\ output>sequence 2 [ [undo] '[ dup _ assure-same-class _ input<sequence ] ] define-pop-inverse
|
||||
\ input<sequence 1 [ [undo] '[ _ { } output>sequence ] ] define-pop-inverse
|
||||
|
||||
! conditionals
|
||||
|
||||
:: undo-if-empty ( result a b -- seq )
|
||||
a call( -- b ) result = [ { } ] [ result b [undo] call( a -- b ) ] if ;
|
||||
|
||||
:: undo-if* ( result a b -- boolean )
|
||||
b call( -- b ) result = [ f ] [ result a [undo] call( a -- b ) ] if ;
|
||||
|
||||
\ if-empty 2 [ swap [ undo-if-empty ] 2curry ] define-pop-inverse
|
||||
|
||||
\ if* 2 [ swap [ undo-if* ] 2curry ] define-pop-inverse
|
||||
|
||||
! Constructor inverse
|
||||
: deconstruct-pred ( class -- quot )
|
||||
"predicate" word-prop [ dupd call assure ] curry ;
|
||||
|
@ -283,4 +295,4 @@ M: no-match summary drop "Fall through in switch" ;
|
|||
reverse [ [ [undo] ] dip compose ] { } assoc>map
|
||||
recover-chain ;
|
||||
|
||||
MACRO: switch ( quot-alist -- ) [switch] ;
|
||||
MACRO: switch ( quot-alist -- ) [switch] ;
|
|
@ -0,0 +1,15 @@
|
|||
USING: accessors models models.arrow inverse kernel ;
|
||||
IN: models.illusion
|
||||
|
||||
TUPLE: illusion < arrow ;
|
||||
|
||||
: <illusion> ( model quot -- illusion )
|
||||
illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
|
||||
swap >>quot over >>model [ add-dependency ] keep ;
|
||||
|
||||
: <activated-illusion> ( model quot -- illusion ) <illusion> dup activate-model ;
|
||||
|
||||
: backtalk ( value object -- )
|
||||
[ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;
|
||||
|
||||
M: illusion update-model ( model -- ) [ [ value>> ] keep backtalk ] with-locked-model ;
|
|
@ -0,0 +1 @@
|
|||
Two Way Arrows
|
|
@ -58,7 +58,7 @@ mouse-color
|
|||
column-line-color
|
||||
selection-required?
|
||||
single-click?
|
||||
selected-value
|
||||
selection
|
||||
min-rows
|
||||
min-cols
|
||||
max-rows
|
||||
|
|
|
@ -16,17 +16,17 @@ $nl
|
|||
{ $subsection column-titles } ;
|
||||
|
||||
ARTICLE: "ui.gadgets.tables.selection" "Table row selection"
|
||||
"At any given time, a single row in the table may be selected."
|
||||
$nl
|
||||
"A few slots in the table gadget concern row selection:"
|
||||
{ $table
|
||||
{ { $slot "selected-value" } { " - if set to a model, the currently selected row's value, as determined by a " { $link row-value } " call to the renderer, is stored in this model. See " { $link "models" } "." } }
|
||||
{ { $slot "selected-index" } " - the index of the currently selected row." }
|
||||
{ { $slot "selection" } { " - if set to a model, the values of the currently selected row or rows, as determined by a " { $link row-value } " call to the renderer, is stored in this model. See " { $link "models" } "." } }
|
||||
{ { $slot "selection-index" } { " - if set to a model, the indices of the currently selected rows." } }
|
||||
{ { $slot "selection-required?" } { " - if set to a true value, the table ensures that some row is always selected, if the model is non-empty. If set to " { $link f } ", a state where nothing is selected is permitted to occur. The default is " { $link f } "." } }
|
||||
{ { $slot "multiple-selection?" } { " - if set to a true value, users are allowed to select more than one value." } }
|
||||
}
|
||||
"Some words for row selection:"
|
||||
{ $subsection selected-row }
|
||||
{ $subsection (selected-row) } ;
|
||||
{ $subsection selected-rows }
|
||||
{ $subsection (selected-rows) }
|
||||
{ $subsection selected } ;
|
||||
|
||||
ARTICLE: "ui.gadgets.tables.actions" "Table row actions"
|
||||
"When the user double-clicks on a row, or presses " { $command table "row" row-action } " while a row is selected, optional action and hook quotations are invoked. The action receives the row value and the hook receives the table gadget itself. These quotations are stored in the " { $slot "action" } " and " { $snippet "hook" } " slots of a table, respectively."
|
||||
|
|
|
@ -1,12 +1,13 @@
|
|||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays colors colors.constants fry kernel math
|
||||
math.functions math.rectangles math.order math.vectors namespaces
|
||||
opengl sequences ui.gadgets ui.gadgets.scrollers ui.gadgets.status-bar
|
||||
ui.gadgets.worlds ui.gestures ui.render ui.pens.solid ui.text
|
||||
ui.commands ui.images ui.gadgets.menus ui.gadgets.line-support
|
||||
models math.ranges combinators
|
||||
combinators.short-circuit fonts locals strings ;
|
||||
math.functions math.ranges math.rectangles math.order math.vectors
|
||||
models.illusion namespaces opengl sequences ui.gadgets
|
||||
ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.worlds
|
||||
ui.gestures ui.render ui.pens.solid ui.text ui.commands ui.images
|
||||
ui.gadgets.menus ui.gadgets.line-support models
|
||||
combinators combinators.short-circuit
|
||||
fonts locals strings sequences.extras sets ;
|
||||
IN: ui.gadgets.tables
|
||||
|
||||
! Row rendererer protocol
|
||||
|
@ -41,19 +42,35 @@ focus-border-color
|
|||
{ mouse-color initial: COLOR: black }
|
||||
column-line-color
|
||||
selection-required?
|
||||
selected-index selected-value
|
||||
selection
|
||||
selection-index
|
||||
selected-indices
|
||||
mouse-index
|
||||
{ takes-focus? initial: t }
|
||||
focused? ;
|
||||
focused?
|
||||
multiple-selection? ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: push-selected-index ( table n -- table ) swap
|
||||
[ insert-sorted prune >array ] change-selected-indices ;
|
||||
: multiple>single ( values -- value/f ? ) [ f f ] [ first t ] if-empty ;
|
||||
: multiple>single* ( values -- value/f ) multiple>single drop ;
|
||||
: selected-index ( table -- n ) selected-indices>> multiple>single* ;
|
||||
: set-selected-index ( table n -- table ) 1array >>selected-indices ;
|
||||
PRIVATE>
|
||||
: selected ( table -- index/indices ) dup multiple-selection?>>
|
||||
[ selected-indices>> ] [ selected-index ] if ;
|
||||
|
||||
: new-table ( rows renderer class -- table )
|
||||
new-line-gadget
|
||||
swap >>renderer
|
||||
swap >>model
|
||||
f <model> >>selected-value
|
||||
sans-serif-font >>font
|
||||
focus-border-color >>focus-border-color
|
||||
transparent >>column-line-color ; inline
|
||||
transparent >>column-line-color
|
||||
f <model> >>selection-index
|
||||
f <model> >>selection ;
|
||||
|
||||
: <table> ( rows renderer -- table ) table new-table ;
|
||||
|
||||
|
@ -131,21 +148,21 @@ M: table layout*
|
|||
: row-bounds ( table row -- loc dim )
|
||||
row-rect rect-bounds ; inline
|
||||
|
||||
: draw-selected-row ( table -- )
|
||||
: draw-selected-rows ( table -- )
|
||||
{
|
||||
{ [ dup selected-index>> not ] [ drop ] }
|
||||
{ [ dup selected-indices>> empty? ] [ drop ] }
|
||||
[
|
||||
[ ] [ selected-index>> ] [ selection-color>> gl-color ] tri
|
||||
row-bounds gl-fill-rect
|
||||
[ selected-indices>> ] [ selection-color>> gl-color ] [ ] tri
|
||||
[ swap row-bounds gl-fill-rect ] curry each
|
||||
]
|
||||
} cond ;
|
||||
|
||||
: draw-focused-row ( table -- )
|
||||
{
|
||||
{ [ dup focused?>> not ] [ drop ] }
|
||||
{ [ dup selected-index>> not ] [ drop ] }
|
||||
{ [ dup selected-index not ] [ drop ] }
|
||||
[
|
||||
[ ] [ selected-index>> ] [ focus-border-color>> gl-color ] tri
|
||||
[ ] [ selected-index ] [ focus-border-color>> gl-color ] tri
|
||||
row-bounds gl-rect
|
||||
]
|
||||
} cond ;
|
||||
|
@ -189,10 +206,10 @@ M: table layout*
|
|||
dup renderer>> column-alignment
|
||||
[ ] [ column-widths>> length 0 <repetition> ] ?if ;
|
||||
|
||||
:: row-font ( row index table -- font )
|
||||
:: row-font ( row ind table -- font )
|
||||
table font>> clone
|
||||
row table renderer>> row-color [ >>foreground ] when*
|
||||
index table selected-index>> = [ table selection-color>> >>background ] when ;
|
||||
ind table selected-indices>> index [ table selection-color>> >>background ] when ;
|
||||
|
||||
: draw-columns ( columns widths alignment font gap -- )
|
||||
'[ [ _ ] 3dip _ draw-column ] 3each ;
|
||||
|
@ -213,7 +230,7 @@ M: table draw-gadget*
|
|||
dup control-value empty? [ drop ] [
|
||||
dup line-height \ line-height [
|
||||
{
|
||||
[ draw-selected-row ]
|
||||
[ draw-selected-rows ]
|
||||
[ draw-lines ]
|
||||
[ draw-column-lines ]
|
||||
[ draw-focused-row ]
|
||||
|
@ -236,17 +253,26 @@ M: table pref-dim*
|
|||
|
||||
PRIVATE>
|
||||
|
||||
: (selected-row) ( table -- value/f ? )
|
||||
[ selected-index>> ] keep nth-row ;
|
||||
: (selected-rows) ( table -- {row} )
|
||||
[ selected-indices>> ] keep
|
||||
[ nth-row [ 1array ] [ drop { } ] if ] curry map concat ;
|
||||
|
||||
: selected-row ( table -- value/f ? )
|
||||
[ (selected-row) ] keep
|
||||
swap [ renderer>> row-value t ] [ 2drop f f ] if ;
|
||||
: selected-rows ( table -- {value} )
|
||||
[ (selected-rows) ] [ renderer>> ] bi [ row-value ] curry map ;
|
||||
: (selected-row) ( table -- value/f ? ) (selected-rows) multiple>single ;
|
||||
: selected-row ( table -- value/f ? ) selected-rows multiple>single ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: update-selected-value ( table -- )
|
||||
[ selected-row drop ] [ selected-value>> ] bi set-model ;
|
||||
: set-table-model ( model value multiple? -- )
|
||||
[ multiple>single* ] unless swap set-model ;
|
||||
|
||||
: update-selected ( table -- )
|
||||
[ [ selection>> ] [ selected-rows ] [ multiple-selection?>> ] tri set-table-model ]
|
||||
[
|
||||
[ selection-index>> ] [ selected-indices>> ] [ multiple-selection?>> ] tri
|
||||
set-table-model
|
||||
] bi ;
|
||||
|
||||
: show-row-summary ( table n -- )
|
||||
over nth-row
|
||||
|
@ -260,49 +286,65 @@ PRIVATE>
|
|||
: find-row-index ( value table -- n/f )
|
||||
[ model>> value>> ] [ renderer>> '[ _ row-value ] map index ] bi ;
|
||||
|
||||
: initial-selected-index ( table -- n/f )
|
||||
: initial-selected-indices ( table -- {n}/f )
|
||||
{
|
||||
[ model>> value>> empty? not ]
|
||||
[ selection-required?>> ]
|
||||
[ drop 0 ]
|
||||
[ drop { 0 } ]
|
||||
} 1&& ;
|
||||
|
||||
: (update-selected-index) ( table -- n/f )
|
||||
[ selected-value>> value>> ] keep over
|
||||
[ find-row-index ] [ 2drop f ] if ;
|
||||
: (update-selected-indices) ( table -- {n}/f )
|
||||
[ selection>> value>> dup array? [ 1array ] unless ] keep
|
||||
[ find-row-index ] curry map [ ] filter [ f ] when-empty ;
|
||||
|
||||
: update-selected-index ( table -- n/f )
|
||||
: update-selected-indices ( table -- {n}/f )
|
||||
{
|
||||
[ (update-selected-index) ]
|
||||
[ initial-selected-index ]
|
||||
[ (update-selected-indices) ]
|
||||
[ initial-selected-indices ]
|
||||
} 1|| ;
|
||||
|
||||
M: table model-changed
|
||||
nip dup update-selected-index {
|
||||
[ >>selected-index f >>mouse-index drop ]
|
||||
[ show-row-summary ]
|
||||
[ drop update-selected-value ]
|
||||
nip dup update-selected-indices [ { } ] unless* {
|
||||
[ >>selected-indices f >>mouse-index drop ]
|
||||
[ [ f ] [ first ] if-empty show-row-summary ]
|
||||
[ drop update-selected ]
|
||||
[ drop relayout ]
|
||||
} 2cleave ;
|
||||
|
||||
: thin-row-rect ( table row -- rect )
|
||||
row-rect [ { 0 1 } v* ] change-dim ;
|
||||
|
||||
: scroll-to-row ( table n -- )
|
||||
dup [ [ thin-row-rect ] [ drop ] 2bi scroll>rect ] [ 2drop ] if ;
|
||||
|
||||
: add-selected-row ( table n -- )
|
||||
[ scroll-to-row ]
|
||||
[ push-selected-index relayout-1 ] 2bi ;
|
||||
|
||||
: (select-row) ( table n -- )
|
||||
[ dup [ [ thin-row-rect ] [ drop ] 2bi scroll>rect ] [ 2drop ] if ]
|
||||
[ >>selected-index relayout-1 ]
|
||||
[ scroll-to-row ]
|
||||
[ set-selected-index relayout-1 ]
|
||||
2bi ;
|
||||
|
||||
: mouse-row ( table -- n )
|
||||
[ hand-rel second ] keep y>line ;
|
||||
|
||||
: if-mouse-row ( table true: ( table mouse-index -- ) false: ( table -- ) -- )
|
||||
: if-mouse-row ( table true: ( mouse-index table -- ) false: ( table -- ) -- )
|
||||
[ [ mouse-row ] keep 2dup valid-line? ]
|
||||
[ ] [ '[ nip @ ] ] tri* if ; inline
|
||||
|
||||
: table-button-down ( table -- )
|
||||
dup takes-focus?>> [ dup request-focus ] when
|
||||
[ swap [ >>mouse-index ] [ (select-row) ] bi ] [ drop ] if-mouse-row ;
|
||||
: (table-button-down) ( quot table -- )
|
||||
dup takes-focus?>> [ dup request-focus ] when swap
|
||||
'[ swap [ >>mouse-index ] _ bi ] [ drop ] if-mouse-row ; inline
|
||||
|
||||
: table-button-down ( table -- ) [ (select-row) ] swap (table-button-down) ;
|
||||
: continued-button-down ( table -- ) dup multiple-selection?>>
|
||||
[ [ add-selected-row ] swap (table-button-down) ] [ table-button-down ] if ;
|
||||
: thru-button-down ( table -- ) dup multiple-selection?>> [
|
||||
[ 2dup over selected-index (a,b) swap
|
||||
[ swap push-selected-index drop ] curry each add-selected-row ]
|
||||
swap (table-button-down)
|
||||
] [ table-button-down ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -319,7 +361,7 @@ PRIVATE>
|
|||
|
||||
: table-button-up ( table -- )
|
||||
dup [ mouse-row ] keep valid-line? [
|
||||
dup row-action? [ row-action ] [ update-selected-value ] if
|
||||
dup row-action? [ row-action ] [ update-selected ] if
|
||||
] [ drop ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
@ -327,14 +369,14 @@ PRIVATE>
|
|||
: select-row ( table n -- )
|
||||
over validate-line
|
||||
[ (select-row) ]
|
||||
[ drop update-selected-value ]
|
||||
[ drop update-selected ]
|
||||
[ show-row-summary ]
|
||||
2tri ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: prev/next-row ( table n -- )
|
||||
[ dup selected-index>> ] dip '[ _ + ] [ 0 ] if* select-row ;
|
||||
[ dup selected-index ] dip '[ _ + ] [ 0 ] if* select-row ;
|
||||
|
||||
: previous-row ( table -- )
|
||||
-1 prev/next-row ;
|
||||
|
@ -386,8 +428,11 @@ table "sundry" f {
|
|||
{ mouse-enter show-mouse-help }
|
||||
{ mouse-leave hide-mouse-help }
|
||||
{ motion show-mouse-help }
|
||||
{ T{ button-down } table-button-down }
|
||||
{ T{ button-down f { S+ } 1 } thru-button-down }
|
||||
{ T{ button-down f { A+ } 1 } continued-button-down }
|
||||
{ T{ button-up } table-button-up }
|
||||
{ T{ button-up f { S+ } } table-button-up }
|
||||
{ T{ button-down } table-button-down }
|
||||
{ gain-focus focus-table }
|
||||
{ lose-focus unfocus-table }
|
||||
{ T{ drag } table-button-down }
|
||||
|
|
|
@ -71,7 +71,7 @@ M: source-file-renderer filled-column drop 1 ;
|
|||
60 >>min-cols
|
||||
60 >>max-cols
|
||||
t >>selection-required?
|
||||
error-list source-file>> >>selected-value ;
|
||||
error-list source-file>> >>selection ;
|
||||
|
||||
SINGLETON: error-renderer
|
||||
|
||||
|
@ -120,7 +120,7 @@ M: error-renderer column-alignment drop { 0 1 0 0 } ;
|
|||
60 >>min-cols
|
||||
60 >>max-cols
|
||||
t >>selection-required?
|
||||
error-list error>> >>selected-value ;
|
||||
error-list error>> >>selection ;
|
||||
|
||||
TUPLE: error-display < track ;
|
||||
|
||||
|
|
|
@ -0,0 +1,13 @@
|
|||
USING: assocs io.pathnames fry namespaces namespaces.private kernel sequences parser hashtables ;
|
||||
IN: closures
|
||||
SYMBOL: |
|
||||
|
||||
! Selective Binding
|
||||
: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip >hashtable [ _ bind ] curry ] ;
|
||||
SYNTAX: C[ | parse-until parse-quotation delayed-bind-with over push-all ;
|
||||
! Common ones
|
||||
SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with over push-all ;
|
||||
|
||||
! Namespace Binding
|
||||
: bind-to-namespace ( quot -- quot' ) '[ namespace [ _ bind ] curry ] ;
|
||||
SYNTAX: NS[ parse-quotation bind-to-namespace over push-all ;
|
|
@ -0,0 +1,15 @@
|
|||
USING: accessors sequences generalizations io.encodings.utf8 db.postgresql parser combinators vocabs.parser db.sqlite
|
||||
io.files ;
|
||||
IN: db.info
|
||||
! having sensative (and likely to change) information directly in source code seems a bad idea
|
||||
: get-info ( -- lines ) current-vocab name>> "vocab:" "/dbinfo.txt" surround utf8 file-lines ;
|
||||
SYNTAX: get-psql-info <postgresql-db> get-info 5 firstn
|
||||
{
|
||||
[ >>host ]
|
||||
[ >>port ]
|
||||
[ >>username ]
|
||||
[ [ f ] [ ] if-empty >>password ]
|
||||
[ >>database ]
|
||||
} spread parsed ;
|
||||
|
||||
SYNTAX: get-sqlite-info get-info first <sqlite-db> parsed ;
|
|
@ -1,14 +1,14 @@
|
|||
USING: tools.deploy.config ;
|
||||
H{
|
||||
{ deploy-unicode? f }
|
||||
{ deploy-threads? t }
|
||||
{ deploy-math? t }
|
||||
{ deploy-name "drills" }
|
||||
{ deploy-ui? t }
|
||||
{ deploy-c-types? t }
|
||||
{ "stop-after-last-window?" t }
|
||||
{ deploy-word-props? f }
|
||||
{ deploy-c-types? f }
|
||||
{ deploy-io 2 }
|
||||
{ deploy-word-defs? f }
|
||||
{ deploy-reflection 1 }
|
||||
{ deploy-unicode? t }
|
||||
{ deploy-threads? t }
|
||||
{ deploy-reflection 6 }
|
||||
{ deploy-word-defs? t }
|
||||
{ deploy-math? t }
|
||||
{ deploy-ui? t }
|
||||
{ deploy-word-props? t }
|
||||
{ deploy-io 3 }
|
||||
}
|
||||
|
|
|
@ -1,11 +1,11 @@
|
|||
USING: accessors arrays cocoa.dialogs combinators continuations
|
||||
USING: arrays cocoa.dialogs combinators continuations
|
||||
fry grouping io.encodings.utf8 io.files io.styles kernel math
|
||||
math.parser models models.arrow models.history namespaces random
|
||||
sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
|
||||
ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
|
||||
ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks fonts
|
||||
wrap.strings system ;
|
||||
|
||||
EXCLUDE: accessors => change-model ;
|
||||
IN: drills.deployed
|
||||
SYMBOLS: it startLength ;
|
||||
: big ( gadget -- gadget ) T{ font { name "sans-serif" } { size 30 } } >>font ;
|
||||
|
|
|
@ -1,16 +1,17 @@
|
|||
USING: accessors arrays cocoa.dialogs combinators continuations
|
||||
USING: arrays cocoa.dialogs combinators continuations
|
||||
fry grouping io.encodings.utf8 io.files io.styles kernel math
|
||||
math.parser models models.arrow models.history namespaces random
|
||||
sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
|
||||
ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
|
||||
ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks fonts
|
||||
wrap.strings ;
|
||||
EXCLUDE: accessors => change-model ;
|
||||
|
||||
IN: drills
|
||||
SYMBOLS: it startLength ;
|
||||
: big ( gadget -- gadget ) T{ font { name "sans-serif" } { size 30 } } >>font ;
|
||||
: card ( model quot -- button ) <arrow> <label-control> big [ next ] <book-btn> ;
|
||||
: op ( quot str -- gadget ) <label> big swap <book-bevel-btn> ;
|
||||
: op ( quot str -- gadget ) <label> big swap <book-border-btn> ;
|
||||
|
||||
: show ( model -- gadget ) dup it set-global [ random ] <arrow>
|
||||
{ [ [ first ] card ]
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
|
@ -0,0 +1,8 @@
|
|||
! Copyright (C) 2009 Sam Anklesaria.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel parser vocabs.parser words ;
|
||||
IN: enter
|
||||
! main words are usually only used for entry, doing initialization, etc
|
||||
! it makes sense, then to define it all at once, rather than factoring it out into a seperate word
|
||||
! and then declaring it main
|
||||
SYNTAX: ENTER: gensym [ parse-definition (( -- )) define-declared ] keep current-vocab (>>main) ;
|
|
@ -1,17 +1,26 @@
|
|||
USING: accessors arrays delegate delegate.protocols
|
||||
io.pathnames kernel locals namespaces prettyprint sequences
|
||||
ui.frp vectors ;
|
||||
io.pathnames kernel locals sequences
|
||||
vectors make strings models.combinators ui.gadgets.controls
|
||||
sequences.extras ;
|
||||
IN: file-trees
|
||||
|
||||
TUPLE: tree node children ;
|
||||
TUPLE: walkable-vector vector father ;
|
||||
CONSULT: sequence-protocol walkable-vector vector>> ;
|
||||
|
||||
M: walkable-vector set-nth [ vector>> set-nth ] 3keep nip
|
||||
father>> swap children>> vector>> push ;
|
||||
|
||||
TUPLE: tree node comment children ;
|
||||
CONSULT: sequence-protocol tree children>> ;
|
||||
|
||||
: <tree> ( start -- tree ) V{ } clone
|
||||
[ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
|
||||
: file? ( tree -- ? ) children>> [ node>> ".." = not ] filter empty? ;
|
||||
|
||||
: <dir-tree> ( {start,comment} -- tree ) first2 walkable-vector new vector new >>vector
|
||||
[ tree boa dup children>> ] [ ".." -rot tree boa ] 2bi swap (>>father) ;
|
||||
|
||||
DEFER: (tree-insert)
|
||||
|
||||
: tree-insert ( path tree -- ) [ unclip <tree> ] [ children>> ] bi* (tree-insert) ;
|
||||
: tree-insert ( path tree -- ) [ unclip <dir-tree> ] [ children>> ] bi* (tree-insert) ;
|
||||
:: (tree-insert) ( path-rest path-head tree-children -- )
|
||||
tree-children [ node>> path-head node>> = ] find nip
|
||||
[ path-rest swap tree-insert ]
|
||||
|
@ -19,10 +28,22 @@ DEFER: (tree-insert)
|
|||
path-head tree-children push
|
||||
path-rest [ path-head tree-insert ] unless-empty
|
||||
] if* ;
|
||||
: create-tree ( file-list -- tree ) [ path-components ] map
|
||||
t <tree> [ [ tree-insert ] curry each ] keep ;
|
||||
|
||||
: add-paths ( pathseq -- {{name,path}} )
|
||||
"" [ [ "/" glue dup ] keep swap 2array , ] [ reduce drop ] f make ;
|
||||
|
||||
: go-to-path ( path tree -- tree' ) over empty? [ nip ]
|
||||
[ [ unclip ] [ children>> ] bi* swap [ swap node>> = ] curry find nip go-to-path ] if ;
|
||||
|
||||
: find-root ( pathseq -- root ) dup flip
|
||||
[ [ dupd = [ ] [ drop f ] if ] reduce1 ] find-last drop
|
||||
[ first ] dip head-slice >string path-components ;
|
||||
|
||||
: create-tree ( file-list -- tree ) [ find-root ]
|
||||
[ [ path-components add-paths ] map { "/" "/" } <dir-tree> [ [ tree-insert ] curry each ] keep ] bi
|
||||
go-to-path ;
|
||||
|
||||
: <dir-table> ( tree-model -- table )
|
||||
<frp-list*> [ node>> 1array ] >>quot
|
||||
[ selected-value>> <switch> ]
|
||||
<list*> [ node>> 1array ] >>quot
|
||||
[ selected-value>> [ file? not ] filter-model swap switch-models ]
|
||||
[ swap >>model ] bi ;
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
|
@ -0,0 +1 @@
|
|||
Syntax for modifying gadget fonts
|
|
@ -0,0 +1,6 @@
|
|||
USING: help.syntax help.markup ;
|
||||
IN: fonts.syntax
|
||||
|
||||
HELP: FONT:
|
||||
{ $syntax "\"testing\" <label> FONT: 18 serif bold ... ;" }
|
||||
{ $description "Used after a gadget to change font settings. Attributes can be in any order: the first number is set as the size, the style attributes like bold and italic will set the bold? and italic? slots, and font-names like serif or monospace will set the name slot." } ;
|
|
@ -0,0 +1,16 @@
|
|||
USING: accessors arrays variants combinators io.styles
|
||||
kernel math parser sequences fry ;
|
||||
IN: fonts.syntax
|
||||
|
||||
VARIANT: fontname serif monospace ;
|
||||
|
||||
: install ( object quot -- quot/? ) over [ curry ] [ 2drop [ ] ] if ;
|
||||
|
||||
: >>name* ( object fontname -- object ) name>> >>name ;
|
||||
|
||||
SYNTAX: FONT: \ ; parse-until {
|
||||
[ [ number? ] find nip [ >>size ] install ]
|
||||
[ [ italic = ] find nip [ >>italic? ] install ]
|
||||
[ [ bold = ] find nip [ >>bold? ] install ]
|
||||
[ [ fontname? ] find nip [ >>name* ] install ]
|
||||
} cleave 4array concat '[ dup font>> @ drop ] over push-all ;
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
|
@ -0,0 +1,13 @@
|
|||
USING: arrays vectors combinators effects kernel math sequences splitting
|
||||
strings.parser parser fry sequences.extras ;
|
||||
IN: fries
|
||||
: str-fry ( str on -- quot ) split
|
||||
[ unclip-last [ [ spin glue ] reduce-r ] 2curry ]
|
||||
[ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
|
||||
: gen-fry ( str on -- quot ) split
|
||||
[ unclip-last [ [ spin 1array glue ] reduce-r ] 2curry ]
|
||||
[ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
|
||||
|
||||
SYNTAX: i" parse-string rest "_" str-fry over push-all ;
|
||||
SYNTAX: i{ \ } parse-until >array { _ } gen-fry over push-all ;
|
||||
SYNTAX: iV{ \ } parse-until >vector V{ _ } gen-fry over push-all ;
|
|
@ -0,0 +1 @@
|
|||
Generalized Frying
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
|
@ -0,0 +1,10 @@
|
|||
! Copyright (C) 2009 Sam Anklesaria.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs kernel ui.gadgets.borders ui.gestures ;
|
||||
IN: key-handlers
|
||||
|
||||
TUPLE: key-handler < border handlers ;
|
||||
: <keys> ( gadget -- key-handler ) key-handler new-border { 0 0 } >>size ;
|
||||
|
||||
M: key-handler handle-gesture
|
||||
tuck handlers>> at [ call( gadget -- ) f ] [ drop t ] if* ;
|
|
@ -1,14 +1,14 @@
|
|||
USING: tools.deploy.config ;
|
||||
H{
|
||||
{ deploy-math? t }
|
||||
{ deploy-io 2 }
|
||||
{ deploy-unicode? t }
|
||||
{ deploy-name "Merger" }
|
||||
{ deploy-c-types? f }
|
||||
{ "stop-after-last-window?" t }
|
||||
{ deploy-ui? t }
|
||||
{ deploy-reflection 1 }
|
||||
{ deploy-name "Merger" }
|
||||
{ deploy-word-props? f }
|
||||
{ deploy-unicode? f }
|
||||
{ deploy-threads? t }
|
||||
{ deploy-reflection 1 }
|
||||
{ deploy-word-defs? f }
|
||||
{ deploy-math? t }
|
||||
{ deploy-ui? t }
|
||||
{ deploy-word-props? f }
|
||||
{ deploy-io 2 }
|
||||
}
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
USING: accessors arrays fry io.directories kernel models sequences sets ui
|
||||
USING: accessors arrays fry io.directories kernel
|
||||
models sequences sets ui
|
||||
ui.gadgets ui.gadgets.buttons ui.gadgets.labeled
|
||||
ui.gadgets.tracks ui.gadgets.labels ui.gadgets.glass
|
||||
math.rectangles cocoa.dialogs ;
|
||||
|
|
|
@ -0,0 +1,41 @@
|
|||
USING: help.markup help.syntax models models.arrow sequences monads ;
|
||||
IN: models.combinators
|
||||
|
||||
HELP: merge
|
||||
{ $values { "models" "a list of models" } { "model" basic-model } }
|
||||
{ $description "Creates a model that merges the updates of others" } ;
|
||||
|
||||
HELP: filter-model
|
||||
{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-model" filter-model } }
|
||||
{ $description "Creates a model that uses the updates of another model only when they satisfy a given predicate" } ;
|
||||
|
||||
HELP: fold
|
||||
{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "model" model } }
|
||||
{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
|
||||
|
||||
HELP: switch-models
|
||||
{ $values { "model1" model } { "model2" model } { "model'" model } }
|
||||
{ $description "Creates a model that starts with the behavior of model2 and switches to the behavior of model1 on its update" } ;
|
||||
|
||||
HELP: <mapped>
|
||||
{ $values { "model" model } { "quot" "applied to model's value on updates" } { "model" model } }
|
||||
{ $description "An expanded version of " { $link <arrow> } ". Use " { $link fmap } " instead." } ;
|
||||
|
||||
HELP: when-model
|
||||
{ $values { "model" model } { "quot" "called on the model if the quot yields true" } { "cond" "a quotation called on the model's value, yielding a boolean value" } }
|
||||
{ $description "Calls quot when model updates if its value meets the condition set in cond" } ;
|
||||
|
||||
HELP: with-self
|
||||
{ $values { "quot" "quotation that recieves its own return value" } { "model" model } }
|
||||
{ $description "Fixed points for models: the quot reacts to the same model to gives" } ;
|
||||
|
||||
HELP: #1
|
||||
{ $values { "model" model } { "model'" model } }
|
||||
{ $description "Moves a model to the top of its dependencies' connections, thus being notified before the others" } ;
|
||||
|
||||
ARTICLE: "models.combinators" "Extending models"
|
||||
"The " { $vocab-link "models.combinators" } " library expands models to have discrete start and end times. "
|
||||
"Also, it provides methods of manipulating and combining models, expecially useful when programming user interfaces: "
|
||||
"The output models of some gadgets (see " { $vocab-link "ui.gadgets.controls" } " ) can be manipulated and used as the input models of others. " ;
|
||||
|
||||
ABOUT: "models.combinators"
|
|
@ -0,0 +1,105 @@
|
|||
USING: accessors arrays kernel models models.product monads
|
||||
sequences sequences.extras ;
|
||||
FROM: syntax => >> ;
|
||||
IN: models.combinators
|
||||
|
||||
TUPLE: multi-model < model important? ;
|
||||
GENERIC: (model-changed) ( model observer -- )
|
||||
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
|
||||
M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
|
||||
M: multi-model model-activated dup dependencies>> [ value>> ] find nip
|
||||
[ swap model-changed ] [ drop ] if* ;
|
||||
|
||||
: #1 ( model -- model' ) t >>important? ;
|
||||
|
||||
IN: models
|
||||
: notify-connections ( model -- )
|
||||
dup connections>> dup [ dup multi-model? [ important?>> ] [ drop f ] if ] find-all
|
||||
[ second tuck [ remove ] dip prefix ] each
|
||||
[ model-changed ] with each ;
|
||||
IN: models.combinators
|
||||
|
||||
TUPLE: basic-model < multi-model ;
|
||||
M: basic-model (model-changed) [ value>> ] dip set-model ;
|
||||
: merge ( models -- model ) basic-model <multi-model> ;
|
||||
: 2merge ( model1 model2 -- model ) 2array merge ;
|
||||
: <basic> ( value -- model ) basic-model new-model ;
|
||||
|
||||
TUPLE: filter-model < multi-model quot ;
|
||||
M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
|
||||
[ set-model ] [ 2drop ] if ;
|
||||
: filter-model ( model quot -- filter-model ) [ 1array \ filter-model <multi-model> ] dip >>quot ;
|
||||
|
||||
TUPLE: fold-model < multi-model quot base values ;
|
||||
M: fold-model (model-changed) 2dup base>> =
|
||||
[ [ [ value>> ] [ [ values>> ] [ quot>> ] bi ] bi* swapd reduce* ] keep set-model ]
|
||||
[ [ [ value>> ] [ values>> ] bi* push ]
|
||||
[ [ [ value>> ] [ [ value>> ] [ quot>> ] bi ] bi* call( val oldval -- newval ) ] keep set-model ] 2bi
|
||||
] if ;
|
||||
M: fold-model model-activated drop ;
|
||||
: new-fold-model ( deps -- model ) fold-model <multi-model> V{ } clone >>values ;
|
||||
: fold ( model oldval quot -- model ) rot 1array new-fold-model swap >>quot
|
||||
swap >>value ;
|
||||
: fold* ( model oldmodel quot -- model ) over [ [ 2array new-fold-model ] dip >>quot ]
|
||||
dip [ >>base ] [ value>> >>value ] bi ;
|
||||
|
||||
TUPLE: updater-model < multi-model values updates ;
|
||||
M: updater-model (model-changed) [ tuck updates>> =
|
||||
[ [ values>> value>> ] keep set-model ]
|
||||
[ drop ] if ] keep f swap (>>value) ;
|
||||
: updates ( values updates -- model ) [ 2array updater-model <multi-model> ] 2keep
|
||||
[ >>values ] [ >>updates ] bi* ;
|
||||
|
||||
SYMBOL: switch
|
||||
TUPLE: switch-model < multi-model original switcher on ;
|
||||
M: switch-model (model-changed) 2dup switcher>> =
|
||||
[ [ value>> ] dip over switch = [ nip [ original>> ] keep f >>on model-changed ] [ t >>on set-model ] if ]
|
||||
[ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
|
||||
: switch-models ( model1 model2 -- model' ) swap [ 2array switch-model <multi-model> ] 2keep
|
||||
[ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
|
||||
M: switch-model model-activated [ original>> ] keep model-changed ;
|
||||
: >behavior ( event -- behavior ) t >>value ;
|
||||
|
||||
TUPLE: mapped-model < multi-model model quot ;
|
||||
: new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
|
||||
<multi-model> swap >>quot swap >>model ;
|
||||
: <mapped> ( model quot -- model ) mapped-model new-mapped-model ;
|
||||
M: mapped-model (model-changed)
|
||||
[ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
|
||||
set-model ;
|
||||
|
||||
TUPLE: side-effect-model < mapped-model ;
|
||||
M: side-effect-model (model-changed) [ value>> ] dip [ quot>> call( old -- ) ] 2keep set-model ;
|
||||
|
||||
TUPLE: quot-model < mapped-model ;
|
||||
M: quot-model (model-changed) nip [ quot>> call( -- b ) ] keep set-model ;
|
||||
|
||||
TUPLE: action-value < basic-model parent ;
|
||||
: <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
|
||||
M: action-value model-activated dup parent>> dup activate-model model-changed ; ! a fake dependency of sorts
|
||||
|
||||
TUPLE: action < multi-model quot ;
|
||||
M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
|
||||
[ swap add-connection ] 2keep model-changed ;
|
||||
: <action> ( model quot -- action-model ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
|
||||
|
||||
TUPLE: collection < multi-model ;
|
||||
: <collection> ( models -- product ) collection <multi-model> ;
|
||||
M: collection (model-changed)
|
||||
nip
|
||||
dup dependencies>> [ value>> ] all?
|
||||
[ dup [ value>> ] product-value swap set-model ]
|
||||
[ drop ] if ;
|
||||
M: collection model-activated dup (model-changed) ;
|
||||
|
||||
! for side effects
|
||||
TUPLE: (when-model) < multi-model quot cond ;
|
||||
: when-model ( model quot cond -- model ) rot 1array (when-model) <multi-model> swap >>cond swap >>quot ;
|
||||
M: (when-model) (model-changed) [ quot>> ] 2keep
|
||||
[ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
|
||||
|
||||
! only used in construction
|
||||
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
|
||||
|
||||
USE: models.combinators.templates
|
||||
<< { "$>" "<$" "fmap" } [ fmaps ] each >>
|
|
@ -0,0 +1 @@
|
|||
Model combination and manipulation
|
|
@ -0,0 +1,23 @@
|
|||
USING: kernel sequences functors fry macros generalizations ;
|
||||
IN: models.combinators.templates
|
||||
FROM: models.combinators => <collection> #1 ;
|
||||
FUNCTOR: fmaps ( W -- )
|
||||
W IS ${W}
|
||||
w-n DEFINES ${W}-n
|
||||
w-2 DEFINES 2${W}
|
||||
w-3 DEFINES 3${W}
|
||||
w-4 DEFINES 4${W}
|
||||
w-n* DEFINES ${W}-n*
|
||||
w-2* DEFINES 2${W}*
|
||||
w-3* DEFINES 3${W}*
|
||||
w-4* DEFINES 4${W}*
|
||||
WHERE
|
||||
MACRO: w-n ( int -- quot ) dup '[ [ _ narray <collection> ] dip [ _ firstn ] prepend W ] ;
|
||||
: w-2 ( a b quot -- mapped ) 2 w-n ; inline
|
||||
: w-3 ( a b c quot -- mapped ) 3 w-n ; inline
|
||||
: w-4 ( a b c d quot -- mapped ) 4 w-n ; inline
|
||||
MACRO: w-n* ( int -- quot ) dup '[ [ _ narray <collection> #1 ] dip [ _ firstn ] prepend W ] ;
|
||||
: w-2* ( a b quot -- mapped ) 2 w-n* ; inline
|
||||
: w-3* ( a b c quot -- mapped ) 3 w-n* ; inline
|
||||
: w-4* ( a b c d quot -- mapped ) 4 w-n* ; inline
|
||||
;FUNCTOR
|
|
@ -0,0 +1,5 @@
|
|||
USING: help.syntax help.markup modules.rpc-server modules.using ;
|
||||
IN: modules.rpc-server
|
||||
HELP: service
|
||||
{ $syntax "IN: my-vocab service" }
|
||||
{ $description "Allows words defined in the vocabulary to be used as remote procedure calls by " { $link POSTPONE: USING*: } } ;
|
|
@ -0,0 +1,31 @@
|
|||
! Copyright (C) 2009 Sam Anklesaria.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs combinators continuations effects
|
||||
io.encodings.binary io.servers.connection kernel namespaces
|
||||
sequences serialize sets threads vocabs vocabs.parser init io ;
|
||||
IN: modules.rpc-server
|
||||
|
||||
<PRIVATE
|
||||
TUPLE: rpc-request args vocabspec wordname ;
|
||||
SYMBOL: serving-vocabs serving-vocabs [ V{ } clone ] initialize
|
||||
|
||||
: getter ( -- ) deserialize dup serving-vocabs get-global index
|
||||
[ vocab-words [ stack-effect ] { } assoc-map-as ]
|
||||
[ \ no-vocab boa ] if serialize flush ;
|
||||
|
||||
: doer ( -- ) deserialize dup vocabspec>> serving-vocabs get-global index
|
||||
[ [ args>> ] [ wordname>> ] [ vocabspec>> vocab-words ] tri at [ execute ] curry with-datastack ]
|
||||
[ vocabspec>> \ no-vocab boa ] if serialize flush ;
|
||||
|
||||
PRIVATE>
|
||||
SYNTAX: service current-vocab name>> serving-vocabs get-global adjoin ;
|
||||
|
||||
[ [ binary <threaded-server>
|
||||
"rpcs" >>name 9012 >>insecure
|
||||
[ deserialize {
|
||||
{ "getter" [ getter ] }
|
||||
{ "doer" [ doer ] }
|
||||
{ "loader" [ deserialize vocab serialize flush ] }
|
||||
} case ] >>handler
|
||||
start-server ] in-thread
|
||||
] "modules.rpc-server" add-init-hook
|
|
@ -0,0 +1 @@
|
|||
Serve factor words as rpcs
|
|
@ -0,0 +1,27 @@
|
|||
! Copyright (C) 2009 Sam Anklesaria.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs fry generalizations io.encodings.binary
|
||||
io.sockets kernel locals namespaces parser sequences serialize
|
||||
vocabs vocabs.parser words io ;
|
||||
IN: modules.rpc
|
||||
|
||||
TUPLE: rpc-request args vocabspec wordname ;
|
||||
|
||||
: send-with-check ( message -- reply/* )
|
||||
serialize flush deserialize dup no-vocab? [ throw ] when ;
|
||||
|
||||
:: define-remote ( str effect addrspec vocabspec -- )
|
||||
str create-in effect [ in>> length ] [ out>> length ] bi
|
||||
'[ _ narray vocabspec str rpc-request boa addrspec 9012 <inet> binary
|
||||
[ "doer" serialize send-with-check ] with-client _ firstn ]
|
||||
effect define-declared ;
|
||||
|
||||
:: remote-vocab ( addrspec vocabspec -- vocab )
|
||||
vocabspec "-remote" append dup vocab [ dup set-current-vocab
|
||||
vocabspec addrspec 9012 <inet> binary [ "getter" serialize send-with-check ] with-client
|
||||
[ first2 addrspec vocabspec define-remote ] each
|
||||
] unless ;
|
||||
|
||||
: remote-load ( addr vocabspec -- voabspec ) [ swap
|
||||
9012 <inet> binary [ "loader" serialize serialize flush deserialize ] with-client ] keep
|
||||
[ dictionary get-global set-at ] keep ;
|
|
@ -0,0 +1 @@
|
|||
Improved module import syntax with network transparency
|
|
@ -0,0 +1,11 @@
|
|||
USING: help.syntax help.markup strings modules.using ;
|
||||
IN: modules.using
|
||||
ARTICLE: { "modules.using" "use" } "Using the modules.using vocab"
|
||||
"This vocabulary defines " { $link POSTPONE: USING*: } " as an alternative to " { $link POSTPONE: USING: } " which makes qualified imports easier. "
|
||||
"Secondly, it allows loading vocabularies from remote servers, as long as the remote vocabulary can be accessed at compile time. "
|
||||
"Finally, the word can treat words in remote vocabularies as remote procedure calls. Any inputs are passed to the imported words as normal, and the result will appear on the stack- the only difference is that the word isn't called locally." ;
|
||||
ABOUT: { "modules.using" "use" }
|
||||
|
||||
HELP: USING*:
|
||||
{ $syntax "USING: rpc-server::module fetch-sever:module { module qualified-name } { module => word ... } { qualified-module } { module EXCEPT word ... } { module word => importname } ;" }
|
||||
{ $description "Adds vocabularies to the search path. Vocabularies can be loaded off a server or called as an rpc if preceded by a valid hostname. Bracketed pairs facilitate all types of qualified imports on both remote and local modules." } ;
|
|
@ -0,0 +1,28 @@
|
|||
! Copyright (C) 2009 Sam Anklesaria.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel modules.rpc peg peg-lexer peg.ebnf sequences
|
||||
strings vocabs.parser ;
|
||||
IN: modules.using
|
||||
|
||||
EBNF: modulize
|
||||
tokenpart = (!(':').)+ => [[ >string ]]
|
||||
s = ':' => [[ drop ignore ]]
|
||||
rpc = tokenpart s s tokenpart => [[ first2 remote-vocab ]]
|
||||
remote = tokenpart s tokenpart => [[ first2 remote-load ]]
|
||||
module = rpc | remote | tokenpart
|
||||
;EBNF
|
||||
|
||||
ON-BNF: USING*:
|
||||
tokenizer = <foreign factor>
|
||||
sym = !(";"|"}"|"=>"|"EXCEPT").
|
||||
modspec = sym => [[ modulize ]]
|
||||
qualified-with = modspec sym => [[ first2 add-qualified ignore ]]
|
||||
qualified = modspec => [[ dup add-qualified ignore ]]
|
||||
from = modspec "=>" sym+ => [[ first3 nip add-words-from ignore ]]
|
||||
exclude = modspec "EXCEPT" sym+ => [[ first3 nip add-words-excluding ignore ]]
|
||||
rename = modspec sym "=>" sym => [[ first4 nip swapd add-renamed-word ignore ]]
|
||||
long = "{" ( from | exclude | rename | qualified-with | qualified ) "}" => [[ drop ignore ]]
|
||||
short = modspec => [[ use-vocab ignore ]]
|
||||
wordSpec = long | short
|
||||
using = wordSpec+ ";" => [[ drop ignore ]]
|
||||
;ON-BNF
|
|
@ -7,6 +7,8 @@ IN: monads
|
|||
|
||||
! Functors
|
||||
GENERIC# fmap 1 ( functor quot -- functor' )
|
||||
GENERIC# <$ 1 ( functor quot -- functor' )
|
||||
GENERIC# $> 1 ( functor quot -- functor' )
|
||||
|
||||
! Monads
|
||||
|
||||
|
@ -22,6 +24,7 @@ M: monad return monad-of return ;
|
|||
M: monad fail monad-of fail ;
|
||||
|
||||
: bind ( mvalue quot -- mvalue' ) swap >>= call( quot -- mvalue ) ;
|
||||
: bind* ( mvalue quot -- mvalue' ) '[ drop @ ] bind ;
|
||||
: >> ( mvalue k -- mvalue' ) '[ drop _ ] bind ;
|
||||
|
||||
:: lift-m2 ( m1 m2 f monad -- m3 )
|
||||
|
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
|
@ -0,0 +1,30 @@
|
|||
USING: accessors arrays byte-arrays calendar classes
|
||||
classes.tuple classes.tuple.parser combinators db db.queries
|
||||
db.tuples db.types kernel math nmake parser sequences strings
|
||||
strings.parser unicode.case urls words ;
|
||||
IN: persistency
|
||||
|
||||
TUPLE: persistent id ;
|
||||
|
||||
: add-types ( table -- table' ) [ dup array? [ [ first dup >upper ] [ second ] bi 3array ]
|
||||
[ dup >upper FACTOR-BLOB 3array ] if
|
||||
] map { "id" "ID" +db-assigned-id+ } prefix ;
|
||||
|
||||
: remove-types ( table -- table' ) [ dup array? [ first ] when ] map ;
|
||||
|
||||
SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-types define-tuple-class ]
|
||||
[ nip [ dup name>> >upper ] [ add-types ] bi* define-persistent ] 3bi ;
|
||||
|
||||
: define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
|
||||
|
||||
: query>tuple ( tuple/query -- tuple ) dup query? [ tuple>> ] when ;
|
||||
: w/db ( query quot -- ) [ dup query>tuple class "database" word-prop ] dip with-db ; inline
|
||||
: get-tuples ( query -- tuples ) [ select-tuples ] w/db ;
|
||||
: get-tuple ( query -- tuple ) [ select-tuple ] w/db ;
|
||||
: store-tuple ( tuple -- ) [ insert-tuple ] w/db ;
|
||||
: modify-tuple ( tuple -- ) [ update-tuple ] w/db ;
|
||||
: remove-tuples ( tuple -- ) [ delete-tuples ] w/db ;
|
||||
|
||||
TUPLE: pattern value ; C: <pattern> pattern
|
||||
SYNTAX: %" parse-string <pattern> parsed ;
|
||||
M: pattern where value>> over column-name>> 0% " LIKE " 0% bind# ;
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
@ -0,0 +1,61 @@
|
|||
USING: accessors arrays colors.constants combinators
|
||||
db.sqlite db.tuples db.types kernel locals math
|
||||
monads persistency sequences sequences.extras ui ui.gadgets.controls
|
||||
ui.gadgets.layout models.combinators ui.gadgets.labels
|
||||
ui.gadgets.scrollers ui.pens.solid io.files.temp ;
|
||||
FROM: sets => prune ;
|
||||
IN: recipes
|
||||
|
||||
STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
|
||||
: <recipe> ( title genre text -- recipe ) recipe new swap >>txt swap >>genre swap >>title 0 >>votes ;
|
||||
"recipes.db" temp-file <sqlite-db> recipe define-db
|
||||
: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
|
||||
"votes" >>order 30 >>limit swap >>offset get-tuples ;
|
||||
: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 short head-slice ;
|
||||
|
||||
: interface ( -- book ) [
|
||||
[
|
||||
[ $ TOOLBAR $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
|
||||
[ "Genres:" <label> , <spacer> $ ALL $ $ GENRES $ ] <hbox>
|
||||
{ 5 0 } >>gap COLOR: gray <solid> >>interior ,
|
||||
$ RECIPES $
|
||||
] <vbox> ,
|
||||
[
|
||||
[ "Title:" <label> , $ TITLE $ "Genre:" <label> , $ GENRE $ ] <hbox> ,
|
||||
$ BODY $
|
||||
$ BUTTON $
|
||||
] <vbox> ,
|
||||
] <book*> { 350 245 } >>pref-dim ;
|
||||
|
||||
:: recipe-browser ( -- ) [ [
|
||||
interface
|
||||
<table*> :> tbl
|
||||
"okay" <model-border-btn> BUTTON -> :> ok
|
||||
IMG-MODEL-BTN: submit [ store-tuple ] >>value TOOLBAR -> :> submit
|
||||
IMG-MODEL-BTN: love 1 >>value TOOLBAR ->
|
||||
IMG-MODEL-BTN: hate -1 >>value -> 2array merge :> votes
|
||||
IMG-MODEL-BTN: back -> [ -30 ] <$
|
||||
IMG-MODEL-BTN: more -> [ 30 ] <$ 2array merge :> viewed
|
||||
<spacer> <model-field*> ->% 1 :> search
|
||||
submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot
|
||||
viewed 0 [ + ] fold search ok t <basic> "all" <model-btn> ALL ->
|
||||
tbl selection>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
|
||||
4array merge
|
||||
[ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> ups
|
||||
ups [ top-genres [ <model-btn> GENRES -> ] map merge ] bind*
|
||||
[ text>> T{ recipe } swap >>genre get-tuples ] fmap
|
||||
tbl swap ups 2merge >>model
|
||||
[ [ title>> ] [ genre>> ] bi 2array ] >>quot
|
||||
{ "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>>
|
||||
submit [ "" dup dup <recipe> ] <$ 2array merge
|
||||
{ [ [ title>> ] fmap <model-field> TITLE ->% .5 ]
|
||||
[ [ genre>> ] fmap <model-field> GENRE ->% .5 ]
|
||||
[ [ txt>> ] fmap <model-editor> BODY ->% 1 ]
|
||||
} cleave
|
||||
[ <recipe> ] 3fmap
|
||||
[ [ 1 ] <$ ]
|
||||
[ quot ok updates #1 [ call( recipe -- ) 0 ] 2fmap ] bi
|
||||
2merge 0 <basic> switch-models >>model
|
||||
] with-interface "recipes" open-window ] with-ui ;
|
||||
|
||||
MAIN: recipe-browser
|
|
@ -0,0 +1 @@
|
|||
Database backed recipe sharing
|
|
@ -0,0 +1,3 @@
|
|||
USING: io io.encodings.utf8 io.launcher kernel sequences ;
|
||||
IN: run-desc
|
||||
: run-desc ( desc -- result ) utf8 [ contents [ but-last ] [ f ] if* ] with-process-reader ;
|
|
@ -0,0 +1,21 @@
|
|||
USING: arrays kernel locals math sequences ;
|
||||
IN: sequences.extras
|
||||
: reduce1 ( seq quot -- result ) [ unclip ] dip reduce ; inline
|
||||
|
||||
:: reduce-r
|
||||
( list identity quot: ( obj1 obj2 -- obj ) -- result )
|
||||
list empty?
|
||||
[ identity ]
|
||||
[ list rest identity quot reduce-r list first quot call ] if ;
|
||||
inline recursive
|
||||
|
||||
! Quot must have static stack effect, unlike "reduce"
|
||||
:: reduce* ( seq id quot -- result ) seq
|
||||
[ id ]
|
||||
[ unclip id swap quot call( prev elt -- next ) quot reduce* ] if-empty ; inline recursive
|
||||
|
||||
:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
|
||||
: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
|
||||
[ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
|
||||
|
||||
: insert-sorted ( elt seq -- seq ) 2dup [ < ] with find drop over length or swap insert-nth ;
|
|
@ -0,0 +1,9 @@
|
|||
USING: accessors assocs fry generalizations kernel math
|
||||
namespaces parser sequences words ;
|
||||
IN: set-n
|
||||
: get* ( var n -- val ) namestack dup length rot - head assoc-stack ;
|
||||
|
||||
: set* ( val var n -- ) 1 + namestack [ length swap - ] keep nth set-at ;
|
||||
|
||||
! dynamic lambda
|
||||
SYNTAX: :| (:) dup in>> dup length [ spin '[ _ narray _ swap zip _ bind ] ] 2curry dip define-declared ;
|
|
@ -1,7 +0,0 @@
|
|||
USING: combinators effects kernel math sequences splitting
|
||||
strings.parser ;
|
||||
IN: str-fry
|
||||
: str-fry ( str -- quot ) "_" split
|
||||
[ unclip [ [ rot glue ] reduce ] 2curry ]
|
||||
[ length 1 - 1 <effect> [ call-effect ] 2curry ] bi ;
|
||||
SYNTAX: I" parse-string rest str-fry over push-all ;
|
|
@ -1 +0,0 @@
|
|||
String Frying
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
|
@ -0,0 +1,40 @@
|
|||
USING: accessors arrays combinators.short-circuit grouping kernel lists
|
||||
lists.lazy locals math math.functions math.parser math.ranges
|
||||
models.product monads random sequences sets ui ui.gadgets.controls
|
||||
ui.gadgets.layout models.combinators ui.gadgets.alerts vectors fry
|
||||
ui.gadgets.labels ;
|
||||
IN: sudokus
|
||||
|
||||
: row ( index -- row ) 1 + 9 / ceiling ;
|
||||
: col ( index -- col ) 9 mod 1 + ;
|
||||
: sq ( index -- square ) [ row ] [ col ] bi [ 3 / ceiling ] bi@ 2array ;
|
||||
: near ( a pos -- ? ) { [ [ row ] bi@ = ] [ [ col ] bi@ = ] [ [ sq ] bi@ = ] } 2|| ;
|
||||
: nth-or-lower ( n seq -- elt ) [ length 1 - 2dup > [ nip ] [ drop ] if ] keep nth ;
|
||||
|
||||
:: solutions ( puzzle random? -- solutions )
|
||||
f puzzle random? [ indices [ f ] [ random? swap nth-or-lower ] if-empty ] [ index ] if
|
||||
[ :> pos
|
||||
1 9 [a,b] 80 iota [ pos near ] filter [ puzzle nth ] map prune diff
|
||||
[ 1array puzzle pos cut-slice rest surround ] map >list [ random? solutions ] bind
|
||||
] [ puzzle list-monad return ] if* ;
|
||||
|
||||
: solution ( puzzle random? -- solution ) dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
|
||||
: hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ f solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
|
||||
: create ( difficulty -- puzzle ) 81 [ f ] replicate
|
||||
40 random solution [ [ dup length random f spin set-nth ] curry times ] keep ;
|
||||
|
||||
: do-sudoku ( -- ) [ [
|
||||
[
|
||||
81 [ "" ] replicate <basic> switch-models [ [ <basic> ] map 9 group [ 3 group ] map 3 group
|
||||
[ [ [ <spacer> [ [ <model-field> ->% 2 [ string>number ] fmap ]
|
||||
map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product>
|
||||
[ "Difficulty:" <label> , "1" <basic> <model-field> -> [ string>number 1 or 1 + 10 * ] fmap
|
||||
"Generate" <model-border-btn> -> updates [ create ] fmap <spacer>
|
||||
"Hint" <model-border-btn> -> "Solve" <model-border-btn> -> ] <hbox> ,
|
||||
roll [ swap updates ] curry bi@
|
||||
[ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array merge [ [ [ number>string ] [ "" ] if* ] map ] fmap
|
||||
] bind
|
||||
] with-self , ] <vbox> { 280 220 } >>pref-dim
|
||||
"Sudoku Sleuth" open-window ] with-ui ;
|
||||
|
||||
MAIN: do-sudoku
|
|
@ -0,0 +1 @@
|
|||
graphical sudoku solver
|
|
@ -1,46 +0,0 @@
|
|||
USING: help.markup help.syntax models monads sequences
|
||||
ui.gadgets.buttons ui.gadgets.tracks ;
|
||||
IN: ui.frp
|
||||
|
||||
! Layout utilities
|
||||
|
||||
HELP: ,
|
||||
{ $values { "uiitem" "a gadget or model" } }
|
||||
{ $description "Used in a series of gadgets created by a box, accumulating the gadget" } ;
|
||||
HELP: ->
|
||||
{ $values { "uiitem" "a gadget or model" } { "model" model } }
|
||||
{ $description "Like " { $link , } "but passes its model on for further use." } ;
|
||||
HELP: <hbox>
|
||||
{ $values { "gadgets" "a list of gadgets" } { "track" track } }
|
||||
{ $syntax "[ gadget , gadget , ... ] <hbox>" }
|
||||
{ $description "Creates an horizontal track containing the gadgets listed in the quotation" } ;
|
||||
HELP: <vbox>
|
||||
{ $values { "gadgets" "a list of gadgets" } { "track" track } }
|
||||
{ $syntax "[ gadget , gadget , ... ] <hbox>" }
|
||||
{ $description "Creates an vertical track containing the gadgets listed in the quotation" } ;
|
||||
|
||||
! Gadgets
|
||||
HELP: <frp-button>
|
||||
{ $values { "text" "the button's label" } { "button" button } }
|
||||
{ $description "Creates an button whose model updates on clicks" } ;
|
||||
|
||||
HELP: <merge>
|
||||
{ $values { "models" "a list of models" } { "model" merge-model } }
|
||||
{ $description "Creates a model that merges the updates of others" } ;
|
||||
|
||||
HELP: <filter>
|
||||
{ $values { "model" model } { "quot" "quotation with stack effect ( a b -- c )" } { "filter-model" filter-model } }
|
||||
{ $description "Creates a model that uses the updates of another model when they satisfy a given predicate" } ;
|
||||
|
||||
HELP: <fold>
|
||||
{ $values { "oldval" "starting value" } { "quot" "applied to update and previous values" } { "model" model } { "model'" model } }
|
||||
{ $description "Similar to " { $link reduce } " but works on models, applying a quotation to the previous and new values at each update" } ;
|
||||
|
||||
HELP: <switch>
|
||||
{ $values { "signal1" model } { "signal2" model } { "signal'" model } }
|
||||
{ $description "Creates a model that starts with the behavior of model1 and switches to the behavior of model2 on its update" } ;
|
||||
|
||||
ARTICLE: { "frp" "instances" } "FRP Instances"
|
||||
"Models are all functors, as " { $link fmap } " corresponds directly to the " { $link "models.arrow" } " vocabulary. "
|
||||
"Also, a gadget is a monad. Binding recieves a model and creates a new gadget." ;
|
||||
|
|
@ -1,104 +0,0 @@
|
|||
USING: accessors arrays colors fonts kernel models
|
||||
models.product monads sequences ui.gadgets ui.gadgets.buttons
|
||||
ui.gadgets.editors ui.gadgets.line-support ui.gadgets.tables
|
||||
ui.gadgets.tracks ui.render ui.gadgets.scrollers ;
|
||||
QUALIFIED: make
|
||||
IN: ui.frp
|
||||
|
||||
! Gadgets
|
||||
: <frp-button> ( text -- button ) [ t swap set-control-value ] <border-button> f <model> >>model ;
|
||||
TUPLE: frp-table < table quot val-quot color-quot column-titles column-alignment ;
|
||||
M: frp-table column-titles column-titles>> ;
|
||||
M: frp-table column-alignment column-alignment>> ;
|
||||
M: frp-table row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
||||
M: frp-table row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
||||
M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
||||
|
||||
: <frp-table> ( model -- table )
|
||||
frp-table new-line-gadget dup >>renderer [ ] >>quot swap >>model
|
||||
f <model> >>selected-value sans-serif-font >>font
|
||||
focus-border-color >>focus-border-color
|
||||
transparent >>column-line-color [ ] >>val-quot ;
|
||||
: <frp-table*> ( -- table ) f <model> <frp-table> ;
|
||||
: <frp-list> ( model -- table ) <frp-table> [ 1array ] >>quot ;
|
||||
: <frp-list*> ( -- table ) f <model> <frp-list> ;
|
||||
|
||||
: <frp-field> ( -- field ) f <model> <model-field> ;
|
||||
|
||||
! Layout utilities
|
||||
|
||||
GENERIC: output-model ( gadget -- model )
|
||||
M: gadget output-model model>> ;
|
||||
M: frp-table output-model selected-value>> ;
|
||||
M: model-field output-model field-model>> ;
|
||||
M: scroller output-model children>> first model>> ;
|
||||
|
||||
GENERIC: , ( uiitem -- )
|
||||
M: gadget , make:, ;
|
||||
M: model , activate-model ;
|
||||
|
||||
GENERIC: -> ( uiitem -- model )
|
||||
M: gadget -> dup make:, output-model ;
|
||||
M: model -> dup , ;
|
||||
M: table -> dup , selected-value>> ;
|
||||
|
||||
: <box> ( gadgets type -- track )
|
||||
[ { } make:make ] dip <track> swap [ f track-add ] each ; inline
|
||||
: <box*> ( gadgets type -- track ) [ <box> ] [ [ model>> ] map <product> ] bi >>model ; inline
|
||||
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
|
||||
: <hbox*> ( gadgets -- track ) horizontal <box*> ; inline
|
||||
: <vbox> ( gadgets -- track ) vertical <box> ; inline
|
||||
: <vbox*> ( gadgets -- track ) vertical <box*> ; inline
|
||||
|
||||
! !!! Model utilities
|
||||
TUPLE: multi-model < model ;
|
||||
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
|
||||
|
||||
! Events- discrete model utilities
|
||||
|
||||
TUPLE: merge-model < multi-model ;
|
||||
M: merge-model model-changed [ value>> ] dip set-model ;
|
||||
: <merge> ( models -- model ) merge-model <multi-model> ;
|
||||
|
||||
TUPLE: filter-model < multi-model quot ;
|
||||
M: filter-model model-changed [ value>> ] dip [ quot>> call( val -- bool ) ] 2keep
|
||||
[ set-model ] [ 2drop ] if ;
|
||||
: <filter> ( model quot -- filter-model ) [ 1array filter-model <multi-model> ] dip >>quot ;
|
||||
|
||||
! Behaviors - continuous model utilities
|
||||
|
||||
TUPLE: fold-model < multi-model oldval quot ;
|
||||
M: fold-model model-changed [ [ value>> ] [ [ oldval>> ] [ quot>> ] bi ] bi*
|
||||
call( val oldval -- newval ) ] keep set-model ;
|
||||
: <fold> ( oldval quot model -- model' ) 1array fold-model <multi-model> swap >>quot
|
||||
swap [ >>oldval ] [ >>value ] bi ;
|
||||
|
||||
TUPLE: switch-model < multi-model original switcher on ;
|
||||
M: switch-model model-changed 2dup switcher>> =
|
||||
[ over value>> [ [ value>> ] [ t >>on ] bi* set-model ] [ 2drop ] if ]
|
||||
[ dup on>> [ 2drop ] [ [ value>> ] dip set-model ] if ] if ;
|
||||
M: switch-model model-activated [ original>> ] keep model-changed ;
|
||||
: <switch> ( signal1 signal2 -- signal' ) [ 2array switch-model <multi-model> ] 2keep
|
||||
[ >>original ] [ >>switcher ] bi* ;
|
||||
|
||||
TUPLE: mapped < model model quot ;
|
||||
|
||||
: <mapped> ( model quot -- arrow )
|
||||
f mapped new-model
|
||||
swap >>quot
|
||||
over >>model
|
||||
[ add-dependency ] keep ;
|
||||
|
||||
M: mapped model-changed
|
||||
[ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
|
||||
set-model ;
|
||||
|
||||
! Instances
|
||||
M: model fmap <mapped> ;
|
||||
|
||||
SINGLETON: gadget-monad
|
||||
INSTANCE: gadget-monad monad
|
||||
INSTANCE: gadget monad
|
||||
M: gadget monad-of drop gadget-monad ;
|
||||
M: gadget-monad return drop <gadget> swap >>model ;
|
||||
M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
|
|
@ -1 +0,0 @@
|
|||
Utilities for functional reactive programming in user interfaces
|
|
@ -1,4 +1,28 @@
|
|||
USING: accessors ui ui.gadgets ui.gadgets.labels ui.gadgets.buttons ui.gadgets.packs locals sequences fonts io.styles ;
|
||||
USING: accessors models monads macros generalizations kernel
|
||||
ui ui.gadgets.controls models.combinators ui.gadgets.layout ui.gadgets
|
||||
ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
|
||||
ui.gadgets.packs locals sequences fonts io.styles
|
||||
wrap.strings ;
|
||||
|
||||
IN: ui.gadgets.alerts
|
||||
:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
|
||||
"okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
|
||||
:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
|
||||
string 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
|
||||
"okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
|
||||
|
||||
: alert* ( str -- ) [ ] swap alert ;
|
||||
|
||||
:: ask-user ( string -- model' )
|
||||
[ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
|
||||
fldm [ <model-field*> ->% 1 ]
|
||||
btn [ "okay" <model-border-btn> ] |
|
||||
btn -> [ fldm swap updates ]
|
||||
[ [ drop lbl close-window ] $> , ] bi
|
||||
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
|
||||
|
||||
MACRO: ask-buttons ( buttons -- quot ) dup length [
|
||||
[ swap
|
||||
[ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
|
||||
[ [ <model-border-btn> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
|
||||
"" open-window
|
||||
] dip firstn
|
||||
] 2curry ;
|
|
@ -5,8 +5,13 @@ IN: ui.gadgets.book-extras
|
|||
: |<< ( book -- ) 0 swap set-control-value ;
|
||||
: next ( book -- ) model>> [ 1 + ] change-model ;
|
||||
: prev ( book -- ) model>> [ 1 - ] change-model ;
|
||||
: (book-t) ( quot -- quot ) '[ : owner ( gadget -- book ) parent>> dup book? [ owner ] unless ; owner @ ] ;
|
||||
: owner ( gadget -- book ) parent>> dup book? [ owner ] unless ;
|
||||
: (book-t) ( quot -- quot ) '[ owner @ ] ;
|
||||
: <book-btn> ( label quot -- button ) (book-t) <button> ;
|
||||
: <book-bevel-btn> ( label quot -- button ) (book-t) <border-button> ;
|
||||
: >>> ( label -- button ) [ next ] <book-btn> ;
|
||||
: <<< ( label -- button ) [ prev ] <book-btn> ;
|
||||
: <book-border-btn> ( label quot -- button ) (book-t) <border-button> ;
|
||||
: >>> ( gadget -- ) owner next ;
|
||||
: <<< ( gadget -- ) owner prev ;
|
||||
: go-to ( gadget number -- ) swap owner model>> set-model ;
|
||||
|
||||
: <forward-btn> ( label -- button ) [ >>> ] <button> ;
|
||||
: <backward-btn> ( label -- button ) [ <<< ] <button> ;
|
||||
|
|
|
@ -1,22 +1,22 @@
|
|||
USING: accessors arrays kernel math.rectangles models sequences
|
||||
ui.frp ui.gadgets ui.gadgets.glass ui.gadgets.labels
|
||||
ui.gadgets.tables ui.gestures ;
|
||||
USING: accessors arrays kernel math.rectangles sequences
|
||||
ui.gadgets.controls models.combinators ui.gadgets ui.gadgets.glass
|
||||
ui.gadgets.labels ui.gestures ;
|
||||
QUALIFIED-WITH: ui.gadgets.tables tbl
|
||||
IN: ui.gadgets.comboboxes
|
||||
|
||||
TUPLE: combo-table < table spawner ;
|
||||
|
||||
M: combo-table handle-gesture [ call-next-method ] 2keep swap
|
||||
M: combo-table handle-gesture [ call-next-method drop ] 2keep swap
|
||||
T{ button-up } = [
|
||||
[ spawner>> ]
|
||||
[ selected-value>> value>> [ swap set-control-value ] [ drop ] if* ]
|
||||
[ hide-glass ] tri drop t
|
||||
] [ drop ] if ;
|
||||
[ tbl:selected-row [ swap set-control-value ] [ 2drop ] if ]
|
||||
[ hide-glass ] tri
|
||||
] [ drop ] if t ;
|
||||
|
||||
TUPLE: combobox < label-control table ;
|
||||
combobox H{
|
||||
{ T{ button-down } [ dup table>> over >>spawner <zero-rect> show-glass ] }
|
||||
} set-gestures
|
||||
|
||||
: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <model> >>model ] keep
|
||||
[ 1array ] map <model> trivial-renderer combo-table new-table
|
||||
>>table ;
|
||||
: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <basic> >>model ] keep
|
||||
<basic> combo-table new-table [ 1array ] >>quot >>table ;
|
|
@ -0,0 +1,71 @@
|
|||
USING: accessors help.markup help.syntax ui.gadgets.buttons
|
||||
ui.gadgets.editors models ui.gadgets ;
|
||||
IN: ui.gadgets.controls
|
||||
|
||||
HELP: <model-btn>
|
||||
{ $values { "gadget" "the button's label" } { "button" button } }
|
||||
{ $description "Creates an button whose signal updates on clicks. " } ;
|
||||
|
||||
HELP: <model-border-btn>
|
||||
{ $values { "text" "the button's label" } { "button" button } }
|
||||
{ $description "Creates an button whose signal updates on clicks. " } ;
|
||||
|
||||
HELP: <table>
|
||||
{ $values { "model" "values the table is to display" } { "table" table } }
|
||||
{ $description "Creates an " { $link table } } ;
|
||||
|
||||
HELP: <table*>
|
||||
{ $values { "table" table } }
|
||||
{ $description "Creates an " { $link table } " with no initial values to display" } ;
|
||||
|
||||
HELP: <list>
|
||||
{ $values { "column-model" "values the table is to display" } { "table" table } }
|
||||
{ $description "Creates an " { $link table } " with a val-quot that renders each element as its own row" } ;
|
||||
|
||||
HELP: <list*>
|
||||
{ $values { "table" table } }
|
||||
{ $description "Creates an model-list with no initial values to display" } ;
|
||||
|
||||
HELP: indexed
|
||||
{ $values { "table" table } }
|
||||
{ $description "Sets the output model of an table to the selected-index, rather than the selected-value" } ;
|
||||
|
||||
HELP: <model-field>
|
||||
{ $values { "model" model } { "gadget" model-field } }
|
||||
{ $description "Creates a field with an initial value" } ;
|
||||
|
||||
HELP: <model-field*>
|
||||
{ $values { "field" model-field } }
|
||||
{ $description "Creates a field with an empty initial value" } ;
|
||||
|
||||
HELP: <empty-field>
|
||||
{ $values { "model" model } { "field" model-field } }
|
||||
{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
|
||||
|
||||
HELP: <model-editor>
|
||||
{ $values { "model" model } { "gadget" model-field } }
|
||||
{ $description "Creates an editor with an initial value" } ;
|
||||
|
||||
HELP: <model-editor*>
|
||||
{ $values { "editor" "an editor" } }
|
||||
{ $description "Creates a editor with an empty initial value" } ;
|
||||
|
||||
HELP: <empty-editor>
|
||||
{ $values { "model" model } { "editor" "an editor" } }
|
||||
{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
|
||||
|
||||
HELP: <model-action-field>
|
||||
{ $values { "field" action-field } }
|
||||
{ $description "Field that updates its model with its contents when the user hits the return key" } ;
|
||||
|
||||
HELP: IMG-MODEL-BTN:
|
||||
{ $syntax "IMAGE-MODEL-BTN: filename" }
|
||||
{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path" } ;
|
||||
|
||||
HELP: IMG-BTN:
|
||||
{ $syntax "[ do-something ] IMAGE-BTN: filename" }
|
||||
{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path, calling the specified quotation on click" } ;
|
||||
|
||||
HELP: output-model
|
||||
{ $values { "gadget" gadget } { "model" model } }
|
||||
{ $description "Returns the model a gadget uses for output. Often the same as " { $link model>> } } ;
|
|
@ -0,0 +1,83 @@
|
|||
USING: accessors assocs arrays kernel models monads sequences
|
||||
models.combinators ui.gadgets ui.gadgets.borders ui.gadgets.buttons
|
||||
ui.gadgets.buttons.private ui.gadgets.editors words images.loader
|
||||
ui.gadgets.scrollers ui.images vocabs.parser lexer
|
||||
models.range ui.gadgets.sliders ;
|
||||
QUALIFIED-WITH: ui.gadgets.sliders slider
|
||||
QUALIFIED-WITH: ui.gadgets.tables tbl
|
||||
EXCLUDE: ui.gadgets.editors => model-field ;
|
||||
IN: ui.gadgets.controls
|
||||
|
||||
TUPLE: model-btn < button hook value ;
|
||||
: <model-btn> ( gadget -- button ) [
|
||||
[ dup hook>> [ call( button -- ) ] [ drop ] if* ]
|
||||
[ [ [ value>> ] [ ] bi or ] keep set-control-value ]
|
||||
[ model>> f swap (>>value) ] tri
|
||||
] model-btn new-button f <basic> >>model ;
|
||||
: <model-border-btn> ( text -- button ) <model-btn> border-button-theme ;
|
||||
|
||||
TUPLE: table < tbl:table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
|
||||
M: table tbl:column-titles column-titles>> ;
|
||||
M: table tbl:column-alignment column-alignment>> ;
|
||||
M: table tbl:row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
||||
M: table tbl:row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
||||
M: table tbl:row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
||||
|
||||
: new-table ( model class -- table ) f swap tbl:new-table dup >>renderer
|
||||
f <basic> >>actions dup actions>> [ set-model ] curry >>action ;
|
||||
: <table> ( model -- table ) table new-table ;
|
||||
: <table*> ( -- table ) V{ } clone <model> <table> ;
|
||||
: <list> ( column-model -- table ) <table> [ 1array ] >>quot ;
|
||||
: <list*> ( -- table ) V{ } clone <model> <list> ;
|
||||
: indexed ( table -- table ) f >>val-quot ;
|
||||
|
||||
TUPLE: model-field < field model* ;
|
||||
: init-field ( model -- model' ) [ [ ] [ "" ] if* ] change-value ;
|
||||
: <model-field> ( model -- gadget ) model-field new-field swap init-field >>model* ;
|
||||
M: model-field graft*
|
||||
[ [ model*>> value>> ] [ editor>> ] bi set-editor-string ]
|
||||
[ dup editor>> model>> add-connection ]
|
||||
[ dup model*>> add-connection ] tri ;
|
||||
M: model-field ungraft*
|
||||
[ dup editor>> model>> remove-connection ]
|
||||
[ dup model*>> remove-connection ] bi ;
|
||||
M: model-field model-changed 2dup model*>> =
|
||||
[ [ value>> ] [ editor>> ] bi* set-editor-string ]
|
||||
[ nip [ editor>> editor-string ] [ model*>> ] bi set-model ] if ;
|
||||
|
||||
: (new-field) ( editor field -- gadget ) [ new-editor ] dip new-border dup gadget-child >>editor
|
||||
field-theme { 1 0 } >>align ; inline
|
||||
: <model-field*> ( -- field ) "" <model> <model-field> ;
|
||||
: <empty-field> ( model -- field ) "" <model> switch-models <model-field> ;
|
||||
: <model-editor> ( model -- gadget ) multiline-editor model-field (new-field) swap init-field >>model* ;
|
||||
: <model-editor*> ( -- editor ) "" <model> <model-editor> ;
|
||||
: <empty-editor> ( model -- editor ) "" <model> switch-models <model-editor> ;
|
||||
|
||||
: <model-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
|
||||
f <model> >>model ;
|
||||
|
||||
: <slider> ( init page min max step -- slider ) <range> horizontal slider:<slider> ;
|
||||
|
||||
: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
|
||||
SYNTAX: IMG-MODEL-BTN: image-prep [ <model-btn> ] curry over push-all ;
|
||||
|
||||
SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
|
||||
|
||||
GENERIC: output-model ( gadget -- model )
|
||||
M: gadget output-model model>> ;
|
||||
M: table output-model dup val-quot>> [ selection>> ] [ selection-index>> ] if ;
|
||||
M: model-field output-model model*>> ;
|
||||
M: scroller output-model viewport>> children>> first output-model ;
|
||||
M: slider output-model model>> range-model ;
|
||||
|
||||
IN: accessors
|
||||
M: model-btn text>> children>> first text>> ;
|
||||
|
||||
IN: ui.gadgets.controls
|
||||
|
||||
SINGLETON: gadget-monad
|
||||
INSTANCE: gadget-monad monad
|
||||
INSTANCE: gadget monad
|
||||
M: gadget monad-of drop gadget-monad ;
|
||||
M: gadget-monad return drop <gadget> swap >>model ;
|
||||
M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
|
|
@ -0,0 +1 @@
|
|||
Gadgets with expanded model usage
|
|
@ -0,0 +1,53 @@
|
|||
USING: help.markup help.syntax models ui.gadgets.tracks ;
|
||||
IN: ui.gadgets.layout
|
||||
|
||||
HELP: ,
|
||||
{ $values { "item" "a gadget or model" } }
|
||||
{ $description "Used in a series of gadgets created by a box, accumulating the gadget" } ;
|
||||
|
||||
HELP: ,%
|
||||
{ $syntax "gadget ,% width" }
|
||||
{ $description "Like ',' but stretches the gadget to always fill a percent of the parent" } ;
|
||||
|
||||
HELP: ->
|
||||
{ $values { "uiitem" "a gadget or model" } { "model" model } }
|
||||
{ $description "Like ',' but passes its model on for further use." } ;
|
||||
|
||||
HELP: ->%
|
||||
{ $syntax "gadget ,% width" }
|
||||
{ $description "Like '->' but stretches the gadget to always fill a percent of the parent" } ;
|
||||
|
||||
HELP: <spacer>
|
||||
{ $description "Grows to fill any empty space in a box" } ;
|
||||
|
||||
HELP: <hbox>
|
||||
{ $values { "gadgets" "a list of gadgets" } { "track" track } }
|
||||
{ $syntax "[ gadget , gadget , ... ] <hbox>" }
|
||||
{ $description "Creates an horizontal track containing the gadgets listed in the quotation" } ;
|
||||
|
||||
HELP: <vbox>
|
||||
{ $values { "gadgets" "a list of gadgets" } { "track" track } }
|
||||
{ $syntax "[ gadget , gadget , ... ] <hbox>" }
|
||||
{ $description "Creates an vertical track containing the gadgets listed in the quotation" } ;
|
||||
|
||||
HELP: $
|
||||
{ $syntax "$ PLACEHOLDER-NAME $" }
|
||||
{ $description "Defines an insertion point in a template named PLACEHOLDER-NAME which can be used by calling its name" } ;
|
||||
|
||||
HELP: with-interface
|
||||
{ $values { "quot" "quotation that builds a template and inserts into it" } }
|
||||
{ $description "Create templates, used with " { $link POSTPONE: $ } } ;
|
||||
|
||||
ARTICLE: "ui.gadgets.layout" "GUI Layout"
|
||||
"Laying out GUIs works the same way as building lists with " { $vocab-link "make" }
|
||||
". Gadgets are layed out using " { $vocab-link "ui.gadgets.tracks" } " through " { $link <hbox> } " and " { $link <vbox> } ", which allow both fixed and percentage widths. "
|
||||
{ $link , } " and " { $link -> } " add a model or gadget to the gadget you're building. "
|
||||
"Also, books can be made with " { $link <book> } ". "
|
||||
{ $link <spacer> } "s add flexable space between items. " $nl
|
||||
"Using " { $link with-interface } ", one can pre-build templates to add items to later: "
|
||||
"Like in the StringTemplate framework for java, placeholders are defined using $ PLACERHOLDER-NAME $ "
|
||||
"Using PLACEHOLDER-NAME again sets it as the current insertion point. "
|
||||
"For examples using normal layout, see the " { $vocab-link "sudokus" } " demo. "
|
||||
"For examples of templating, see the " { $vocab-link "recipes" } " demo. " ;
|
||||
|
||||
ABOUT: "ui.gadgets.layout"
|
|
@ -0,0 +1,89 @@
|
|||
USING: accessors assocs arrays fry kernel lexer make math.parser
|
||||
models monads namespaces parser sequences
|
||||
sequences.extras models.combinators ui.gadgets
|
||||
ui.gadgets.tracks words ui.gadgets.controls ;
|
||||
QUALIFIED: make
|
||||
QUALIFIED-WITH: ui.gadgets.books book
|
||||
IN: ui.gadgets.layout
|
||||
|
||||
SYMBOL: templates
|
||||
TUPLE: layout gadget size ; C: <layout> layout
|
||||
TUPLE: placeholder < gadget members ;
|
||||
: <placeholder> ( -- placeholder ) placeholder new V{ } clone >>members ;
|
||||
|
||||
: (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ]
|
||||
[ nip [ gadget? ] filter [ unparent ] each ] 2bi ;
|
||||
|
||||
: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep delete-all ] if-empty ;
|
||||
: add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ;
|
||||
|
||||
: , ( item -- ) make:, ;
|
||||
: make* ( quot -- list ) { } make ; inline
|
||||
|
||||
! Just take the previous mentioned placeholder and use it
|
||||
! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
|
||||
DEFER: with-interface
|
||||
: insertion-quot ( quot -- quot' ) make:building get [ [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
|
||||
templates get spin '[ [ _ templates set _ , @ ] with-interface ] ] when* ;
|
||||
|
||||
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
|
||||
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
|
||||
|
||||
GENERIC: -> ( uiitem -- model )
|
||||
M: gadget -> dup , output-model ;
|
||||
M: model -> dup , ;
|
||||
|
||||
: <spacer> ( -- ) <gadget> 1 <layout> , ;
|
||||
|
||||
: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ;
|
||||
: layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
|
||||
[ [ dup layout? [ f <layout> ] unless ] map ]
|
||||
[ [ dup gadget? [ gadget>> ] unless ] map ] if ;
|
||||
: make-layout ( building sized? -- models layouts ) [ swap layouts ] curry
|
||||
[ make* [ [ model? ] filter ] ] dip bi ; inline
|
||||
: <box> ( gadgets type -- track )
|
||||
[ t make-layout ] dip <track>
|
||||
swap [ add-layout ] each
|
||||
swap [ <collection> >>model ] unless-empty ; inline
|
||||
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
|
||||
: <vbox> ( gadgets -- track ) vertical <box> ; inline
|
||||
|
||||
: make-book ( models gadgets model -- book ) book:<book> swap [ "No models in books" throw ] unless-empty ;
|
||||
: <book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
|
||||
: <book*> ( quot -- book ) f make-layout f make-book ; inline
|
||||
|
||||
ERROR: not-in-template word ;
|
||||
SYNTAX: $ CREATE-WORD dup
|
||||
[ [ dup templates get at [ nip , ] [ not-in-template ] if* ] curry (( -- )) define-declared "$" expect ]
|
||||
[ [ <placeholder> [ swap templates get set-at ] keep , ] curry ] bi over push-all ;
|
||||
|
||||
: insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ;
|
||||
: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
|
||||
: insertion-point ( placeholder -- number parent ) dup parent>> [ children>> index ] keep ;
|
||||
|
||||
GENERIC: >layout ( gadget -- layout )
|
||||
M: gadget >layout f <layout> ;
|
||||
M: layout >layout ;
|
||||
|
||||
GENERIC# (add-gadget-at) 2 ( parent item n -- )
|
||||
M: gadget (add-gadget-at) -rot [ add-gadget ] keep insert-gadget ;
|
||||
M: track (add-gadget-at) -rot >layout [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
|
||||
|
||||
GENERIC# add-gadget-at 1 ( item location -- )
|
||||
M: object add-gadget-at insertion-point -rot (add-gadget-at) ;
|
||||
M: model add-gadget-at parent>> dup book:book? [ "No models in books" throw ]
|
||||
[ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
|
||||
: track-add-at ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;
|
||||
: (track-add-at) ( parent item n size -- ) swap [ <layout> ] dip (add-gadget-at) ;
|
||||
|
||||
: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
|
||||
[ add-member ] 2keep add-gadget-at ;
|
||||
|
||||
: insert-items ( makelist -- ) t swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
|
||||
|
||||
: with-interface ( quot -- ) [ make* ] curry H{ } clone templates rot with-variable [ insert-items ] with-scope ; inline
|
||||
|
||||
M: model >>= [ swap insertion-quot <action> ] curry ;
|
||||
M: model fmap insertion-quot <mapped> ;
|
||||
M: model $> insertion-quot side-effect-model new-mapped-model ;
|
||||
M: model <$ insertion-quot quot-model new-mapped-model ;
|
|
@ -0,0 +1 @@
|
|||
Syntax for easily building GUIs and using templates
|
|
@ -0,0 +1 @@
|
|||
Sam Anklesaria
|
|
@ -0,0 +1,50 @@
|
|||
! Copyright (C) 2009 Sam Anklesaria
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays accessors combinators kernel math
|
||||
models models.combinators namespaces sequences
|
||||
ui.gadgets ui.gadgets.controls ui.gadgets.layout
|
||||
ui.gadgets.tracks ui.gestures ui.gadgets.line-support ;
|
||||
EXCLUDE: ui.gadgets.editors => model-field ;
|
||||
IN: ui.gadgets.poppers
|
||||
|
||||
TUPLE: popped < model-field { fatal? initial: t } ;
|
||||
TUPLE: popped-editor < multiline-editor ;
|
||||
: <popped> ( text -- gadget ) <basic> init-field popped-editor popped (new-field) swap >>model* ;
|
||||
|
||||
: set-expansion ( popped size -- ) over dup parent>> [ children>> index ] [ sizes>> ] bi set-nth relayout ;
|
||||
: new-popped ( popped -- ) insertion-point "" <popped>
|
||||
[ rot 1 + f (track-add-at) ] keep [ relayout ] [ request-focus ] bi ;
|
||||
: focus-prev ( popped -- ) dup parent>> children>> length 1 =
|
||||
[ drop ] [
|
||||
insertion-point [ 1 - dup -1 = [ drop 1 ] when ] [ children>> ] bi* nth
|
||||
[ request-focus ] [ editor>> end-of-document ] bi
|
||||
] if ;
|
||||
: initial-popped ( popper -- ) "" <popped> [ f track-add drop ] keep request-focus ;
|
||||
|
||||
TUPLE: popper < track { unfocus-hook initial: [ drop ] } ;
|
||||
! list of strings is model (make shown objects implement sequence protocol)
|
||||
: <popper> ( model -- popper ) vertical popper new-track swap >>model ;
|
||||
|
||||
M: popped handle-gesture swap {
|
||||
{ gain-focus [ 1 set-expansion f ] }
|
||||
{ lose-focus [ dup parent>>
|
||||
[ [ unfocus-hook>> call( a -- ) ] curry [ f set-expansion ] bi ]
|
||||
[ drop ] if* f
|
||||
] }
|
||||
{ T{ key-up f f "RET" } [ dup editor>> delete-previous-character new-popped f ] }
|
||||
{ T{ key-up f f "BACKSPACE" } [ dup editor>> editor-string "" =
|
||||
[ dup fatal?>> [ [ focus-prev ] [ unparent ] bi ] [ t >>fatal? drop ] if ]
|
||||
[ f >>fatal? drop ] if f
|
||||
] }
|
||||
[ swap call-next-method ]
|
||||
} case ;
|
||||
|
||||
M: popper handle-gesture swap T{ button-down f f 1 } =
|
||||
[ hand-click# get 2 = [ initial-popped ] [ drop ] if ] [ drop ] if f ;
|
||||
|
||||
M: popper model-changed
|
||||
[ children>> [ unparent ] each ]
|
||||
[ [ value>> [ <popped> ] map ] dip [ f track-add ] reduce request-focus ] bi ;
|
||||
|
||||
M: popped pref-dim* editor>> [ pref-dim* first ] [ line-height ] bi 2array ;
|
||||
M: popper focusable-child* children>> [ t ] [ first ] if-empty ;
|
|
@ -0,0 +1,36 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
x = ENV["TM_FILEPATH"][/\/([^\/]+\.factor)/,1]
|
||||
y = x.sub("-tests","").sub("docs", "tests")
|
||||
if x == y then
|
||||
z = x.sub(".factor","")
|
||||
factor_eval(%Q(USING: tools.scaffold #{z} ;\n"#{z}" scaffold-help))
|
||||
y = x.sub(".factor", "-docs.factor")
|
||||
end
|
||||
exec "mate #{ENV["TM_FILEPATH"][/(.*\/)[^\/]+\.factor/,1] << y}"</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>none</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>^@`</string>
|
||||
<key>name</key>
|
||||
<string>Cycle Vocabs/Docs/Tests</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>D348BE40-6F51-4471-B300-DDDA70ED8C8C</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,32 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: editors\n "#{word}" edit-vocab))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>@V</string>
|
||||
<key>name</key>
|
||||
<string>Edit Vocab</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>0034EC1C-DAD1-498F-82FD-BEF7015F84EE</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,32 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USING: help.topics editors ;\n \\ #{word} >link edit))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>@D</string>
|
||||
<key>name</key>
|
||||
<string>Edit Word Docs</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>D95A617C-E1C6-44DA-9126-04171CB21299</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,32 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: editors\n \\ #{word} edit))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>@E</string>
|
||||
<key>name</key>
|
||||
<string>Edit Word</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>C573487C-DD7D-497F-A728-52D7962D95E2</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,29 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: ui.tools.operations\n [ #{ENV["TM_SELECTED_TEXT"} ] com-expand-macros))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>name</key>
|
||||
<string>Expand Selection</string>
|
||||
<key>output</key>
|
||||
<string>showAsTooltip</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>8465B33D-7CA0-4337-945C-4078346D64BC</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,32 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_run(%Q(#{doc_using_statements(doc)} USE: editors\n \\ #{word} fix))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>@F</string>
|
||||
<key>name</key>
|
||||
<string>Fix Word</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>D02D9D74-E073-48AE-A78E-B40FFFA519D5</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -11,7 +11,7 @@ require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
|||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
factor_run(%Q(#{doc_using_statements(doc)} USE: ui.tools.workspace\n \\ #{word} help-window))</string>
|
||||
factor_run(%Q(#{doc_using_statements(doc)} USE: help\n \\ #{word} help))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
|
|
|
@ -10,13 +10,15 @@
|
|||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: inference\n [ #{ENV["TM_SELECTED_TEXT"]} ] infer.))</string>
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: stack-checker\n [ #{ENV["TM_SELECTED_TEXT"]} ] infer.))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>^i</string>
|
||||
<key>name</key>
|
||||
<string>Infer Effect of Selection</string>
|
||||
<string>Infer Selection</string>
|
||||
<key>output</key>
|
||||
<string>showAsTooltip</string>
|
||||
<key>scope</key>
|
|
@ -0,0 +1,27 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: stack-checker\n [ #{ENV["TM_SELECTED_TEXT"]} ] infer.))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>name</key>
|
||||
<string>Insert Inferrence</string>
|
||||
<key>output</key>
|
||||
<string>afterSelectedText</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>DBC0A0CA-5368-43A7-864B-7B9C4034AD08</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,32 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_run(%Q(#{doc_using_statements(doc)} USE: tools.profiler\n [ #{word} ] profile))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>^p</string>
|
||||
<key>name</key>
|
||||
<string>Profile</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>7FF52332-CA5B-4D46-99EF-DAE0659DB478</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,26 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
doc = STDIN.read
|
||||
factor_run(%Q(USE: vocabs.loader\n "#{doc[/\bIN:\s(\S+)/, 1]}" reload))</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>^r</string>
|
||||
<key>name</key>
|
||||
<string>Reload in Listener</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>8088D204-FFD7-4384-8FDD-A01536FFD0E7</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,32 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.annotations\n \\ #{word} reset))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>^~r</string>
|
||||
<key>name</key>
|
||||
<string>Reset Word</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>71F08D9B-3D24-4E78-84C9-82CA736554D1</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -11,7 +11,7 @@ require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
|||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: prettyprint\n \\ #{word} see))</string>
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: see\n \\ #{word} see))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
|
|
|
@ -0,0 +1,32 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.annotations\n \\ #{word} breakpoint))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>^b</string>
|
||||
<key>name</key>
|
||||
<string>Set Breakpoint</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>E4614756-DF2E-433A-8935-197159C67AB8</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,29 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
factor_run(%Q(USING: namespaces parser ;
|
||||
auto-use? t set "#{ENV["TM_FILEPATH"]}" run-file auto-use? f set))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>none</string>
|
||||
<key>keyEquivalent</key>
|
||||
<string>^u</string>
|
||||
<key>name</key>
|
||||
<string>Show Using</string>
|
||||
<key>output</key>
|
||||
<string>discard</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>93AF1721-C14D-428A-B5A0-34CEFAA3B3C5</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,30 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
doc = STDIN.read
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_eval(%Q(#{doc_using_statements(doc)} USE: tools.crossref\n \\ #{word} usage.))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>document</string>
|
||||
<key>name</key>
|
||||
<string>Usage</string>
|
||||
<key>output</key>
|
||||
<string>showAsTooltip</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>3043A033-A113-4283-BCBB-3DE2CCC8F63E</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,29 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_eval(%Q(USE: tools.crossref\n "#{word}" vocab-usage.))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>none</string>
|
||||
<key>name</key>
|
||||
<string>Vocab Usage</string>
|
||||
<key>output</key>
|
||||
<string>showAsTooltip</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>B1F81321-B760-474F-875D-78FB52752E1B</string>
|
||||
</dict>
|
||||
</plist>
|
|
@ -0,0 +1,29 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE plist PUBLIC "-//Apple//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
||||
<plist version="1.0">
|
||||
<dict>
|
||||
<key>beforeRunningCommand</key>
|
||||
<string>nop</string>
|
||||
<key>bundleUUID</key>
|
||||
<string>8061D2F3-B603-411D-AFFE-61784A07906D</string>
|
||||
<key>command</key>
|
||||
<string>#!/usr/bin/env ruby
|
||||
|
||||
require "#{ENV["TM_BUNDLE_SUPPORT"]}/lib/tm_factor"
|
||||
|
||||
word = line_current_word(ENV["TM_CURRENT_LINE"], ENV["TM_LINE_INDEX"].to_i)
|
||||
puts factor_eval(%Q(USE: tools.crossref\n "#{word}" vocab-uses.))</string>
|
||||
<key>fallbackInput</key>
|
||||
<string>word</string>
|
||||
<key>input</key>
|
||||
<string>none</string>
|
||||
<key>name</key>
|
||||
<string>Vocab Uses</string>
|
||||
<key>output</key>
|
||||
<string>showAsTooltip</string>
|
||||
<key>scope</key>
|
||||
<string>source.factor</string>
|
||||
<key>uuid</key>
|
||||
<string>BC3E2E39-3B79-460C-B05E-BD00BAACB90E</string>
|
||||
</dict>
|
||||
</plist>
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue