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

Merge branch 'master' of git://factorcode.org/git/factor into mongo-factor-driver

db4
Sascha Matzke 2009-05-01 14:46:32 +02:00
parent 3bfc30c793 31c2ede034
commit 3de9a8a1e5
7 changed files with 49 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/documents/elements/elements.factor
View File

@ -79,6 +79,13 @@ M: one-word-elt next-elt
drop
[ f next-word ] modify-col ;
SINGLETON: word-start-elt
M: word-start-elt prev-elt
drop one-word-elt prev-elt ;
M: word-start-elt next-elt 2drop ;
SINGLETON: word-elt
M: word-elt prev-elt

11
basis/tools/vocabs/vocabs.factor
View File

@ -74,8 +74,6 @@ SYMBOL: failures
SYMBOL: changed-vocabs
[ f changed-vocabs set-global ] "tools.vocabs" add-init-hook
: changed-vocab ( vocab -- )
dup vocab changed-vocabs get and
[ dup changed-vocabs get set-at ] [ drop ] if ;
@ -287,3 +285,12 @@ MEMO: all-authors ( -- seq )
\ all-vocabs-seq reset-memoized
\ all-authors reset-memoized
\ all-tags reset-memoized ;
SINGLETON: cache-observer
M: cache-observer vocabs-changed drop reset-cache ;
[
f changed-vocabs set-global
cache-observer add-vocab-observer
] "tools.vocabs" add-init-hook

6
basis/ui/gadgets/sliders/sliders.factor
View File

@ -53,8 +53,8 @@ CONSTANT: min-thumb-dim 30
[ slider-max* 1 max ]
bi / ;
: slider>screen ( m slider -- n ) slider-scale * elevator-padding + ;
: screen>slider ( m slider -- n ) [ elevator-padding - ] dip slider-scale / ;
: slider>screen ( m slider -- n ) slider-scale * ;
: screen>slider ( m slider -- n ) slider-scale / ;
M: slider model-changed nip elevator>> relayout-1 ;
@ -133,7 +133,7 @@ elevator H{
swap >>orientation ;
: thumb-loc ( slider -- loc )
[ slider-value ] keep slider>screen ;
[ slider-value ] keep slider>screen elevator-padding + ;
: layout-thumb-loc ( thumb slider -- )
[ thumb-loc ] [ orientation>> ] bi n*v

6
basis/ui/gestures/gestures.factor
View File

@ -310,16 +310,16 @@ HOOK: keysym>string os ( keysym -- string )
M: macosx keysym>string >upper ;
M: object keysym>string ;
M: object keysym>string dup length 1 = [ >lower ] when ;
M: key-down gesture>string
[ mods>> ] [ sym>> ] bi
{
{ [ dup { [ length 1 = ] [ first LETTER? ] } 1&& ] [ [ S+ prefix ] dip ] }
{ [ dup " " = ] [ drop "SPACE" ] }
[ keysym>string ]
[ ]
} cond
[ modifiers>string ] dip append ;
[ modifiers>string ] [ keysym>string ] bi* append ;
M: button-up gesture>string
[

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

@ -25,7 +25,10 @@ M: browser-gadget set-history-value
: show-help ( link browser-gadget -- )
[ >link ] dip
[ [ add-recent ] [ history>> add-history ] bi* ]
[
2dup model>> value>> =
[ 2drop ] [ [ add-recent ] [ history>> add-history ] bi* ] if
]
[ model>> set-model ]
2bi ;

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

@ -39,7 +39,7 @@ M: history-completion completion-quot drop '[ drop _ history-list ] ;
GENERIC: completion-element ( completion-mode -- element )
M: object completion-element drop one-word-elt ;
M: object completion-element drop word-start-elt ;
M: history-completion completion-element drop one-line-elt ;
GENERIC: completion-banner ( completion-mode -- string )
@ -72,13 +72,13 @@ M: vocab-completion row-color
drop vocab? COLOR: black COLOR: dark-gray ? ;
: complete-IN:/USE:? ( tokens -- ? )
2 short tail* { "IN:" "USE:" } intersects? ;
1 short head* 2 short tail* { "IN:" "USE:" } intersects? ;
: chop-; ( seq -- seq' )
{ ";" } split1-last [ ] [ ] ?if ;
: complete-USING:? ( tokens -- ? )
chop-; { "USING:" } intersects? ;
chop-; 1 short head* { "USING:" } intersects? ;
: complete-CHAR:? ( tokens -- ? )
2 short tail* "CHAR:" swap member? ;

23
core/vocabs/vocabs.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs strings kernel sorting namespaces
sequences definitions ;
sequences definitions init ;
IN: vocabs
SYMBOL: dictionary
@ -65,8 +65,24 @@ M: object vocab-main vocab vocab-main ;
M: f vocab-main ;
SYMBOL: vocab-observers
GENERIC: vocabs-changed ( obj -- )
[ V{ } clone vocab-observers set-global ] "vocabs" add-init-hook
: add-vocab-observer ( obj -- )
vocab-observers get push ;
: remove-vocab-observer ( obj -- )
vocab-observers get delq ;
: notify-vocab-observers ( -- )
vocab-observers get [ vocabs-changed ] each ;
: create-vocab ( name -- vocab )
dictionary get [ <vocab> ] cache ;
dictionary get [ <vocab> ] cache
notify-vocab-observers ;
ERROR: no-vocab name ;
@ -99,7 +115,8 @@ M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
: forget-vocab ( vocab -- )
dup words forget-all
vocab-name dictionary get delete-at ;
vocab-name dictionary get delete-at
notify-vocab-observers ;
M: vocab-spec forget* forget-vocab ;