Unicode.case supports lithuanian properly (hopefully)

diff --git a/basis/unicode/case/case-tests.factor b/basis/unicode/case/case-tests.factor
index 6e26a36a190d1c447a9079c27bd9428679eb1dc8..52a8d9755eb2ef7a99afbe90b0816e2f1c8a07be 100644 (file)
--- a/basis/unicode/case/case-tests.factor
+++ b/basis/unicode/case/case-tests.factor
@@ -1,4 +1,7 @@
-USING: unicode.case tools.test namespaces ;
+! Copyright (C) 2008, 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: unicode.case unicode.case.private tools.test namespaces strings unicode.normalize ;
+IN: unicode.case.tests
 
 \ >upper must-infer
 \ >lower must-infer
@@ -9,12 +12,21 @@ USING: unicode.case tools.test namespaces ;
 [ "\u0003C3a\u0003C2 \u0003C3\u0003C2 \u0003C3a\u0003C2" ] [ "\u0003A3A\u0003A3 \u0003A3\u0003A3 \u0003A3A\u0003A3" >lower ] unit-test
 [ t ] [ "hello how are you?" lower? ] unit-test
 [
+    [ f ] [ i-dot? ] unit-test
+    [ f ] [ lt? ] unit-test
     "tr" locale set
+    [ t ] [ i-dot? ] unit-test
+    [ f ] [ lt? ] unit-test
     [ "i\u000131i \u000131jj" ] [ "i\u000131I\u000307 IJj" >lower ] unit-test
     [ "I\u000307\u000131i Ijj" ] [ "i\u000131I\u000307 IJj" >title ] unit-test
     [ "I\u000307II\u000307 IJJ" ] [ "i\u000131I\u000307 IJj" >upper ] unit-test
     "lt" locale set
-    ! Lithuanian casing tests
+    [ f ] [ i-dot? ] unit-test
+    [ t ] [ lt? ] unit-test
+    [ "i\u000307\u000300" ] [ HEX: CC 1string nfd >lower ] unit-test
+    [ "\u00012f\u000307" ] [ HEX: 12E 1string nfd >lower nfc ] unit-test
+    [ "I\u000300" ] [ "i\u000307\u000300" >upper ] unit-test
+!    [ "I\u000300" ] [ "i\u000307\u000300" >title ] unit-test
 ] with-scope
 
 [ t ] [ "asdf" lower? ] unit-test

diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor
index 65fab0ac382c5d3671a455902788cb1c4bdd7a30..3ac98cd57f276d69aef87e25e4b774c8a4cc75a3 100644 (file)
--- a/basis/unicode/case/case.factor
+++ b/basis/unicode/case/case.factor
@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Daniel Ehrenberg.
+! Copyright (C) 2008, 2009 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: unicode.data sequences namespaces
 sbufs make unicode.syntax unicode.normalize math hints
-unicode.categories combinators unicode.syntax assocs
+unicode.categories combinators unicode.syntax assocs combinators.short-circuit
 strings splitting kernel accessors unicode.breaks fry locals ;
 QUALIFIED: ascii
 IN: unicode.case
@@ -26,6 +26,9 @@ SYMBOL: locale ! Just casing locale, or overall?
 : i-dot? ( -- ? )
     locale get { "tr" "az" } member? ;
 
+: lt? ( -- ? )
+    locale get "lt" = ;
+
 : lithuanian? ( -- ? ) locale get "lt" = ;
 
 : dot-over ( -- ch ) HEX: 307 ;
@@ -37,18 +40,21 @@ SYMBOL: locale ! Just casing locale, or overall?
 : mark-above? ( ch -- ? )
     combining-class 230 = ;
 
-: with-rest ( seq quot: ( seq -- seq ) -- seq )
-    [ unclip ] dip swap slip prefix ; inline
+:: with-rest ( seq quot: ( seq -- seq ) -- seq )
+    seq unclip quot dip prefix ; inline
 
 : add-dots ( seq -- seq )
-    [ [ "" ] [
-        dup first mark-above?
-        [ CHAR: combining-dot-above prefix ] when
+    [ [ { } ] [
+        [
+            dup first
+            { [ mark-above? ] [ CHAR: combining-ogonek = ] } 1||
+            [ CHAR: combining-dot-above prefix ] when
+        ] map
     ] if-empty ] with-rest ; inline
 
 : lithuanian>lower ( string -- lower )
-    "i" split add-dots "i" join
-    "j" split add-dots "i" join ; inline
+    "I" split add-dots "I" join
+    "J" split add-dots "J" join ; inline
 
 : turk>upper ( string -- upper-i )
     "i" "I\u000307" replace ; inline
@@ -88,13 +94,16 @@ SYMBOL: locale ! Just casing locale, or overall?
 PRIVATE>
 
 : >lower ( string -- lower )
-    i-dot? [ turk>lower ] when final-sigma
+    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 ;
@@ -103,6 +112,7 @@ HINTS: >upper string ;
 
 : (>title) ( string -- title )
     i-dot? [ turk>upper ] when
+    lt? [ lithuanian>upper ] when
     [ title>> ] [ ch>title ] map-case ; inline
 
 : title-word ( string -- title )