Merge branch 'master' of git://factorcode.org/git/factor into mongo-factor-driver
commit
3de9a8a1e5
|
@ -79,6 +79,13 @@ M: one-word-elt next-elt
|
||||||
drop
|
drop
|
||||||
[ f next-word ] modify-col ;
|
[ 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
|
SINGLETON: word-elt
|
||||||
|
|
||||||
M: word-elt prev-elt
|
M: word-elt prev-elt
|
||||||
|
|
|
@ -74,8 +74,6 @@ SYMBOL: failures
|
||||||
|
|
||||||
SYMBOL: changed-vocabs
|
SYMBOL: changed-vocabs
|
||||||
|
|
||||||
[ f changed-vocabs set-global ] "tools.vocabs" add-init-hook
|
|
||||||
|
|
||||||
: changed-vocab ( vocab -- )
|
: changed-vocab ( vocab -- )
|
||||||
dup vocab changed-vocabs get and
|
dup vocab changed-vocabs get and
|
||||||
[ dup changed-vocabs get set-at ] [ drop ] if ;
|
[ dup changed-vocabs get set-at ] [ drop ] if ;
|
||||||
|
@ -287,3 +285,12 @@ MEMO: all-authors ( -- seq )
|
||||||
\ all-vocabs-seq reset-memoized
|
\ all-vocabs-seq reset-memoized
|
||||||
\ all-authors reset-memoized
|
\ all-authors reset-memoized
|
||||||
\ all-tags 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
|
|
@ -53,8 +53,8 @@ CONSTANT: min-thumb-dim 30
|
||||||
[ slider-max* 1 max ]
|
[ slider-max* 1 max ]
|
||||||
bi / ;
|
bi / ;
|
||||||
|
|
||||||
: slider>screen ( m slider -- n ) slider-scale * elevator-padding + ;
|
: slider>screen ( m slider -- n ) slider-scale * ;
|
||||||
: screen>slider ( m slider -- n ) [ elevator-padding - ] dip slider-scale / ;
|
: screen>slider ( m slider -- n ) slider-scale / ;
|
||||||
|
|
||||||
M: slider model-changed nip elevator>> relayout-1 ;
|
M: slider model-changed nip elevator>> relayout-1 ;
|
||||||
|
|
||||||
|
@ -133,7 +133,7 @@ elevator H{
|
||||||
swap >>orientation ;
|
swap >>orientation ;
|
||||||
|
|
||||||
: thumb-loc ( slider -- loc )
|
: thumb-loc ( slider -- loc )
|
||||||
[ slider-value ] keep slider>screen ;
|
[ slider-value ] keep slider>screen elevator-padding + ;
|
||||||
|
|
||||||
: layout-thumb-loc ( thumb slider -- )
|
: layout-thumb-loc ( thumb slider -- )
|
||||||
[ thumb-loc ] [ orientation>> ] bi n*v
|
[ thumb-loc ] [ orientation>> ] bi n*v
|
||||||
|
|
|
@ -310,16 +310,16 @@ HOOK: keysym>string os ( keysym -- string )
|
||||||
|
|
||||||
M: macosx keysym>string >upper ;
|
M: macosx keysym>string >upper ;
|
||||||
|
|
||||||
M: object keysym>string ;
|
M: object keysym>string dup length 1 = [ >lower ] when ;
|
||||||
|
|
||||||
M: key-down gesture>string
|
M: key-down gesture>string
|
||||||
[ mods>> ] [ sym>> ] bi
|
[ mods>> ] [ sym>> ] bi
|
||||||
{
|
{
|
||||||
{ [ dup { [ length 1 = ] [ first LETTER? ] } 1&& ] [ [ S+ prefix ] dip ] }
|
{ [ dup { [ length 1 = ] [ first LETTER? ] } 1&& ] [ [ S+ prefix ] dip ] }
|
||||||
{ [ dup " " = ] [ drop "SPACE" ] }
|
{ [ dup " " = ] [ drop "SPACE" ] }
|
||||||
[ keysym>string ]
|
[ ]
|
||||||
} cond
|
} cond
|
||||||
[ modifiers>string ] dip append ;
|
[ modifiers>string ] [ keysym>string ] bi* append ;
|
||||||
|
|
||||||
M: button-up gesture>string
|
M: button-up gesture>string
|
||||||
[
|
[
|
||||||
|
|
|
@ -25,7 +25,10 @@ M: browser-gadget set-history-value
|
||||||
|
|
||||||
: show-help ( link browser-gadget -- )
|
: show-help ( link browser-gadget -- )
|
||||||
[ >link ] dip
|
[ >link ] dip
|
||||||
[ [ add-recent ] [ history>> add-history ] bi* ]
|
[
|
||||||
|
2dup model>> value>> =
|
||||||
|
[ 2drop ] [ [ add-recent ] [ history>> add-history ] bi* ] if
|
||||||
|
]
|
||||||
[ model>> set-model ]
|
[ model>> set-model ]
|
||||||
2bi ;
|
2bi ;
|
||||||
|
|
||||||
|
|
|
@ -39,7 +39,7 @@ M: history-completion completion-quot drop '[ drop _ history-list ] ;
|
||||||
|
|
||||||
GENERIC: completion-element ( completion-mode -- element )
|
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 ;
|
M: history-completion completion-element drop one-line-elt ;
|
||||||
|
|
||||||
GENERIC: completion-banner ( completion-mode -- string )
|
GENERIC: completion-banner ( completion-mode -- string )
|
||||||
|
@ -72,13 +72,13 @@ M: vocab-completion row-color
|
||||||
drop vocab? COLOR: black COLOR: dark-gray ? ;
|
drop vocab? COLOR: black COLOR: dark-gray ? ;
|
||||||
|
|
||||||
: complete-IN:/USE:? ( tokens -- ? )
|
: complete-IN:/USE:? ( tokens -- ? )
|
||||||
2 short tail* { "IN:" "USE:" } intersects? ;
|
1 short head* 2 short tail* { "IN:" "USE:" } intersects? ;
|
||||||
|
|
||||||
: chop-; ( seq -- seq' )
|
: chop-; ( seq -- seq' )
|
||||||
{ ";" } split1-last [ ] [ ] ?if ;
|
{ ";" } split1-last [ ] [ ] ?if ;
|
||||||
|
|
||||||
: complete-USING:? ( tokens -- ? )
|
: complete-USING:? ( tokens -- ? )
|
||||||
chop-; { "USING:" } intersects? ;
|
chop-; 1 short head* { "USING:" } intersects? ;
|
||||||
|
|
||||||
: complete-CHAR:? ( tokens -- ? )
|
: complete-CHAR:? ( tokens -- ? )
|
||||||
2 short tail* "CHAR:" swap member? ;
|
2 short tail* "CHAR:" swap member? ;
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.
|
! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors assocs strings kernel sorting namespaces
|
USING: accessors assocs strings kernel sorting namespaces
|
||||||
sequences definitions ;
|
sequences definitions init ;
|
||||||
IN: vocabs
|
IN: vocabs
|
||||||
|
|
||||||
SYMBOL: dictionary
|
SYMBOL: dictionary
|
||||||
|
@ -65,8 +65,24 @@ M: object vocab-main vocab vocab-main ;
|
||||||
|
|
||||||
M: f 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 )
|
: create-vocab ( name -- vocab )
|
||||||
dictionary get [ <vocab> ] cache ;
|
dictionary get [ <vocab> ] cache
|
||||||
|
notify-vocab-observers ;
|
||||||
|
|
||||||
ERROR: no-vocab name ;
|
ERROR: no-vocab name ;
|
||||||
|
|
||||||
|
@ -99,7 +115,8 @@ M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
|
||||||
|
|
||||||
: forget-vocab ( vocab -- )
|
: forget-vocab ( vocab -- )
|
||||||
dup words forget-all
|
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 ;
|
M: vocab-spec forget* forget-vocab ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue