Case conversion title case fixed

db4
Daniel Ehrenberg 2009-01-07 23:54:19 -06:00
parent 8b351b1ad6
commit 1aa0684d45
5 changed files with 31 additions and 29 deletions

View File

@ -3,7 +3,7 @@
USING: combinators.short-circuit unicode.categories kernel math USING: combinators.short-circuit unicode.categories kernel math
combinators splitting sequences math.parser io.files io assocs combinators splitting sequences math.parser io.files io assocs
arrays namespaces make math.ranges unicode.normalize.private values arrays namespaces make math.ranges unicode.normalize.private values
io.encodings.ascii unicode.syntax unicode.data compiler.units io.encodings.ascii unicode.syntax unicode.data compiler.units fry
alien.syntax sets accessors interval-maps memoize locals words ; alien.syntax sets accessors interval-maps memoize locals words ;
IN: unicode.breaks IN: unicode.breaks
@ -111,14 +111,9 @@ PRIVATE>
<PRIVATE <PRIVATE
:: (>pieces) ( str quot -- ) : >pieces ( str quot: ( str -- i ) -- graphemes )
str [ [ dup empty? not ] swap '[ dup @ cut-slice swap ]
dup quot call cut-slice [ ] produce nip ; inline
swap , quot (>pieces)
] unless-empty ; inline recursive
: >pieces ( str quot -- graphemes )
[ (>pieces) ] { } make ; inline
PRIVATE> PRIVATE>

View File

@ -4,7 +4,7 @@ USING: unicode.case tools.test namespaces ;
\ >lower must-infer \ >lower must-infer
\ >title must-infer \ >title must-infer
[ "Hello How Are You? I'M Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test [ "Hello How Are You? I'm Good" ] [ "hEllo how ARE yOU? I'm good" >title ] unit-test
[ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test [ "FUSS" ] [ "Fu\u0000DF" >upper ] unit-test
[ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test [ "\u0003C3\u0003C2" ] [ "\u0003A3\u0003A3" >lower ] unit-test
[ t ] [ "hello how are you?" lower? ] unit-test [ t ] [ "hello how are you?" lower? ] unit-test

View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: unicode.data sequences sequences.next namespaces make USING: unicode.data sequences sequences.next namespaces make
unicode.normalize math unicode.categories combinators unicode.normalize math unicode.categories combinators
assocs strings splitting kernel accessors ; assocs strings splitting kernel accessors unicode.breaks ;
IN: unicode.case IN: unicode.case
<PRIVATE <PRIVATE
@ -82,23 +82,30 @@ SYMBOL: locale ! Just casing locale, or overall?
[ [ % ] compose ] [ [ , ] compose ] bi* ?if [ [ % ] compose ] [ [ , ] compose ] bi* ?if
] 2curry each ] 2curry each
] "" make ; inline ] "" make ; inline
PRIVATE>
: >lower ( string -- lower )
i-dot? [ turk>lower ] when
final-sigma [ lower>> ] [ ch>lower ] map-case ;
: >upper ( string -- upper ) : (>lower) ( string -- lower )
i-dot? [ turk>upper ] when [ lower>> ] [ ch>lower ] map-case ;
: (>title) ( string -- title )
[ title>> ] [ ch>title ] map-case ;
: (>upper) ( string -- upper )
[ upper>> ] [ ch>upper ] map-case ; [ upper>> ] [ ch>upper ] map-case ;
: title-word ( string -- title )
unclip 1string [ (>lower) ] [ (>title) ] bi* prepend ;
PRIVATE>
: >lower ( string -- lower )
i-dot? [ turk>lower ] when
final-sigma (>lower) ;
: >upper ( string -- upper )
i-dot? [ turk>upper ] when (>upper) ;
: >title ( string -- title ) : >title ( string -- title )
final-sigma final-sigma >words [ title-word ] map concat ;
CHAR: \s swap
[ tuck word-boundary swapd
[ title>> ] [ lower>> ] if ]
[ tuck word-boundary swapd
[ ch>title ] [ ch>lower ] if ]
map-case nip ;
: >case-fold ( string -- fold ) : >case-fold ( string -- fold )
>upper >lower ; >upper >lower ;

View File

@ -1,6 +1,6 @@
USING: io io.files splitting grouping unicode.collation USING: io io.files splitting grouping unicode.collation
sequences kernel io.encodings.utf8 math.parser math.order sequences kernel io.encodings.utf8 math.parser math.order
tools.test assocs io.streams.null words ; tools.test assocs words ;
IN: unicode.collation.tests IN: unicode.collation.tests
: parse-test ( -- strings ) : parse-test ( -- strings )
@ -25,4 +25,4 @@ IN: unicode.collation.tests
unit-test unit-test
parse-test 2 <clumps> parse-test 2 <clumps>
[ [ test-two ] assoc-each ] with-null-writer [ test-two ] assoc-each

View File

@ -155,7 +155,7 @@ DEFER: compose-iter
] if (compose) ] if (compose)
] when* ; ] when* ;
: compose ( str -- comp ) : combine ( str -- comp )
[ [
main-str set main-str set
0 ind set 0 ind set
@ -166,7 +166,7 @@ DEFER: compose-iter
PRIVATE> PRIVATE>
: nfc ( string -- nfc ) : nfc ( string -- nfc )
nfd compose ; nfd combine ;
: nfkc ( string -- nfkc ) : nfkc ( string -- nfkc )
nfkd compose ; nfkd combine ;