! Copyright (C) 2008, 2009 Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: unicode.data sequences namespaces
-sbufs make unicode.normalize math hints
-unicode.categories combinators assocs combinators.short-circuit
-strings splitting kernel accessors unicode.breaks fry locals ;
+USING: combinators.short-circuit kernel namespaces sbufs
+sequences splitting unicode.categories unicode.data ;
QUALIFIED: ascii
IN: unicode.case
<PRIVATE
-: split-subseq ( string sep -- strings )
- [ dup ] swap '[ _ split1-slice swap ] produce nip ;
+: i-dot? ( locale -- ? )
+ { "tr" "az" } member? ; inline
-: replace ( old new str -- newstr )
- [ split-subseq ] dip join ; inline
-
-: i-dot? ( -- ? )
- locale get { "tr" "az" } member? ;
-
-: lt? ( -- ? )
- locale get "lt" = ;
-
-: lithuanian? ( -- ? ) locale get "lt" = ;
-
-: dot-over ( -- ch ) HEX: 307 ;
+: lithuanian? ( locale -- ? ) "lt" = ; inline
: lithuanian>upper ( string -- lower )
"i\u000307" "i" replace
: fix-sigma-end ( string -- string )
[ "" ] [
dup last CHAR: greek-small-letter-sigma =
- [ 1 head* CHAR: greek-small-letter-final-sigma suffix ] when
+ [ but-last CHAR: greek-small-letter-final-sigma suffix ] when
] if-empty ; inline
+! this duplicate unicode to prevent dependencies
+CATEGORY-NOT: (uncased) Lu Ll Lt Lm Mn Me ;
+
: sigma-map ( string -- string )
{ CHAR: greek-capital-letter-sigma } split [ [
[ { CHAR: greek-small-letter-sigma } ] [
- dup first uncased?
+ dup first (uncased)?
CHAR: greek-small-letter-final-sigma
CHAR: greek-small-letter-sigma ? prefix
] if-empty
[ char-quot call out push ] ?if
] each out "" like ; inline
-PRIVATE>
-
-: >lower ( string -- lower )
- i-dot? [ turk>lower ] when
- lt? [ lithuanian>lower ] when
- final-sigma
- [ lower>> ] [ ch>lower ] map-case ;
-
-HINTS: >lower string ;
-
-: >upper ( string -- upper )
- i-dot? [ turk>upper ] when
- lt? [ lithuanian>upper ] when
- [ upper>> ] [ ch>upper ] map-case ;
-
-HINTS: >upper string ;
+: locale>lower ( string -- string' )
+ locale get
+ [ i-dot? [ turk>lower ] when ]
+ [ lithuanian? [ lithuanian>lower ] when ] bi ;
-<PRIVATE
-
-: (>title) ( string -- title )
- i-dot? [ turk>upper ] when
- lt? [ lithuanian>upper ] when
- [ title>> ] [ ch>title ] map-case ; inline
+: locale>upper ( string -- string' )
+ locale get
+ [ i-dot? [ turk>upper ] when ]
+ [ lithuanian? [ lithuanian>upper ] when ] bi ;
PRIVATE>
-
-: capitalize ( string -- title )
- unclip 1string [ >lower ] [ (>title) ] bi* prepend ; inline
-
-: >title ( string -- title )
- final-sigma >words [ capitalize ] map concat ;
-
-HINTS: >title string ;
-
-: >case-fold ( string -- fold )
- >upper >lower ;
-
-: lower? ( string -- ? ) dup >lower = ;
-
-: upper? ( string -- ? ) dup >upper = ;
-
-: title? ( string -- ? ) dup >title = ;
-
-: case-fold? ( string -- ? ) dup >case-fold = ;